commit 218748c26287ae865229fe8a3c520facfa12fede (HEAD, refs/remotes/origin/master) Author: Stefan Monnier Date: Mon Mar 4 23:42:50 2024 -0500 disass.el (disassemble-1): Minor simplification * lisp/emacs-lisp/disass.el (disassemble-1): Remove code for functions of the form (lambda ARGS (byte-code ...)) which we don't use any more nowadays. diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index b7db2adde59..850cc2085f7 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -54,7 +54,7 @@ (defun disassemble (object &optional buffer indent interactive-p) "Print disassembled code for OBJECT in (optional) BUFFER. OBJECT can be a symbol defined as a function, or a function itself -\(a lambda expression or a compiled-function object). +\(a lambda expression or a byte-code-function object). If OBJECT is not already compiled, we compile it, but do not redefine OBJECT if it is a symbol." (interactive @@ -70,7 +70,7 @@ redefine OBJECT if it is a symbol." (save-excursion (if (or interactive-p (null buffer)) (with-output-to-temp-buffer "*Disassemble*" - (set-buffer "*Disassemble*") + (set-buffer standard-output) (let ((lexical-binding lb)) (disassemble-internal object indent (not interactive-p)))) (set-buffer buffer) @@ -250,29 +250,22 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler." ;; if the succeeding op is byte-switch, display the jump table ;; used (cond ((eq (car-safe (car-safe (cdr lap))) 'byte-switch) - (insert (format "")) - ;; if the value of the constant is compiled code, then - ;; recursively disassemble it. - ((or (byte-code-function-p arg) - (and (consp arg) (functionp arg) - (assq 'byte-code arg)) + (insert (format "")) + ;; if the value of the constant is compiled code, then + ;; recursively disassemble it. + ((or (byte-code-function-p arg) (and (eq (car-safe arg) 'macro) - (or (byte-code-function-p (cdr arg)) - (and (consp (cdr arg)) - (functionp (cdr arg)) - (assq 'byte-code (cdr arg)))))) + (byte-code-function-p (cdr arg)))) (cond ((byte-code-function-p arg) (insert "\n")) - ((functionp arg) - (insert "")) (t (insert "\n"))) (disassemble-internal arg @@ -285,7 +278,7 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler." (+ indent disassemble-recursive-indent))) ((eq (car-safe (car-safe arg)) 'byte-code) (insert "(...)\n") - (mapc ;recurse on list of byte-code objects + (mapc ;Recurse on list of byte-code objects. (lambda (obj) (disassemble-1 obj commit 418ad866bf846a6a3328d91df28c958be75337be Author: Stefan Monnier Date: Mon Mar 4 23:12:29 2024 -0500 cl-preloaded.el: Further fine-tuning * lisp/emacs-lisp/cl-preloaded.el (cl--direct-supertypes-of-type): Fix some left over issues: - Remove redundant `number-or-marker` from `marker`s parents. - Add `function` to the types, since it was missing. (cl--typeof-types): Add a warning for missing type info. * admin/syncdoc-type-hierarchy.el (syncdoc-hierarchy): Fix parent of `oclosure`. * doc/lispref/type_hierarchy.txt: * doc/lispref/type_hierarchy.jpg: Update. diff --git a/admin/syncdoc-type-hierarchy.el b/admin/syncdoc-type-hierarchy.el index cb4df63a312..6448369625b 100644 --- a/admin/syncdoc-type-hierarchy.el +++ b/admin/syncdoc-type-hierarchy.el @@ -69,7 +69,7 @@ (not (eq type 'eieio-default-superclass))) '(eieio-default-superclass)) ;; OClosures can still be lists :-( - ((eq 'oclosure type) '(t)) + ((eq 'oclosure type) '(function)) (t '(atom))) ht))))) ht)) diff --git a/doc/lispref/type_hierarchy.jpg b/doc/lispref/type_hierarchy.jpg index b7eba7d1cf7..6b9be985817 100644 Binary files a/doc/lispref/type_hierarchy.jpg and b/doc/lispref/type_hierarchy.jpg differ diff --git a/doc/lispref/type_hierarchy.txt b/doc/lispref/type_hierarchy.txt index c74bc45635b..6827bbbc580 100644 --- a/doc/lispref/type_hierarchy.txt +++ b/doc/lispref/type_hierarchy.txt @@ -1,22 +1,27 @@ -| Type | Derived Types | -|-------------------+----------------------------------------------------------| -| t | sequence atom | -| sequence | list array | -| atom | class structure tree-sitter-compiled-query | -| | tree-sitter-node tree-sitter-parser user-ptr font-object | -| | font-entity font-spec condvar mutex thread terminal | -| | hash-table frame buffer function window process | -| | window-configuration overlay integer-or-marker | -| | number-or-marker symbol array obarray | -| number | float integer | -| number-or-marker | marker number | -| integer | bignum fixnum | -| symbol | keyword boolean symbol-with-pos | -| array | vector bool-vector char-table string | -| list | null cons | -| integer-or-marker | integer marker | -| compiled-function | byte-code-function | -| function | subr module-function compiled-function | -| boolean | null | -| subr | subr-native-elisp subr-primitive | -| symbol-with-pos | keyword | +| Type | Derived Types | +|--------------------------+------------------------------------------------------------| +| t | sequence atom | +| sequence | list array | +| atom | array function tree-sitter-compiled-query tree-sitter-node | +| | tree-sitter-parser user-ptr font-object font-entity | +| | font-spec condvar mutex thread terminal hash-table frame | +| | buffer window process window-configuration overlay | +| | number-or-marker symbol obarray native-comp-unit | +| | cl-structure-object eieio-default-superclass | +| number | float integer | +| integer-or-marker | integer marker | +| number-or-marker | integer-or-marker number | +| integer | bignum fixnum | +| symbol | keyword boolean symbol-with-pos | +| array | vector bool-vector char-table string | +| boolean | null | +| list | null cons | +| compiled-function | byte-code-function subr | +| function | module-function compiled-function oclosure | +| subr | subr-native-elisp subr-primitive | +| oclosure | advice kmacro | +| cl--class | oclosure--class cl-structure-class eieio--class | +| cl-structure-object | cl--class xref-elisp-location frameset-register | +| eieio-default-superclass | eieio-named transient-child | +| transient-suffix | transient-infix | +| transient-child | transient-suffix | diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index a4ddc55b257..ea08d35ecec 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -51,14 +51,25 @@ (signal 'cl-assertion-failed `(,form ,@sargs))))) (defconst cl--direct-supertypes-of-type + ;; Please run `sycdoc-update-type-hierarchy' in + ;; `admin/syncdoc-type-hierarchy.el' each time this is modified to + ;; reflect the change in the documentation. (let ((table (make-hash-table :test #'eq))) + ;; FIXME: Our type DAG has various quirks: + ;; - `subr' says it's a `compiled-function' but that's not true + ;; for those subrs that are special forms! + ;; - Some `keyword's are also `symbol-with-pos' but that's not reflected + ;; in the DAG. + ;; - An OClosure can be an interpreted function or a `byte-code-function', + ;; so the DAG of OClosure types is "orthogonal" to the distinction + ;; between interpreted and compiled functions. (dolist (x '((sequence t) (atom t) (list sequence) (array sequence atom) (float number) (integer number integer-or-marker) - (marker integer-or-marker number-or-marker) + (marker integer-or-marker) (integer-or-marker number-or-marker) (number number-or-marker) (bignum integer) @@ -73,10 +84,11 @@ ;; FIXME: This results in `atom' coming before `list' :-( (null boolean list) (cons list) + (function atom) (byte-code-function compiled-function) (subr compiled-function) - (module-function function atom) - (compiled-function function atom) + (module-function function) + (compiled-function function) (subr-native-elisp subr) (subr-primitive subr))) (puthash (car x) (cdr x) table)) @@ -100,8 +112,11 @@ (lambda (type) ;; FIXME: copy&pasted from `cl--class-allparents'. (let ((parents (gethash type cl--direct-supertypes-of-type))) + (unless parents + (message "Warning: Type without parent: %S!" type)) (cons type (merge-ordered-lists + ;; FIXME: Can't remember why `t' is excluded. (mapcar allparents (remq t parents)))))))) (maphash (lambda (type _) (push (funcall allparents type) alist)) commit 1a35eb86b8cb75ce390525dd3394a52376b622a6 Author: Po Lu Date: Tue Mar 5 11:23:27 2024 +0800 Rearrange Android splash screen messages * lisp/startup.el (fancy-startup-tail, fancy-startup-screen) (normal-splash-screen): Adjust for function renaming; move the storage permissions notice to the top of the splash screen. * lisp/term/android-win.el (android-after-splash-screen): Rename from android-before-splash-screen and adjust layout lightly. * src/android.c (android_wc_lookup_string): Terminate character composition after a character is returned, whether it contain a Unicode character or not. diff --git a/lisp/startup.el b/lisp/startup.el index 33e1124b998..357a4154e4c 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -2040,10 +2040,6 @@ a face or button specification." (call-interactively 'recover-session))) " to recover the files you were editing.")))) - ;; Insert the permissions notice if the user has yet to grant Emacs - ;; storage permissions. - (when (fboundp 'android-after-splash-screen) - (funcall 'android-after-splash-screen t)) (when concise (fancy-splash-insert :face 'variable-pitch "\n" @@ -2096,6 +2092,10 @@ splash screen in another window." (make-local-variable 'startup-screen-inhibit-startup-screen) (if pure-space-overflow (insert pure-space-overflow-message)) + ;; Insert the permissions notice if the user has yet to grant Emacs + ;; storage permissions. + (when (fboundp 'android-before-splash-screen) + (funcall 'android-before-splash-screen t)) (unless concise (fancy-splash-head)) (dolist (text fancy-startup-text) @@ -2202,7 +2202,10 @@ splash screen in another window." (if pure-space-overflow (insert pure-space-overflow-message)) - + ;; Insert the permissions notice if the user has yet to grant + ;; Emacs storage permissions. + (when (fboundp 'android-before-splash-screen) + (funcall 'android-before-splash-screen nil)) ;; The convention for this piece of code is that ;; each piece of output starts with one or two newlines ;; and does not end with any newlines. @@ -2244,12 +2247,6 @@ splash screen in another window." (insert "\n\nIf an Emacs session crashed recently, " "type M-x recover-session RET\nto recover" " the files you were editing.\n")) - - ;; Insert the permissions notice if the user has yet to grant - ;; Emacs storage permissions. - (when (fboundp 'android-after-splash-screen) - (funcall 'android-after-splash-screen nil)) - (use-local-map splash-screen-keymap) ;; Display the input that we set up in the buffer. diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index b7b0920626e..1d10402b15d 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -398,7 +398,7 @@ directory /content/storage. (inhibit-read-only t)) (fill-region (point-min) (point-max)))))))) -(defun android-after-splash-screen (fancy-p) +(defun android-before-splash-screen (fancy-p) "Insert a brief notice on the absence of storage permissions. If storage permissions are as yet denied to Emacs, insert a short notice to that effect, followed by a button that enables the user @@ -412,14 +412,14 @@ screen display; see `fancy-splash-insert'." (fancy-splash-insert :face '(variable-pitch font-lock-function-call-face) - "\nPermissions necessary to access external storage directories have -been denied. Click " + "Permissions necessary to access external storage directories have" + "\nbeen denied. Click " :link '("here" android-display-storage-permission-popup) - " to grant them.") + " to grant them.\n") (insert - "\nPermissions necessary to access external storage directories have been -denied. ") - (insert-button "Click here to grant them." + "Permissions necessary to access external storage directories" + "\nhave been denied. ") + (insert-button "Click here to grant them.\n" 'action #'android-display-storage-permission-popup 'follow-link t) (newline)))) diff --git a/src/android.c b/src/android.c index eb6981093be..5b3fbb25373 100644 --- a/src/android.c +++ b/src/android.c @@ -5533,6 +5533,10 @@ android_wc_lookup_string (android_key_pressed_event *event, rc = 0; } + /* Terminate any ongoing character composition after a key is + registered. */ + if (compose_status) + compose_status->chars_matched = 0; *status_return = status; return rc; } commit b06916cb218b133a4ebc9d7fa87b370fc2c2ed02 Author: Stefan Monnier Date: Mon Mar 4 13:24:34 2024 -0500 syncdoc-type-hierarchy.el: Adjust to changes in `cl-preloaded.el` * admin/syncdoc-type-hierarchy.el (syncdoc-lispref-dir): Use `macroexp-file-name`. (syncdoc-hierarchy): New var. (syncdoc-insert-dot-content, syncdoc-make-type-table): Use it. (syncdoc-update-type-hierarchy): Don't crash if `dot` is absent. diff --git a/admin/syncdoc-type-hierarchy.el b/admin/syncdoc-type-hierarchy.el index b3dfe63406a..cb4df63a312 100644 --- a/admin/syncdoc-type-hierarchy.el +++ b/admin/syncdoc-type-hierarchy.el @@ -24,8 +24,8 @@ ;; This file is used to keep the type hierarchy representation present ;; in the elisp manual in sync with the current type hierarchy. This -;; is specified in `cl--type-hierarchy' in cl-preloaded.el, so each -;; time `cl--type-hierarchy' is modified +;; is specified in `cl--direct-supertypes-of-type' in cl-preloaded.el, so each +;; time `cl--direct-supertypes-of-type' is modified ;; `syncdoc-update-type-hierarchy' must be run before the ;; documentation is regenerated. @@ -37,17 +37,49 @@ (require 'cl-lib) (require 'org-table) -(defconst syncdoc-lispref-dir (concat (file-name-directory - (or load-file-name - buffer-file-name)) - "../doc/lispref/")) +(defconst syncdoc-lispref-dir + (expand-file-name "../doc/lispref/" + (file-name-directory + (or (macroexp-file-name) + buffer-file-name)))) + +(defconst syncdoc-hierarchy + (let ((ht (copy-hash-table cl--direct-supertypes-of-type))) + ;; Include info about "representative" other structure types, + ;; to illustrate how they fit. + (mapc #'require '(kmacro eieio-base elisp-mode frameset transient)) + (let ((extra-types '(advice kmacro cl-structure-object cl-structure-class + eieio-default-superclass eieio-named transient-infix + xref-elisp-location frameset-register)) + (seen ())) + (while extra-types + (let* ((type (pop extra-types)) + (class (get type 'cl--class)) + (parents (cl--class-parents class))) + (unless (member type seen) + (push type seen) + (push (type-of class) extra-types) + (puthash type (cond + (parents + (let ((ps (mapcar #'cl--class-name parents))) + (setq extra-types (append ps extra-types)) + ps)) + ;; EIEIO's parents don't mention the default. + ((and (eq (type-of class) 'eieio--class) + (not (eq type 'eieio-default-superclass))) + '(eieio-default-superclass)) + ;; OClosures can still be lists :-( + ((eq 'oclosure type) '(t)) + (t '(atom))) + ht))))) + ht)) (defun syncdoc-insert-dot-content (rankdir) (maphash (lambda (child parents) (cl-loop for parent in parents do (insert " \"" (symbol-name child) "\" -> \"" (symbol-name parent) "\";\n"))) - cl--direct-supertypes-of-type) + syncdoc-hierarchy) (sort-lines nil (point-min) (point-max)) (goto-char (point-min)) @@ -58,18 +90,24 @@ (defun syncdoc-make-type-table (file) (with-temp-file file (insert "|Type| Derived Types|\n|-\n") - (cl-loop for (type . children) in cl--type-hierarchy - do (insert "|" (symbol-name type) " |") - do (cl-loop with x = 0 - for child in children - for child-len = (length (symbol-name child)) - when (> (+ x child-len 2) 60) - do (progn - (insert "|\n||") - (setq x 0)) - do (insert (symbol-name child) " ") - do (cl-incf x (1+ child-len)) ) - do (insert "\n")) + (let ((subtypes ())) + ;; First collect info from the "builtin" types. + (maphash (lambda (type parents) + (dolist (parent parents) + (push type (alist-get parent subtypes)))) + syncdoc-hierarchy) + (cl-loop for (type . children) in (reverse subtypes) + do (insert "|" (symbol-name type) " |") + do (cl-loop with x = 0 + for child in (reverse children) + for child-len = (length (symbol-name child)) + when (> (+ x child-len 2) 60) + do (progn + (insert "|\n||") + (setq x 0)) + do (insert (symbol-name child) " ") + do (cl-incf x (1+ child-len)) ) + do (insert "\n"))) (org-table-align))) (defun syncdoc-update-type-hierarchy () @@ -77,9 +115,10 @@ (interactive) (with-temp-buffer (syncdoc-insert-dot-content "LR") - (call-process-region nil nil "dot" t (current-buffer) nil "-Tjpg" "-o" - (expand-file-name "type_hierarchy.jpg" - syncdoc-lispref-dir))) + (with-demoted-errors "%S" ;In case "dot" is not found! + (call-process-region nil nil "dot" t (current-buffer) nil "-Tjpg" "-o" + (expand-file-name "type_hierarchy.jpg" + syncdoc-lispref-dir)))) (syncdoc-make-type-table (expand-file-name "type_hierarchy.txt" syncdoc-lispref-dir))) commit 167c17c1ad740b35ed1c875b57817784655851d9 Author: Stefan Monnier Date: Mon Mar 4 12:02:45 2024 -0500 admin/syncdoc-type-hierarchy.el: Move from `etc` AFAICT `admin` is where we keep these kinds of files. diff --git a/etc/syncdoc-type-hierarchy.el b/admin/syncdoc-type-hierarchy.el similarity index 100% rename from etc/syncdoc-type-hierarchy.el rename to admin/syncdoc-type-hierarchy.el commit 94632c611e6ba5607a1039a8939d5ab173ee5bfb Author: Stefan Monnier Date: Mon Mar 4 11:19:08 2024 -0500 Revert "Update some native comp tests" This reverts commit 4a0d430bdc3650ca3dfd8bdd14781764fbcbdc7e. AFAICT that commit was made to accomodate regressions introduced in the new `cl-preloaded.el` code and these have been fixed. diff --git a/test/lisp/emacs-lisp/comp-cstr-tests.el b/test/lisp/emacs-lisp/comp-cstr-tests.el index 955a99ced57..991ab1f40eb 100644 --- a/test/lisp/emacs-lisp/comp-cstr-tests.el +++ b/test/lisp/emacs-lisp/comp-cstr-tests.el @@ -196,7 +196,7 @@ The arg is an alist of: type specifier -> expected type specifier." ;; 74 ((and boolean (or number marker)) . nil) ;; 75 - ((and atom (or number marker)) . (or integer-or-marker number-or-marker)) + ((and atom (or number marker)) . number-or-marker) ;; 76 ((and symbol (or number marker)) . nil) ;; 77 diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 67d632823b2..fbcb6ca9560 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -1029,7 +1029,7 @@ Return a list of results." (if (= x y) x 'foo)) - '(or (member foo) number-or-marker integer-or-marker)) + '(or (member foo) number-or-marker)) ;; 14 ((defun comp-tests-ret-type-spec-f (x) @@ -1169,7 +1169,7 @@ Return a list of results." ((defun comp-tests-ret-type-spec-f (x) (when (> x 1.0) x)) - '(or null number-or-marker integer-or-marker)) + '(or null number-or-marker)) ;; 36 ((defun comp-tests-ret-type-spec-f (x y) commit 5b49a38d1b37707bbbc8c069ed20ce7cd18fb2ac Author: Michael Albinus Date: Mon Mar 4 15:44:24 2024 +0100 tramp-androidsu.el code cleanup * lisp/net/tramp-androidsu.el (tramp-androidsu-generate-wrapper): Prefer #' notation for function names. (tramp-androidsu-handle-copy-file) (tramp-androidsu-handle-file-local-copy) (tramp-androidsu-handle-make-symbolic-link) (tramp-androidsu-handle-rename-file) (tramp-androidsu-handle-write-region): Don't use a wrapper. (tramp-adb-connection-local-default-ps-profile): Don't initialize, this happens in tramp-db.el. diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index 12453d40acd..c7fb67d4081 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -232,19 +232,19 @@ FUNCTION." ;; tramp-adb-wait-for-output addresses problems introduced ;; by the adb utility itself, not Android utilities, so ;; replace it with the regular TRAMP function. - (fset 'tramp-adb-wait-for-output #'tramp-wait-for-output) + (fset #'tramp-adb-wait-for-output #'tramp-wait-for-output) ;; Likewise, except some special treatment is necessary on ;; account of flaws in Android's su implementation. - (fset 'tramp-adb-maybe-open-connection + (fset #'tramp-adb-maybe-open-connection #'tramp-androidsu-maybe-open-connection) (apply function args)) ;; Restore the original definitions of the functions overridden ;; above. - (fset 'tramp-adb-wait-for-output tramp-adb-wait-for-output) - (fset 'tramp-adb-maybe-open-connection tramp-adb-maybe-open-connection))))) + (fset #'tramp-adb-wait-for-output tramp-adb-wait-for-output) + (fset #'tramp-adb-maybe-open-connection + tramp-adb-maybe-open-connection))))) -(defalias 'tramp-androidsu-handle-copy-file - (tramp-androidsu-generate-wrapper #'tramp-sh-handle-copy-file)) +(defalias 'tramp-androidsu-handle-copy-file #'tramp-sh-handle-copy-file) (defalias 'tramp-androidsu-handle-delete-directory (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-directory)) @@ -253,7 +253,8 @@ FUNCTION." (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-file)) (defalias 'tramp-androidsu-handle-directory-files-and-attributes - (tramp-androidsu-generate-wrapper #'tramp-adb-handle-directory-files-and-attributes)) + (tramp-androidsu-generate-wrapper + #'tramp-adb-handle-directory-files-and-attributes)) (defalias 'tramp-androidsu-handle-exec-path (tramp-androidsu-generate-wrapper #'tramp-adb-handle-exec-path)) @@ -268,10 +269,11 @@ FUNCTION." (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-exists-p)) (defalias 'tramp-androidsu-handle-file-local-copy - (tramp-androidsu-generate-wrapper #'tramp-sh-handle-file-local-copy)) + #'tramp-sh-handle-file-local-copy) (defalias 'tramp-androidsu-handle-file-name-all-completions - (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-name-all-completions)) + (tramp-androidsu-generate-wrapper + #'tramp-adb-handle-file-name-all-completions)) (defalias 'tramp-androidsu-handle-file-readable-p (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-readable-p)) @@ -400,14 +402,12 @@ FUNCTION." p))))) (defalias 'tramp-androidsu-handle-make-symbolic-link - (tramp-androidsu-generate-wrapper - #'tramp-sh-handle-make-symbolic-link)) + #'tramp-sh-handle-make-symbolic-link) (defalias 'tramp-androidsu-handle-process-file (tramp-androidsu-generate-wrapper #'tramp-adb-handle-process-file)) -(defalias 'tramp-androidsu-handle-rename-file - (tramp-androidsu-generate-wrapper #'tramp-sh-handle-rename-file)) +(defalias 'tramp-androidsu-handle-rename-file #'tramp-sh-handle-rename-file) (defalias 'tramp-androidsu-handle-set-file-modes (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-modes)) @@ -424,8 +424,7 @@ FUNCTION." (defalias 'tramp-androidsu-handle-get-remote-uid (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-uid)) -(defalias 'tramp-androidsu-handle-write-region - (tramp-androidsu-generate-wrapper #'tramp-sh-handle-write-region)) +(defalias 'tramp-androidsu-handle-write-region #'tramp-sh-handle-write-region) ;;;###tramp-autoload (defconst tramp-androidsu-file-name-handler-alist @@ -458,7 +457,8 @@ FUNCTION." (file-local-copy . tramp-androidsu-handle-file-local-copy) (file-locked-p . tramp-handle-file-locked-p) (file-modes . tramp-handle-file-modes) - (file-name-all-completions . tramp-androidsu-handle-file-name-all-completions) + (file-name-all-completions + . tramp-androidsu-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p) (file-name-completion . tramp-handle-file-name-completion) @@ -542,10 +542,6 @@ arguments to pass to the OPERATION." (tramp-register-foreign-file-name-handler #'tramp-androidsu-file-name-p #'tramp-androidsu-file-name-handler)) -(connection-local-set-profile-variables - 'tramp-adb-connection-local-default-ps-profile - tramp-adb-connection-local-default-ps-variables) - (with-eval-after-load 'shell (connection-local-set-profiles `(:application tramp :protocol ,tramp-androidsu-method) commit 11ffb4656d768b09e1f7dfacc091d85eef4a403a Author: Mattias Engdegård Date: Mon Mar 4 14:14:05 2024 +0100 Revert "Replace XSETSYMBOL with make_lisp_symbol" This reverts commit de6b1e1efb1a36c69e7a6e09297e1de5b1477121. While it did simplify code, there aren't much in the way of technical benefits the change at this time, and there were protest against the unwarranted style change. diff --git a/src/alloc.c b/src/alloc.c index 16257469aa6..2ffd2415447 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3960,7 +3960,7 @@ Its value is void, and its function definition and property list are nil. */) if (symbol_free_list) { ASAN_UNPOISON_SYMBOL (symbol_free_list); - val = make_lisp_symbol (symbol_free_list); + XSETSYMBOL (val, symbol_free_list); symbol_free_list = symbol_free_list->u.s.next; } else @@ -3976,7 +3976,7 @@ Its value is void, and its function definition and property list are nil. */) } ASAN_UNPOISON_SYMBOL (&symbol_block->symbols[symbol_block_index]); - val = make_lisp_symbol (&symbol_block->symbols[symbol_block_index]); + XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]); symbol_block_index++; } @@ -7398,8 +7398,12 @@ process_mark_stack (ptrdiff_t base_sp) mark_stack_push_value (SYMBOL_VAL (ptr)); break; case SYMBOL_VARALIAS: - mark_stack_push_value (make_lisp_symbol (SYMBOL_ALIAS (ptr))); - break; + { + Lisp_Object tem; + XSETSYMBOL (tem, SYMBOL_ALIAS (ptr)); + mark_stack_push_value (tem); + break; + } case SYMBOL_LOCALIZED: { struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (ptr); diff --git a/src/buffer.c b/src/buffer.c index 9f55a8813fa..43a9249528c 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1340,7 +1340,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer) case SYMBOL_LOCALIZED: { /* Look in local_var_alist. */ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); - variable = make_lisp_symbol (sym); /* Update In case of aliasing. */ + XSETSYMBOL (variable, sym); /* Update In case of aliasing. */ result = assq_no_quit (variable, BVAR (buf, local_var_alist)); if (!NILP (result)) { @@ -4985,7 +4985,7 @@ defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd, const char *namestring, sym->u.s.declared_special = true; sym->u.s.redirect = SYMBOL_FORWARDED; SET_SYMBOL_FWD (sym, bo_fwd); - PER_BUFFER_SYMBOL (offset) = make_lisp_symbol (sym); + XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym); if (PER_BUFFER_IDX (offset) == 0) /* Did a DEFVAR_PER_BUFFER without initializing the corresponding diff --git a/src/data.c b/src/data.c index c87b5317618..df08eaf8102 100644 --- a/src/data.c +++ b/src/data.c @@ -1256,7 +1256,7 @@ If OBJECT is not a symbol, just return it. */) struct Lisp_Symbol *sym = XSYMBOL (object); while (sym->u.s.redirect == SYMBOL_VARALIAS) sym = SYMBOL_ALIAS (sym); - object = make_lisp_symbol (sym); + XSETSYMBOL (object, sym); } return object; } @@ -1506,9 +1506,12 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_ if (blv->fwd.fwdptr) set_blv_value (blv, do_symval_forwarding (blv->fwd)); /* Choose the new binding. */ - tem1 = assq_no_quit (make_lisp_symbol (symbol), - BVAR (current_buffer, local_var_alist)); - set_blv_where (blv, Fcurrent_buffer ()); + { + Lisp_Object var; + XSETSYMBOL (var, symbol); + tem1 = assq_no_quit (var, BVAR (current_buffer, local_var_alist)); + set_blv_where (blv, Fcurrent_buffer ()); + } if (!(blv->found = !NILP (tem1))) tem1 = blv->defcell; @@ -1652,8 +1655,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, set_blv_value (blv, do_symval_forwarding (blv->fwd)); /* Find the new binding. */ - /* May have changed via aliasing. */ - symbol = make_lisp_symbol (sym); + XSETSYMBOL (symbol, sym); /* May have changed via aliasing. */ Lisp_Object tem1 = assq_no_quit (symbol, BVAR (XBUFFER (where), local_var_alist)); @@ -2057,10 +2059,13 @@ make_blv (struct Lisp_Symbol *sym, bool forwarded, union Lisp_Val_Fwd valcontents) { struct Lisp_Buffer_Local_Value *blv = xmalloc (sizeof *blv); - Lisp_Object tem = Fcons (make_lisp_symbol (sym), - forwarded - ? do_symval_forwarding (valcontents.fwd) - : valcontents.value); + Lisp_Object symbol; + Lisp_Object tem; + + XSETSYMBOL (symbol, sym); + tem = Fcons (symbol, (forwarded + ? do_symval_forwarding (valcontents.fwd) + : valcontents.value)); /* Buffer_Local_Values cannot have as realval a buffer-local or keyboard-local forwarding. */ @@ -2216,7 +2221,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) } /* Make sure this buffer has its own value of symbol. */ - variable = make_lisp_symbol (sym); /* Update in case of aliasing. */ + XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ tem = assq_no_quit (variable, BVAR (current_buffer, local_var_alist)); if (NILP (tem)) { @@ -2296,7 +2301,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) notify_variable_watchers (variable, Qnil, Qmakunbound, Fcurrent_buffer ()); /* Get rid of this buffer's alist element, if any. */ - variable = make_lisp_symbol (sym); /* Propagate variable indirection. */ + XSETSYMBOL (variable, sym); /* Propagate variable indirection. */ tem = assq_no_quit (variable, BVAR (current_buffer, local_var_alist)); if (!NILP (tem)) bset_local_var_alist @@ -2341,7 +2346,7 @@ Also see `buffer-local-boundp'.*/) Lisp_Object tmp; struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); XSETBUFFER (tmp, buf); - variable = make_lisp_symbol (sym); /* Update in case of aliasing. */ + XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ if (EQ (blv->where, tmp)) /* The binding is already loaded. */ return blv_found (blv) ? Qt : Qnil; @@ -2391,7 +2396,7 @@ value in BUFFER, or if VARIABLE is automatically buffer-local (see struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); if (blv->local_if_set) return Qt; - variable = make_lisp_symbol (sym); /* Update in case of aliasing. */ + XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ return Flocal_variable_p (variable, buffer); } case SYMBOL_FORWARDED: diff --git a/src/eval.c b/src/eval.c index 9d3b98eb359..95eb21909d2 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3475,7 +3475,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) switch (sym->u.s.redirect) { case SYMBOL_VARALIAS: - sym = SYMBOL_ALIAS (sym); symbol = make_lisp_symbol (sym); goto start; + sym = SYMBOL_ALIAS (sym); XSETSYMBOL (symbol, sym); goto start; case SYMBOL_PLAINVAL: /* The most common case is that of a non-constant symbol with a trivial value. Make that as fast as we can. */ diff --git a/src/lisp.h b/src/lisp.h index 4fc44745211..f353e4956eb 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1380,6 +1380,7 @@ make_lisp_ptr (void *ptr, enum Lisp_Type type) #define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons)) #define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike)) #define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String)) +#define XSETSYMBOL(a, b) ((a) = make_lisp_symbol (b)) #define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float)) /* Return a Lisp_Object value that does not correspond to any object. commit b9e8474a4470f71c30a4b89651fd3c5f2ef92ba2 Author: Mattias Engdegård Date: Mon Mar 4 10:44:19 2024 +0100 Repair miscompilation of single-arg `apply` (bug#69533) * lisp/emacs-lisp/byte-opt.el (byte-optimize-apply): Don't optimise single-argument `apply`; it's a legacy construct. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases): Add test case. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index add13a5c312..f75be3f71ad 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1448,7 +1448,8 @@ See Info node `(elisp) Integer Basics'." (defun byte-optimize-apply (form) (let ((len (length form))) - (if (>= len 2) + ;; Single-arg `apply' is an abomination that we don't bother optimizing. + (if (> len 2) (let ((fn (nth 1 form)) (last (nth (1- len) form))) (cond diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 8ccac492141..26408e8685a 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -800,6 +800,9 @@ inner loops respectively." ;; Aristotelian identity optimization (let ((x (bytecomp-test-identity 1))) (list (eq x x) (eql x x) (equal x x))) + + ;; Legacy single-arg `apply' call + (apply '(* 2 3)) ) "List of expressions for cross-testing interpreted and compiled code.") commit 2c2a15bd171ecbf87fdac4405c7ea5f567fcf38a Author: Mattias Engdegård Date: Sun Mar 3 15:55:30 2024 +0100 ; * lisp/vc/diff-mode.el (diff--refine-hunk): Escape literal `+`. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 99ac50c155a..ac7d55c8a46 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2353,7 +2353,7 @@ by `diff-refine-hunk'." (match-end 0) 'diff-refine-removed)) (goto-char middle) - (while (re-search-forward "^\\(?:+.*\n\\)+" end t) + (while (re-search-forward "^\\(?:\\+.*\n\\)+" end t) (diff--refine-propertize (match-beginning 0) (match-end 0) 'diff-refine-added)))))) commit 3b7cb55e5bec692fc1055e0b70a95afb4fac107f Author: Mattias Engdegård Date: Tue Feb 27 12:31:57 2024 +0100 ; * etc/NEWS: add missing definite article diff --git a/etc/NEWS b/etc/NEWS index 41bff184676..06856602ea8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1964,8 +1964,8 @@ Example: "Uses c:\remote\dir\files and the key \C-x." ...) -where the docstring contains four control characters 'CR', 'DEL', 'FF' -and 'C-x'. +where the docstring contains the four control characters 'CR', 'DEL', +'FF' and 'C-x'. The warning name is 'docstrings-control-chars'. commit 0df3dc3d46fe7848aabb3ca5ff7085ca59799f43 Author: Eli Zaretskii Date: Mon Mar 4 14:59:27 2024 +0200 Avoid crashes due to base-less indirect buffer * src/buffer.c (Fkill_buffer): Prevent killing a buffer if its indirect buffer refuses to be killed. (Bug#69529) diff --git a/src/buffer.c b/src/buffer.c index 126f3eb055a..9f55a8813fa 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1971,8 +1971,16 @@ cleaning up all windows currently displaying the buffer to be killed. */) Lisp_Object tail, other; FOR_EACH_LIVE_BUFFER (tail, other) - if (XBUFFER (other)->base_buffer == b) - Fkill_buffer (other); + { + struct buffer *obuf = XBUFFER (other); + if (obuf->base_buffer == b) + { + Fkill_buffer (other); + if (BUFFER_LIVE_P (obuf)) + error ("Unable to kill buffer whose indirect buffer `%s' cannot be killed", + SDATA (BVAR (obuf, name))); + } + } /* Exit if we now have killed the base buffer (Bug#11665). */ if (!BUFFER_LIVE_P (b)) commit 912e37b811107768e0cb3bc95184177f817dbdb2 Author: Martin Rudalics Date: Mon Mar 4 10:33:49 2024 +0100 Fix 'set-window-configuration' and 'window-state-put' Fix some bugs with 'window-state-put' (Bug#69093). Add new hook 'window-kept-windows-functions' (Bug#68235). * doc/lispref/windows.texi (Window Configurations): Mention 'window-kept-windows-functions'. (Window Hooks): Describe new abnormal hook 'window-kept-windows-functions'. * src/marker.c (Fmarker_last_position): New function to return the last position of a marker even if its buffer is now dead. * src/window.c (Fset_window_configuration): If 'window-kept-windows-functions' is non-nil, do not delete any window whose buffer is now dead but remember all such windows in a list to pass to 'window-kept-windows-functions'. Run 'window-kept-windows-functions' if it is non-nil. (Vwindow_kept_windows_functions): New abnormal hook run by Fset_window_configuration and 'window-state-put' with two arguments - the frame whose configuration is restored and a list of entries for each window whose buffer was found dead during restoration. Each entry is a list of four elements, the window, the dead buffer, and the last know positions of the start and point of that window. * lisp/window.el (window-state-put-kept-windows) (window-state-put-selected-window): New variables. (window--state-put-2): Make sure buffer is live before restoring its state. Set 'window-state-put-selected-window' to state's selected window. If 'window-kept-windows-functions' is non-nil, do not delete any windows whose buffer is found dead but remember all such windows in a list to pass to 'window-kept-windows-functions'. (window-state-put): Run 'window-kept-windows-functions' if it is non-nil. Select window recorded in 'window-state-put-selected-window'. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index f14e74bc785..fe3dc573df5 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -6266,9 +6266,13 @@ this function does is to restore the value of the variable If the buffer of a window of @var{configuration} has been killed since @var{configuration} was made, that window is, as a rule, removed from -the restored configuration. However, if that window is the last -window remaining in the restored configuration, another live buffer is -shown in it. +the restored configuration. However, if that window is the last window +remaining in the restored configuration, another live buffer is shown in +it. Also, if the variable @var{window-kept-windows-functions} is +non-@code{nil}, any window whose buffer is now dead is not deleted. +Rather, this function will show another live buffer in that window and +include an entry for that window when calling any function in +@var{window-kept-windows-functions} (@pxref{Window Hooks}). Here is a way of using this function to get the same effect as @code{save-window-excursion}: @@ -6357,6 +6361,15 @@ a live window, it is replaced by a new live window created on the same frame before putting @var{state} into it. If @var{window} is @code{nil}, it puts the window state into a new window. +If the buffer of any window recorded in @var{state} has been killed +since @var{state} was made, that window is, as a rule, not restored. +However, if that window is the only window in @var{state}, another live +buffer will be shown in it. Also, if the variable +@var{window-kept-windows-functions} is non-@code{nil}, any window whose +buffer is now dead is restored. This function will show another live +buffer in it and include an entry for that window when calling a +function in @var{window-kept-windows-functions} (@pxref{Window Hooks}). + If the optional argument @var{ignore} is non-@code{nil}, it means to ignore minimum window sizes and fixed-size restrictions. If @var{ignore} is @code{safe}, this means windows can get as small as one line @@ -6623,6 +6636,27 @@ Lock fontification function, which will be called whenever parts of a buffer are (re)fontified because a window was scrolled or its size changed. @xref{Other Font Lock Variables}. +@cindex window kept windows functions +@defvar window-kept-windows-functions + This variable holds a list of functions that Emacs will call after +restoring a window configuration via @code{set-window-configuration} or +state via @code{window-state-put} (@pxref{Window Configurations}). When +the value of this variable is non-@code{nil}, these functions will not +delete any window whose buffer has been killed since the corresponding +configuration or state was saved, but show some live buffer in it. + +The value should be a list of functions that take two arguments. The +first argument specifies the frame whose windows have been restored. +The second argument specifies a list of entries for each window whose +buffer has been found dead at the time @code{set-window-configuration} +or @code{window-state-put} tried to restore it. Each entry is a list of +four values - the window whose buffer was found dead, the dead buffer, +and the last known positions of start and point of the buffer in that +window. Any function run by this hook should check that the window is +live since another function run by this hook may have deleted it in the +meantime. +@end defvar + @cindex window change functions The remainder of this section covers six hooks that are called during redisplay provided a significant, non-scrolling change of a diff --git a/lisp/window.el b/lisp/window.el index 6df20353b5e..29336f573f8 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -6174,6 +6174,12 @@ value can be also stored on disk and read back in a new session." (defvar window-state-put-stale-windows nil "Helper variable for `window-state-put'.") +(defvar window-state-put-kept-windows nil + "Helper variable for `window-state-put'.") + +(defvar window-state-put-selected-window nil + "Helper variable for `window-state-put'.") + (defun window--state-put-1 (state &optional window ignore totals pixelwise) "Helper function for `window-state-put'." (let ((type (car state))) @@ -6278,9 +6284,10 @@ value can be also stored on disk and read back in a new session." (set-window-parameter window (car parameter) (cdr parameter)))) ;; Process buffer related state. (when state - (let ((buffer (get-buffer (car state))) - (state (cdr state))) - (if buffer + (let* ((old-buffer-or-name (car state)) + (buffer (get-buffer old-buffer-or-name)) + (state (cdr state))) + (if (buffer-live-p buffer) (with-current-buffer buffer (set-window-buffer window buffer) (set-window-hscroll window (cdr (assq 'hscroll state))) @@ -6348,7 +6355,18 @@ value can be also stored on disk and read back in a new session." (set-window-point window (cdr (assq 'point state)))) ;; Select window if it's the selected one. (when (cdr (assq 'selected state)) - (select-window window)) + ;; This used to call 'select-window' which, however, + ;; can be partially undone because the current buffer + ;; may subsequently change twice: When leaving the + ;; present 'with-current-buffer' and when leaving the + ;; containing 'with-temp-buffer' form (Bug#69093). + ;; 'window-state-put-selected-window' should now work + ;; around that bug but we leave this 'select-window' + ;; in since some code run before the part that fixed + ;; it might still refer to this window as the selected + ;; one. + (select-window window) + (setq window-state-put-selected-window window)) (set-window-next-buffers window (delq nil (mapcar (lambda (buffer) @@ -6375,7 +6393,20 @@ value can be also stored on disk and read back in a new session." ;; save the window with the intention of deleting it later ;; if possible. (switch-to-prev-buffer window) - (push window window-state-put-stale-windows))))))) + (if window-kept-windows-functions + (let* ((start (cdr (assq 'start state))) + ;; Handle both - marker positions from writable + ;; states and markers from non-writable states. + (start-pos (if (markerp start) + (marker-last-position start) + start)) + (point (cdr (assq 'point state))) + (point-pos (if (markerp point) + (marker-last-position point) + point))) + (push (list window old-buffer-or-name start-pos point-pos) + window-state-put-kept-windows)) + (push window window-state-put-stale-windows)))))))) (defun window-state-put (state &optional window ignore) "Put window state STATE into WINDOW. @@ -6388,8 +6419,20 @@ If WINDOW is nil, create a new window before putting STATE into it. Optional argument IGNORE non-nil means ignore minimum window sizes and fixed size restrictions. IGNORE equal `safe' means windows can get as small as `window-safe-min-height' and -`window-safe-min-width'." +`window-safe-min-width'. + +If the abnormal hook `window-kept-windows-functions' is non-nil, +do not delete any windows saved by STATE whose buffers were +deleted since STATE was saved. Rather, show some live buffer in +them and call the functions in `window-kept-windows-functions' +with a list of two arguments: the frame where STATE was put and a +list of entries for each such window. Each entry contains four +elements - the window, its old buffer and the last positions of +`window-start' and `window-point' for the buffer in that window. +Always check the window for liveness because another function run +by this hook may have deleted it." (setq window-state-put-stale-windows nil) + (setq window-state-put-kept-windows nil) ;; When WINDOW is internal or nil, reduce it to a live one, ;; then create a new window on the same frame to put STATE into. @@ -6482,6 +6525,7 @@ windows can get as small as `window-safe-min-height' and (error "Window %s too small to accommodate state" window) (setq state (cdr state)) (setq window-state-put-list nil) + (setq window-state-put-selected-window nil) ;; Work on the windows of a temporary buffer to make sure that ;; splitting proceeds regardless of any buffer local values of ;; `window-size-fixed'. Release that buffer after the buffers of @@ -6490,14 +6534,21 @@ windows can get as small as `window-safe-min-height' and (set-window-buffer window (current-buffer)) (window--state-put-1 state window nil totals pixelwise) (window--state-put-2 ignore pixelwise)) + (when (window-live-p window-state-put-selected-window) + (select-window window-state-put-selected-window)) (while window-state-put-stale-windows (let ((window (pop window-state-put-stale-windows))) - ;; Avoid that 'window-deletable-p' throws an error if window + ;; Avoid that 'window-deletable-p' throws an error if window ;; was already deleted when exiting 'with-temp-buffer' above ;; (Bug#54028). (when (and (window-valid-p window) (eq (window-deletable-p window) t)) (delete-window window)))) + (when window-kept-windows-functions + (run-hook-with-args + 'window-kept-windows-functions + frame window-state-put-kept-windows) + (setq window-state-put-kept-windows nil)) (window--check frame)))) (defun window-state-buffers (state) diff --git a/src/marker.c b/src/marker.c index 1559dd52719..2abc951fc76 100644 --- a/src/marker.c +++ b/src/marker.c @@ -463,6 +463,18 @@ DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0, return Qnil; } +DEFUN ("marker-last-position", Fmarker_last_position, Smarker_last_position, 1, 1, 0, + doc: /* Return last position of MARKER in its buffer. +This is like `marker-position' with one exception: If the buffer of +MARKER is dead, it returns the last position of MARKER in that buffer +before it was killed. */) + (Lisp_Object marker) +{ + CHECK_MARKER (marker); + + return make_fixnum (XMARKER (marker)->charpos); +} + /* Change M so it points to B at CHARPOS and BYTEPOS. */ static void @@ -830,6 +842,7 @@ void syms_of_marker (void) { defsubr (&Smarker_position); + defsubr (&Smarker_last_position); defsubr (&Smarker_buffer); defsubr (&Sset_marker); defsubr (&Scopy_marker); diff --git a/src/window.c b/src/window.c index 0c84b4f4bf3..ea761fad8bc 100644 --- a/src/window.c +++ b/src/window.c @@ -7109,6 +7109,24 @@ current at the start of the function. If DONT-SET-MINIWINDOW is non-nil, the mini-window of the frame doesn't get set to the corresponding element of CONFIGURATION. +Normally, this function will try to delete any dead window in +CONFIGURATION whose buffer has been deleted since CONFIGURATION was +made. However, if the abnormal hook `window-kept-windows-functions' is +non-nil, it will preserve such a window in the restored layout and show +another buffer in it. + +After restoring the frame layout, this function runs the abnormal hook +`window-kept-windows-functions' with two arguments - the frame whose +layout it has restored and a list of entries for each window whose +buffer has been found dead when it tried to restore CONFIGURATION: Each +entry is a list of four elements where +`window' denotes the window whose buffer was found dead, `buffer' +denotes the dead buffer, and `start' and `point' denote the last known +positions of `window-start' and `window-point' of the buffer in that +window. Any function run by this hook should check such a window for +liveness because another function run by this hook may have deleted it +in the meantime." + If CONFIGURATION was made from a frame that is now deleted, only frame-independent values can be restored. In this case, the return value is nil. Otherwise the value is t. */) @@ -7119,6 +7137,7 @@ the return value is nil. Otherwise the value is t. */) struct Lisp_Vector *saved_windows; Lisp_Object new_current_buffer; Lisp_Object frame; + Lisp_Object kept_windows = Qnil; Lisp_Object old_frame = selected_frame; struct frame *f; ptrdiff_t old_point = -1; @@ -7359,6 +7378,11 @@ the return value is nil. Otherwise the value is t. */) BUF_PT (XBUFFER (w->contents)), BUF_PT_BYTE (XBUFFER (w->contents))); w->start_at_line_beg = true; + if (!NILP (Vwindow_kept_windows_functions)) + kept_windows = Fcons (list4 (window, p->buffer, + Fmarker_last_position (p->start), + Fmarker_last_position (p->pointm)), + kept_windows); } else if (!NILP (w->start)) /* Leaf window has no live buffer, get one. */ @@ -7379,6 +7403,11 @@ the return value is nil. Otherwise the value is t. */) dead_windows = Fcons (window, dead_windows); /* Make sure window is no more dedicated. */ wset_dedicated (w, Qnil); + if (!NILP (Vwindow_kept_windows_functions)) + kept_windows = Fcons (list4 (window, p->buffer, + Fmarker_last_position (p->start), + Fmarker_last_position (p->pointm)), + kept_windows); } } @@ -7430,12 +7459,13 @@ the return value is nil. Otherwise the value is t. */) unblock_input (); /* Scan dead buffer windows. */ - for (; CONSP (dead_windows); dead_windows = XCDR (dead_windows)) - { - window = XCAR (dead_windows); - if (WINDOW_LIVE_P (window) && !EQ (window, FRAME_ROOT_WINDOW (f))) - delete_deletable_window (window); - } + if (!NILP (Vwindow_kept_windows_functions)) + for (; CONSP (dead_windows); dead_windows = XCDR (dead_windows)) + { + window = XCAR (dead_windows); + if (WINDOW_LIVE_P (window) && !EQ (window, FRAME_ROOT_WINDOW (f))) + delete_deletable_window (window); + } /* Record the selected window's buffer here. The window should already be the selected one from the call above. */ @@ -7482,6 +7512,11 @@ the return value is nil. Otherwise the value is t. */) minibuf_selected_window = data->minibuf_selected_window; SAFE_FREE (); + + if (!NILP (Vrun_hooks) && !NILP (Vwindow_kept_windows_functions)) + run_hook_with_args_2 (Qwindow_kept_windows_functions, frame, + kept_windows); + return FRAME_LIVE_P (f) ? Qt : Qnil; } @@ -8479,6 +8514,8 @@ syms_of_window (void) DEFSYM (Qheader_line_format, "header-line-format"); DEFSYM (Qtab_line_format, "tab-line-format"); DEFSYM (Qno_other_window, "no-other-window"); + DEFSYM (Qwindow_kept_windows_functions, + "window-kept-windows-functions"); DEFVAR_LISP ("temp-buffer-show-function", Vtemp_buffer_show_function, doc: /* Non-nil means call as function to display a help buffer. @@ -8636,6 +8673,28 @@ its buffer or its total or body size since the last redisplay. Each call is performed with the frame temporarily selected. */); Vwindow_configuration_change_hook = Qnil; + DEFVAR_LISP ("window-kept-windows-functions", + Vwindow_kept_windows_functions, + doc: /* Functions run after restoring a window configuration or state. +These functions are called by `set-window-configuration' and +`window-state-put'. When the value of this variable is non-nil, these +functions restore any window whose buffer has been deleted since the +corresponding configuration or state was saved. Rather than deleting +such a window, `set-window-configuration' and `window-state-put' show +some live buffer in it. + +The value should be a list of functions that take two arguments. The +first argument specifies the frame whose configuration has been +restored. The second argument, if non-nil, specifies a list of entries +for each window whose buffer has been found dead at the time +'set-window-configuration' or `window-state-put' tried to restore it in +that window. Each entry is a list of four values - the window whose +buffer was found dead, the dead buffer, and the positions of start and +point of the buffer in that window. Note that the window may be already +dead since another function on this list may have deleted it in the +meantime. */); + Vwindow_kept_windows_functions = Qnil; + DEFVAR_LISP ("recenter-redisplay", Vrecenter_redisplay, doc: /* Non-nil means `recenter' redraws entire frame. If this option is non-nil, then the `recenter' command with a nil