commit 77ca6aa56e3425c87861cab8abce52bee3697cf4 (HEAD, refs/remotes/origin/master) Author: Luke Lee Date: Sun Jan 15 12:26:02 2023 +0800 hideif.el: Support C99 and GNU style variadic macros * lisp/progmodes/hideif.el (hif-end-of-line, hif-cpp-prefix) (hif-ifx-regexp, hif-macro-expr-prefix-regexp, hif-white-regexp) (hif-macroref-regexp, hif-tokenize, hif-find-any-ifX) (hif-find-next-relevant, hif-find-previous-relevant, hif-find-range) (hif-parse-macro-arglist, hif-add-new-defines, hide-ifdef-guts): Variadic macro parsing, comments and multi-line parsing. (hif-line-concat, hif-etc-regexp): New regexp for better macro scans. (hif-expand-token-list, hif-get-argument-list, hif-delimit) (hif-macro-supply-arguments, hif-canonicalize, hif-find-define): Variadic macro argument replacement and expansion. (hif-display-macro): Display variadic macros. (hif-is-in-comment, hif-search-ifX-regexp): New functions to better handle macros in comments and comments in macros. diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 30893638f0d..4405ce0fe04 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -113,6 +113,7 @@ ;; Various floating point types and operations are also supported but the ;; actual precision is limited by the Emacs internal floating representation, ;; which is the C data type "double" or IEEE binary64 format. +;; C99 and GNU style variadic arguments support is completed in 2022/E. ;;; Code: @@ -392,8 +393,10 @@ hif-after-revert-function (add-hook 'after-revert-hook 'hif-after-revert-function) (defun hif-end-of-line () + "Find the end-point of line concatenation." (end-of-line) - (while (= (logand 1 (skip-chars-backward "\\\\")) 1) + (while (progn (skip-chars-backward " \t" (line-beginning-position)) + (= ?\\ (char-before))) (end-of-line 2))) (defun hif-merge-ifdef-region (start end) @@ -536,10 +539,10 @@ hif-defined ;;===%%SF%% parsing (Start) === ;;; The code that understands what ifs and ifdef in files look like. -(defconst hif-cpp-prefix "\\(^\\|\r\\)[ \t]*#[ \t]*") +(defconst hif-cpp-prefix "\\(^\\|\r\\)?[ \t]*#[ \t]*") (defconst hif-ifxdef-regexp (concat hif-cpp-prefix "if\\(n\\)?def")) (defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef")) -(defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\(n?def\\)?[ \t]+")) +(defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\((\\|\\(n?def\\)?[ \t]+\\)")) (defconst hif-elif-regexp (concat hif-cpp-prefix "elif")) (defconst hif-else-regexp (concat hif-cpp-prefix "else")) (defconst hif-endif-regexp (concat hif-cpp-prefix "endif")) @@ -547,18 +550,23 @@ hif-ifx-else-endif-regexp (concat hif-ifx-regexp "\\|" hif-elif-regexp "\\|" hif-else-regexp "\\|" hif-endif-regexp)) (defconst hif-macro-expr-prefix-regexp - (concat hif-cpp-prefix "\\(if\\(n?def\\)?\\|elif\\|define\\)[ \t]+")) + (concat hif-cpp-prefix "\\(if(\\|if\\(n?def\\)?[ \t]+\\|elif\\|define[ \t]+\\)")) -(defconst hif-white-regexp "[ \t]*") +(defconst hif-line-concat "\\\\[ \t]*[\n\r]") +;; If `hif-white-regexp' is modified, `hif-tokenize' might need to be modified +;; accordingly. +(defconst hif-white-regexp (concat "\\(?:\\(?:[ \t]\\|/\\*.*\\*/\\)*" + "\\(?:" hif-line-concat "\\)?\\)*")) (defconst hif-define-regexp (concat hif-cpp-prefix "\\(define\\|undef\\)")) (defconst hif-id-regexp (concat "[[:alpha:]_][[:alnum:]_]*")) +(defconst hif-etc-regexp "\\.\\.\\.") (defconst hif-macroref-regexp (concat hif-white-regexp "\\(" hif-id-regexp "\\)" "\\(" "(" hif-white-regexp "\\(" hif-id-regexp "\\)?" hif-white-regexp "\\(" "," hif-white-regexp hif-id-regexp hif-white-regexp "\\)*" - "\\(\\.\\.\\.\\)?" hif-white-regexp + "\\(" "," hif-white-regexp "\\)?" "\\(" hif-etc-regexp "\\)?" hif-white-regexp ")" "\\)?" )) @@ -936,7 +944,11 @@ hif-backward-comment (defun hif-tokenize (start end) "Separate string between START and END into a list of tokens." (let ((token-list nil) - (white-regexp "[ \t]+") + ;; Similar to `hif-white-regexp' but keep the spaces if there are + (white-regexp (concat "\\(?:" + "\\(?:\\([ \t]+\\)\\|\\(?:/\\*.*\\*/\\)?\\)*" + "\\(?:" hif-line-concat "\\)?" + "\\)*")) token) (setq hif-simple-token-only t) (with-syntax-table hide-ifdef-syntax-table @@ -956,29 +968,31 @@ hif-tokenize (forward-char 2)) ((looking-at hif-string-literal-regexp) - (setq token (substring-no-properties (match-string 1))) + (setq token (match-string-no-properties 1)) (goto-char (match-end 0)) (when (looking-at white-regexp) - (add-text-properties 0 1 '(hif-space t) token) + (if (not (zerop (length (match-string-no-properties 1)))) + (add-text-properties 0 1 '(hif-space t) token)) (goto-char (match-end 0))) (push token token-list)) ((looking-at hif-token-regexp) (goto-char (match-end 0)) - (setq token (hif-strtok - (substring-no-properties (match-string 0)))) + (setq token (hif-strtok (match-string-no-properties 0))) (push token token-list) (when (looking-at white-regexp) - ;; We can't just append a space to the token string, otherwise - ;; `0xf0 ' ## `01' will become `0xf0 01' instead of the expected - ;; `0xf001', hence a standalone `hif-space' is placed instead. - (push 'hif-space token-list) + (if (not (zerop (length (match-string-no-properties 1)))) + ;; We can't just append a space to the token string, + ;; otherwise `0xf0 ' ## `01' will become `0xf0 01' instead + ;; of the expected `0xf001', hence a standalone `hif-space' + ;; is placed instead. + (push 'hif-space token-list)) (goto-char (match-end 0)))) ((looking-at "\r") ; Sometimes MS-Windows user will leave CR in (forward-char 1)) ; the source code. Let's not get stuck here. - (t (error "Bad #if expression: %s" (buffer-string))))))) + (t (error "Bad preprocessor expression: %s" (buffer-string))))))) (if (eq 'hif-space (car token-list)) (setq token-list (cdr token-list))) ;; remove trailing white space (nreverse token-list)))) @@ -1126,7 +1140,7 @@ hif-expand-token-list (and (eq (car remains) 'hif-space) (eq (cadr remains) 'hif-lparen) (setq remains (cdr remains))))) - ;; No argument, no invocation + ;; No argument list, no invocation tok ;; Argumented macro, get arguments and invoke it. ;; Dynamically bind `hif-token-list' and `hif-token' @@ -1369,8 +1383,9 @@ hif-get-argument-list (parmlist nil) ; A "token" list of parameters, will later be parsed (parm nil)) - (while (or (not (eq (hif-nexttoken keep-space) 'hif-rparen)) - (/= nest 0)) + (while (and (or (not (eq (hif-nexttoken keep-space) 'hif-rparen)) + (/= nest 0)) + hif-token) (if (eq (car (last parm)) 'hif-comma) (setq parm nil)) (cond @@ -1384,6 +1399,8 @@ hif-get-argument-list (setq parm nil))) (push hif-token parm)) + (if (equal parm '(hif-comma)) ;; missing the last argument + (setq parm '(nil))) (push (nreverse parm) parmlist) ; Okay even if PARM is nil (hif-nexttoken keep-space) ; Drop the `hif-rparen', get next token (nreverse parmlist))) @@ -1609,11 +1626,21 @@ hif-token-concatenation ;; no need to reassemble the list if no `##' presents l)) -(defun hif-delimit (lis atom) - (nconc (mapcan (lambda (l) (list l atom)) +(defun hif-delimit (lis elem) + (nconc (mapcan (lambda (l) (list l elem)) (butlast lis)) (last lis))) +(defun hif-delete-nth (n lst) + "Non-destructively delete the nth item from a list." + (if (zerop n) + (cdr lst) + ;; non-destructive + (let* ((duplst (copy-sequence lst)) + (node (nthcdr (1- n) duplst))) + (setcdr node (cddr node)) + duplst))) + ;; Perform token replacement: (defun hif-macro-supply-arguments (macro-name actual-parms) "Expand a macro call, replace ACTUAL-PARMS in the macro body." @@ -1633,49 +1660,160 @@ hif-macro-supply-arguments ;; For each actual parameter, evaluate each one and associate it ;; with an actual parameter, put it into local table and finally ;; evaluate the macro body. - (if (setq etc (eq (car formal-parms) 'hif-etc)) + (if (setq etc (or (eq (car formal-parms) 'hif-etc) + (and (eq (car formal-parms) 'hif-etc-c99) 'c99))) ;; Take care of `hif-etc' first. Prefix `hif-comma' back if needed. (setq formal-parms (cdr formal-parms))) (setq formal-count (length formal-parms) actual-count (length actual-parms)) - (if (> formal-count actual-count) - (error "Too few parameters for macro %S" macro-name) - (if (< formal-count actual-count) - (or etc - (error "Too many parameters for macro %S" macro-name)))) + ;; Fix empty arguments applied + (if (and (= formal-count 1) + (null (car formal-parms))) + (setq formal-parms nil + formal-count (1- formal-count))) + (if (and (= actual-count 1) + (or (null (car actual-parms)) + ;; white space as the only argument + (equal '(hif-space) (car actual-parms)))) + (setq actual-parms nil + actual-count (1- actual-count))) + + ;; Basic error checking + (if etc + (if (eq etc 'c99) + (if (and (> formal-count 1) ; f(a,b,...) + (< actual-count formal-count)) + (error "C99 variadic argument macro %S need at least %d arguments" + macro-name formal-count)) + ;; GNU style variadic argument + (if (and (> formal-count 1) + (< actual-count (1- formal-count))) + (error "GNU variadic argument macro %S need at least %d arguments" + macro-name (1- formal-count)))) + (if (> formal-count actual-count) + (error "Too few parameters for macro %S; %d instead of %d" + macro-name actual-count formal-count) + (if (< formal-count actual-count) + (error "Too many parameters for macro %S; %d instead of %d" + macro-name actual-count formal-count)))) ;; Perform token replacement on the MACRO-BODY with the parameters - (while (setq formal (pop formal-parms)) - ;; Prevent repetitive substitution, thus cannot use `subst' - ;; for example: - ;; #define mac(a,b) (a+b) - ;; #define testmac mac(b,y) - ;; testmac should expand to (b+y): replace of argument a and b - ;; occurs simultaneously, not sequentially. If sequentially, - ;; according to the argument order, it will become: - ;; 1. formal parm #1 'a' replaced by actual parm 'b', thus (a+b) - ;; becomes (b+b) - ;; 2. formal parm #2 'b' replaced by actual parm 'y', thus (b+b) - ;; becomes (y+y). - (setq macro-body - ;; Unlike `subst', `substitute' replace only the top level - ;; instead of the whole tree; more importantly, it's not - ;; destructive. - (cl-substitute (if (and etc (null formal-parms)) - (hif-delimit actual-parms 'hif-comma) - (car actual-parms)) - formal macro-body)) - (setq actual-parms (cdr actual-parms))) - - ;; Replacement completed, stringifiy and concatenate the token list. - ;; Stringification happens must take place before flattening, otherwise - ;; only the first token will be stringified. - (setq macro-body - (flatten-tree (hif-token-stringification macro-body))) - - ;; Token concatenation happens here, keep single 'hif-space - (hif-keep-single (hif-token-concatenation macro-body) 'hif-space)))) + + ;; Every substituted argument in the macro-body must be in list form so + ;; that it won't again be substituted incorrectly in later iterations. + ;; Finally we will flatten the list to fix that. + (cl-loop + do + ;; Note that C99 '...' and GNU 'x...' allow empty match + (setq formal (pop formal-parms)) + ;; + ;; Prevent repetitive substitution, thus cannot use `subst' + ;; for example: + ;; #define mac(a,b) (a+b) + ;; #define testmac mac(b,y) + ;; testmac should expand to (b+y): replace of argument a and b + ;; occurs simultaneously, not sequentially. If sequentially, + ;; according to the argument order, it will become: + ;; 1. formal parm #1 'a' replaced by actual parm 'b', thus (a+b) + ;; becomes (b+b) + ;; 2. formal parm #2 'b' replaced by actual parm 'y', thus (b+b) + ;; becomes (y+y). + ;; Unlike `subst', `cl-substitute' replace only the top level + ;; instead of the whole tree; more importantly, it's not + ;; destructive. + ;; + (if (not (and (null formal-parms) etc)) + ;; One formal with one actual + (setq macro-body + (cl-substitute (car actual-parms) formal macro-body)) + ;; `formal-parms' used up, now take care of '...' + (cond + + ((eq etc 'c99) ; C99 __VA_ARGS__ style '...' + (when formal + (setq macro-body + (cl-substitute (car actual-parms) formal macro-body)) + ;; Now the whole __VA_ARGS__ represents the whole + ;; remaining actual params + (pop actual-parms)) + ;; Replace if __VA_ARGS__ presents: + ;; if yes, see if it's prefixed with ", ##" or not, + ;; if yes, remove the "##", then if actual-params is + ;; exhausted, remove the prefixed ',' as well. + ;; Prepare for destructive operation + (let ((rem-body (copy-sequence macro-body)) + new-body va left part) + ;; Find each __VA_ARGS__ and remove its immediate prefixed '##' + ;; and comma if presents and if `formal_param' is exhausted + (while (setq va (cl-position '__VA_ARGS__ rem-body)) + ;; Split REM-BODY @ __VA_ARGS__ into LEFT and right + (setq part nil) + (if (zerop va) + (setq left nil ; __VA_ARGS__ trimed + rem-body (cdr rem-body)) + (setq left rem-body + rem-body (cdr (nthcdr va rem-body))) ; _V_ removed + (setcdr (nthcdr va left) nil) ; now _V_ be the last in LEFT + ;; now LEFT=(, w? ## w? _V_) rem=(W X Y) where w = white space + (setq left (cdr (nreverse left)))) ; left=(w? ## w? ,) + + ;; Try to recognize w?##w? and remove ", ##" if found + ;; (remember head = __VA_ARGS__ is temporarily removed) + (while (and left (eq 'hif-space (car left))) ; skip whites + (setq part (cons 'hif-space part) + left (cdr left))) + + (if (eq (car left) 'hif-token-concat) ; match '##' + (if actual-parms + ;; Keep everything + (setq part (append part (cdr left))) + ;; `actual-params' exhausted, delete ',' if presents + (while (and left (eq 'hif-space (car left))) ; skip whites + (setq part (cons 'hif-space part) + left (cdr left))) + (setq part + (append part + (if (eq (car left) 'hif-comma) ; match ',' + (cdr left) + left)))) + ;; No immediate '##' found + (setq part (append part left))) + + ;; Insert __VA_ARGS__ as a list + (push (hif-delimit actual-parms 'hif-comma) part) + ;; Reverse `left' back + (setq left (nreverse part) + new-body (append new-body left))) + + ;; Replacement of __VA_ARGS__ done here, add rem-body back + (setq macro-body (append new-body rem-body) + actual-parms nil))) + + (etc ; GNU style '...', substitute last argument + (if (null actual-parms) + ;; Must be non-destructive otherwise the original function + ;; definition defined in `hide-ifdef-env' will be destroyed. + (setq macro-body (remove formal macro-body)) + (setq macro-body + (cl-substitute (hif-delimit actual-parms 'hif-comma) + formal macro-body) + actual-parms nil))) + + (t + (error "Interal error: impossible case.")))) + + (pop actual-parms) + while actual-parms) ; end cl-loop + + ;; Replacement completed, stringifiy and concatenate the token list. + ;; Stringification happens must take place before flattening, otherwise + ;; only the first token will be stringified. + (setq macro-body + (flatten-tree (hif-token-stringification macro-body)))) + + ;; Token concatenation happens here, keep single 'hif-space + (hif-keep-single (hif-token-concatenation macro-body) 'hif-space))) (defun hif-invoke (macro-name actual-parms) "Invoke a macro by expanding it, reparse macro-body and finally invoke it." @@ -1710,7 +1848,9 @@ hif-canonicalize Do this when cursor is at the beginning of `regexp' (i.e. #ifX)." (let ((case-fold-search nil)) (save-excursion - (re-search-forward regexp) + (if (re-search-forward regexp) + (if (= ?\( (char-before)) ;; "#if(" found + (goto-char (1- (point))))) (let* ((curr-regexp (match-string 0)) (defined (string-match hif-ifxdef-regexp curr-regexp)) (negate (and defined @@ -1724,29 +1864,48 @@ hif-canonicalize (setq tokens (list 'hif-not tokens))) (hif-parse-exp tokens))))) +(defun hif-is-in-comment () + "Check if we're currently within a C(++) comment." + (or (nth 4 (syntax-ppss)) + (looking-at "/[/*]"))) + +(defun hif-search-ifX-regexp (hif-regexp &optional backward) + "Search for a valid ifX regexp defined in hideif." + (let ((start (point)) + (re-search-func (if backward + #'re-search-backward + #'re-search-forward)) + (limit (if backward (point-min) (point-max))) + found) + (while (and (setq found + (funcall re-search-func hif-regexp limit t)) + (hif-is-in-comment))) + ;; Jump to the pattern if found + (if found + (unless backward + (setq found + (goto-char (- (point) (length (match-string 0)))))) + (goto-char start)) + found)) + (defun hif-find-any-ifX () "Move to next #if..., or #ifndef, at point or after." ;; (message "find ifX at %d" (point)) - (prog1 - (re-search-forward hif-ifx-regexp (point-max) t) - (beginning-of-line))) - + (hif-search-ifX-regexp hif-ifx-regexp)) (defun hif-find-next-relevant () "Move to next #if..., #elif..., #else, or #endif, after the current line." ;; (message "hif-find-next-relevant at %d" (point)) (end-of-line) - ;; Avoid infinite recursion by only going to line-beginning if match found - (if (re-search-forward hif-ifx-else-endif-regexp (point-max) t) - (beginning-of-line))) + ;; Avoid infinite recursion by going to the pattern only if a match is found + (hif-search-ifX-regexp hif-ifx-else-endif-regexp)) (defun hif-find-previous-relevant () "Move to previous #if..., #else, or #endif, before the current line." ;; (message "hif-find-previous-relevant at %d" (point)) (beginning-of-line) - ;; Avoid infinite recursion by only going to line-beginning if match found - (if (re-search-backward hif-ifx-else-endif-regexp (point-min) t) - (beginning-of-line))) + ;; Avoid infinite recursion by going to the pattern only if a match is found + (hif-search-ifX-regexp hif-ifx-else-endif-regexp 't)) (defun hif-looking-at-ifX () @@ -1931,6 +2090,7 @@ hif-find-range ((hif-looking-at-else) (setq else (point))) (t + (beginning-of-line) ; otherwise #endif line will be hidden (setq end (point))))) ;; If found #else, look for #endif. (when else @@ -1940,6 +2100,7 @@ hif-find-range (hif-ifdef-to-endif)) (if (hif-looking-at-else) (error "Found two elses in a row? Broken!")) + (beginning-of-line) ; otherwise #endif line will be hidden (setq end (point))) ; (line-end-position) (hif-make-range start end else elif)))) @@ -2085,16 +2246,20 @@ hif-display-macro (eq (car def) 'hif-define-macro)) (let ((cdef (concat "#define " name)) (parmlist (cadr def)) - s) + p s etc) (setq def (caddr def)) ;; parmlist (when parmlist (setq cdef (concat cdef "(")) - (while (car parmlist) - (setq cdef (concat cdef (symbol-name (car parmlist)) - (if (cdr parmlist) ",")) + (if (setq etc (or (eq (setq p (car parmlist)) 'hif-etc) + (and (eq p 'hif-etc-c99) 'c99))) + (pop parmlist)) + (while (setq p (car parmlist)) + (setq cdef (concat cdef (symbol-name p) (if (cdr parmlist) ",")) parmlist (cdr parmlist))) - (setq cdef (concat cdef ")"))) + (setq cdef (concat cdef + (if etc (concat (if (eq etc 'c99) ",") "...")) + ")"))) (setq cdef (concat cdef " ")) ;; body (while def @@ -2221,25 +2386,38 @@ hif-evaluate-macro result)))) (defun hif-parse-macro-arglist (str) - "Parse argument list formatted as `( arg1 [ , argn] [...] )'. + "Parse argument list formatted as `( arg1 [ , argn] [,] [...] )'. The `...' is also included. Return a list of the arguments, if `...' exists the first arg will be `hif-etc'." (let* ((hif-simple-token-only nil) ; Dynamic binding var for `hif-tokenize' (tokenlist (cdr (hif-tokenize (- (point) (length str)) (point)))) ; Remove `hif-lparen' - etc result token) - (while (not (eq (setq token (pop tokenlist)) 'hif-rparen)) + etc result token prevtok prev2tok) + (while (not (eq (setq prev2tok prevtok + prevtok token + token (pop tokenlist)) 'hif-rparen)) (cond ((eq token 'hif-etc) - (setq etc t)) + ;; GNU type "..." or C99 type + (setq etc (if (or (null prevtok) + (eq prevtok 'hif-comma) + (and (eq prevtok 'hif-space) + (eq prev2tok 'hif-comma))) + 'c99 t))) ((eq token 'hif-comma) - t) + (if etc + (error "Syntax error: no comma allowed after `...'."))) (t (push token result)))) - (if etc - (cons 'hif-etc (nreverse result)) - (nreverse result)))) + (setq result (nreverse result)) + (cond + ((eq etc 'c99) + (cons 'hif-etc-c99 result)) + ((eq etc t) + (cons 'hif-etc result)) + (t + result)))) ;; The original version of hideif evaluates the macro early and store the ;; final values for the defined macro into the symbol database (aka @@ -2280,9 +2458,11 @@ hif-find-define (let* ((defining (string= "define" (match-string 2))) (name (and (re-search-forward hif-macroref-regexp max t) (match-string 1))) - (parmlist (or (and (match-string 3) ; First arg id found + (parmlist (or (and (or (match-string 3) ; First arg id found + (match-string 6)) ; '...' found (delq 'hif-space - (hif-parse-macro-arglist (match-string 2)))) + (hif-parse-macro-arglist + (match-string 2)))) (and (match-string 2) ; empty arglist (list nil))))) (if defining @@ -2325,7 +2505,8 @@ hif-find-define (expr (and tokens ;; `hif-simple-token-only' is checked only ;; here. - (or (and hif-simple-token-only + (or (and (null parmlist) + hif-simple-token-only (listp tokens) (= (length tokens) 1) (hif-parse-exp tokens)) @@ -2354,13 +2535,22 @@ hif-add-new-defines (save-excursion (save-restriction ;; (mark-region min max) ;; for debugging + (and min (goto-char min)) (setq hif-verbose-define-count 0) (forward-comment (point-max)) - (while (hif-find-define min max) - (forward-comment (point-max)) - (setf min (point))) + (setq min (point)) + (let ((breakloop nil)) + (while (and (not breakloop) + (hif-find-define min max)) + (forward-comment (point-max)) + (if (and max + (> (point) max)) + (setq max (point) + breakloop t)) + (setq min (point)))) (if max (goto-char max) - (goto-char (point-max)))))) + (goto-char (point-max)) + nil)))) (defun hide-ifdef-guts () "Does most of the work of `hide-ifdefs'. @@ -2376,7 +2566,7 @@ hide-ifdef-guts min max) (setq hif-__COUNTER__ 0) (goto-char (point-min)) - (setf min (point)) + (setq min (point)) ;; Without this `condition-case' it would be easier to see which ;; operation went wrong thru the backtrace `iff' user realize ;; the underlying meaning of all hif-* operation; for example, @@ -2384,11 +2574,11 @@ hide-ifdef-guts ;; operation arguments would be invalid. (condition-case err (cl-loop do - (setf max (hif-find-any-ifX)) - (hif-add-new-defines min max) + (setq max (hif-find-any-ifX)) + (setq max (hif-add-new-defines min max)) (if max (hif-possibly-hide expand-header)) - (setf min (point)) + (setq min (point)) while max) (error (error "Error: failed at line %d %S" (line-number-at-pos) err)))))) commit db836637b0e2050fe4477b4c81a7a2852d8eb960 Author: Stefan Kangas Date: Sun Jan 15 05:09:03 2023 +0100 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index c21955c3f06..4d5921582cc 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -1079,10 +1079,11 @@ 'command-apropos search for matches for that word as a substring. If it is a list of words, search for matches for any two (or more) of those words. -Note that by default this command only searches in the file specified by -`internal-doc-file-name'; i.e., the etc/DOC file. With \\[universal-argument] prefix, -or if `apropos-do-all' is non-nil, it searches all currently defined -documentation strings. +Note that by default this command only searches in the functions predefined +at Emacs startup, i.e., the primitives implemented in C or preloaded in the +Emacs dump image. +With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, it searches +all currently defined documentation strings. Returns list of symbols and documentation found. @@ -2929,6 +2930,10 @@ "semantic/bovine/c" (autoload 'c-ts-mode "c-ts-mode" "\ Major mode for editing C, powered by tree-sitter. +This mode is independent from the classic cc-mode.el based +`c-mode', so configuration variables of that mode, like +`c-basic-offset', don't affect this mode. + (fn)" t) (autoload 'c++-ts-mode "c-ts-mode" "\ Major mode for editing C++, powered by tree-sitter. @@ -4114,6 +4119,22 @@ "cfengine" non-nil, means also include partially matching ligatures and non-canonical equivalences. +Each line of the display shows the equivalences in two different +ways separated by a colon: + + - as the literal character or sequence + - using an ASCII-only escape syntax + +For example, for the letter \\='r\\=', the first line is + + r: ?\\N{LATIN SMALL LETTER R} + +which is for the requested character itself, and a later line has + + ṟ: ?\\N{LATIN SMALL LETTER R}?\\N{COMBINING MACRON BELOW} + +which clearly shows what the constituent characters are. + (fn CHAR &optional LAX)" t) (register-definition-prefixes "char-fold" '("char-fold-")) @@ -11261,8 +11282,10 @@ eww-suggest-uris (defalias 'browse-web 'eww) (autoload 'eww-open-file "eww" "\ Render FILE using EWW. +If NEW-BUFFER is non-nil (interactively, the prefix arg), use a +new buffer instead of reusing the default EWW buffer. -(fn FILE)" t) +(fn FILE &optional NEW-BUFFER)" t) (autoload 'eww-search-words "eww" "\ Search the web for the text in the region. If region is active (and not whitespace), search the web for @@ -22327,7 +22350,7 @@ "opascal" ;;; Generated autoloads from org/org.el -(push (purecopy '(org 9 6)) package--builtin-versions) +(push (purecopy '(org 9 6 1)) package--builtin-versions) (autoload 'org-babel-do-load-languages "org" "\ Load the languages defined in `org-babel-load-languages'. @@ -24511,6 +24534,7 @@ "pop3" (autoload 'pp-emacs-lisp-code "pp" "\ Insert SEXP into the current buffer, formatted as Emacs Lisp code. Use the `pp-max-width' variable to control the desired line length. +Note that this could be slow for large SEXPs. (fn SEXP)") (register-definition-prefixes "pp" '("pp-")) @@ -25097,7 +25121,7 @@ "ede/proj-shared" ;;; Generated autoloads from progmodes/project.el -(push (purecopy '(project 0 9 3)) package--builtin-versions) +(push (purecopy '(project 0 9 4)) package--builtin-versions) (autoload 'project-current "project" "\ Return the project instance in DIRECTORY, defaulting to `default-directory'. @@ -27320,6 +27344,13 @@ "rtree" ;;; Generated autoloads from progmodes/ruby-mode.el (push (purecopy '(ruby-mode 1 2)) package--builtin-versions) +(autoload 'ruby-base-mode "ruby-mode" "\ +Generic major mode for editing Ruby. + +This mode is intended to be inherited by concrete major modes. +Currently there are `ruby-mode' and `ruby-ts-mode'. + +(fn)" t) (autoload 'ruby-mode "ruby-mode" "\ Major mode for editing Ruby code. @@ -27328,6 +27359,15 @@ "rtree" (dolist (name (list "ruby" "rbx" "jruby" "ruby1.9" "ruby1.8")) (add-to-list 'interpreter-mode-alist (cons (purecopy name) 'ruby-mode))) (register-definition-prefixes "ruby-mode" '("ruby-")) + +;;; Generated autoloads from progmodes/ruby-ts-mode.el + +(autoload 'ruby-ts-mode "ruby-ts-mode" "\ +Major mode for editing Ruby, powered by tree-sitter. + +(fn)" t) +(register-definition-prefixes "ruby-ts-mode" '("ruby-ts-")) + ;;; Generated autoloads from ruler-mode.el @@ -30223,7 +30263,7 @@ string-blank-p (autoload 'string-glyph-split "subr-x" "\ Split STRING into a list of strings representing separate glyphs. This takes into account combining characters and grapheme clusters: -if compositions are enbaled, each sequence of characters composed +if compositions are enabled, each sequence of characters composed on display into a single grapheme cluster is treated as a single indivisible unit. @@ -32409,7 +32449,6 @@ "todo-mode" ;;; Generated autoloads from textmodes/toml-ts-mode.el -(add-to-list 'auto-mode-alist '("\\.toml\\'" . toml-ts-mode)) (autoload 'toml-ts-mode "toml-ts-mode" "\ Major mode for editing TOML, powered by tree-sitter. @@ -32601,7 +32640,7 @@ tramp-archive-compression-suffixes List of suffixes which indicate a compressed file. It must be supported by libarchive(3).") (defmacro tramp-archive-autoload-file-name-regexp nil "\ -Regular expression matching archive file names." (if (<= emacs-major-version 26) '(concat "\\`" "\\(" ".+" "\\." (regexp-opt tramp-archive-suffixes) "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" "\\)" "\\(" "/" ".*" "\\)" "\\'") `(rx bos (group (+ nonl) "." (| ,@tramp-archive-suffixes) (32 "." (| ,@tramp-archive-compression-suffixes))) (group "/" (* nonl)) eos))) +Regular expression matching archive file names." `(rx bos (group (+ nonl) "." (| ,@tramp-archive-suffixes) (32 "." (| ,@tramp-archive-compression-suffixes))) (group "/" (* nonl)) eos)) (defun tramp-archive-autoload-file-name-handler (operation &rest args) "\ Load Tramp archive file name handler, and perform OPERATION." (defvar tramp-archive-autoload) (let ((default-directory temporary-file-directory) (tramp-archive-autoload tramp-archive-enabled)) (apply #'tramp-autoload-file-name-handler operation args))) (defun tramp-register-archive-autoload-file-name-handler nil "\ @@ -32623,7 +32662,6 @@ "tramp-cmds" ;;; Generated autoloads from net/tramp-compat.el - (defalias 'tramp-compat-rx #'rx) (register-definition-prefixes "tramp-compat" '("tramp-")) @@ -32689,7 +32727,7 @@ "tramp-uu" ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 6 0 -1)) package--builtin-versions) +(push (purecopy '(tramp 2 7 0 -1)) package--builtin-versions) (register-definition-prefixes "trampver" '("tramp-")) @@ -32797,6 +32835,21 @@ "tree-widget" ;;; Generated autoloads from treesit.el +(autoload 'treesit-install-language-grammar "treesit" "\ +Build and install the tree-sitter language grammar library for LANG. + +Interactively, if `treesit-language-source-alist' doesn't already +have data for building the grammar for LANG, prompt for its +repository URL and the C/C++ compiler to use. + +This command requires Git, a C compiler and (sometimes) a C++ compiler, +and the linker to be installed and on PATH. It also requires that the +recipe for LANG exists in `treesit-language-source-alist'. + +See `exec-path' for the current path where Emacs looks for +executable programs, such as the C/C++ compiler and linker. + +(fn LANG)" t) (register-definition-prefixes "treesit" '("treesit-")) @@ -36791,7 +36844,7 @@ "xmltok" ;;; Generated autoloads from progmodes/xref.el -(push (purecopy '(xref 1 6 0)) package--builtin-versions) +(push (purecopy '(xref 1 6 1)) package--builtin-versions) (autoload 'xref-find-backend "xref") (define-obsolete-function-alias 'xref-pop-marker-stack #'xref-go-back "29.1") (autoload 'xref-go-back "xref" "\ commit 16579f6ed77020e2cdcc5d8031b20efdccdb2ca9 Author: Po Lu Date: Sun Jan 15 09:26:18 2023 +0800 Fix the MS-DOS build * msdos/sed1v2.inp: Edit out QCOPY_ACL_LIB. diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp index ac7041a1bed..162ccb3e8d8 100644 --- a/msdos/sed1v2.inp +++ b/msdos/sed1v2.inp @@ -182,6 +182,7 @@ s/ *@WEBP_LIBS@// /^TREE_SITTER_CFLAGS *=/s/@TREE_SITTER_CFLAGS@// /^HARFBUZZ_CFLAGS *=/s/@HARFBUZZ_CFLAGS@// /^HARFBUZZ_LIBS *=/s/@HARFBUZZ_LIBS@// +/^QCOPY_ACL_LIB *=/s/@QCOPY_ACL_LIB@// /^LCMS2_CFLAGS *=/s/@LCMS2_CFLAGS@// /^LCMS2_LIBS *=/s/@LCMS2_LIBS@// /^LIBGMP *=/s/@LIBGMP@// commit 50fd58be614230e9f0ad5fcf79aa7a5f3a499e04 Author: Theodor Thornhill Date: Sat Jan 14 22:41:00 2023 +0100 Use treesit-sentence-type-regexp in java-ts-mode Initial support for forward/backward-sentence movement with tree-sitter. Include all statements, and some declarations. Don't include the bigger declarations we don't want to jump over too big blocks of code. * lisp/progmodes/java-ts-mode.el (java-ts-mode): Add relevant node types to treesit-sentence-type-regexp. diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 5f4c1275f66..eac052ca4f1 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -319,6 +319,14 @@ java-ts-mode "module_declaration"))) (setq-local treesit-defun-name-function #'java-ts-mode--defun-name) + (setq-local treesit-sentence-type-regexp + (regexp-opt '("statement" + "local_variable_declaration" + "field_declaration" + "module_declaration" + "package_declaration" + "import_declaration"))) + ;; Font-lock. (setq-local treesit-font-lock-settings java-ts-mode--font-lock-settings) (setq-local treesit-font-lock-feature-list commit c257fd3a406d6aa83be60b96217e42b49b62cf5f Author: Jim Porter Date: Sun Jan 8 13:50:50 2023 -0800 Use the 'field' property to navigate through Eshell prompts * lisp/eshell/esh-mode.el (eshell-skip-prompt-function): Make obsolete. * lisp/eshell/em-prompt.el (eshell-prompt-regexp): Update docstring. (eshell-prompt-initialize): Don't set 'eshell-skip-prompt-function'. (eshell-next-prompt): Search for the 'field' property set to 'prompt' to find the next prompt. (eshell-previous-prompt): Move 'forward-line' call into 'eshell-next-prompt'. (eshell-forward-matching-input, eshell-backward-matching-input): Reimplement on top of 'eshell-next-prompt'. (eshell-skip-prompt): Make obsolete. * test/lisp/eshell/em-prompt-tests.el (em-prompt-test/next-previous-prompt): New test. diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el index 5a89ff35a2b..52d46282c52 100644 --- a/lisp/eshell/em-prompt.el +++ b/lisp/eshell/em-prompt.el @@ -29,6 +29,8 @@ (require 'esh-mode) (eval-when-compile (require 'eshell)) +(require 'text-property-search) + ;;;###autoload (progn (defgroup eshell-prompt nil @@ -58,11 +60,12 @@ eshell-prompt-function :group 'eshell-prompt) (defcustom eshell-prompt-regexp "^[^#$\n]* [#$] " - "A regexp which fully matches your eshell prompt. -This setting is important, since it affects how eshell will interpret -the lines that are passed to it. -If this variable is changed, all Eshell buffers must be exited and -re-entered for it to take effect." + "A regexp which fully matches your Eshell prompt. +This is useful for navigating by paragraph using \ +\\[forward-paragraph] and \\[backward-paragraph]. + +If this variable is changed, all Eshell buffers must be exited +and re-entered for it to take effect." :type 'regexp :group 'eshell-prompt) @@ -123,7 +126,6 @@ eshell-prompt-initialize (if eshell-prompt-regexp (setq-local paragraph-start eshell-prompt-regexp)) - (setq-local eshell-skip-prompt-function #'eshell-skip-prompt) (eshell-prompt-mode))) (defun eshell-emit-prompt () @@ -149,57 +151,55 @@ eshell-emit-prompt (eshell-interactive-filter nil prompt))) (run-hooks 'eshell-after-prompt-hook)) -(defun eshell-backward-matching-input (regexp arg) - "Search backward through buffer for match for REGEXP. -Matches are searched for on lines that match `eshell-prompt-regexp'. -With prefix argument N, search for Nth previous match. -If N is negative, find the next or Nth next match." - (interactive (eshell-regexp-arg "Backward input matching (regexp): ")) - (let* ((re (concat eshell-prompt-regexp ".*" regexp)) - (pos (save-excursion (end-of-line (if (> arg 0) 0 1)) - (if (re-search-backward re nil t arg) - (point))))) - (if (null pos) - (progn (message "Not found") - (ding)) - (goto-char pos) - (beginning-of-line)))) - (defun eshell-forward-matching-input (regexp arg) - "Search forward through buffer for match for REGEXP. -Matches are searched for on lines that match `eshell-prompt-regexp'. -With prefix argument N, search for Nth following match. -If N is negative, find the previous or Nth previous match." + "Search forward through buffer for command input that matches REGEXP. +With prefix argument N, search for Nth next match. If N is +negative, find the Nth previous match." (interactive (eshell-regexp-arg "Forward input matching (regexp): ")) - (eshell-backward-matching-input regexp (- arg))) + (let ((direction (if (> arg 0) 1 -1)) + (count (abs arg))) + (unless (catch 'found + (while (> count 0) + (eshell-next-prompt direction) + (when (and (string-match regexp (field-string)) + (= (setq count (1- count)) 0)) + (throw 'found t)))) + (message "Not found") + (ding)))) + +(defun eshell-backward-matching-input (regexp arg) + "Search backward through buffer for command input that matches REGEXP. +With prefix argument N, search for Nth previous match. If N is +negative, find the Nth next match." + (interactive (eshell-regexp-arg "Backward input matching (regexp): ")) + (eshell-forward-matching-input regexp (- arg))) (defun eshell-next-prompt (n) - "Move to end of Nth next prompt in the buffer. -See `eshell-prompt-regexp'." + "Move to end of Nth next prompt in the buffer." (interactive "p") - (if eshell-highlight-prompt - (progn - (while (< n 0) - (while (and (re-search-backward eshell-prompt-regexp nil t) - (not (get-text-property (match-beginning 0) 'read-only)))) - (setq n (1+ n))) - (while (> n 0) - (while (and (re-search-forward eshell-prompt-regexp nil t) - (not (get-text-property (match-beginning 0) 'read-only)))) - (setq n (1- n)))) - (re-search-forward eshell-prompt-regexp nil t n)) - (eshell-skip-prompt)) + (if (natnump n) + (while (and (> n 0) + (text-property-search-forward 'field 'prompt t)) + (setq n (1- n))) + (let (match this-match) + (forward-line 0) ; Don't count prompt on current line. + (while (and (< n 0) + (setq this-match (text-property-search-backward + 'field 'prompt t))) + (setq match this-match + n (1+ n))) + (when match + (goto-char (prop-match-end match)))))) (defun eshell-previous-prompt (n) - "Move to end of Nth previous prompt in the buffer. -See `eshell-prompt-regexp'." + "Move to end of Nth previous prompt in the buffer." (interactive "p") - (forward-line 0) ; Don't count prompt on current line. (eshell-next-prompt (- n))) (defun eshell-skip-prompt () "Skip past the text matching regexp `eshell-prompt-regexp'. If this takes us past the end of the current line, don't skip at all." + (declare (obsolete nil "30.1")) (let ((eol (line-end-position))) (if (and (looking-at eshell-prompt-regexp) (<= (match-end 0) eol)) diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 90e003d188b..503d9ba1b63 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -176,6 +176,8 @@ eshell-skip-prompt-function "A function called from beginning of line to skip the prompt." :type '(choice (const nil) function)) +(make-obsolete-variable 'eshell-skip-prompt-function nil "30.1") + (defcustom eshell-status-in-mode-line t "If non-nil, let the user know a command is running in the mode line." :type 'boolean) diff --git a/test/lisp/eshell/em-prompt-tests.el b/test/lisp/eshell/em-prompt-tests.el index 695cb1bab23..91464a98c26 100644 --- a/test/lisp/eshell/em-prompt-tests.el +++ b/test/lisp/eshell/em-prompt-tests.el @@ -78,4 +78,41 @@ em-prompt-test/field-properties/no-highlight (propertize "hello\n" 'rear-nonsticky '(field) 'field 'command-output))))))) +(ert-deftest em-prompt-test/next-previous-prompt () + "Check that navigating forward/backward through old prompts works correctly." + (with-temp-eshell + (eshell-insert-command "echo one") + (eshell-insert-command "echo two") + (eshell-insert-command "echo three") + (insert "echo fou") ; A partially-entered command. + ;; Go back one prompt. + (eshell-previous-prompt 1) + (should (equal (eshell-get-old-input) "echo three")) + ;; Go back two prompts, starting from the end of this line. + (end-of-line) + (eshell-previous-prompt 2) + (should (equal (eshell-get-old-input) "echo one")) + ;; Go forward three prompts. + (eshell-next-prompt 3) + (should (equal (eshell-get-old-input) "echo fou")))) + +(ert-deftest em-prompt-test/forward-backward-matching-input () + "Check that navigating forward/backward via regexps works correctly." + (with-temp-eshell + (eshell-insert-command "echo one") + (eshell-insert-command "printnl something else") + (eshell-insert-command "echo two") + (eshell-insert-command "echo three") + (insert "echo fou") ; A partially-entered command. + ;; Go back one prompt. + (eshell-backward-matching-input "echo" 1) + (should (equal (eshell-get-old-input) "echo three")) + ;; Go back two prompts, starting from the end of this line. + (end-of-line) + (eshell-backward-matching-input "echo" 2) + (should (equal (eshell-get-old-input) "echo one")) + ;; Go forward three prompts. + (eshell-forward-matching-input "echo" 3) + (should (equal (eshell-get-old-input) "echo fou")))) + ;;; em-prompt-tests.el ends here commit 54051c97f2e950eaa229b18f0cf209c727b2daa3 Author: Jim Porter Date: Sun Jan 8 13:05:59 2023 -0800 Make 'eshell-bol' obsolete Now that Eshell uses fields for its output, 'eshell-bol' is no longer needed, and we can just use 'beginning-of-line'. * lisp/eshell/esh-mode.el (eshell-bol): Mark obsolete. (eshell-mode-map): Remove 'C-a' mapping. (eshell-command-map): Use 'move-beginning-of-line'. (eshell-move-argument, eshell-kill-input): Use 'beginning-of-line'. (eshell-get-old-input): Remove unnecessary call to 'eshell-skip-prompt-function'. * lisp/eshell/em-rebind.el (eshell-rebind-keys-alist): Remove 'C-a' and '' mappings; the global mapping for these ('move-beginning-of-line') does the same thing now. * lisp/eshell/em-cmpl.el (eshell-complete-parse-arguments): * lisp/eshell/em-elecslash.el (eshell-electric-forward-slash): * lisp/eshell/em-hist.el (eshell-hist-word-reference) (eshell-previous-matching-input-from-input, eshell-test-imatch): * lisp/eshell/em-prompt.el (eshell-backward-matching-input): * lisp/eshell/em-rebind.el (eshell-point-within-input-p): * test/lisp/eshell/eshell-tests.el (eshell-test/forward-arg): Use 'beginning-of-line'. * test/lisp/eshell/eshell-tests.el (eshell-test/run-old-command): Rename to... (eshell-test/get-old-input): ... this, and expand the test. diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index 94ec5e8f1db..4206ad048fa 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -312,7 +312,7 @@ eshell-complete-parse-arguments (eshell-interactive-process-p)) (eshell--pcomplete-insert-tab)) (let ((end (point-marker)) - (begin (save-excursion (eshell-bol) (point))) + (begin (save-excursion (beginning-of-line) (point))) (posns (list t)) args delim) (when (and pcomplete-allow-modifications diff --git a/lisp/eshell/em-elecslash.el b/lisp/eshell/em-elecslash.el index 80bc0f031ef..2b003f58dc7 100644 --- a/lisp/eshell/em-elecslash.el +++ b/lisp/eshell/em-elecslash.el @@ -72,7 +72,7 @@ eshell-electric-forward-slash (delete-char -1) (let ((tilde-before (eq ?~ (char-before))) (command (save-excursion - (eshell-bol) + (beginning-of-line) (skip-syntax-forward " ") (thing-at-point 'sexp))) (prefix (file-remote-p default-directory))) diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 05e9598f530..6e0e471d910 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -555,7 +555,7 @@ eshell-hist-word-reference (defun eshell-hist-parse-arguments (&optional b e) "Parse current command arguments in a history-code-friendly way." (let ((end (or e (point))) - (begin (or b (save-excursion (eshell-bol) (point)))) + (begin (or b (save-excursion (beginning-of-line) (point)))) (posb (list t)) (pose (list t)) (textargs (list t)) @@ -913,7 +913,7 @@ eshell-previous-matching-input-from-input eshell-next-matching-input-from-input))) ;; Starting a new search (setq eshell-matching-input-from-input-string - (buffer-substring (save-excursion (eshell-bol) (point)) + (buffer-substring (save-excursion (beginning-of-line) (point)) (point)) eshell-history-index nil)) (eshell-previous-matching-input @@ -933,7 +933,7 @@ eshell-test-imatch (if (get-text-property (point) 'history) (progn (beginning-of-line) t) (let ((before (point))) - (eshell-bol) + (beginning-of-line) (if (and (not (bolp)) (<= (point) before)) t diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el index fdd16ca846a..5a89ff35a2b 100644 --- a/lisp/eshell/em-prompt.el +++ b/lisp/eshell/em-prompt.el @@ -163,7 +163,7 @@ eshell-backward-matching-input (progn (message "Not found") (ding)) (goto-char pos) - (eshell-bol)))) + (beginning-of-line)))) (defun eshell-forward-matching-input (regexp arg) "Search forward through buffer for match for REGEXP. diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el index 2c95d4fdffb..f147d432300 100644 --- a/lisp/eshell/em-rebind.el +++ b/lisp/eshell/em-rebind.el @@ -50,9 +50,7 @@ eshell-rebind-load-hook :group 'eshell-rebind) (defcustom eshell-rebind-keys-alist - '(([(control ?a)] . eshell-bol) - ([home] . eshell-bol) - ([(control ?d)] . eshell-delchar-or-maybe-eof) + '(([(control ?d)] . eshell-delchar-or-maybe-eof) ([backspace] . eshell-delete-backward-char) ([delete] . eshell-delete-backward-char) ([(control ?w)] . backward-kill-word) @@ -190,7 +188,7 @@ eshell-point-within-input-p (and eshell-remap-previous-input (setq begin (save-excursion - (eshell-bol) + (beginning-of-line) (and (not (bolp)) (point)))) (>= pos begin) (<= pos (line-end-position)) diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 97edc826c9a..90e003d188b 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -262,14 +262,13 @@ eshell-mode-map "C-c" 'eshell-command-map "RET" #'eshell-send-input "M-RET" #'eshell-queue-input - "C-M-l" #'eshell-show-output - "C-a" #'eshell-bol) + "C-M-l" #'eshell-show-output) (defvar-keymap eshell-command-map :prefix 'eshell-command-map "M-o" #'eshell-mark-output "M-d" #'eshell-toggle-direct-send - "C-a" #'eshell-bol + "C-a" #'move-beginning-of-line "C-b" #'eshell-backward-argument "C-e" #'eshell-show-maximum-output "C-f" #'eshell-forward-argument @@ -472,7 +471,7 @@ eshell-find-tag (defun eshell-move-argument (limit func property arg) "Move forward ARG arguments." (catch 'eshell-incomplete - (eshell-parse-arguments (save-excursion (eshell-bol) (point)) + (eshell-parse-arguments (save-excursion (beginning-of-line) (point)) (line-end-position))) (let ((pos (save-excursion (funcall func 1) @@ -505,12 +504,7 @@ eshell-repeat-argument (kill-ring-save begin (point)) (yank))) -(defun eshell-bol () - "Go to the beginning of line, then skip past the prompt, if any." - (interactive) - (beginning-of-line) - (and eshell-skip-prompt-function - (funcall eshell-skip-prompt-function))) +(define-obsolete-function-alias 'eshell-bol #'beginning-of-line "30.1") (defsubst eshell-push-command-mark () "Push a mark at the end of the last input text." @@ -856,7 +850,7 @@ eshell-kill-input (if (> (point) eshell-last-output-end) (kill-region eshell-last-output-end (point)) (let ((here (point))) - (eshell-bol) + (beginning-of-line) (kill-region (point) here)))) (defun eshell-show-maximum-output (&optional interactive) @@ -884,17 +878,18 @@ eshell/clear-scrollback (erase-buffer))) (defun eshell-get-old-input (&optional use-current-region) - "Return the command input on the current line." + "Return the command input on the current line. +If USE-CURRENT-REGION is non-nil, return the current region." (if use-current-region (buffer-substring (min (point) (mark)) (max (point) (mark))) (save-excursion - (beginning-of-line) - (and eshell-skip-prompt-function - (funcall eshell-skip-prompt-function)) - (let ((beg (point))) - (end-of-line) - (buffer-substring beg (point)))))) + (let ((inhibit-field-text-motion t)) + (end-of-line)) + (let ((inhibit-field-text-motion) + (end (point))) + (beginning-of-line) + (buffer-substring (point) end))))) (defun eshell-copy-old-input () "Insert after prompt old input at point as new input to be edited." diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index be968e1558f..776cfb9b92f 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -117,14 +117,14 @@ eshell-test/forward-arg (with-temp-eshell (eshell-insert-command "echo $(+ 1 (- 4 3)) \"alpha beta\" file" 'ignore) (let ((here (point)) begin valid) - (eshell-bol) + (beginning-of-line) (setq begin (point)) (eshell-forward-argument 4) (setq valid (= here (point))) (eshell-backward-argument 4) (prog1 (and valid (= begin (point))) - (eshell-bol) + (beginning-of-line) (delete-region (point) (point-max)))))) (ert-deftest eshell-test/queue-input () @@ -148,12 +148,17 @@ eshell-test/flush-output (should (eshell-match-output (concat "^" (regexp-quote "*** output flushed ***\n") "$"))))) -(ert-deftest eshell-test/run-old-command () - "Re-run an old command" +(ert-deftest eshell-test/get-old-input () + "Test that we can get the input of a previous command." (with-temp-eshell (eshell-insert-command "echo alpha") (goto-char eshell-last-input-start) - (string= (eshell-get-old-input) "echo alpha"))) + (should (string= (eshell-get-old-input) "echo alpha")) + ;; Make sure that `eshell-get-old-input' works even if the point is + ;; inside the prompt. + (let ((inhibit-field-text-motion t)) + (beginning-of-line)) + (should (string= (eshell-get-old-input) "echo alpha")))) (provide 'eshell-tests) commit 558f04c39e036d2f681f72556627768d7bee9ab5 Author: Jim Porter Date: Sun Jan 8 13:00:47 2023 -0800 Set the 'field' property for Eshell output This makes Eshell work more like 'M-x shell', and lets the key move to the beginning of the user's input at the prompt (bug#60666). * lisp/eshell/em-prompt.el (eshell-emit-prompt): Add 'field' property to prompt. (eshell-bol-ignoring-prompt): New function. * lisp/eshell/esh-io.el: Declare 'eshell-interactive-print'... (eshell-output-object-to-target): ... use it. * lisp/eshell/esh-mode.el (eshell-output-filter-functions): Update docstring. (eshell-interactive-print): Set the output to have a field value of 'command-output'. (eshell-output-filter): Rename to... (eshell-interactive-filter): ... this, and take a buffer instead of a process. * lisp/eshell/esh-proc.el (eshell-interactive-process-filter): New function, adapted from 'eshell-output-filter'... (eshell-gather-process-output): ... use it. * test/lisp/eshell/em-prompt-tests.el: New file. * etc/NEWS: Announce this change. diff --git a/etc/NEWS b/etc/NEWS index cb83ec24a61..068f7a27db8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -127,6 +127,15 @@ of arguments into a command, such as when defining aliases. For more information, see the "(eshell) Dollars Expansion" node in the Eshell manual. +--- +*** Eshell now uses 'field' properties in its output. +In particular, this means that pressing the key moves the point +to the beginning of your input, not the beginning of the whole line. +If you want to go back to the old behavior, add something like this to +your configuration: + + (keymap-set eshell-mode-map "" #'eshell-bol-ignoring-prompt) + +++ *** 'eshell-read-aliases-list' is now an interactive command. After manually editing 'eshell-aliases-file', you can use this command diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el index 575b5a595f1..fdd16ca846a 100644 --- a/lisp/eshell/em-prompt.el +++ b/lisp/eshell/em-prompt.el @@ -134,14 +134,19 @@ eshell-emit-prompt (if (not eshell-prompt-function) (set-marker eshell-last-output-end (point)) (let ((prompt (funcall eshell-prompt-function))) - (and eshell-highlight-prompt - (add-text-properties 0 (length prompt) - '(read-only t - font-lock-face eshell-prompt - front-sticky (font-lock-face read-only) - rear-nonsticky (font-lock-face read-only)) - prompt)) - (eshell-interactive-print prompt))) + (add-text-properties + 0 (length prompt) + (if eshell-highlight-prompt + '( read-only t + field prompt + font-lock-face eshell-prompt + front-sticky (read-only field font-lock-face) + rear-nonsticky (read-only field font-lock-face)) + '( field prompt + front-sticky (field) + rear-nonsticky (field))) + prompt) + (eshell-interactive-filter nil prompt))) (run-hooks 'eshell-after-prompt-hook)) (defun eshell-backward-matching-input (regexp arg) @@ -200,6 +205,14 @@ eshell-skip-prompt (<= (match-end 0) eol)) (goto-char (match-end 0))))) +(defun eshell-bol-ignoring-prompt (arg) + "Move point to the beginning of the current line, past the prompt (if any). +With argument ARG not nil or 1, move forward ARG - 1 lines +first (see `move-beginning-of-line' for more information)." + (interactive "^p") + (let ((inhibit-field-text-motion t)) + (move-beginning-of-line arg))) + (provide 'em-prompt) ;; Local Variables: diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 4dad4c7429a..cccdb49ce2a 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -74,6 +74,8 @@ (eval-when-compile (require 'cl-lib)) +(declare-function eshell-interactive-print "esh-mode" (string)) + (defgroup eshell-io nil "Eshell's I/O management code provides a scheme for treating many different kinds of objects -- symbols, files, buffers, etc. -- as @@ -597,8 +599,6 @@ eshell-printn (eshell-print object) (eshell-print "\n")) -(autoload 'eshell-output-filter "esh-mode") - (defun eshell-output-object-to-target (object target) "Insert OBJECT into TARGET. Returns what was actually sent, or nil if nothing was sent." @@ -608,7 +608,7 @@ eshell-output-object-to-target ((symbolp target) (if (eq target t) ; means "print to display" - (eshell-output-filter nil (eshell-stringify object)) + (eshell-interactive-print (eshell-stringify object)) (if (not (symbol-value target)) (set target object) (setq object (eshell-stringify object)) diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index d80f1d1f390..97edc826c9a 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -155,7 +155,8 @@ eshell-output-filter-functions eshell-watch-for-password-prompt) "Functions to call before output is displayed. These functions are only called for output that is displayed -interactively, and not for output which is redirected." +interactively (see `eshell-interactive-filter'), and not for +output which is redirected." :type 'hook) (defcustom eshell-preoutput-filter-functions nil @@ -525,9 +526,13 @@ eshell-goto-input-start (custom-add-option 'eshell-pre-command-hook #'eshell-goto-input-start) -(defsubst eshell-interactive-print (string) +(defun eshell-interactive-print (string) "Print STRING to the eshell display buffer." - (eshell-output-filter nil string)) + (when string + (add-text-properties 0 (length string) + '(field command-output rear-nonsticky (field)) + string) + (eshell-interactive-filter nil string))) (defsubst eshell-begin-on-new-line () "This function outputs a newline if not at beginning of line." @@ -687,14 +692,14 @@ eshell-kill-new (custom-add-option 'eshell-input-filter-functions 'eshell-kill-new) -(defun eshell-output-filter (process string) - "Send the output from PROCESS (STRING) to the interactive display. +(defun eshell-interactive-filter (buffer string) + "Send output (STRING) to the interactive display, using BUFFER. This is done after all necessary filtering has been done." - (let ((oprocbuf (if process (process-buffer process) - (current-buffer))) - (inhibit-modification-hooks t)) - (when (and string oprocbuf (buffer-name oprocbuf)) - (with-current-buffer oprocbuf + (unless buffer + (setq buffer (current-buffer))) + (when (and string (buffer-live-p buffer)) + (let ((inhibit-modification-hooks t)) + (with-current-buffer buffer (let ((functions eshell-preoutput-filter-functions)) (while (and functions string) (setq string (funcall (car functions) string)) diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index 8a803c67e46..9bae812c922 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -304,7 +304,7 @@ eshell-gather-process-output :name (concat (file-name-nondirectory command) "-stderr") :buffer (current-buffer) :filter (if (eshell-interactive-output-p eshell-error-handle) - #'eshell-output-filter + #'eshell-interactive-process-filter #'eshell-insertion-filter) :sentinel #'eshell-sentinel)) (eshell-record-process-properties stderr-proc eshell-error-handle)) @@ -320,7 +320,7 @@ eshell-gather-process-output :buffer (current-buffer) :command (cons command args) :filter (if (eshell-interactive-output-p) - #'eshell-output-filter + #'eshell-interactive-process-filter #'eshell-insertion-filter) :sentinel #'eshell-sentinel :connection-type conn-type @@ -381,7 +381,7 @@ eshell-gather-process-output line (buffer-substring-no-properties lbeg lend)) (set-buffer oldbuf) (if interact-p - (eshell-output-filter nil line) + (eshell-interactive-process-filter nil line) (eshell-output-object line)) (setq lbeg lend) (set-buffer proc-buf)) @@ -402,6 +402,22 @@ eshell-gather-process-output (setq proc t)))) proc)) +(defun eshell-interactive-process-filter (process string) + "Send the output from PROCESS (STRING) to the interactive display. +This is done after all necessary filtering has been done." + (when string + (add-text-properties 0 (length string) + '(field command-output rear-nonsticky (field)) + string) + (require 'esh-mode) + (declare-function eshell-interactive-filter "esh-mode" (buffer string)) + (eshell-interactive-filter (if process (process-buffer process) + (current-buffer)) + string))) + +(define-obsolete-function-alias 'eshell-output-filter + #'eshell-interactive-process-filter "30.1") + (defun eshell-insertion-filter (proc string) "Insert a string into the eshell buffer, or a process/file/buffer. PROC is the process for which we're inserting output. STRING is the diff --git a/test/lisp/eshell/em-prompt-tests.el b/test/lisp/eshell/em-prompt-tests.el new file mode 100644 index 00000000000..695cb1bab23 --- /dev/null +++ b/test/lisp/eshell/em-prompt-tests.el @@ -0,0 +1,81 @@ +;;; em-prompt-tests.el --- em-prompt test suite -*- lexical-binding:t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Tests for Eshell's prompt support. + +;;; Code: + +(require 'ert) +(require 'eshell) +(require 'em-prompt) + +(require 'eshell-tests-helpers + (expand-file-name "eshell-tests-helpers" + (file-name-directory (or load-file-name + default-directory)))) + +;;; Tests: + +(ert-deftest em-prompt-test/field-properties () + "Check that field properties are properly set on Eshell output/prompts." + (with-temp-eshell + (eshell-insert-command "echo hello") + (let ((last-prompt (field-string (1- eshell-last-input-start))) + (last-input (field-string (1+ eshell-last-input-start))) + (last-output (field-string (1+ eshell-last-input-end)))) + (should (equal-including-properties + last-prompt + (propertize + (format "%s $ " (directory-file-name default-directory)) + 'read-only t + 'field 'prompt + 'font-lock-face 'eshell-prompt + 'front-sticky '(read-only field font-lock-face) + 'rear-nonsticky '(read-only field font-lock-face)))) + (should (equal last-input "echo hello\n")) + (should (equal-including-properties + last-output + (propertize "hello\n" 'rear-nonsticky '(field) + 'field 'command-output)))))) + +(ert-deftest em-prompt-test/field-properties/no-highlight () + "Check that field properties are properly set on Eshell output/prompts. +This tests the case when `eshell-highlight-prompt' is nil." + (let ((eshell-highlight-prompt nil)) + (with-temp-eshell + (eshell-insert-command "echo hello") + (let ((last-prompt (field-string (1- eshell-last-input-start))) + (last-input (field-string (1+ eshell-last-input-start))) + (last-output (field-string (1+ eshell-last-input-end)))) + (should (equal-including-properties + last-prompt + (propertize + (format "%s $ " (directory-file-name default-directory)) + 'field 'prompt + 'front-sticky '(field) + 'rear-nonsticky '(field)))) + (should (equal last-input "echo hello\n")) + (should (equal-including-properties + last-output + (propertize "hello\n" 'rear-nonsticky '(field) + 'field 'command-output))))))) + +;;; em-prompt-tests.el ends here commit a06c13db9eee0487975177089b44198dd08206be Merge: 48bd17923a9 fd77de542d8 Author: Eli Zaretskii Date: Sat Jan 14 13:56:58 2023 -0500 Merge from origin/emacs-29 fd77de542d8 ; * etc/NEWS: Fix typos. 195afb68e31 Merge branch 'emacs-29' of git.savannah.gnu.org:/srv/git/... cd83bc930ca ; * lisp/htmlfontify.el (hfy-exclude-file-rules): Fix :ve... 8d7ad656658 Fix indent and font-lock for annotation_type # Conflicts: # etc/NEWS commit fd77de542d8a18e8477884839b22ef59e4000ba0 Author: Michael Albinus Date: Sat Jan 14 19:30:55 2023 +0100 ; * etc/NEWS: Fix typos. diff --git a/etc/NEWS b/etc/NEWS index a9392ba627d..ac338da71e8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1645,12 +1645,11 @@ when using MuPDF as the converter for PDF files, which generally leads to sharper images (especially when zooming), and allows customization of background and foreground color of the page via the new user options 'doc-view-svg-background' and 'doc-view-svg-foreground'. To -activate this behaviour, set 'doc-view-mupdf-use-svg' to non-nil if +activate this behavior, set 'doc-view-mupdf-use-svg' to non-nil if your Emacs has SVG support. Note that, with some versions of MuPDF, SVG generation is known to sometimes produce SVG files that are buggy or can take a long time to render. - ** Enriched Mode +++ commit 195afb68e3126f5f5dd25aa3d0760b7f555718e2 Merge: cd83bc930ca 8d7ad656658 Author: Eli Zaretskii Date: Sat Jan 14 18:30:05 2023 +0200 Merge branch 'emacs-29' of git.savannah.gnu.org:/srv/git/emacs into emacs-29 commit cd83bc930ca4cfdb4b666e70424ffcf9ee4d5556 Author: Eli Zaretskii Date: Sat Jan 14 18:15:46 2023 +0200 ; * lisp/htmlfontify.el (hfy-exclude-file-rules): Fix :version. diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index 0e3b48470d1..0959405081f 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -380,7 +380,7 @@ hfy-exclude-file-rules "Define some regular expressions to exclude files" :tag "exclude-rules" :type '(list string) - :version 29.1) + :version "29.1") (defcustom hfy-display-class nil "Display class to use to determine which display class to use when commit 48bd17923a98f49a30bdce2f3a52e03fe45d63f0 Author: Stefan Monnier Date: Sat Jan 14 09:26:17 2023 -0500 (apropos-documentation): Don't try to parse .elc files The old code scanned for #@ in .elc files, assuming they're docstrings and then looking around them to try and guess to which definition that docstring belongs, making many assumptions about how the code happens to be layed out by bytecomp. Replace that with code which relies on the (FILE . POS) info to extract the docstring knowing already where they are and what def they belong to. * lisp/apropos.el (apropos-documentation-check-elc-file): Delete function. (apropos--documentation-add-from-elc): New function to replace it. (apropos--documentation-add): New function, extracted from `apropos-documentation`. (apropos-documentation): Use them. Let-bind `apropos-accumulator` and `apropos-files-scanned`. (apropos-documentation-internal): Don't handle the `cons` case any more. (apropos-item): Don't declare as global var. (apropos-documentation-check-doc-file): Use `apropos-item` as a local var rather than a global var. (apropos-print-doc): Receive `apropos-item` as arg rather than refer to it as a global variable. (apropos-print): Adjust calls accordingly. diff --git a/lisp/apropos.el b/lisp/apropos.el index 459dc72b475..e95f45f1804 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -54,6 +54,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defgroup apropos nil "Apropos commands for users and programmers." :group 'help @@ -193,9 +195,6 @@ apropos-accumulator the face docstring, and CUS-GROUP-DOC is the custom group docstring. Each docstring is either nil or a string.") -(defvar apropos-item () - "Current item in or for `apropos-accumulator'.") - (defvar apropos-synonyms '( ("find" "open" "edit") ("kill" "cut") @@ -906,6 +905,18 @@ apropos--map-preloaded-atoms ((symbolp def) (funcall f def)) ((eq 'defun (car-safe def)) (funcall f (cdr def))))))))) +(defun apropos--documentation-add (symbol doc pos) + (when (setq doc (apropos-documentation-internal doc)) + (let ((score (apropos-score-doc doc)) + (item (cdr (assq symbol apropos-accumulator)))) + (unless item + (push (cons symbol + (setq item (list (apropos-score-symbol symbol 2) + nil nil))) + apropos-accumulator)) + (setf (nth pos item) doc) + (setcar item (+ (car item) score))))) + ;;;###autoload (defun apropos-documentation (pattern &optional do-all) "Show symbols whose documentation contains matches for PATTERN. @@ -928,40 +939,28 @@ apropos-documentation (setq apropos--current (list #'apropos-documentation pattern do-all)) (apropos-parse-pattern pattern t) (or do-all (setq do-all apropos-do-all)) - (setq apropos-accumulator () apropos-files-scanned ()) - (with-temp-buffer - (let ((standard-input (current-buffer)) - (apropos-sort-by-scores apropos-documentation-sort-by-scores) - f v sf sv) - (apropos-documentation-check-doc-file) - (funcall - (if do-all #'mapatoms #'apropos--map-preloaded-atoms) - (lambda (symbol) - (setq f (apropos-safe-documentation symbol) - v (get symbol 'variable-documentation)) - (if (integerp v) (setq v nil)) - (setq f (apropos-documentation-internal f) - v (apropos-documentation-internal v)) - (setq sf (apropos-score-doc f) - sv (apropos-score-doc v)) - (if (or f v) - (if (setq apropos-item - (cdr (assq symbol apropos-accumulator))) - (progn - (if f - (progn - (setcar (nthcdr 1 apropos-item) f) - (setcar apropos-item (+ (car apropos-item) sf)))) - (if v - (progn - (setcar (nthcdr 2 apropos-item) v) - (setcar apropos-item (+ (car apropos-item) sv))))) - (setq apropos-accumulator - (cons (list symbol - (+ (apropos-score-symbol symbol 2) sf sv) - f v) - apropos-accumulator)))))) - (apropos-print nil "\n----------------\n" nil t)))) + (let ((apropos-accumulator ()) + (apropos-files-scanned ()) + (delayed (make-hash-table :test #'equal))) + (with-temp-buffer + (let ((standard-input (current-buffer)) + (apropos-sort-by-scores apropos-documentation-sort-by-scores) + f v) + (apropos-documentation-check-doc-file) + (funcall + (if do-all #'mapatoms #'apropos--map-preloaded-atoms) + (lambda (symbol) + (setq f (apropos-safe-documentation symbol) + v (get symbol 'variable-documentation)) + (if (integerp v) (setq v nil)) + (if (consp f) + (push (list symbol (cdr f) 1) (gethash (car f) delayed)) + (apropos--documentation-add symbol f 1)) + (if (consp v) + (push (list symbol (cdr v) 2) (gethash (car v) delayed)) + (apropos--documentation-add symbol v 2)))) + (maphash #'apropos--documentation-add-from-elc delayed) + (apropos-print nil "\n----------------\n" nil t))))) (defun apropos-value-internal (predicate symbol function) @@ -982,11 +981,11 @@ apropos-value-internal symbol))) (defun apropos-documentation-internal (doc) + ;; By the time we get here, refs to DOC or to .elc files should have + ;; been converted into actual strings. + (cl-assert (not (or (consp doc) (integerp doc)))) (cond - ((consp doc) - (apropos-documentation-check-elc-file (car doc))) - ((and doc - ;; Sanity check in case bad data sneaked into the + ((and ;; Sanity check in case bad data sneaked into the ;; documentation slot. (stringp doc) (string-match apropos-all-words-regexp doc) @@ -1053,89 +1052,51 @@ apropos-documentation-check-doc-file ;; So we exclude them. (cond ((= 3 type) (boundp symbol)) ((= 2 type) (fboundp symbol)))) - (or (and (setq apropos-item (assq symbol apropos-accumulator)) - (setcar (cdr apropos-item) - (apropos-score-doc doc))) - (setq apropos-item (list symbol - (+ (apropos-score-symbol symbol 2) - (apropos-score-doc doc)) - nil nil) - apropos-accumulator (cons apropos-item - apropos-accumulator))) - (when apropos-match-face - (setq doc (substitute-command-keys doc)) - (if (or (string-match apropos-pattern-quoted doc) - (string-match apropos-all-words-regexp doc)) - (put-text-property (match-beginning 0) - (match-end 0) - 'face apropos-match-face doc))) - (setcar (nthcdr type apropos-item) doc)))) + (let ((apropos-item (assq symbol apropos-accumulator))) + (or (and apropos-item + (setcar (cdr apropos-item) + (apropos-score-doc doc))) + (setq apropos-item (list symbol + (+ (apropos-score-symbol symbol 2) + (apropos-score-doc doc)) + nil nil) + apropos-accumulator (cons apropos-item + apropos-accumulator))) + (when apropos-match-face + (setq doc (substitute-command-keys doc)) + (if (or (string-match apropos-pattern-quoted doc) + (string-match apropos-all-words-regexp doc)) + (put-text-property (match-beginning 0) + (match-end 0) + 'face apropos-match-face doc))) + (setcar (nthcdr type apropos-item) doc))))) (setq sepa (goto-char sepb))))) -(defun apropos-documentation-check-elc-file (file) - ;; .elc files have the location of the file specified as #$, but for - ;; built-in files, that's a relative name (while for the rest, it's - ;; absolute). So expand the name in the former case. - (unless (file-name-absolute-p file) - (setq file (expand-file-name file lisp-directory))) - (if (or (member file apropos-files-scanned) - (not (file-exists-p file))) - nil - (let (symbol doc beg end this-is-a-variable) - (setq apropos-files-scanned (cons file apropos-files-scanned)) - (erase-buffer) - (insert-file-contents file) - (while (search-forward "#@" nil t) - ;; Read the comment length, and advance over it. - ;; This #@ may be a false positive, so don't get upset if - ;; it's not followed by the expected number of bytes to skip. - (when (and (setq end (ignore-errors (read))) (natnump end)) - (setq beg (1+ (point)) - end (+ (point) end -1)) - (forward-char) - (if (save-restriction - ;; match ^ and $ relative to doc string - (narrow-to-region beg end) - (re-search-forward apropos-all-words-regexp nil t)) - (progn - (goto-char (+ end 2)) - (setq doc (buffer-substring beg end) - end (- (match-end 0) beg) - beg (- (match-beginning 0) beg)) - (when (apropos-true-hit-doc doc) - (setq this-is-a-variable (looking-at "(def\\(var\\|const\\) ") - symbol (progn - (skip-chars-forward "(a-z") - (forward-char) - (read)) - symbol (if (consp symbol) - (nth 1 symbol) - symbol)) - (if (if this-is-a-variable - (get symbol 'variable-documentation) - (and (fboundp symbol) (apropos-safe-documentation symbol))) - (progn - (or (and (setq apropos-item (assq symbol apropos-accumulator)) - (setcar (cdr apropos-item) - (+ (cadr apropos-item) (apropos-score-doc doc)))) - (setq apropos-item (list symbol - (+ (apropos-score-symbol symbol 2) - (apropos-score-doc doc)) - nil nil) - apropos-accumulator (cons apropos-item - apropos-accumulator))) - (when apropos-match-face - (setq doc (substitute-command-keys doc)) - (if (or (string-match apropos-pattern-quoted doc) - (string-match apropos-all-words-regexp doc)) - (put-text-property (match-beginning 0) - (match-end 0) - 'face apropos-match-face doc))) - (setcar (nthcdr (if this-is-a-variable 3 2) - apropos-item) - doc))))))))))) - - +(defun apropos--documentation-add-from-elc (file defs) + (erase-buffer) + (insert-file-contents + (if (file-name-absolute-p file) file + (expand-file-name file lisp-directory))) + (pcase-dolist (`(,symbol ,begbyte ,pos) defs) + ;; We presume the file-bytes are the same as the buffer bytes, + ;; which should indeed be the case because .elc files use the + ;; `emacs-internal' encoding. + (let* ((beg (byte-to-position (+ (point-min) begbyte))) + (sizeend (1- beg)) + (size (save-excursion + (goto-char beg) + (skip-chars-backward " 0-9") + (cl-assert (looking-back "#@" (- (point) 2))) + (string-to-number (buffer-substring (point) sizeend)))) + (end (byte-to-position (+ begbyte size -1)))) + (when (save-restriction + ;; match ^ and $ relative to doc string + (narrow-to-region beg end) + (goto-char (point-min)) + (re-search-forward apropos-all-words-regexp nil t)) + (let ((doc (buffer-substring beg end))) + (when (apropos-true-hit-doc doc) + (apropos--documentation-add symbol doc pos))))))) (defun apropos-safe-documentation (function) "Like `documentation', except it avoids calling `get_doc_string'. @@ -1252,14 +1213,16 @@ apropos-print (put-text-property (- (point) 3) (point) 'face 'apropos-keybinding))) (terpri)) - (apropos-print-doc 2 + (apropos-print-doc apropos-item + 2 (if (commandp symbol) 'apropos-command (if (macrop symbol) 'apropos-macro 'apropos-function)) (not nosubst)) - (apropos-print-doc 3 + (apropos-print-doc apropos-item + 3 (if (custom-variable-p symbol) 'apropos-user-option 'apropos-variable) @@ -1277,10 +1240,10 @@ apropos-print (lambda (_) (message "Value: %s" value)))) (insert "\n"))) - (apropos-print-doc 7 'apropos-group t) - (apropos-print-doc 6 'apropos-face t) - (apropos-print-doc 5 'apropos-widget t) - (apropos-print-doc 4 'apropos-plist nil)) + (apropos-print-doc apropos-item 7 'apropos-group t) + (apropos-print-doc apropos-item 6 'apropos-face t) + (apropos-print-doc apropos-item 5 'apropos-widget t) + (apropos-print-doc apropos-item 4 'apropos-plist nil)) (setq-local truncate-partial-width-windows t) (setq-local truncate-lines t))) (when help-window-select @@ -1288,7 +1251,7 @@ apropos-print (prog1 apropos-accumulator (setq apropos-accumulator ()))) ; permit gc -(defun apropos-print-doc (i type do-keys) +(defun apropos-print-doc (apropos-item i type do-keys) (let ((doc (nth i apropos-item))) (when (stringp doc) (if apropos-compact-layout commit 8d7ad65665833ae99b7e7119dae37afa438968a4 Author: Theodor Thornhill Date: Sat Jan 14 15:18:40 2023 +0100 Fix indent and font-lock for annotation_type * lisp/progmodes/java-ts-mode.el (java-ts-mode--indent-rules): Indent inside body. (java-ts-mode--font-lock-settings): Add rule for name in annotation_type_element_declaration. diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 1d704f16b47..03342ab52bb 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -78,6 +78,7 @@ java-ts-mode--indent-rules ((parent-is "comment") prev-adaptive-prefix 0) ((parent-is "text_block") no-indent) ((parent-is "class_body") parent-bol java-ts-mode-indent-offset) + ((parent-is "annotation_type_body") parent-bol java-ts-mode-indent-offset) ((parent-is "interface_body") parent-bol java-ts-mode-indent-offset) ((parent-is "constructor_body") parent-bol java-ts-mode-indent-offset) ((parent-is "enum_body") parent-bol java-ts-mode-indent-offset) @@ -225,7 +226,10 @@ java-ts-mode--font-lock-settings :language 'java :override t :feature 'definition - `((method_declaration + `((annotation_type_element_declaration + name: (identifier) @font-lock-function-name-face) + + (method_declaration name: (identifier) @font-lock-function-name-face) (variable_declarator commit ad6d8f7df180a9563d3f064f29c6366f114b8de0 Merge: d9a2673ee95 9a1dbb7f088 Author: Stefan Monnier Date: Sat Jan 14 09:17:30 2023 -0500 Merge remote-tracking branch 'refs/remotes/origin/master' commit d9a2673ee95cf7172a622dc0229ddf72aec8e8c1 Merge: b6207e87fa1 96601cd90ba Author: Stefan Monnier Date: Sat Jan 14 09:12:14 2023 -0500 Merge from origin/emacs-29 96601cd90ba apropos.el: Fix bug#60628 10032f424cc Fix indentation of some declarations and statements e2e937300f5 Fix indentation of object_expressions in csharp-ts-mode 0116e27b26c ; Fix NEWS markup 435ba92ccc4 ; Fix last change in htmlfontify.el 7100ecd7a47 Replace 'hfy-find-cmd' with 'directory-files-recursively'. f102145d381 ; * etc/PROBLEMS: Describe problems with MuPDF 1.21. (Bu... commit b6207e87fa12f62f3c575151e735aff2f89fc321 Merge: a192ce03a0d 79971ebacc7 Author: Stefan Monnier Date: Sat Jan 14 09:10:45 2023 -0500 ; Merge from origin/emacs-29 The following commit was skipped: 79971ebacc7 Disable and document 'doc-view-mupdf-use-svg' (bug#58041) commit a192ce03a0d3066bc0e180436d4cda230b849c1a Merge: 3eb495851ef f1032bf24e7 Author: Stefan Monnier Date: Sat Jan 14 09:10:45 2023 -0500 Merge from origin/emacs-29 f1032bf24e7 Eglot: don't use "nil" as minibuffer initial input 1b9ffd28116 Fix dependency bug when building lwlib dc33a122230 Fix use of build_pure_c_string in treesit.c commit 3eb495851ef0de8ca8ab81274d57954d51ead58e Merge: 4f0459aaf75 59c3c53efa4 Author: Stefan Monnier Date: Sat Jan 14 09:10:45 2023 -0500 ; Merge from origin/emacs-29 The following commits were skipped: 59c3c53efa4 * lisp/subr.el (combine-change-calls-1): Fix bug#60467 9f8f8ed1baf Adapt tramp-tests.el (do not merge with master) commit 4f0459aaf756e56db5fb943177eec6eb5bd5fc4a Merge: 99120491730 861556c1339 Author: Stefan Monnier Date: Sat Jan 14 09:10:45 2023 -0500 Merge from origin/emacs-29 861556c1339 Fix minibuffer-completion tests c0578edc8fc ; * doc/misc/eglot.texi (Troubleshooting Eglot): Fix typo... c6bbf9cc270 Add c-ts-mode tests a760364f5f3 Fix c-ts-mode--fill-paragraph 2a2b1d09ac7 Fix minor issues with 'pp' and related commands dfb38fb2ee6 ; Improve documentation of tree-sitter node comparison e8a89a18b69 ; Fix non-tree-sitter builds f27a330b99e ; Fix typo in ert-with-temp-file 956889d8ff1 Equal now recognizes tree-sitter nodes (bug#60659) 8f446c2d397 Fix c-ts-mode comment indentation (bug#60270) 083badc9c12 * lisp/subr.el (while-let): Use if-let, not if-let* (bug#... 9ecebcdded1 * lisp/simple.el (next-completion): Handle first completi... cfd2b3504ab Fix encoding with 'utf-8-auto' 53b47df8229 Report cursor correctly on PGTK when there is a margin # Conflicts: # etc/NEWS commit 96601cd90ba1b8a650d0e41dad2a58cb9e270f1b Author: Stefan Monnier Date: Sat Jan 14 09:06:10 2023 -0500 apropos.el: Fix bug#60628 * lisp/apropos.el (apropos--map-preloaded-atoms): New function. (apropos-documentation): Use it. (apropos-documentation-check-elc-file): Don't presume #@ is preceded by a newline (since that's not the case any more since commit 900b09c0235d54d5), but be more careful not to burp on false positives. diff --git a/lisp/apropos.el b/lisp/apropos.el index b260d889955..5d7fe6962a5 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -886,6 +886,26 @@ apropos-local-value (if (consp pattern) "keywords " "") pattern)))) +(defun apropos--map-preloaded-atoms (f) + "Like `mapatoms' but only enumerates functions&vars that are predefined." + (let ((preloaded-regexp + (concat "\\`" + (regexp-quote lisp-directory) + (regexp-opt preloaded-file-list) + "\\.elc?\\'"))) + ;; FIXME: I find this regexp approach brittle. Maybe a better + ;; option would be find/record the nthcdr of `load-history' which + ;; corresponds to the `load-history' state when we dumped. + ;; (Then again, maybe an even better approach would be to record the + ;; state of the `obarray' when we dumped, which we may also be able to + ;; use in `bytecomp' to provide a clean initial environment?) + (dolist (x load-history) + (when (string-match preloaded-regexp (car x)) + (dolist (def (cdr x)) + (cond + ((symbolp def) (funcall f def)) + ((eq 'defun (car-safe def)) (funcall f (cdr def))))))))) + ;;;###autoload (defun apropos-documentation (pattern &optional do-all) "Show symbols whose documentation contains matches for PATTERN. @@ -894,10 +914,11 @@ apropos-documentation search for matches for that word as a substring. If it is a list of words, search for matches for any two (or more) of those words. -Note that by default this command only searches in the file specified by -`internal-doc-file-name'; i.e., the etc/DOC file. With \\[universal-argument] prefix, -or if `apropos-do-all' is non-nil, it searches all currently defined -documentation strings. +Note that by default this command only searches in the functions predefined +at Emacs startup, i.e., the primitives implemented in C or preloaded in the +Emacs dump image. +With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, it searches +all currently defined documentation strings. Returns list of symbols and documentation found." ;; The doc used to say that DO-ALL includes key-bindings info in the @@ -913,33 +934,33 @@ apropos-documentation (apropos-sort-by-scores apropos-documentation-sort-by-scores) f v sf sv) (apropos-documentation-check-doc-file) - (if do-all - (mapatoms - (lambda (symbol) - (setq f (apropos-safe-documentation symbol) - v (get symbol 'variable-documentation)) - (if (integerp v) (setq v nil)) - (setq f (apropos-documentation-internal f) - v (apropos-documentation-internal v)) - (setq sf (apropos-score-doc f) - sv (apropos-score-doc v)) - (if (or f v) - (if (setq apropos-item - (cdr (assq symbol apropos-accumulator))) - (progn - (if f - (progn - (setcar (nthcdr 1 apropos-item) f) - (setcar apropos-item (+ (car apropos-item) sf)))) - (if v - (progn - (setcar (nthcdr 2 apropos-item) v) - (setcar apropos-item (+ (car apropos-item) sv))))) - (setq apropos-accumulator - (cons (list symbol - (+ (apropos-score-symbol symbol 2) sf sv) - f v) - apropos-accumulator))))))) + (funcall + (if do-all #'mapatoms #'apropos--map-preloaded-atoms) + (lambda (symbol) + (setq f (apropos-safe-documentation symbol) + v (get symbol 'variable-documentation)) + (if (integerp v) (setq v nil)) + (setq f (apropos-documentation-internal f) + v (apropos-documentation-internal v)) + (setq sf (apropos-score-doc f) + sv (apropos-score-doc v)) + (if (or f v) + (if (setq apropos-item + (cdr (assq symbol apropos-accumulator))) + (progn + (if f + (progn + (setcar (nthcdr 1 apropos-item) f) + (setcar apropos-item (+ (car apropos-item) sf)))) + (if v + (progn + (setcar (nthcdr 2 apropos-item) v) + (setcar apropos-item (+ (car apropos-item) sv))))) + (setq apropos-accumulator + (cons (list symbol + (+ (apropos-score-symbol symbol 2) sf sv) + f v) + apropos-accumulator)))))) (apropos-print nil "\n----------------\n" nil t)))) @@ -1064,53 +1085,55 @@ apropos-documentation-check-elc-file (setq apropos-files-scanned (cons file apropos-files-scanned)) (erase-buffer) (insert-file-contents file) - (while (search-forward "\n#@" nil t) + (while (search-forward "#@" nil t) ;; Read the comment length, and advance over it. - (setq end (read) - beg (1+ (point)) - end (+ (point) end -1)) - (forward-char) - (if (save-restriction - ;; match ^ and $ relative to doc string - (narrow-to-region beg end) - (re-search-forward apropos-all-words-regexp nil t)) - (progn - (goto-char (+ end 2)) - (setq doc (buffer-substring beg end) - end (- (match-end 0) beg) - beg (- (match-beginning 0) beg)) - (when (apropos-true-hit-doc doc) - (setq this-is-a-variable (looking-at "(def\\(var\\|const\\) ") - symbol (progn - (skip-chars-forward "(a-z") - (forward-char) - (read)) - symbol (if (consp symbol) - (nth 1 symbol) - symbol)) - (if (if this-is-a-variable - (get symbol 'variable-documentation) - (and (fboundp symbol) (apropos-safe-documentation symbol))) - (progn - (or (and (setq apropos-item (assq symbol apropos-accumulator)) - (setcar (cdr apropos-item) - (+ (cadr apropos-item) (apropos-score-doc doc)))) - (setq apropos-item (list symbol - (+ (apropos-score-symbol symbol 2) - (apropos-score-doc doc)) - nil nil) - apropos-accumulator (cons apropos-item - apropos-accumulator))) - (when apropos-match-face - (setq doc (substitute-command-keys doc)) - (if (or (string-match apropos-pattern-quoted doc) - (string-match apropos-all-words-regexp doc)) - (put-text-property (match-beginning 0) - (match-end 0) - 'face apropos-match-face doc))) - (setcar (nthcdr (if this-is-a-variable 3 2) - apropos-item) - doc)))))))))) + ;; This #@ may be a false positive, so don't get upset if + ;; it's not followed by the expected number of bytes to skip. + (when (and (setq end (ignore-errors (read))) (natnump end)) + (setq beg (1+ (point)) + end (+ (point) end -1)) + (forward-char) + (if (save-restriction + ;; match ^ and $ relative to doc string + (narrow-to-region beg end) + (re-search-forward apropos-all-words-regexp nil t)) + (progn + (goto-char (+ end 2)) + (setq doc (buffer-substring beg end) + end (- (match-end 0) beg) + beg (- (match-beginning 0) beg)) + (when (apropos-true-hit-doc doc) + (setq this-is-a-variable (looking-at "(def\\(var\\|const\\) ") + symbol (progn + (skip-chars-forward "(a-z") + (forward-char) + (read)) + symbol (if (consp symbol) + (nth 1 symbol) + symbol)) + (if (if this-is-a-variable + (get symbol 'variable-documentation) + (and (fboundp symbol) (apropos-safe-documentation symbol))) + (progn + (or (and (setq apropos-item (assq symbol apropos-accumulator)) + (setcar (cdr apropos-item) + (+ (cadr apropos-item) (apropos-score-doc doc)))) + (setq apropos-item (list symbol + (+ (apropos-score-symbol symbol 2) + (apropos-score-doc doc)) + nil nil) + apropos-accumulator (cons apropos-item + apropos-accumulator))) + (when apropos-match-face + (setq doc (substitute-command-keys doc)) + (if (or (string-match apropos-pattern-quoted doc) + (string-match apropos-all-words-regexp doc)) + (put-text-property (match-beginning 0) + (match-end 0) + 'face apropos-match-face doc))) + (setcar (nthcdr (if this-is-a-variable 3 2) + apropos-item) + doc))))))))))) commit 10032f424ccf611783f5b92742e91e70595587c4 Author: Theodor Thornhill Date: Fri Jan 13 11:33:58 2023 +0100 Fix indentation of some declarations and statements * lisp/progmodes/java-ts-mode.el (java-ts-mode--indent-rules): Add new rules so that we don't anchor at col 0. diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 86e753c5f53..1d704f16b47 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -85,6 +85,10 @@ java-ts-mode--indent-rules ((parent-is "record_declaration_body") parent-bol java-ts-mode-indent-offset) ((query "(method_declaration (block _ @indent))") parent-bol java-ts-mode-indent-offset) ((query "(method_declaration (block (_) @indent))") parent-bol java-ts-mode-indent-offset) + ((parent-is "local_variable_declaration") parent-bol java-ts-mode-indent-offset) + ((parent-is "expression_statement") parent-bol java-ts-mode-indent-offset) + ((parent-is "field_declaration") parent-bol java-ts-mode-indent-offset) + ((parent-is "return_statement") parent-bol java-ts-mode-indent-offset) ((parent-is "variable_declarator") parent-bol java-ts-mode-indent-offset) ((parent-is "method_invocation") parent-bol java-ts-mode-indent-offset) ((parent-is "switch_rule") parent-bol java-ts-mode-indent-offset) commit e2e937300f5a68ce1e2a349a583859a29394ac5f Author: Theodor Thornhill Date: Thu Jan 12 09:06:45 2023 +0100 Fix indentation of object_expressions in csharp-ts-mode * lisp/progmodes/csharp-mode.el (csharp-ts-mode--indent-rules): Make sure the opening brace is indented at parent-bol, and everything else is indented. diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index 79afd7f91dc..81ce41618e7 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -640,6 +640,11 @@ csharp-ts-mode--indent-rules ((parent-is "namespace_declaration") parent-bol 0) ((parent-is "class_declaration") parent-bol 0) ((parent-is "constructor_declaration") parent-bol 0) + ((parent-is "initializer_expression") parent-bol csharp-ts-mode-indent-offset) + ((match "{" "anonymous_object_creation_expression") parent-bol 0) + ((parent-is "anonymous_object_creation_expression") parent-bol csharp-ts-mode-indent-offset) + ((match "{" "object_creation_expression") parent-bol 0) + ((parent-is "object_creation_expression") parent-bol 0) ((parent-is "method_declaration") parent-bol 0) ((parent-is "enum_declaration") parent-bol 0) ((parent-is "operator_declaration") parent-bol 0) commit 0116e27b26cb4a98f2de8dca12d8e9d90d222992 Author: Eli Zaretskii Date: Sat Jan 14 11:53:37 2023 +0200 ; Fix NEWS markup diff --git a/etc/NEWS b/etc/NEWS index fa28ba465f8..a9392ba627d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1638,6 +1638,7 @@ This can be used to trigger actions based on the battery status. ** DocView +--- *** doc-view can now generate SVG images when viewing PDF files. If Emacs is built with SVG support, doc-view can generate SVG files when using MuPDF as the converter for PDF files, which generally leads commit 9a1dbb7f088c95a46a3be6334572ebece83d2dde Author: Eli Zaretskii Date: Sat Jan 14 11:48:55 2023 +0200 Teach 'eww-open-file' about prefix argument * lisp/net/eww.el (eww-open-file): Accept a new optional argument NEW-BUFFER to show FILE in a new buffer. (Bug#60809) * etc/NEWS: * doc/misc/eww.texi (Basics): Document the new feature. diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index bc556ed88e2..836eb38503e 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -92,9 +92,10 @@ Basics either prefix the file name with @code{file://} or use the command @kbd{M-x eww-open-file}. - If you invoke @code{eww} with a prefix argument, as in @w{@kbd{C-u -M-x eww}}, it will create a new EWW buffer instead of reusing the -default one, which is normally called @file{*eww*}. + If you invoke @code{eww} or @code{eww-open-file} with a prefix +argument, as in @w{@kbd{C-u M-x eww}}, they will create a new EWW +buffer instead of reusing the default one, which is normally called +@file{*eww*}. @findex eww-quit @findex eww-reload diff --git a/etc/NEWS b/etc/NEWS index 90a6c6a0522..cb83ec24a61 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -147,6 +147,15 @@ point is not in a comment or a string. It is by default bound to *** New connection method "toolbox". This allow accessing system containers provided by Toolbox. +** EWW + ++++ +*** 'eww-open-file' can now display the file in a new buffer. +By default, the command reuses the '*eww*' buffer, but if called with +the new argument non-nil, it will use a new buffer instead. +Interactively, invoke 'eww-open-file' with a prefix argument to +activate this behavior. + * New Modes and Packages in Emacs 30.1 diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 763b2f07a5c..73d11c0ef52 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -488,14 +488,17 @@ eww--preprocess-html ;;;###autoload (defalias 'browse-web 'eww) ;;;###autoload -(defun eww-open-file (file) - "Render FILE using EWW." - (interactive "fFile: ") +(defun eww-open-file (file &optional new-buffer) + "Render FILE using EWW. +If NEW-BUFFER is non-nil (interactively, the prefix arg), use a +new buffer instead of reusing the default EWW buffer." + (interactive "fFile: \nP") (let ((url-allow-non-local-files t)) (eww (concat "file://" (and (memq system-type '(windows-nt ms-dos)) "/") - (expand-file-name file))))) + (expand-file-name file)) + new-buffer))) (defun eww--file-buffer (file) (with-current-buffer (generate-new-buffer " *eww file*") commit 435ba92ccc4c46914c261de57f71ac6d92c20178 Author: Eli Zaretskii Date: Sat Jan 14 11:10:53 2023 +0200 ; Fix last change in htmlfontify.el diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index f05bc4e1e35..0e3b48470d1 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -78,7 +78,7 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) +(require 'cl-lib) (require 'cus-edit) (defconst hfy-meta-tags @@ -379,7 +379,8 @@ hfy-exclude-file-rules "/\\.git\\(?:/.*\\)?$") "Define some regular expressions to exclude files" :tag "exclude-rules" - :type '(list string)) + :type '(list string) + :version 29.1) (defcustom hfy-display-class nil "Display class to use to determine which display class to use when commit 7100ecd7a472a5ff49d7c8a4b9c061a50520e93b Author: Xi Lu Date: Sat Jan 7 22:46:40 2023 +0800 Replace 'hfy-find-cmd' with 'directory-files-recursively'. This removes a potential vulnerability to maliciously named files. (Bug#60562) * lisp/htmlfontify.el (hfy-exclude-file-rules): New defcustom. (hfy-list-files): Reimplement using 'directory-files-recursively'. diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index c989a12d205..f05bc4e1e35 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -372,11 +372,14 @@ hfy-istext-command :tag "istext-command" :type '(string)) -(defcustom hfy-find-cmd - "find . -type f \\! -name \\*~ \\! -name \\*.flc \\! -path \\*/CVS/\\*" - "Find command used to harvest a list of files to attempt to fontify." - :tag "find-command" - :type '(string)) +(defcustom hfy-exclude-file-rules + '("\\.flc$" + "/CVS/.*" + ".*~$" + "/\\.git\\(?:/.*\\)?$") + "Define some regular expressions to exclude files" + :tag "exclude-rules" + :type '(list string)) (defcustom hfy-display-class nil "Display class to use to determine which display class to use when @@ -1826,8 +1829,12 @@ hfy-list-files ;;(message "hfy-list-files");;DBUG ;; FIXME: this changes the dir of the current buffer. Is that right?? (cd directory) - (mapcar (lambda (F) (if (string-match "^./\\(.*\\)" F) (match-string 1 F) F)) - (split-string (shell-command-to-string hfy-find-cmd))) ) + (cl-remove-if (lambda (f) + (or (null (file-regular-p f)) + (seq-some (lambda (r) + (string-match r f)) + hfy-exclude-file-rules))) + (directory-files-recursively "." ".*" nil t))) ;; strip the filename off, return a directory name ;; not a particularly thorough implementation, but it will be commit f102145d381f975e937dd4512a2ac53af604be4a Author: Eli Zaretskii Date: Sat Jan 14 10:52:06 2023 +0200 ; * etc/PROBLEMS: Describe problems with MuPDF 1.21. (Bug#60308) diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 1b796b11caf..69c42e9bed0 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -628,6 +628,18 @@ To work around the problem, customize the option 'window-adjust-process-window-size-function' to "Do not adjust process window sizes" (Lisp value 'ignore'). +*** Displaying PDF files in DocView produces an empty buffer. + +This can happen if your Emacs is configured to convert PDF to SVG for +display, and the version of the MuPDF package you have installed has a +a known bug, whereby it sometimes produces invalid SVG images. +Version 1.21 of MuPDF is known to be affected. + +The solution is either to upgrade or downgrade to a version of MuPDF +that doesn't have this bug, or to disable conversion of PDF files to +SVG images by customizing the user option 'doc-view-mupdf-use-svg'. +Emacs will then convert PDF to PNG images instead. + *** In Inferior Python mode, input is echoed and native completion doesn't work. commit ac2a6fc83fac6390892b068a830ebe0f22364e05 Author: Eli Zaretskii Date: Sat Jan 14 10:40:15 2023 +0200 ; * lisp/proced.el (proced--determine-pos): Fix doc string wording. diff --git a/lisp/proced.el b/lisp/proced.el index 29a05f2d5db..03a7f1bebdf 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -814,11 +814,11 @@ proced--position-info (current-column)))))) (defun proced--determine-pos (key column) - "Return the point in the current line using KEY and COLUMN. + "Return position of point in the current line using KEY and COLUMN. Attempt to find the first position on the current line where the text property proced-key is equal to KEY. If this is not possible, return -the point of column COLUMN on the current line." +the position of point of column COLUMN on the current line." (save-excursion (let (new-pos) (if key commit f0ac01812f93ea8bea95e37415987e8d7a82fb1c Author: Laurence Warne Date: Thu Dec 22 17:16:08 2022 +0000 Preserve the window position with proced (bug#60381) Preserve the window position for windows which display a proced buffer, but are not the selected window when a proced buffer is updated. Previously, the window position would be set to the start of the buffer when a proced buffer was updated and it was not displayed in the selected window. Similarly, preserve the position in proced buffers which are not displayed in any window by setting 'switch-to-buffer-preserve-window-point' to nil in proced buffers. * lisp/proced.el (proced-auto-update-timer): Only update a given proced buffer if it is displayed in a window. (proced-update): Set the window position if the proced buffer is displayed in a window. (proced--position-info, proced--determine-pos): New Functions. (proced-mode): Set 'switch-to-buffer-preserve-window-point' to nil in proced buffers. * test/lisp/proced-tests.el (proced-update-preserves-pid-at-point-test): New test. diff --git a/lisp/proced.el b/lisp/proced.el index 839b36b528f..29a05f2d5db 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -792,6 +792,52 @@ proced-pid-at-point (if (looking-at "^. .") (get-text-property (match-end 0) 'proced-pid)))) +(defun proced--position-info (pos) + "Return information of the process at POS. + +The returned information will have the form `(PID KEY COLUMN)' where +PID is the process ID of the process at point, KEY is the value of the +proced-key text property at point, and COLUMN is the column for which the +current value of the proced-key text property starts, or 0 if KEY is nil." + ;; If point is on a field, we try to return point to that field. + ;; Otherwise we try to return to the same column + (save-excursion + (goto-char pos) + (let ((pid (proced-pid-at-point)) + (key (get-text-property (point) 'proced-key))) + (list pid key ; can both be nil + (if key + (if (get-text-property (1- (point)) 'proced-key) + (- (point) (previous-single-property-change + (point) 'proced-key)) + 0) + (current-column)))))) + +(defun proced--determine-pos (key column) + "Return the point in the current line using KEY and COLUMN. + +Attempt to find the first position on the current line where the +text property proced-key is equal to KEY. If this is not possible, return +the point of column COLUMN on the current line." + (save-excursion + (let (new-pos) + (if key + (let ((limit (line-end-position)) pos) + (while (and (not new-pos) + (setq pos (next-property-change (point) nil limit))) + (goto-char pos) + (when (eq key (get-text-property (point) 'proced-key)) + (forward-char (min column (- (next-property-change (point)) + (point)))) + (setq new-pos (point)))) + (unless new-pos + ;; we found the process, but the field of point + ;; is not listed anymore + (setq new-pos (proced-move-to-goal-column)))) + (setq new-pos (min (+ (line-beginning-position) column) + (line-end-position)))) + new-pos))) + ;; proced mode (define-derived-mode proced-mode special-mode "Proced" @@ -847,6 +893,7 @@ proced-mode (setq-local revert-buffer-function #'proced-revert) (setq-local font-lock-defaults '(proced-font-lock-keywords t nil nil beginning-of-line)) + (setq-local switch-to-buffer-preserve-window-point nil) (if (and (not proced-auto-update-timer) proced-auto-update-interval) (setq proced-auto-update-timer (run-at-time t proced-auto-update-interval @@ -1889,17 +1936,10 @@ proced-update (if (consp buffer-undo-list) (setq buffer-undo-list nil)) (let ((buffer-undo-list t) - ;; If point is on a field, we try to return point to that field. - ;; Otherwise we try to return to the same column - (old-pos (let ((pid (proced-pid-at-point)) - (key (get-text-property (point) 'proced-key))) - (list pid key ; can both be nil - (if key - (if (get-text-property (1- (point)) 'proced-key) - (- (point) (previous-single-property-change - (point) 'proced-key)) - 0) - (current-column))))) + (window-pos-infos + (mapcar (lambda (w) `(,w . ,(proced--position-info (window-point w)))) + (get-buffer-window-list (current-buffer) nil t))) + (old-pos (proced--position-info (point))) buffer-read-only mp-list) ;; remember marked processes (whatever the mark was) (goto-char (point-min)) @@ -1932,7 +1972,8 @@ proced-update ;; Sometimes this puts point in the middle of the proced buffer ;; where it is not interesting. Is there a better / more flexible solution? (goto-char (point-min)) - (let (pid mark new-pos) + + (let (pid mark new-pos win-points) (if (or mp-list (car old-pos)) (while (not (eobp)) (setq pid (proced-pid-at-point)) @@ -1941,28 +1982,25 @@ proced-update (delete-char 1) (beginning-of-line)) (when (eq (car old-pos) pid) - (if (nth 1 old-pos) - (let ((limit (line-end-position)) pos) - (while (and (not new-pos) - (setq pos (next-property-change (point) nil limit))) - (goto-char pos) - (when (eq (nth 1 old-pos) - (get-text-property (point) 'proced-key)) - (forward-char (min (nth 2 old-pos) - (- (next-property-change (point)) - (point)))) - (setq new-pos (point)))) - (unless new-pos - ;; we found the process, but the field of point - ;; is not listed anymore - (setq new-pos (proced-move-to-goal-column)))) - (setq new-pos (min (+ (line-beginning-position) (nth 2 old-pos)) - (line-end-position))))) + (setq new-pos (proced--determine-pos (nth 1 old-pos) + (nth 2 old-pos)))) + (mapc (lambda (w-pos) + (when (eq (cadr w-pos) pid) + (push `(,(car w-pos) . ,(proced--determine-pos + (nth 1 (cdr w-pos)) + (nth 2 (cdr w-pos)))) + win-points))) + window-pos-infos) (forward-line))) - (if new-pos - (goto-char new-pos) - (goto-char (point-min)) - (proced-move-to-goal-column))) + (let ((fallback (save-excursion (goto-char (point-min)) + (proced-move-to-goal-column) + (point)))) + (goto-char (or new-pos fallback)) + ;; Update window points + (mapc (lambda (w-pos) + (set-window-point (car w-pos) + (alist-get (car w-pos) win-points fallback))) + window-pos-infos))) ;; update mode line ;; Does the long `mode-name' clutter the mode line? It would be nice ;; to have some other location for displaying the values of the various diff --git a/test/lisp/proced-tests.el b/test/lisp/proced-tests.el index 3c1f5493e74..1f475665298 100644 --- a/test/lisp/proced-tests.el +++ b/test/lisp/proced-tests.el @@ -101,5 +101,22 @@ proced-refine-with-update-test (should (string= pid (word-at-point))) (forward-line))))) +(ert-deftest proced-update-preserves-pid-at-point-test () + (proced--within-buffer + 'medium + 'user + (goto-char (point-min)) + (search-forward (number-to-string (emacs-pid))) + (proced--move-to-column "PID") + (save-window-excursion + (let ((pid (proced-pid-at-point)) + (new-window (split-window)) + (old-window (get-buffer-window))) + (select-window new-window) + (with-current-buffer "*Proced*" + (proced-update t t)) + (select-window old-window) + (should (= pid (proced-pid-at-point))))))) + (provide 'proced-tests) ;;; proced-tests.el ends here commit 4514b7ecc6fdf8d2642ea6ff84f0af3868a3a658 Author: Eli Zaretskii Date: Sat Jan 14 10:32:44 2023 +0200 ; * lisp/doc-view.el (doc-view-mupdf-use-svg): Bump :version. diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 7c272f52fb3..0303fec67a6 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -212,7 +212,7 @@ doc-view-pdf->png-converter-function (defcustom doc-view-mupdf-use-svg (image-type-available-p 'svg) "Whether to use svg images for PDF files." :type 'boolean - :version "29.1") + :version "30.1") (defcustom doc-view-imenu-enabled (and (executable-find "mutool") t) "Whether to generate an imenu outline when \"mutool\" is available." commit 79971ebacc7ea114cbb9210d3505a576c95b2964 Author: Eli Zaretskii Date: Sat Jan 14 10:26:40 2023 +0200 Disable and document 'doc-view-mupdf-use-svg' (bug#58041) * lisp/doc-view.el (doc-view-mupdf-use-svg): Disable by default. * etc/NEWS: Document. Patch by Visuwesh . Do not merge to master. diff --git a/etc/NEWS b/etc/NEWS index 08c7f8a4dd6..fa28ba465f8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1636,6 +1636,20 @@ randomness as before, or to use a bag). *** New user option 'battery-update-functions'. This can be used to trigger actions based on the battery status. +** DocView + +*** doc-view can now generate SVG images when viewing PDF files. +If Emacs is built with SVG support, doc-view can generate SVG files +when using MuPDF as the converter for PDF files, which generally leads +to sharper images (especially when zooming), and allows customization +of background and foreground color of the page via the new user +options 'doc-view-svg-background' and 'doc-view-svg-foreground'. To +activate this behaviour, set 'doc-view-mupdf-use-svg' to non-nil if +your Emacs has SVG support. Note that, with some versions of MuPDF, +SVG generation is known to sometimes produce SVG files that are buggy +or can take a long time to render. + + ** Enriched Mode +++ diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 7c272f52fb3..427da557d23 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -209,8 +209,8 @@ doc-view-pdf->png-converter-function function) :version "24.4") -(defcustom doc-view-mupdf-use-svg (image-type-available-p 'svg) - "Whether to use svg images for PDF files." +(defcustom doc-view-mupdf-use-svg nil + "Whether to use SVG images for PDF files." :type 'boolean :version "29.1") commit f1032bf24e79cf32341473c5d9f447c4c74f9d2b Author: Eshel Yaron Date: Sat Jan 14 10:12:11 2023 +0200 Eglot: don't use "nil" as minibuffer initial input Doing M-x eglot in a buffer for which buffer-file-name is nil, prompts the user for a major mode to manage by invoking completing-read. The way completing-read was called would end up with the string "nil" as the initial minibuffer input, which is not very useful nor is it a valid input. * lisp/progmodes/eglot.el (eglot--guess-contact): Tweak prompt for major mode. (Bug#60379) Copyright-paperwork-exempt: yes diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 6d192d9b333..0082a171303 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -991,6 +991,7 @@ eglot--guess-contact non-nil, maybe prompt user, else error as soon as something can't be guessed." (let* ((guessed-mode (if buffer-file-name major-mode)) + (guessed-mode-name (and guessed-mode (symbol-name guessed-mode))) (main-mode (cond ((and interactive @@ -1000,7 +1001,7 @@ eglot--guess-contact (completing-read "[eglot] Start a server to manage buffers of what major mode? " (mapcar #'symbol-name (eglot--all-major-modes)) nil t - (symbol-name guessed-mode) nil (symbol-name guessed-mode) nil))) + guessed-mode-name nil guessed-mode-name nil))) ((not guessed-mode) (eglot--error "Can't guess mode to manage for `%s'" (current-buffer))) (t guessed-mode))) commit 1b9ffd281162794e71a7e6a4d26cfbb3991c0cde Author: Paul Eggert Date: Fri Jan 13 18:22:47 2023 -0800 Fix dependency bug when building lwlib * lwlib/Makefile.in (DEPFLAGS): Use OBJS to calculate dependency file names, not ALLOBJS. This fixes a typo introduced in 2015-05-15 "Replace AC_SUBST_FILE in configure with include in Makefiles" that caused lwlib/*.o to not be rebuilt sometimes when that was needed. diff --git a/lwlib/Makefile.in b/lwlib/Makefile.in index 903461a2f4a..70f6cd17d78 100644 --- a/lwlib/Makefile.in +++ b/lwlib/Makefile.in @@ -63,7 +63,7 @@ AUTO_DEPEND = DEPDIR = deps ifeq ($(AUTO_DEPEND),yes) DEPFLAGS = -MMD -MF $(DEPDIR)/$*.d -MP - -include $(ALLOBJS:%.o=$(DEPDIR)/%.d) + -include $(OBJS:%.o=$(DEPDIR)/%.d) else DEPFLAGS = include $(srcdir)/deps.mk commit dc33a122230adbfa37926f4eb19c0620b3affd85 Author: Yuan Fu Date: Fri Jan 13 17:26:08 2023 -0800 Fix use of build_pure_c_string in treesit.c This is brought up in bug#60691. build_pure_c_string should only be used in places such as syms_of_treesit, which are called just once, during dumping. * src/treesit.c (Vtreesit_str_libtree_sitter): (Vtreesit_str_tree_sitter): (Vtreesit_str_dot): (Vtreesit_str_question_mark): (Vtreesit_str_star): (Vtreesit_str_plus): (Vtreesit_str_pound_equal): (Vtreesit_str_pound_match): (Vtreesit_str_pound_pred): (Vtreesit_str_open_bracket): (Vtreesit_str_close_bracket): (Vtreesit_str_open_paren): (Vtreesit_str_close_paren): (Vtreesit_str_space): (Vtreesit_str_equal): (Vtreesit_str_match): (Vtreesit_str_pred): New variables. (treesit_load_language): (Ftreesit_pattern_expand): (Ftreesit_query_expand): (treesit_eval_predicates): Use new varaibles. (treesit_check_buffer_size): (treesit_compose_query_signal_data): (treesit_check_range_argument): (Ftreesit_parser_set_included_ranges): (treesit_predicate_capture_name_to_node): (treesit_predicate_equal): (treesit_predicate_match): (treesit_predicate_pred): Use build_string for signal message. (syms_of_treesit): Initialize new variables. diff --git a/src/treesit.c b/src/treesit.c index 33a7e3c8528..3886fed346e 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -406,6 +406,24 @@ #define ts_tree_root_node fn_ts_tree_root_node /*** Initialization */ +static Lisp_Object Vtreesit_str_libtree_sitter; +static Lisp_Object Vtreesit_str_tree_sitter; +static Lisp_Object Vtreesit_str_dot; +static Lisp_Object Vtreesit_str_question_mark; +static Lisp_Object Vtreesit_str_star; +static Lisp_Object Vtreesit_str_plus; +static Lisp_Object Vtreesit_str_pound_equal; +static Lisp_Object Vtreesit_str_pound_match; +static Lisp_Object Vtreesit_str_pound_pred; +static Lisp_Object Vtreesit_str_open_bracket; +static Lisp_Object Vtreesit_str_close_bracket; +static Lisp_Object Vtreesit_str_open_paren; +static Lisp_Object Vtreesit_str_close_paren; +static Lisp_Object Vtreesit_str_space; +static Lisp_Object Vtreesit_str_equal; +static Lisp_Object Vtreesit_str_match; +static Lisp_Object Vtreesit_str_pred; + /* This is the limit on recursion levels for some tree-sitter functions. Remember to update docstrings when changing this value. */ @@ -534,9 +552,9 @@ treesit_load_language (Lisp_Object language_symbol, /* Figure out the library name and C name. */ Lisp_Object lib_base_name - = concat2 (build_pure_c_string ("libtree-sitter-"), symbol_name); + = concat2 (Vtreesit_str_libtree_sitter, symbol_name); Lisp_Object base_name - = concat2 (build_pure_c_string ("tree-sitter-"), symbol_name); + = concat2 (Vtreesit_str_tree_sitter, symbol_name); /* Override the library name and C name, if appropriate. */ Lisp_Object override_name; @@ -945,7 +963,7 @@ treesit_check_buffer_size (struct buffer *buffer) ptrdiff_t buffer_size_bytes = (BUF_Z_BYTE (buffer) - BUF_BEG_BYTE (buffer)); if (buffer_size_bytes > UINT32_MAX) xsignal2 (Qtreesit_buffer_too_large, - build_pure_c_string ("Buffer size cannot be larger than 4GB"), + build_string ("Buffer size cannot be larger than 4GB"), make_fixnum (buffer_size_bytes)); } @@ -1200,7 +1218,7 @@ treesit_compose_query_signal_data (uint32_t error_offset, return list4 (build_string (treesit_query_error_to_string (error_type)), make_fixnum (error_offset + 1), query_source, - build_pure_c_string ("Debug the query with `treesit-query-validate'")); + build_string ("Debug the query with `treesit-query-validate'")); } /* Ensure the QUERY is compiled. Return the TSQuery. It could be @@ -1498,8 +1516,8 @@ treesit_check_range_argument (Lisp_Object ranges) EMACS_INT end = XFIXNUM (XCDR (range)); if (!(last_point <= beg && beg <= end && end <= point_max)) xsignal2 (Qtreesit_range_invalid, - build_pure_c_string ("RANGE is either overlapping," - " out-of-order or out-of-range"), + build_string ("RANGE is either overlapping," + " out-of-order or out-of-range"), ranges); last_point = end; } @@ -1607,7 +1625,7 @@ DEFUN ("treesit-parser-set-included-ranges", if (!success) xsignal2 (Qtreesit_range_invalid, - build_pure_c_string ("Something went wrong when setting ranges"), + build_string ("Something went wrong when setting ranges"), ranges); XTS_PARSER (parser)->need_reparse = true; @@ -2210,30 +2228,32 @@ DEFUN ("treesit-pattern-expand", (Lisp_Object pattern) { if (EQ (pattern, QCanchor)) - return build_pure_c_string ("."); + return Vtreesit_str_dot; if (EQ (pattern, intern_c_string (":?"))) - return build_pure_c_string ("?"); + return Vtreesit_str_question_mark; if (EQ (pattern, intern_c_string (":*"))) - return build_pure_c_string ("*"); + return Vtreesit_str_star; if (EQ (pattern, intern_c_string (":+"))) - return build_pure_c_string ("+"); + return Vtreesit_str_plus; if (EQ (pattern, QCequal)) - return build_pure_c_string ("#equal"); + return Vtreesit_str_pound_equal; if (EQ (pattern, QCmatch)) - return build_pure_c_string ("#match"); + return Vtreesit_str_pound_match; if (EQ (pattern, QCpred)) - return build_pure_c_string ("#pred"); + return Vtreesit_str_pound_pred; Lisp_Object opening_delimeter - = build_pure_c_string (VECTORP (pattern) ? "[" : "("); + = VECTORP (pattern) + ? Vtreesit_str_open_bracket : Vtreesit_str_open_paren; Lisp_Object closing_delimiter - = build_pure_c_string (VECTORP (pattern) ? "]" : ")"); + = VECTORP (pattern) + ? Vtreesit_str_close_bracket : Vtreesit_str_close_paren; if (VECTORP (pattern) || CONSP (pattern)) return concat3 (opening_delimeter, Fmapconcat (Qtreesit_pattern_expand, pattern, - build_pure_c_string (" ")), + Vtreesit_str_space), closing_delimiter); - return CALLN (Fformat, build_pure_c_string ("%S"), pattern); + return Fprin1_to_string (pattern, Qnil, Qt); } DEFUN ("treesit-query-expand", @@ -2260,8 +2280,7 @@ DEFUN ("treesit-query-expand", See Info node `(elisp)Pattern Matching' for detailed explanation. */) (Lisp_Object query) { - return Fmapconcat (Qtreesit_pattern_expand, - query, build_pure_c_string (" ")); + return Fmapconcat (Qtreesit_pattern_expand, query, Vtreesit_str_space); } /* This struct is used for passing captures to be check against @@ -2341,10 +2360,10 @@ treesit_predicate_capture_name_to_node (Lisp_Object name, if (NILP (node)) xsignal3 (Qtreesit_query_error, - build_pure_c_string ("Cannot find captured node"), - name, build_pure_c_string ("A predicate can only refer" - " to captured nodes in the " - "same pattern")); + build_string ("Cannot find captured node"), + name, build_string ("A predicate can only refer" + " to captured nodes in the " + "same pattern")); return node; } @@ -2373,8 +2392,8 @@ treesit_predicate_equal (Lisp_Object args, struct capture_range captures) { if (XFIXNUM (Flength (args)) != 2) xsignal2 (Qtreesit_query_error, - build_pure_c_string ("Predicate `equal' requires " - "two arguments but only given"), + build_string ("Predicate `equal' requires " + "two arguments but only given"), Flength (args)); Lisp_Object arg1 = XCAR (args); @@ -2399,8 +2418,8 @@ treesit_predicate_match (Lisp_Object args, struct capture_range captures) { if (XFIXNUM (Flength (args)) != 2) xsignal2 (Qtreesit_query_error, - build_pure_c_string ("Predicate `equal' requires two " - "arguments but only given"), + build_string ("Predicate `equal' requires two " + "arguments but only given"), Flength (args)); Lisp_Object regexp = XCAR (args); @@ -2412,12 +2431,12 @@ treesit_predicate_match (Lisp_Object args, struct capture_range captures) string-match does.) */ if (!STRINGP (regexp)) xsignal1 (Qtreesit_query_error, - build_pure_c_string ("The first argument to `match' should " - "be a regexp string, not a capture name")); + build_string ("The first argument to `match' should " + "be a regexp string, not a capture name")); if (!SYMBOLP (capture_name)) xsignal1 (Qtreesit_query_error, - build_pure_c_string ("The second argument to `match' should " - "be a capture name, not a string")); + build_string ("The second argument to `match' should " + "be a capture name, not a string")); Lisp_Object text = treesit_predicate_capture_name_to_text (capture_name, captures); @@ -2436,9 +2455,9 @@ treesit_predicate_pred (Lisp_Object args, struct capture_range captures) { if (XFIXNUM (Flength (args)) < 2) xsignal2 (Qtreesit_query_error, - build_pure_c_string ("Predicate `pred' requires " - "at least two arguments, " - "but was only given"), + build_string ("Predicate `pred' requires " + "at least two arguments, " + "but was only given"), Flength (args)); Lisp_Object fn = Fintern (XCAR (args), Qnil); @@ -2466,18 +2485,18 @@ treesit_eval_predicates (struct capture_range captures, Lisp_Object predicates) Lisp_Object predicate = XCAR (tail); Lisp_Object fn = XCAR (predicate); Lisp_Object args = XCDR (predicate); - if (!NILP (Fstring_equal (fn, build_pure_c_string ("equal")))) + if (!NILP (Fstring_equal (fn, Vtreesit_str_equal))) pass &= treesit_predicate_equal (args, captures); - else if (!NILP (Fstring_equal (fn, build_pure_c_string ("match")))) + else if (!NILP (Fstring_equal (fn, Vtreesit_str_match))) pass &= treesit_predicate_match (args, captures); - else if (!NILP (Fstring_equal (fn, build_pure_c_string ("pred")))) + else if (!NILP (Fstring_equal (fn, Vtreesit_str_pred))) pass &= treesit_predicate_pred (args, captures); else xsignal3 (Qtreesit_query_error, - build_pure_c_string ("Invalid predicate"), - fn, build_pure_c_string ("Currently Emacs only supports" - " equal, match, and pred" - " predicate")); + build_string ("Invalid predicate"), + fn, build_string ("Currently Emacs only supports" + " equal, match, and pred" + " predicate")); } /* If all predicates passed, add captures to result list. */ return pass; @@ -3377,6 +3396,41 @@ syms_of_treesit (void) then in the system default locations for dynamic libraries, in that order. */); Vtreesit_extra_load_path = Qnil; + staticpro (&Vtreesit_str_libtree_sitter); + Vtreesit_str_libtree_sitter = build_pure_c_string ("libtree-sitter-"); + staticpro (&Vtreesit_str_tree_sitter); + Vtreesit_str_tree_sitter = build_pure_c_string ("tree-sitter-"); + staticpro (&Vtreesit_str_dot); + Vtreesit_str_dot = build_pure_c_string ("."); + staticpro (&Vtreesit_str_question_mark); + Vtreesit_str_question_mark = build_pure_c_string ("?"); + staticpro (&Vtreesit_str_star); + Vtreesit_str_star = build_pure_c_string ("*"); + staticpro (&Vtreesit_str_plus); + Vtreesit_str_plus = build_pure_c_string ("+"); + staticpro (&Vtreesit_str_pound_equal); + Vtreesit_str_pound_equal = build_pure_c_string ("#equal"); + staticpro (&Vtreesit_str_pound_match); + Vtreesit_str_pound_match = build_pure_c_string ("#match"); + staticpro (&Vtreesit_str_pound_pred); + Vtreesit_str_pound_pred = build_pure_c_string ("#pred"); + staticpro (&Vtreesit_str_open_bracket); + Vtreesit_str_open_bracket = build_pure_c_string ("["); + staticpro (&Vtreesit_str_close_bracket); + Vtreesit_str_close_bracket = build_pure_c_string ("]"); + staticpro (&Vtreesit_str_open_paren); + Vtreesit_str_open_paren = build_pure_c_string ("("); + staticpro (&Vtreesit_str_close_paren); + Vtreesit_str_close_paren = build_pure_c_string (")"); + staticpro (&Vtreesit_str_space); + Vtreesit_str_space = build_pure_c_string (" "); + staticpro (&Vtreesit_str_equal); + Vtreesit_str_equal = build_pure_c_string ("equal"); + staticpro (&Vtreesit_str_match); + Vtreesit_str_match = build_pure_c_string ("match"); + staticpro (&Vtreesit_str_pred); + Vtreesit_str_pred = build_pure_c_string ("pred"); + defsubr (&Streesit_language_available_p); defsubr (&Streesit_library_abi_version); defsubr (&Streesit_language_abi_version); commit 59c3c53efa43e82f0f2e48a4c27d5bd623201d4a Author: Stefan Monnier Date: Fri Jan 13 17:38:04 2023 -0500 * lisp/subr.el (combine-change-calls-1): Fix bug#60467 Don't stop at timestamps. Strip them for now, to be on the safe side. Don't merge into `master` where we'll use a better fix. diff --git a/lisp/subr.el b/lisp/subr.el index 485ca9e4f1b..ab451b5613b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4946,13 +4946,13 @@ combine-change-calls-1 (progn (while (and (not (eq (cdr ptr) old-bul)) ;; In case garbage collection has removed OLD-BUL. - (cdr ptr) - ;; Don't include a timestamp entry. - (not (and (consp (cdr ptr)) - (consp (cadr ptr)) - (eq (caadr ptr) t) - (setq old-bul (cdr ptr))))) - (setq ptr (cdr ptr))) + (cdr ptr)) + (if (and (consp (cdr ptr)) + (consp (cadr ptr)) + (eq (caadr ptr) t)) + ;; Don't include a timestamp entry. + (setcdr ptr (cddr ptr)) + (setq ptr (cdr ptr)))) (unless (cdr ptr) (message "combine-change-calls: buffer-undo-list broken")) (setcdr ptr nil) commit 9f8f8ed1bafba97ac942ee03645fa60c67fdfce7 Author: Michael Albinus Date: Fri Jan 13 19:35:52 2023 +0100 Adapt tramp-tests.el (do not merge with master) * test/lisp/net/tramp-tests.el (tramp--test-container-p): Rename from `tramp--test-docker-p'. Handle also "podman" method. Adapt callees. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index a3d7d9f656b..0f21e3a45eb 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5504,7 +5504,7 @@ tramp-test32-shell-command (format "%s\n" (file-name-nondirectory tmp-name))) (should (string-match-p - ;; Some shells echo, for example the "adb" or "docker" methods. + ;; Some shells echo, for example the "adb" or container methods. (tramp-compat-rx bos (** 1 2 (literal (file-name-nondirectory tmp-name)) "\n") eos) @@ -6637,11 +6637,12 @@ tramp--test-crypt-p "Check, whether the remote directory is encrypted." (tramp-crypt-file-name-p ert-remote-temporary-file-directory)) -(defun tramp--test-docker-p () - "Check, whether the docker method is used. +(defun tramp--test-container-p () + "Check, whether a container method is used. This does not support some special file names." - (string-equal - "docker" (file-remote-p ert-remote-temporary-file-directory 'method))) + (string-match-p + (rx bol (| "docker" "podman") eol) + (file-remote-p ert-remote-temporary-file-directory 'method))) (defun tramp--test-expensive-test-p () "Whether expensive tests are run. @@ -7026,7 +7027,7 @@ tramp-test41-special-characters (let ((files (list (cond ((or (tramp--test-ange-ftp-p) - (tramp--test-docker-p) + (tramp--test-container-p) (tramp--test-gvfs-p) (tramp--test-rclone-p) (tramp--test-sudoedit-p) @@ -7084,7 +7085,7 @@ tramp-test42-utf8 "Check UTF8 encoding in file names and file contents." (skip-unless (tramp--test-enabled)) (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 620s - (skip-unless (not (tramp--test-docker-p))) + (skip-unless (not (tramp--test-container-p))) (skip-unless (not (tramp--test-rsync-p))) (skip-unless (not (tramp--test-windows-nt-and-out-of-band-p))) (skip-unless (not (tramp--test-ksh-p))) @@ -7213,7 +7214,7 @@ tramp-test44-asynchronous-requests ;; remote processes in Emacs. That doesn't work for tramp-adb.el. (when (tramp--test-adb-p) (skip-unless (tramp--test-emacs27-p))) - (skip-unless (not (tramp--test-docker-p))) + (skip-unless (not (tramp--test-container-p))) (skip-unless (not (tramp--test-telnet-p))) (skip-unless (not (tramp--test-sshfs-p))) (skip-unless (not (tramp--test-windows-nt-p))) @@ -7703,6 +7704,8 @@ tramp-test-all ;; * file-equal-p (partly done in `tramp-test21-file-links') ;; * file-in-directory-p ;; * file-name-case-insensitive-p +;; * memory-info +;; * tramp-get-home-directory ;; * tramp-get-remote-gid ;; * tramp-get-remote-groups ;; * tramp-get-remote-uid commit 861556c1339cd65842ec3e24ba48590e6b72bd48 Author: Eli Zaretskii Date: Fri Jan 13 15:36:00 2023 +0200 Fix minibuffer-completion tests * test/lisp/minibuffer-tests.el (completions-header-format-test): Fix the test which first fired, and then drew the target... diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 1de8e56cbd4..2ac5e0f29d6 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -421,7 +421,7 @@ completions-header-format-test (switch-to-completions) ;; Fixed in bug#55430 (should (equal "aa" (get-text-property (point) 'completion--string))) - (next-completion 2) + (next-completion 3) (should (equal "ac" (get-text-property (point) 'completion--string))) (previous-completion 2) (should (equal "aa" (get-text-property (point) 'completion--string))) commit c0578edc8fc4c5f12f72eafad6ecca6b6a16cbc6 Author: Arash Esbati Date: Fri Jan 13 15:24:25 2023 +0200 ; * doc/misc/eglot.texi (Troubleshooting Eglot): Fix typo (bug#60780). diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi index 253bf169ccb..56151b5482f 100644 --- a/doc/misc/eglot.texi +++ b/doc/misc/eglot.texi @@ -1104,7 +1104,7 @@ Troubleshooting Eglot reporting Eglot bugs in a way that facilitates their resolution. When you encounter problems with Eglot, try first using the commands -@kbd{M-x eglot-events-server} and @kbd{M-x eglot-stderr-buffer}. They +@kbd{M-x eglot-events-buffer} and @kbd{M-x eglot-stderr-buffer}. They pop up special buffers that can be used to inspect the communications between the Eglot and language server. In many cases, this will indicate the problems or at least provide a hint. commit c6bbf9cc270dedb8adcafdd0c7ff902611176993 Author: Daniel Martín Date: Sun Jan 8 14:04:24 2023 +0100 Add c-ts-mode tests * test/lisp/progmodes/c-ts-mode-resources/indent.erts: New .erts file to test indentation of typical C constructs and prevent regression of bug fixes. * test/lisp/progmodes/c-ts-mode-tests.el: New file with c-ts-mode tests. diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent.erts b/test/lisp/progmodes/c-ts-mode-resources/indent.erts new file mode 100644 index 00000000000..5defcbd3c83 --- /dev/null +++ b/test/lisp/progmodes/c-ts-mode-resources/indent.erts @@ -0,0 +1,44 @@ +Code: + (lambda () + (c-ts-mode) + (indent-region (point-min) (point-max))) + +Name: Basic + +=-= +int +main (void) +{ + return 0; +} +=-=-= + +Name: Hanging Braces (GNU Style) + +=-= +int +main (void) +{ + if (true) + { + } +} +=-=-= + +Name: Multiline Parameter List (bug#60398) + +=-= +int f2(int x, + int y) { + return x + y; +}; +=-=-= + +Name: Multiline Block Comments (bug#60270) + +=-= +/** + * @some_func: + * @arg1: + */ +=-=-= diff --git a/test/lisp/progmodes/c-ts-mode-tests.el b/test/lisp/progmodes/c-ts-mode-tests.el new file mode 100644 index 00000000000..8606faf9913 --- /dev/null +++ b/test/lisp/progmodes/c-ts-mode-tests.el @@ -0,0 +1,31 @@ +;;; c-ts-mode-tests.el --- Tests for Tree-sitter-based C mode -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'treesit) + +(ert-deftest c-ts-mode-test-indentation () + (skip-unless (treesit-ready-p 'c)) + (ert-test-erts-file (ert-resource-file "indent.erts"))) + +(provide 'c-ts-mode-tests) +;;; c-ts-mode-tests.el ends here commit a760364f5f36ad4ded67b0fd5ca4ef59c9b2d705 Author: Yuan Fu Date: Thu Jan 12 17:29:14 2023 -0800 Fix c-ts-mode--fill-paragraph Example: doc: /* Return non-nil if NODE1 and NODE2 are the same node. If any one of NODE1 and NODE2 is nil, return nil. This function uses the same equivalence metric as `equal'. */ * lisp/progmodes/c-ts-mode.el (c-ts-mode--fill-paragraph): Fix the case where there are words before the /*, like the example above. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index e53ed390ba1..ef5a9c2195a 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -726,7 +726,10 @@ c-ts-mode--fill-paragraph ;; Let `fill-paragraph' do its thing. (goto-char orig-point) (narrow-to-region start end) - (funcall #'fill-paragraph arg) + ;; We don't want to fill the region between START and + ;; START-MARKER, otherwise the filling function might delete + ;; some spaces there. + (fill-region start-marker end arg) ;; Unmask. (when start-marker (goto-char start-marker) commit 2a2b1d09ac77f66629cb5b968d5f7e6451a2c8a9 Author: Eli Zaretskii Date: Fri Jan 13 10:39:58 2023 +0200 Fix minor issues with 'pp' and related commands * etc/NEWS: * lisp/emacs-lisp/pp.el (pp-use-max-width, pp-emacs-lisp-code): Mention in doc string that formatting via 'pp-emacs-lisp-code' could be slow. (pp-eval-expression, pp-macroexpand-expression): Honor 'pp-use-max-width'. (Bug#58687) diff --git a/etc/NEWS b/etc/NEWS index 16d17821b78..08c7f8a4dd6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -4321,15 +4321,21 @@ whose matches are to be replaced. If these variables are nil (which is the default), 'query-replace' and 'query-replace-regexp' take the default value from the previous FROM-TO pair. ---- -** New user option 'pp-use-max-width'. -If non-nil, 'pp' will attempt to limit the line length when formatting -long lists and vectors. +** Lisp pretty-printer ('pp') --- -** New function 'pp-emacs-lisp-code'. +*** New function 'pp-emacs-lisp-code'. 'pp' formats general Lisp sexps. This function does much the same, -but applies formatting rules appropriate for Emacs Lisp code. +but applies formatting rules appropriate for Emacs Lisp code. Note +that this could currently be quite slow, and is thus appropriate only +for relatively small code fragments. + +--- +*** New user option 'pp-use-max-width'. +If non-nil, 'pp' and all 'pp-*' commands that format the results, will +attempt to limit the line length when formatting long lists and +vectors. This uses 'pp-emacs-lisp-code', and thus could be slow for +large lists. +++ ** New function 'file-has-changed-p'. diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index ebda37419f7..e6e3cd6c6f4 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -47,7 +47,9 @@ pp-max-width (defcustom pp-use-max-width nil "If non-nil, `pp'-related functions will try to fold lines. -The target width is given by the `pp-max-width' variable." +The target width is given by the `pp-max-width' variable. +Note that this could slow down `pp' considerably when formatting +large lists." :type 'boolean :version "29.1") @@ -162,14 +164,15 @@ pp-eval-expression (message "Evaluating...") (let ((result (eval expression lexical-binding))) (values--store-value result) - (pp-display-expression result "*Pp Eval Output*"))) + (pp-display-expression result "*Pp Eval Output*" pp-use-max-width))) ;;;###autoload (defun pp-macroexpand-expression (expression) "Macroexpand EXPRESSION and pretty-print its value." (interactive (list (read--expression "Macroexpand: "))) - (pp-display-expression (macroexpand-1 expression) "*Pp Macroexpand Output*")) + (pp-display-expression (macroexpand-1 expression) "*Pp Macroexpand Output*" + pp-use-max-width)) (defun pp-last-sexp () "Read sexp before point. Ignore leading comment characters." @@ -219,7 +222,8 @@ pp-macroexpand-last-sexp ;;;###autoload (defun pp-emacs-lisp-code (sexp) "Insert SEXP into the current buffer, formatted as Emacs Lisp code. -Use the `pp-max-width' variable to control the desired line length." +Use the `pp-max-width' variable to control the desired line length. +Note that this could be slow for large SEXPs." (require 'edebug) (let ((obuf (current-buffer))) (with-temp-buffer commit dfb38fb2ee623a78f7e7e15e0b6f11e4768cef48 Author: Eli Zaretskii Date: Fri Jan 13 09:13:24 2023 +0200 ; Improve documentation of tree-sitter node comparison * doc/lispref/parsing.texi (Accessing Node Information): * src/treesit.c (Ftreesit_node_eq): Improve documentation of node comparison. diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index ecba833eb8f..e4a25249829 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -929,9 +929,13 @@ Accessing Node Information Checks if @var{object} is a tree-sitter syntax node. @end defun +@cindex compare tree-sitter syntax nodes +@cindex tree-sitter nodes, comparing @defun treesit-node-eq node1 node2 -Checks if @var{node1} and @var{node2} are the same node in a syntax -tree. This function uses the same equivalence metric as @code{equal}. +Checks if @var{node1} and @var{node2} refer to the same node in a +tree-sitter syntax tree. This function uses the same equivalence +metric as @code{equal}. You can also compare nodes using @code{equal} +(@pxref{Equality Predicates}). @end defun @heading Property information diff --git a/src/treesit.c b/src/treesit.c index d2db91604ab..33a7e3c8528 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -2167,9 +2167,11 @@ DEFUN ("treesit-node-descendant-for-range", DEFUN ("treesit-node-eq", Ftreesit_node_eq, Streesit_node_eq, 2, 2, 0, - doc: /* Return non-nil if NODE1 and NODE2 are the same node. + doc: /* Return non-nil if NODE1 and NODE2 refer to the same node. If any one of NODE1 and NODE2 is nil, return nil. -This function uses the same equivalence metric as `equal'. */) +This function uses the same equivalence metric as `equal', and returns +non-nil if NODE1 and NODE2 refer to the same node in a syntax tree +produced by tree-sitter. */) (Lisp_Object node1, Lisp_Object node2) { if (NILP (node1) || NILP (node2)) commit e8a89a18b69cc8da2ab5ab4dcf1564f0e4517509 Author: Eli Zaretskii Date: Fri Jan 13 08:58:03 2023 +0200 ; Fix non-tree-sitter builds * src/fns.c (internal_equal): Call treesit_node_eq only if tree-sitter was compiled in. diff --git a/src/fns.c b/src/fns.c index d5f7565d3d7..3984e318feb 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2826,10 +2826,11 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, && !memcmp (bool_vector_data (o1), bool_vector_data (o2), bool_vector_bytes (size))); } + +#ifdef HAVE_TREE_SITTER if (TS_NODEP (o1)) - { - return treesit_node_eq (o1, o2); - } + return treesit_node_eq (o1, o2); +#endif /* Aside from them, only true vectors, char-tables, compiled functions, and fonts (font-spec, font-entity, font-object) commit f27a330b99eebbe7f4690163358b4cacbd4e17a1 Author: Stefan Kangas Date: Fri Jan 13 02:44:44 2023 +0100 ; Fix typo in ert-with-temp-file * lisp/emacs-lisp/ert-x.el (ert-with-temp-file): Fix typo. Reported by F. Jason Park . (Bug#60730) diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 83705ca5b89..98a017c8a8e 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -496,7 +496,7 @@ ert-with-temp-file (progn ,@body) (ignore-errors ,@(when buffer - (list `(with-current-buffer buf + (list `(with-current-buffer ,buffer (set-buffer-modified-p nil)) `(kill-buffer ,buffer)))) (ignore-errors commit 956889d8ff1c79db45ca9b1711f406961e71c272 Author: Yuan Fu Date: Thu Jan 12 17:07:21 2023 -0800 Equal now recognizes tree-sitter nodes (bug#60659) Now equal uses ts_node_eq to check equality between nodes. * doc/lispref/parsing.texi: (Accessing Node Information): Update manual. * src/fns.c (internal_equal): Handle tree-sitter nodes. * src/treesit.c (treesit_node_eq): New function. (Ftreesit_node_eq): Factor out. Update docstring. * src/treesit.h (treesit_node_eq): Declare new function. diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index b55af912f9b..ecba833eb8f 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -931,7 +931,7 @@ Accessing Node Information @defun treesit-node-eq node1 node2 Checks if @var{node1} and @var{node2} are the same node in a syntax -tree. +tree. This function uses the same equivalence metric as @code{equal}. @end defun @heading Property information diff --git a/src/fns.c b/src/fns.c index 1aaf17914a2..d5f7565d3d7 100644 --- a/src/fns.c +++ b/src/fns.c @@ -38,6 +38,10 @@ Copyright (C) 1985-2023 Free Software Foundation, Inc. #include "puresize.h" #include "gnutls.h" +#ifdef HAVE_TREE_SITTER +#include "treesit.h" +#endif + enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES }; static bool internal_equal (Lisp_Object, Lisp_Object, enum equal_kind, int, Lisp_Object); @@ -2822,6 +2826,10 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, && !memcmp (bool_vector_data (o1), bool_vector_data (o2), bool_vector_bytes (size))); } + if (TS_NODEP (o1)) + { + return treesit_node_eq (o1, o2); + } /* Aside from them, only true vectors, char-tables, compiled functions, and fonts (font-spec, font-entity, font-object) diff --git a/src/treesit.c b/src/treesit.c index 55463122d14..d2db91604ab 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -2154,11 +2154,22 @@ DEFUN ("treesit-node-descendant-for-range", return make_treesit_node (XTS_NODE (node)->parser, child); } +/* Return true if NODE1 and NODE2 are the same node. Assumes they are + TS_NODE type. */ +bool treesit_node_eq (Lisp_Object node1, Lisp_Object node2) +{ + treesit_initialize (); + TSNode treesit_node_1 = XTS_NODE (node1)->node; + TSNode treesit_node_2 = XTS_NODE (node2)->node; + return ts_node_eq (treesit_node_1, treesit_node_2); +} + DEFUN ("treesit-node-eq", Ftreesit_node_eq, Streesit_node_eq, 2, 2, 0, doc: /* Return non-nil if NODE1 and NODE2 are the same node. -If any one of NODE1 and NODE2 is nil, return nil. */) +If any one of NODE1 and NODE2 is nil, return nil. +This function uses the same equivalence metric as `equal'. */) (Lisp_Object node1, Lisp_Object node2) { if (NILP (node1) || NILP (node2)) @@ -2166,12 +2177,7 @@ DEFUN ("treesit-node-eq", CHECK_TS_NODE (node1); CHECK_TS_NODE (node2); - treesit_initialize (); - - TSNode treesit_node_1 = XTS_NODE (node1)->node; - TSNode treesit_node_2 = XTS_NODE (node2)->node; - - bool same_node = ts_node_eq (treesit_node_1, treesit_node_2); + bool same_node = treesit_node_eq (node1, node2); return same_node ? Qt : Qnil; } diff --git a/src/treesit.h b/src/treesit.h index 909609737d3..5382bc58817 100644 --- a/src/treesit.h +++ b/src/treesit.h @@ -191,6 +191,7 @@ CHECK_TS_COMPILED_QUERY (Lisp_Object query) extern void treesit_delete_parser (struct Lisp_TS_Parser *); extern void treesit_delete_query (struct Lisp_TS_Query *); extern bool treesit_named_node_p (TSNode); +extern bool treesit_node_eq (Lisp_Object, Lisp_Object); #endif /* HAVE_TREE_SITTER */ commit 8f446c2d39736d752829e37100eede3f484b827e Author: Yuan Fu Date: Wed Jan 11 01:26:21 2023 -0800 Fix c-ts-mode comment indentation (bug#60270) * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-styles): Move the star rule up. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 5c7df4b2141..e53ed390ba1 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -122,11 +122,13 @@ c-ts-mode--indent-styles ((node-is "else") parent-bol 0) ((node-is "case") parent-bol 0) ((node-is "preproc_arg") no-indent) + ;; `c-ts-mode--looking-at-star' has to come before + ;; `c-ts-mode--comment-2nd-line-matcher'. + ((and (parent-is "comment") c-ts-mode--looking-at-star) + c-ts-mode--comment-start-after-first-star -1) (c-ts-mode--comment-2nd-line-matcher c-ts-mode--comment-2nd-line-anchor 1) - ((and (parent-is "comment") c-ts-mode--looking-at-star) - c-ts-mode--comment-start-after-first-star -1) ((parent-is "comment") prev-adaptive-prefix 0) (c-ts-mode--top-level-label-matcher point-min 1) ((node-is "labeled_statement") parent-bol 0) commit 083badc9c122a802080552e7771e78ee47c01e3c Author: Sean Whitton Date: Thu Jan 12 17:09:01 2023 -0700 * lisp/subr.el (while-let): Use if-let, not if-let* (bug#60758). diff --git a/lisp/subr.el b/lisp/subr.el index 62f72734e14..485ca9e4f1b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2545,7 +2545,7 @@ while-let (let ((done (gensym "done"))) `(catch ',done (while t - (if-let* ,spec + (if-let ,spec (progn ,@body) (throw ',done nil)))))) commit 9ecebcdded157e1efc2f51b67967fd101797f225 Author: Gregory Heytings Date: Thu Jan 12 19:47:28 2023 +0200 * lisp/simple.el (next-completion): Handle first completion specially. When completions-header-format is nil and completion-show-help is nil, the first completion is at the beginning the buffer, so 'M-' missed it and moved to the second completion. Handle this case by setting/checking the special text-property 'first-completion' that is nil at the first call (bug#60411). diff --git a/lisp/simple.el b/lisp/simple.el index 24df86c80c2..e23ee961879 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -9755,6 +9755,14 @@ next-completion (let ((tabcommand (member (this-command-keys) '("\t" [backtab]))) pos) (catch 'bound + (when (and (bobp) + (> n 0) + (get-text-property (point) 'mouse-face) + (not (get-text-property (point) 'first-completion))) + (let ((inhibit-read-only t)) + (add-text-properties (point) (1+ (point)) '(first-completion t))) + (setq n (1- n))) + (while (> n 0) (setq pos (point)) ;; If in a completion, move to the end of it. commit cfd2b3504ab5de6eb5f3c7a0784cb447883e1326 Author: Eli Zaretskii Date: Thu Jan 12 16:36:35 2023 +0200 Fix encoding with 'utf-8-auto' * src/coding.c (encode_coding_utf_8): Fix encoding with 'utf-8-auto': it should produce BOM, per the documentation of the :bom attribute. (Bug#60750) * lisp/international/mule.el (define-coding-system): Doc fix. * test/src/coding-tests.el (coding-tests): Use 'with-coding-priority' instead of 'prefer-coding-system', as the latter has global persistent effect and affects further tests. diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 4f6addea387..eddd7b6407a 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -863,7 +863,8 @@ define-coding-system VALUE must be `big' or `little' specifying big-endian and little-endian respectively. The default value is `big'. -This attribute is meaningful only when `:coding-type' is `utf-16'. +Changing this attribute is only meaningful when `:coding-type' +is `utf-16'. `:ccl-decoder' (required if :coding-type is `ccl') diff --git a/src/coding.c b/src/coding.c index 4e59f2b6a1b..49dcd8634f3 100644 --- a/src/coding.c +++ b/src/coding.c @@ -1431,7 +1431,7 @@ encode_coding_utf_8 (struct coding_system *coding) ptrdiff_t produced_chars = 0; int c; - if (CODING_UTF_8_BOM (coding) == utf_with_bom) + if (CODING_UTF_8_BOM (coding) != utf_without_bom) { ASSURE_DESTINATION (3); EMIT_THREE_BYTES (UTF_8_BOM_1, UTF_8_BOM_2, UTF_8_BOM_3); diff --git a/test/src/coding-tests.el b/test/src/coding-tests.el index 6bd8d1ae6c4..b27907027ba 100644 --- a/test/src/coding-tests.el +++ b/test/src/coding-tests.el @@ -148,21 +148,21 @@ coding-tests-ao-gen-file (defun coding-tests (content-type write-coding read-coding detected-coding &optional translator) - (prefer-coding-system 'utf-8-auto) - (let ((filename (coding-tests-filename content-type write-coding))) - (with-temp-buffer - (let ((coding-system-for-read read-coding) - (contents (coding-tests-file-contents content-type)) - (disable-ascii-optimization nil)) - (if translator - (setq contents (funcall translator contents))) - (insert-file-contents filename) - (if (and (coding-system-equal buffer-file-coding-system detected-coding) - (string= (buffer-string) contents)) - nil - (list buffer-file-coding-system - (string-to-list (buffer-string)) - (string-to-list contents))))))) + (with-coding-priority '(utf-8-auto) + (let ((filename (coding-tests-filename content-type write-coding))) + (with-temp-buffer + (let ((coding-system-for-read read-coding) + (contents (coding-tests-file-contents content-type)) + (disable-ascii-optimization nil)) + (if translator + (setq contents (funcall translator contents))) + (insert-file-contents filename) + (if (and (coding-system-equal buffer-file-coding-system detected-coding) + (string= (buffer-string) contents)) + nil + (list buffer-file-coding-system + (string-to-list (buffer-string)) + (string-to-list contents)))))))) (ert-deftest ert-test-coding-ascii () (unwind-protect commit 53b47df8229a3a54777940663edda28de0a01b90 Author: Po Lu Date: Thu Jan 12 18:36:14 2023 +0800 Report cursor correctly on PGTK when there is a margin * src/pgtkterm.c (pgtk_draw_window_cursor): Adjust frame_x by the margin width as well. diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 5158492ca09..c00e13550bd 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -2959,7 +2959,8 @@ pgtk_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, int x, if (w == XWINDOW (f->selected_window)) { int frame_x = (WINDOW_TO_FRAME_PIXEL_X (w, x) - + WINDOW_LEFT_FRINGE_WIDTH (w)); + + WINDOW_LEFT_FRINGE_WIDTH (w) + + WINDOW_LEFT_MARGIN_WIDTH (w)); int frame_y = WINDOW_TO_FRAME_PIXEL_Y (w, y); pgtk_im_set_cursor_location (f, frame_x, frame_y, w->phys_cursor_width,