unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: npostavs@users.sourceforge.net
To: Stefan Monnier <monnier@IRO.UMontreal.CA>
Cc: lekktu@gmail.com, johnw@gnu.org, 6991@debbugs.gnu.org, larsi@gnus.org
Subject: bug#6991: Please keep bytecode out of *Backtrace* buffers
Date: Sun, 25 Jun 2017 23:34:56 -0400	[thread overview]
Message-ID: <87mv8vo1zz.fsf@users.sourceforge.net> (raw)
In-Reply-To: <jwvzicwaxwx.fsf-monnier+emacs@gnu.org> (Stefan Monnier's message of "Sun, 25 Jun 2017 15:11:02 -0400")

[-- Attachment #1: Type: text/plain, Size: 2740 bytes --]


Stefan Monnier <monnier@IRO.UMontreal.CA> writes:
>
>> +        (when fun-file
>> +          (make-text-button fun-pt (+ fun-pt (length (symbol-name fun)))
>> +                            :type 'help-function-def
>> +                            'help-args (list fun fun-file))))
>
> Hmm... this looks like code which was moved from elsewhere, yet I can't
> find this elsewhere in your patch(es).

> I think that other code is in debugger-make-xrefs, so can't we remove
> debugger-make-xrefs?

I'm not sure exactly what you mean by "looks like code which was moved".
It does replace the functionality of debugger-make-xrefs.  But
`ert--make-xrefs-region' is still using `debugger-make-xrefs', and I
don't quite see how to remove that usage.

>> +    (let ((frames (nthcdr
>> +                   ;; Remove debug--implement-debug-on-entry and the
>> +                   ;; advice's `apply' frame.
>> +                   (if (eq (car args) 'debug) 3 1)
>> +                   (backtrace-frames 'debug)))
>> +          (print-escape-newlines t)
>> +          (print-level 8)
>> +          (print-length 50))
>
> Why let-bind print-* here rather than inside debugger-insert-backtrace?

I thought moving those inside might needlessly make the function less
flexible, though nobody is currently making use of the flexibility so
maybe it's not worth it...

>> +      (when (eq (car args) 'exit)
>> +        (setf (cl-getf (nth 3 (car frames)) :debug-on-exit) nil))
>
> This looks like code which was moved from elsewhere, yet I can't find
> this elsewhere in your patch(es).  What am I missing?

backtrace--print-frame I guess?  I haven't changed the printing for
`backtrace', perhaps I should...

>> +  (pcase (help-split-fundoc (documentation object 'raw) object)
>> +    (`(,_ . ,(and doc (guard (stringp doc))))
>> +     (princ " " stream)
>> +     (prin1 doc stream)))
>
> Maybe this deserves a one-line comment explaining that the arglist part
> was already printed via help-function-arglist.

Sure.

>> +(defcustom debugger-print-function #'cl-prin1
>> +  "Function used to print values in the debugger backtraces."
>> +  :type 'function
>> +  :options '(cl-prin1 prin1)
>> +  :group 'debugger
>> +  :version "26.1")
>
> The `:group 'debugger` is redundant (as is the case for all defcustom
> in this file).

Yeah, I just followed the others, I'll remove it.

>> +(defvar cl-print-compiled)
>
> Is this used somewhere?

Oh, I think that's leftover from avoiding Bug#27117.

>> -          (prin1 fun)
>> -          (if args (prin1 args) (princ "()")))
>> +          (funcall debugger-print-function fun)
>> +          (if args (cl-prin1 args) (princ "()")))
>
> This `cl-prin1` should be replaced with debugger-print-function, right?

Oops!


[-- Attachment #2: patch --]
[-- Type: text/plain, Size: 5349 bytes --]

From a4bd2230a428560338afd4b5f2e74eccba9c4afc Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 11 Feb 2017 09:19:00 -0500
Subject: [PATCH v4 1/6] Operate on frame list instead of printed backtrace

* lisp/emacs-lisp/debug.el (debugger-insert-backtrace): New function,
prints the given backtrace frames.
(debugger-setup-buffer): Use it instead of editing the backtrace
buffer text.
---
 lisp/emacs-lisp/debug.el | 84 +++++++++++++++++++++++++++---------------------
 1 file changed, 48 insertions(+), 36 deletions(-)

diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 83456fc31a..0c8306d428 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -264,6 +264,40 @@ (defun debug (&rest args)
       (setq debug-on-next-call debugger-step-after-exit)
       debugger-value)))
 \f
+
+(defun debugger-insert-backtrace (frames do-xrefs)
+  "Format and insert the backtrace FRAMES at point.
+Make functions into cross-reference buttons if DO-XREFS is non-nil."
+  (let ((standard-output (current-buffer))
+        (eval-buffers eval-buffer-list))
+    (require 'help-mode)     ; Define `help-function-def' button type.
+    (pcase-dolist (`(,evald ,fun ,args ,flags) frames)
+      (insert (if (plist-get flags :debug-on-exit)
+                  "* " "  "))
+      (let ((fun-file (and do-xrefs (symbol-file fun 'defun)))
+            (fun-pt (point)))
+        (cond
+         ((and evald (not debugger-stack-frame-as-list))
+          (prin1 fun)
+          (if args (prin1 args) (princ "()")))
+         (t
+          (prin1 (cons fun args))
+          (cl-incf fun-pt)))
+        (when fun-file
+          (make-text-button fun-pt (+ fun-pt (length (symbol-name fun)))
+                            :type 'help-function-def
+                            'help-args (list fun fun-file))))
+      ;; After any frame that uses eval-buffer, insert a line that
+      ;; states the buffer position it's reading at.
+      (when (and eval-buffers (memq fun '(eval-buffer eval-region)))
+        (insert (format "  ; Reading at buffer position %d"
+                        ;; This will get the wrong result if there are
+                        ;; two nested eval-region calls for the same
+                        ;; buffer.  That's not a very useful case.
+                        (with-current-buffer (pop eval-buffers)
+                          (point)))))
+      (insert "\n"))))
+
 (defun debugger-setup-buffer (args)
   "Initialize the `*Backtrace*' buffer for entry to the debugger.
 That buffer should be current already."
@@ -271,22 +305,6 @@ (defun debugger-setup-buffer (args)
   (erase-buffer)
   (set-buffer-multibyte t)		;Why was it nil ?  -stef
   (setq buffer-undo-list t)
-  (let ((standard-output (current-buffer))
-	(print-escape-newlines t)
-	(print-level 8)
-        (print-length 50))
-    ;; FIXME the debugger could pass a custom callback to mapbacktrace
-    ;; instead of manipulating printed results.
-    (mapbacktrace #'backtrace--print-frame 'debug))
-  (goto-char (point-min))
-  (delete-region (point)
-		 (progn
-                   (forward-line (if (eq (car args) 'debug)
-                                     ;; Remove debug--implement-debug-on-entry
-                                     ;; and the advice's `apply' frame.
-				     3
-				   1))
-		   (point)))
   (insert "Debugger entered")
   ;; lambda is for debug-on-call when a function call is next.
   ;; debug is for debug-on-entry function called.
@@ -301,10 +319,7 @@ (defun debugger-setup-buffer (args)
        (setq pos (point))
        (setq debugger-value (nth 1 args))
        (prin1 debugger-value (current-buffer))
-       (insert ?\n)
-       (delete-char 1)
-       (insert ? )
-       (beginning-of-line))
+       (insert ?\n))
       ;; Watchpoint triggered.
       ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args)))
        (insert
@@ -341,23 +356,20 @@ (defun debugger-setup-buffer (args)
                   (cdr args) args)
               (current-buffer))
        (insert ?\n)))
+    (let ((frames (nthcdr
+                   ;; Remove debug--implement-debug-on-entry and the
+                   ;; advice's `apply' frame.
+                   (if (eq (car args) 'debug) 3 1)
+                   (backtrace-frames 'debug)))
+          (print-escape-newlines t)
+          (print-level 8)
+          (print-length 50))
+      (when (eq (car args) 'exit)
+        (setf (cl-getf (nth 3 (car frames)) :debug-on-exit) nil))
+      (debugger-insert-backtrace frames t))
     ;; Place point on "stack frame 0" (bug#15101).
-    (goto-char pos))
-  ;; After any frame that uses eval-buffer,
-  ;; insert a line that states the buffer position it's reading at.
-  (save-excursion
-    (let ((tem eval-buffer-list))
-      (while (and tem
-		  (re-search-forward "^  eval-\\(buffer\\|region\\)(" nil t))
-	(end-of-line)
-	(insert (format "  ; Reading at buffer position %d"
-			;; This will get the wrong result
-			;; if there are two nested eval-region calls
-			;; for the same buffer.  That's not a very useful case.
-			(with-current-buffer (car tem)
-			  (point))))
-	(pop tem))))
-  (debugger-make-xrefs))
+    (goto-char pos)))
+
 
 (defun debugger-make-xrefs (&optional buffer)
   "Attach cross-references to function names in the `*Backtrace*' buffer."
-- 
2.11.1


[-- Attachment #3: patch --]
[-- Type: text/plain, Size: 7008 bytes --]

From 65b27e283c7037a049969ba03098b59018ff3553 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 11 Feb 2017 17:19:41 -0500
Subject: [PATCH v4 2/6] Improve ert backtrace recording

Change ert to use the new `backtrace-frames' function instead of
collecting frames one by one with `backtrace-frame'.  Additionally,
collect frames starting from `signal' instead the somewhat arbitrary
"6 from the bottom".  Skipping 6 frames would skip the expression that
actually caused the signal that triggered the debugger.  Possibly 6
was chosen because in the case of a failed test, the triggering frame
is an `ert-fail' call, which is not so interesting.  But in case of
test throwing an error, this drops the `error' call which is too much.

* lisp/emacs-lisp/ert.el (ert--print-backtrace): Remove.
(ert--print-backtrace): Add DO-XREFS parameter, delegate to
`debugger-insert-backtrace'.
(ert--run-test-debugger): Record the backtrace frames starting from
the instigating `signal' call.
(ert-run-tests-batch): Pass nil for `ert--print-backtrace's new
DO-XREFS parameter.
(ert-results-pop-to-backtrace-for-test-at-point): Pass t as DO-XREFS
to `ert--print-backtrace' and remove call to `debugger-make-xrefs'.
* test/lisp/emacs-lisp/ert-tests.el (ert-test-record-backtrace): Check
the backtrace list instead of comparing its string representation.
Expect `signal' to be the first frame.
---
 lisp/emacs-lisp/ert.el            | 62 ++++++++++++---------------------------
 test/lisp/emacs-lisp/ert-tests.el |  8 ++---
 2 files changed, 21 insertions(+), 49 deletions(-)

diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 2c49a634e3..402798603a 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -670,48 +670,12 @@ (cl-defstruct (ert-test-skipped (:include ert-test-result-with-condition)))
 (cl-defstruct (ert-test-aborted-with-non-local-exit
                (:include ert-test-result)))
 
-
-(defun ert--record-backtrace ()
-  "Record the current backtrace (as a list) and return it."
-  ;; Since the backtrace is stored in the result object, result
-  ;; objects must only be printed with appropriate limits
-  ;; (`print-level' and `print-length') in place.  For interactive
-  ;; use, the cost of ensuring this possibly outweighs the advantage
-  ;; of storing the backtrace for
-  ;; `ert-results-pop-to-backtrace-for-test-at-point' given that we
-  ;; already have `ert-results-rerun-test-debugging-errors-at-point'.
-  ;; For batch use, however, printing the backtrace may be useful.
-  (cl-loop
-   ;; 6 is the number of frames our own debugger adds (when
-   ;; compiled; more when interpreted).  FIXME: Need to describe a
-   ;; procedure for determining this constant.
-   for i from 6
-   for frame = (backtrace-frame i)
-   while frame
-   collect frame))
-
-(defun ert--print-backtrace (backtrace)
+(defun ert--print-backtrace (backtrace do-xrefs)
   "Format the backtrace BACKTRACE to the current buffer."
-  ;; This is essentially a reimplementation of Fbacktrace
-  ;; (src/eval.c), but for a saved backtrace, not the current one.
   (let ((print-escape-newlines t)
         (print-level 8)
         (print-length 50))
-    (dolist (frame backtrace)
-      (pcase-exhaustive frame
-        (`(nil ,special-operator . ,arg-forms)
-         ;; Special operator.
-         (insert
-          (format "  %S\n" (cons special-operator arg-forms))))
-        (`(t ,fn . ,args)
-         ;; Function call.
-         (insert (format "  %S(" fn))
-         (cl-loop for firstp = t then nil
-                  for arg in args do
-                  (unless firstp
-                    (insert " "))
-                  (insert (format "%S" arg)))
-         (insert ")\n"))))))
+    (debugger-insert-backtrace backtrace do-xrefs)))
 
 ;; A container for the state of the execution of a single test and
 ;; environment data needed during its execution.
@@ -750,7 +714,19 @@ (defun ert--run-test-debugger (info args)
                       ((quit) 'quit)
 		      ((ert-test-skipped) 'skipped)
                       (otherwise 'failed)))
-              (backtrace (ert--record-backtrace))
+              ;; We store the backtrace in the result object for
+              ;; `ert-results-pop-to-backtrace-for-test-at-point'.
+              ;; This means we have to limit `print-level' and
+              ;; `print-length' when printing result objects.  That
+              ;; might not be worth while when we can also use
+              ;; `ert-results-rerun-test-debugging-errors-at-point',
+              ;; (i.e., when running interactively) but having the
+              ;; backtrace ready for printing is important for batch
+              ;; use.
+              ;;
+              ;; Grab the frames starting from `signal', frames below
+              ;; that are all from the debugger.
+              (backtrace (backtrace-frames 'signal))
               (infos (reverse ert--infos)))
          (setf (ert--test-execution-info-result info)
                (cl-ecase type
@@ -1409,8 +1385,9 @@ (defun ert-run-tests-batch (&optional selector)
               (ert-test-result-with-condition
                (message "Test %S backtrace:" (ert-test-name test))
                (with-temp-buffer
-                 (ert--print-backtrace (ert-test-result-with-condition-backtrace
-                                        result))
+                 (ert--print-backtrace
+                  (ert-test-result-with-condition-backtrace result)
+                  nil)
                  (goto-char (point-min))
                  (while (not (eobp))
                    (let ((start (point))
@@ -2420,8 +2397,7 @@ (defun ert-results-pop-to-backtrace-for-test-at-point ()
            ;; Use unibyte because `debugger-setup-buffer' also does so.
            (set-buffer-multibyte nil)
            (setq truncate-lines t)
-           (ert--print-backtrace backtrace)
-           (debugger-make-xrefs)
+           (ert--print-backtrace backtrace t)
            (goto-char (point-min))
            (insert (substitute-command-keys "Backtrace for test `"))
            (ert-insert-test-name-button (ert-test-name test))
diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el
index fc5790c365..317838b250 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -367,12 +367,8 @@ (ert-deftest ert-test-record-backtrace ()
          (test (make-ert-test :body test-body))
          (result (ert-run-test test)))
     (should (ert-test-failed-p result))
-    (with-temp-buffer
-      (ert--print-backtrace (ert-test-failed-backtrace result))
-      (goto-char (point-min))
-      (end-of-line)
-      (let ((first-line (buffer-substring-no-properties (point-min) (point))))
-        (should (equal first-line (format "  %S()" test-body)))))))
+    (should (eq (nth 1 (car (ert-test-failed-backtrace result)))
+                'signal))))
 
 (ert-deftest ert-test-messages ()
   :tags '(:causes-redisplay)
-- 
2.11.1


[-- Attachment #4: patch --]
[-- Type: text/plain, Size: 4891 bytes --]

From dc941652d3b7f37fbe950b68bfbea00e0a626513 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 11 Feb 2017 18:13:54 -0500
Subject: [PATCH v4 3/6] Escape control characters in backtraces (Bug#6991)

* src/print.c (syms_of_print): Add new variable,
print-escape-control-characters.
(print_object): Print control characters with octal escape codes when
print-escape-control-characters is true.
* lisp/subr.el (backtrace):
* lisp/emacs-lisp/debug.el (debugger-setup-buffer): Bind
`print-escape-control-characters' to t.
---
 lisp/emacs-lisp/debug.el |  1 +
 lisp/subr.el             |  3 ++-
 src/print.c              | 45 +++++++++++++++++++++++++++++++++------------
 3 files changed, 36 insertions(+), 13 deletions(-)

diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 0c8306d428..effe7f0cb3 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -362,6 +362,7 @@ (defun debugger-setup-buffer (args)
                    (if (eq (car args) 'debug) 3 1)
                    (backtrace-frames 'debug)))
           (print-escape-newlines t)
+          (print-escape-control-characters t)
           (print-level 8)
           (print-length 50))
       (when (eq (car args) 'exit)
diff --git a/lisp/subr.el b/lisp/subr.el
index d0c8517c54..a9edff6166 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4514,7 +4514,8 @@ (defun backtrace--print-frame (evald func args flags)
 (defun backtrace ()
   "Print a trace of Lisp function calls currently active.
 Output stream used is value of `standard-output'."
-  (let ((print-level (or print-level 8)))
+  (let ((print-level (or print-level 8))
+        (print-escape-control-characters t))
     (mapbacktrace #'backtrace--print-frame 'backtrace)))
 
 (defun backtrace-frames (&optional base)
diff --git a/src/print.c b/src/print.c
index 6bf8af9ef9..50c75d7712 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1870,21 +1870,36 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 		}
 	      else
 		{
+                  bool still_need_nonhex = false;
 		  /* If we just had a hex escape, and this character
 		     could be taken as part of it,
 		     output `\ ' to prevent that.  */
-		  if (need_nonhex && c_isxdigit (c))
-		    print_c_string ("\\ ", printcharfun);
-
-		  if (c == '\n' && print_escape_newlines
-		      ? (c = 'n', true)
-		      : c == '\f' && print_escape_newlines
-		      ? (c = 'f', true)
-		      : c == '\"' || c == '\\')
-		    printchar ('\\', printcharfun);
-
-		  printchar (c, printcharfun);
-		  need_nonhex = false;
+                  if (c_isxdigit (c))
+                    {
+                      if (need_nonhex)
+                        print_c_string ("\\ ", printcharfun);
+                      printchar (c, printcharfun);
+                    }
+                  else if (c == '\n' && print_escape_newlines
+                           ? (c = 'n', true)
+                           : c == '\f' && print_escape_newlines
+                           ? (c = 'f', true)
+                           : c == '\0' && print_escape_control_characters
+                           ? (c = '0', still_need_nonhex = true)
+                           : c == '\"' || c == '\\')
+                    {
+                      printchar ('\\', printcharfun);
+                      printchar (c, printcharfun);
+                    }
+                  else if (print_escape_control_characters && c_iscntrl (c))
+                    {
+                      char outbuf[1 + 3 + 1];
+                      int len = sprintf (outbuf, "\\%03o", c + 0u);
+                      strout (outbuf, len, len, printcharfun);
+                    }
+                  else
+                    printchar (c, printcharfun);
+		  need_nonhex = still_need_nonhex;
 		}
 	    }
 	  printchar ('\"', printcharfun);
@@ -2329,6 +2344,11 @@ syms_of_print (void)
 Also print formfeeds as `\\f'.  */);
   print_escape_newlines = 0;
 
+  DEFVAR_BOOL ("print-escape-control-characters", print_escape_control_characters,
+	       doc: /* Non-nil means print control characters in strings as `\\OOO'.
+\(OOO is the octal representation of the character code.)*/);
+  print_escape_control_characters = 0;
+
   DEFVAR_BOOL ("print-escape-nonascii", print_escape_nonascii,
 	       doc: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
 \(OOO is the octal representation of the character code.)
@@ -2418,6 +2438,7 @@ representation) and `#N#' in place of each subsequent occurrence,
   DEFSYM (Qprint_escape_newlines, "print-escape-newlines");
   DEFSYM (Qprint_escape_multibyte, "print-escape-multibyte");
   DEFSYM (Qprint_escape_nonascii, "print-escape-nonascii");
+  DEFSYM (Qprint_escape_control_characters, "print-escape-control-characters");
 
   print_prune_charset_plist = Qnil;
   staticpro (&print_prune_charset_plist);
-- 
2.11.1


[-- Attachment #5: patch --]
[-- Type: text/plain, Size: 2053 bytes --]

From db0b3569a4baac81c40c86da88e93f4ae6561b79 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 27 May 2017 22:40:46 -0400
Subject: [PATCH v4 4/6] Don't redundantly cl-print arglist in function
 docstring again

* lisp/emacs-lisp/cl-print.el (cl-print-object): Don't print arglist
part of docstring.
* test/lisp/emacs-lisp/cl-print-tests.el (cl-print-tests-1): Update
test accordingly.
---
 lisp/emacs-lisp/cl-print.el            | 9 +++++----
 test/lisp/emacs-lisp/cl-print-tests.el | 2 +-
 2 files changed, 6 insertions(+), 5 deletions(-)

diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 89a71d1b6c..824d0b7b4f 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -105,10 +105,11 @@ (cl-defmethod cl-print-object ((object compiled-function) stream)
     (if args
         (prin1 args stream)
       (princ "()" stream)))
-  (let ((doc (documentation object 'raw)))
-    (when doc
-      (princ " " stream)
-      (prin1 doc stream)))
+  (pcase (help-split-fundoc (documentation object 'raw) object)
+    ;; Drop args which `help-function-arglist' already printed.
+    (`(,_usage . ,(and doc (guard (stringp doc))))
+     (princ " " stream)
+     (prin1 doc stream)))
   (let ((inter (interactive-form object)))
     (when inter
       (princ " " stream)
diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el
index dfbe18d784..6448a1b37f 100644
--- a/test/lisp/emacs-lisp/cl-print-tests.el
+++ b/test/lisp/emacs-lisp/cl-print-tests.el
@@ -34,7 +34,7 @@ (ert-deftest cl-print-tests-1 ()
     (let ((print-circle t))
       (should (equal (cl-prin1-to-string `((x . ,x) (y . ,x)))
                      "((x . #1=#s(cl-print--test :a 1 :b 2)) (y . #1#))")))
-    (should (string-match "\\`#f(compiled-function (x) .*\n\n.*)\\'"
+    (should (string-match "\\`#f(compiled-function (x) \"[^\"]+\" [^\)]*)\\'"
                           (cl-prin1-to-string (symbol-function #'caar))))))
 
 (ert-deftest cl-print-tests-2 ()
-- 
2.11.1


[-- Attachment #6: patch --]
[-- Type: text/plain, Size: 2912 bytes --]

From f4a9c861f2b14f9958925d328c7ce19f6eca0e2a Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sun, 11 Jun 2017 09:51:38 -0400
Subject: [PATCH v4 5/6] Hide byte code in backtraces (Bug#6991)

* lisp/emacs-lisp/debug.el (debugger-print-function): New defcustom,
defaulting to `cl-print'.
(debugger-insert-backtrace): Use it.
* etc/NEWS: Announce it.
---
 etc/NEWS                 |  5 +++++
 lisp/emacs-lisp/debug.el | 15 ++++++++++++---
 2 files changed, 17 insertions(+), 3 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index c7a5674e51..21510fe539 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -320,6 +320,11 @@ questions, with a handy way to display help texts.
 all call stack frames in a Lisp backtrace buffer as lists.  Both
 debug.el and edebug.el have been updated to heed to this variable.
 
+---
+** Values in call stack frames are now displayed using 'cl-prin1'.
+The old behaviour of using 'prin1' can be restored by customizing the
+new option 'debugger-print-function'.
+
 +++
 ** The new variable 'x-ctrl-keysym' has been added to the existing
 roster of X keysyms.  It can be used in combination with another
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index effe7f0cb3..78e29c4f17 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -49,6 +49,12 @@ (defcustom debugger-batch-max-lines 40
   :group 'debugger
   :version "21.1")
 
+(defcustom debugger-print-function #'cl-prin1
+  "Function used to print values in the debugger backtraces."
+  :type 'function
+  :options '(cl-prin1 prin1)
+  :version "26.1")
+
 (defcustom debugger-bury-or-kill 'bury
   "What to do with the debugger buffer when exiting `debug'.
 The value affects the behavior of operations on any window
@@ -265,10 +271,13 @@ (defun debug (&rest args)
       debugger-value)))
 \f
 
+(defvar cl-print-compiled-button)
+
 (defun debugger-insert-backtrace (frames do-xrefs)
   "Format and insert the backtrace FRAMES at point.
 Make functions into cross-reference buttons if DO-XREFS is non-nil."
   (let ((standard-output (current-buffer))
+        (cl-print-compiled-button t)
         (eval-buffers eval-buffer-list))
     (require 'help-mode)     ; Define `help-function-def' button type.
     (pcase-dolist (`(,evald ,fun ,args ,flags) frames)
@@ -278,10 +287,10 @@ (defun debugger-insert-backtrace (frames do-xrefs)
             (fun-pt (point)))
         (cond
          ((and evald (not debugger-stack-frame-as-list))
-          (prin1 fun)
-          (if args (prin1 args) (princ "()")))
+          (funcall debugger-print-function fun)
+          (if args (funcall debugger-print-function args) (princ "()")))
          (t
-          (prin1 (cons fun args))
+          (funcall debugger-print-function (cons fun args))
           (cl-incf fun-pt)))
         (when fun-file
           (make-text-button fun-pt (+ fun-pt (length (symbol-name fun)))
-- 
2.11.1


[-- Attachment #7: patch --]
[-- Type: text/plain, Size: 2751 bytes --]

From bd576ed162cd3379cb945d8796d158d9563aa48e Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 11 Feb 2017 19:47:55 -0500
Subject: [PATCH v4 6/6] Escape NUL bytes in X selections (Bug#6991)

* lisp/term/w32-win.el (w32--set-selection):
* lisp/select.el (xselect--encode-string): Replace NUL bytes with
"\0".
* doc/emacs/killing.texi: Document new behavior.
* etc/NEWS (times): Announce it.
---
 doc/emacs/killing.texi | 4 ++++
 etc/NEWS               | 4 ++++
 lisp/select.el         | 3 +++
 lisp/term/w32-win.el   | 2 +-
 4 files changed, 12 insertions(+), 1 deletion(-)

diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi
index 47de053129..0b5efd04a1 100644
--- a/doc/emacs/killing.texi
+++ b/doc/emacs/killing.texi
@@ -519,6 +519,10 @@ Clipboard
 data to the clipboard manager, change the variable
 @code{x-select-enable-clipboard-manager} to @code{nil}.
 
+  Since strings containing NUL bytes are usually truncated when passed
+through the clipboard, Emacs replaces such characters with ``\0''
+before transfering them to the system's clipboard.
+
 @vindex select-enable-primary
 @findex clipboard-kill-region
 @findex clipboard-kill-ring-save
diff --git a/etc/NEWS b/etc/NEWS
index 21510fe539..281bacffd0 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -326,6 +326,10 @@ The old behaviour of using 'prin1' can be restored by customizing the
 new option 'debugger-print-function'.
 
 +++
+** NUL bytes in strings copied to the system clipboard are now
+replaced with "\0".
+
++++
 ** The new variable 'x-ctrl-keysym' has been added to the existing
 roster of X keysyms.  It can be used in combination with another
 variable of this kind to swap modifiers in Emacs.
diff --git a/lisp/select.el b/lisp/select.el
index 4849d7d515..579c5c7e2e 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -475,6 +475,9 @@ (defun xselect--encode-string (type str &optional can-modify)
 	   (t
 	    (error "Unknown selection type: %S" type)))))
 
+      ;; Most programs are unable to handle NUL bytes in strings.
+      (setq str (replace-regexp-in-string "\0" "\\0" str t t))
+
       (setq next-selection-coding-system nil)
       (cons type str))))
 
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index fda93884c4..be895a040d 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -396,7 +396,7 @@ (declare-function w32-selection-exists-p "w32select.c")
 ;;; Fix interface to (X-specific) mouse.el
 (defun w32--set-selection (type value)
   (if (eq type 'CLIPBOARD)
-      (w32-set-clipboard-data value)
+      (w32-set-clipboard-data (replace-regexp-in-string "\0" "\\0" value t t))
     (put 'x-selections (or type 'PRIMARY) value)))
 
 (defun w32--get-selection  (&optional type data-type)
-- 
2.11.1


  reply	other threads:[~2017-06-26  3:34 UTC|newest]

Thread overview: 50+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2010-09-07  1:35 bug#6991: Please keep bytecode out of *Backtrace* buffers jidanni
2012-02-22  1:02 ` Glenn Morris
2012-02-22 16:43   ` Drew Adams
2012-02-22 17:01     ` Juanma Barranquero
2012-07-02 17:40       ` Drew Adams
2012-07-02 18:38         ` Stefan Monnier
2012-07-02 19:06           ` Drew Adams
2013-01-24 22:43             ` Drew Adams
     [not found]             ` <<FEE817DF5DCC41CD9156B414FF2088D1@us.oracle.com>
2013-08-07 22:25               ` Drew Adams
2016-02-26  6:41           ` Lars Ingebrigtsen
2016-02-26 14:11             ` Drew Adams
2016-02-27  0:52               ` John Wiegley
2016-02-27  1:49                 ` Drew Adams
2016-11-19  1:55                   ` npostavs
2016-11-19  2:37                     ` Drew Adams
2016-11-19  7:41                     ` Eli Zaretskii
2016-11-19 14:39                       ` npostavs
2016-11-19 15:07                         ` Eli Zaretskii
2016-11-19 15:20                           ` npostavs
2016-11-19 18:34                             ` Eli Zaretskii
2016-11-19 22:33                               ` npostavs
2016-11-20 15:46                                 ` Eli Zaretskii
2016-11-22 18:07                                   ` Noam Postavsky
2016-11-22 18:52                                     ` Eli Zaretskii
2016-11-22 21:07                                       ` Noam Postavsky
2016-11-23 16:05                                         ` Eli Zaretskii
2016-11-26 17:18                                           ` npostavs
2016-11-26 18:54                                             ` Stefan Monnier
2017-02-12  2:26                                               ` npostavs
2017-05-28 14:58                                                 ` npostavs
2017-06-24 22:27                                                   ` npostavs
2017-06-25 19:11                                                     ` Stefan Monnier
2017-06-26  3:34                                                       ` npostavs [this message]
2017-06-26  4:02                                                         ` Stefan Monnier
2017-06-26 12:50                                                           ` npostavs
2017-06-26 14:54                                                             ` Stefan Monnier
2017-06-27  3:56                                                               ` npostavs
2017-06-27 16:18                                                                 ` Stefan Monnier
2017-06-29 23:52                                                                   ` npostavs
2016-11-26 23:45                                             ` Richard Stallman
2016-11-27  0:33                                               ` Noam Postavsky
2016-11-27  3:34                                                 ` Clément Pit--Claudel
2016-11-27  3:36                                                 ` Eli Zaretskii
2016-11-27 14:10                                                   ` Noam Postavsky
2016-11-27 23:21                                                 ` Richard Stallman
2016-11-19 17:08                       ` Richard Stallman
2016-02-27  4:13                 ` Lars Ingebrigtsen
2017-09-11 10:57 ` bug#6991: Rocky Bernstein
2017-09-11 14:28   ` bug#6991: Eli Zaretskii
2017-09-13  1:13     ` bug#6991: Rocky Bernstein

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87mv8vo1zz.fsf@users.sourceforge.net \
    --to=npostavs@users.sourceforge.net \
    --cc=6991@debbugs.gnu.org \
    --cc=johnw@gnu.org \
    --cc=larsi@gnus.org \
    --cc=lekktu@gmail.com \
    --cc=monnier@IRO.UMontreal.CA \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).