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: Sat, 24 Jun 2017 18:27:46 -0400 [thread overview]
Message-ID: <87o9tdowbh.fsf@users.sourceforge.net> (raw)
In-Reply-To: <87zidx3u5u.fsf@users.sourceforge.net> (npostavs@users.sourceforge.net's message of "Sun, 28 May 2017 10:58:21 -0400")
[-- Attachment #1: Type: text/plain, Size: 1069 bytes --]
npostavs@users.sourceforge.net writes:
> npostavs@users.sourceforge.net writes:
>
>> I propose adding a new flag print_escape_control_characters instead (see
>> patch #3 in the series). I also implemented hiding the byte code
>> functions with text properties in #4. It's not quite satisfactory
>> though, because it doesn't cover byte code functions values that are
>> arguments, only byte code being called. I think printing needs to be
>> made more flexible in order to cleanly catch all byte code values.
>> Patch #5 replaces NUL bytes with "\0" in X selections (I guess it covers
>> w32 as well? Haven't checked yet).
>
> Updated the patchset to use cl-prin1, now it applies to function values
> in arguments as well. This one actually doesn't include the byte code
> text at all (path of least resistance: cl-print-object wasn't already
> omitting bytecode and I haven't bothered adding it).
I made use of cl-prin1 depend on a custom option, and replace NUL bytes
also in w32. I think this is ready to merge now, I will probably do so
sometime next week.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-diff, Size: 5350 bytes --]
From c3aaaccb31bf926ce08cb0dc17b36ffc01ce7e7d Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 11 Feb 2017 09:19:00 -0500
Subject: [PATCH v3 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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: patch --]
[-- Type: text/x-diff, Size: 7007 bytes --]
From aae0b062d707ec490b909b0dec4017483b630dc3 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 11 Feb 2017 17:19:41 -0500
Subject: [PATCH v3 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 drop 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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: patch --]
[-- Type: text/x-diff, Size: 4891 bytes --]
From ff73e5a06cb943dcb58ee24213e82316b8594061 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 11 Feb 2017 18:13:54 -0500
Subject: [PATCH v3 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 ef00286b34..76c13a8d23 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4513,7 +4513,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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: patch --]
[-- Type: text/x-diff, Size: 1982 bytes --]
From 1a6b3342b1f2f401bb1c9e5bcf14a66ae2d7c472 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 27 May 2017 22:40:46 -0400
Subject: [PATCH v3 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 | 8 ++++----
test/lisp/emacs-lisp/cl-print-tests.el | 2 +-
2 files changed, 5 insertions(+), 5 deletions(-)
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 89a71d1b6c..6703fc99e2 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -105,10 +105,10 @@ (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)
+ (`(,_ . ,(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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: patch --]
[-- Type: text/x-diff, Size: 2939 bytes --]
From f6f929626abfff951dcf66d8014a7664a8e4f8c9 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sun, 11 Jun 2017 09:51:38 -0400
Subject: [PATCH v3 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 | 17 ++++++++++++++---
2 files changed, 19 insertions(+), 3 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 3bbcaef3f4..5c5575d8d7 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..e5445416dc 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -49,6 +49,13 @@ (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)
+ :group 'debugger
+ :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 +272,14 @@ (defun debug (&rest args)
debugger-value)))
\f
+(defvar cl-print-compiled)
+(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 +289,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 (cl-prin1 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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: patch --]
[-- Type: text/x-diff, Size: 2751 bytes --]
From ad896373f17c52806638fcf12a5bb6a86b390f45 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 11 Feb 2017 19:47:55 -0500
Subject: [PATCH v3 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 5c5575d8d7..61efba702c 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
next prev parent reply other threads:[~2017-06-24 22:27 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 [this message]
2017-06-25 19:11 ` Stefan Monnier
2017-06-26 3:34 ` npostavs
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=87o9tdowbh.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).