emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

feature/android 9c6256df0d 4/7: Merge remote-tracking branch 'origin/mas


From: Po Lu
Subject: feature/android 9c6256df0d 4/7: Merge remote-tracking branch 'origin/master' into feature/android
Date: Sat, 14 Jan 2023 09:48:54 -0500 (EST)

branch: feature/android
commit 9c6256df0d42f5b6be5ccd20a03a3b2803108b83
Merge: 2b87ab7b27 dce42f5561
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>

    Merge remote-tracking branch 'origin/master' into feature/android
---
 lisp/apropos.el              | 24 +++++----------
 lisp/reveal.el               | 18 +++++------
 lisp/simple.el               | 11 ++++++-
 lisp/subr.el                 | 17 +++++------
 src/doc.c                    | 34 +++++++++++++--------
 test/lisp/net/tramp-tests.el | 17 ++++++-----
 test/src/undo-tests.el       | 72 ++++++++++++++++++++++++++++++++++++++++++++
 7 files changed, 134 insertions(+), 59 deletions(-)

diff --git a/lisp/apropos.el b/lisp/apropos.el
index b260d88995..9b9615221c 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -1117,23 +1117,13 @@ non-nil."
 (defun apropos-safe-documentation (function)
   "Like `documentation', except it avoids calling `get_doc_string'.
 Will return nil instead."
-  (while (and function (symbolp function))
-    (setq function (symbol-function function)))
-  (if (eq (car-safe function) 'macro)
-      (setq function (cdr function)))
-  (setq function (if (byte-code-function-p function)
-                    (if (> (length function) 4)
-                        (aref function 4))
-                  (if (autoloadp function)
-                      (nth 2 function)
-                    (if (eq (car-safe function) 'lambda)
-                        (if (stringp (nth 2 function))
-                            (nth 2 function)
-                          (if (stringp (nth 3 function))
-                              (nth 3 function)))))))
-  (if (integerp function)
-      nil
-    function))
+  (when (setq function (indirect-function function))
+    ;; FIXME: `function-documentation' says not to call it, but `documentation'
+    ;; would turn (FILE . POS) references into strings too eagerly, so
+    ;; we do want to use the lower-level function.
+    (let ((doc (function-documentation function)))
+      ;; Docstrings from the DOC file are handled elsewhere.
+      (if (integerp doc) nil doc))))
 
 (defcustom apropos-compact-layout nil
   "If non-nil, use a single line per binding."
diff --git a/lisp/reveal.el b/lisp/reveal.el
index 8a1239e1aa..5ebc5f7c6c 100644
--- a/lisp/reveal.el
+++ b/lisp/reveal.el
@@ -118,17 +118,13 @@ Each element has the form (WINDOW . OVERLAY).")
           ;; overlay.  Always reveal invisible text, but only reveal
           ;; display properties if `reveal-toggle-invisible' is
           ;; present.
-          (let ((inv (overlay-get ol 'invisible))
-                (disp (and (overlay-get ol 'display)
-                           (overlay-get ol 'reveal-toggle-invisible)))
-                open)
-            (when (and (or (and inv
-                                ;; There's an `invisible' property.
-                                ;; Make sure it's actually invisible,
-                                ;; and ellipsized.
-                                (and (consp buffer-invisibility-spec)
-                                     (cdr (assq inv 
buffer-invisibility-spec))))
-                           disp)
+          (let* ((inv (overlay-get ol 'invisible))
+                 (disp (and (overlay-get ol 'display)
+                            (overlay-get ol 'reveal-toggle-invisible)))
+                 (hidden (invisible-p inv))
+                 (ellipsis (and hidden (not (eq t hidden))))
+                 open)
+            (when (and (or ellipsis disp)
                        (or (setq open
                                  (or (overlay-get ol 'reveal-toggle-invisible)
                                      (and (symbolp inv)
diff --git a/lisp/simple.el b/lisp/simple.el
index f571217723..eedc5d7244 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2709,7 +2709,16 @@ function as needed."
        (let ((doc (car body)))
         (when (funcall docstring-p doc)
            doc)))
-      (_ (signal 'invalid-function (list function))))))
+      ((pred symbolp)
+       (let ((f (indirect-function function)))
+         (if f (function-documentation f)
+           (signal 'void-function (list function)))))
+      (`(macro . ,f) (function-documentation f))
+      (_
+       (let ((doc (internal-subr-documentation function)))
+         (if (eq t doc)
+             (signal 'invalid-function (list function))
+           doc))))))
 
 (cl-defmethod function-documentation ((function accessor))
   (oclosure--accessor-docstring function)) ;; FIXME: η-reduce!
diff --git a/lisp/subr.el b/lisp/subr.el
index d1d3c76caf..9e50b1e7f9 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4966,21 +4966,20 @@ the function `undo--wrap-and-run-primitive-undo'."
                       beg
                       (marker-position end-marker)
                       #'undo--wrap-and-run-primitive-undo
-                      beg (marker-position end-marker) buffer-undo-list))
+                      beg (marker-position end-marker)
+                      ;; We will truncate this list by side-effect below.
+                      buffer-undo-list))
                (ptr buffer-undo-list))
            (if (not (eq buffer-undo-list old-bul))
                (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)))))
+                             (or (cdr ptr)
+                                 (progn
+                                   (message "combine-change-calls: 
buffer-undo-list broken")
+                                   nil)))
                    (setq ptr (cdr ptr)))
-                 (unless (cdr ptr)
-                   (message "combine-change-calls: buffer-undo-list broken"))
+                 ;; Truncate the list that's in the `apply' entry.
                  (setcdr ptr nil)
                  (push ap-elt buffer-undo-list)
                  (setcdr buffer-undo-list old-bul)))))
diff --git a/src/doc.c b/src/doc.c
index df57f84603..174341523d 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -330,19 +330,7 @@ string is passed through `substitute-command-keys'.  */)
     xsignal1 (Qvoid_function, function);
   if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
     fun = XCDR (fun);
-#ifdef HAVE_NATIVE_COMP
-  if (!NILP (Fsubr_native_elisp_p (fun)))
-    doc = native_function_doc (fun);
-  else
-#endif
-  if (SUBRP (fun))
-    doc = make_fixnum (XSUBR (fun)->doc);
-#ifdef HAVE_MODULES
-  else if (MODULE_FUNCTIONP (fun))
-    doc = module_function_documentation (XMODULE_FUNCTION (fun));
-#endif
-  else
-    doc = call1 (Qfunction_documentation, fun);
+  doc = call1 (Qfunction_documentation, fun);
 
   /* If DOC is 0, it's typically because of a dumped file missing
      from the DOC file (bug in src/Makefile.in).  */
@@ -371,6 +359,25 @@ string is passed through `substitute-command-keys'.  */)
   return doc;
 }
 
+DEFUN ("internal-subr-documentation", Fsubr_documentation, 
Ssubr_documentation, 1, 1, 0,
+       doc: /* Return the raw documentation info of a C primitive.  */)
+  (Lisp_Object function)
+{
+#ifdef HAVE_NATIVE_COMP
+  if (!NILP (Fsubr_native_elisp_p (function)))
+    return native_function_doc (function);
+  else
+#endif
+  if (SUBRP (function))
+    return make_fixnum (XSUBR (function)->doc);
+#ifdef HAVE_MODULES
+  else if (MODULE_FUNCTIONP (function))
+    return module_function_documentation (XMODULE_FUNCTION (function));
+#endif
+  else
+    return Qt;
+}
+
 DEFUN ("documentation-property", Fdocumentation_property,
        Sdocumentation_property, 2, 3, 0,
        doc: /* Return the documentation string that is SYMBOL's PROP property.
@@ -713,6 +720,7 @@ compute the correct value for the current terminal in the 
nil case.  */);
   /* Initialized by ‘main’.  */
 
   defsubr (&Sdocumentation);
+  defsubr (&Ssubr_documentation);
   defsubr (&Sdocumentation_property);
   defsubr (&Ssnarf_documentation);
   defsubr (&Stext_quoting_style);
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index dd3de27d3b..918929f55e 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -5469,7 +5469,7 @@ INPUT, if non-nil, is a string sent to the process."
               (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.
                (rx
                 bos (** 1 2 (literal (file-name-nondirectory tmp-name)) "\n")
                 eos)
@@ -6567,11 +6567,12 @@ This is used in tests which we don't want to tag
   "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.
@@ -6945,7 +6946,7 @@ This requires restrictions of file name syntax."
   (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)
@@ -7003,7 +7004,7 @@ This requires restrictions of file name syntax."
   "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)))
@@ -7123,7 +7124,7 @@ process sentinels.  They shall not disturb each other."
                      '(:unstable)))
   (skip-unless (tramp--test-enabled))
   (skip-unless (tramp--test-supports-processes-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)))
diff --git a/test/src/undo-tests.el b/test/src/undo-tests.el
index 84151d3b5d..fd45a9101f 100644
--- a/test/src/undo-tests.el
+++ b/test/src/undo-tests.el
@@ -439,6 +439,78 @@ Demonstrates bug 16818."
 
     (should (string= (buffer-string) "aaaFirst line\nSecond line\nbbb"))))
 
+(ert-deftest undo-test-combine-change-calls-1 ()
+  "Test how `combine-change-calls' updates `buffer-undo-list'.
+Case 1: a file-visiting buffer with `buffer-undo-list' non-nil
+and `buffer-modified-p' non-nil when `combine-change-calls' is
+called."
+  (ert-with-temp-file tempfile
+    (with-current-buffer (find-file tempfile)
+      (insert "A")
+      (undo-boundary)
+      (insert "B")
+      (undo-boundary)
+      (insert "C")
+      (undo-boundary)
+      (insert " ")
+      (undo-boundary)
+      (insert "D")
+      (undo-boundary)
+      (insert "E")
+      (undo-boundary)
+      (insert "F")
+      (should (= (length buffer-undo-list) 14))
+      (goto-char (point-min))
+      (combine-change-calls (point-min) (point-max)
+        (re-search-forward "ABC ")
+        (replace-match "Z "))
+      (should (= (length buffer-undo-list) 15)))))
+
+(ert-deftest undo-test-combine-change-calls-2 ()
+  "Test how `combine-change-calls' updates `buffer-undo-list'.
+Case 2: a file-visiting buffer with `buffer-undo-list' non-nil
+and `buffer-modified-p' nil when `combine-change-calls' is
+called."
+  (ert-with-temp-file tempfile
+    (with-current-buffer (find-file tempfile)
+      (insert "A")
+      (undo-boundary)
+      (insert "B")
+      (undo-boundary)
+      (insert "C")
+      (undo-boundary)
+      (insert " ")
+      (undo-boundary)
+      (insert "D")
+      (undo-boundary)
+      (insert "E")
+      (undo-boundary)
+      (insert "F")
+      (should (= (length buffer-undo-list) 14))
+      (save-buffer)
+      (goto-char (point-min))
+      (combine-change-calls (point-min) (point-max)
+        (re-search-forward "ABC ")
+        (replace-match "Z "))
+      (should (= (length buffer-undo-list) 15)))))
+
+(ert-deftest undo-test-combine-change-calls-3 ()
+  "Test how `combine-change-calls' updates `buffer-undo-list'.
+Case 3: a file-visiting buffer with `buffer-undo-list' nil and
+`buffer-modified-p' nil when `combine-change-calls' is called."
+  (ert-with-temp-file tempfile
+    (with-current-buffer (find-file tempfile)
+      (insert "ABC DEF")
+      (save-buffer)
+      (kill-buffer))
+    (with-current-buffer (find-file tempfile)
+      (should (= (length buffer-undo-list) 0))
+      (goto-char (point-min))
+      (combine-change-calls (point-min) (point-max)
+        (re-search-forward "ABC ")
+        (replace-match "Z "))
+      (should (= (length buffer-undo-list) 1)))))
+
 (defun undo-test-all (&optional interactive)
   "Run all tests for \\[undo]."
   (interactive "p")



reply via email to

[Prev in Thread] Current Thread [Next in Thread]