From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: npostavs@users.sourceforge.net Newsgroups: gmane.emacs.bugs Subject: bug#6991: Please keep bytecode out of *Backtrace* buffers Date: Sun, 28 May 2017 10:58:21 -0400 Message-ID: <87zidx3u5u.fsf@users.sourceforge.net> References: <8739tm9vzl.fsf@jidanni.org> <87vb5ct1lz.fsf@gnus.org> <2223f654-1e67-4a9a-a471-828fd4078410@default> <87fumokzbp.fsf@users.sourceforge.net> <83oa1bc3x2.fsf@gnu.org> <87d1hrlek2.fsf@users.sourceforge.net> <83eg27bjah.fsf@gnu.org> <87a8cvlcmk.fsf@users.sourceforge.net> <8360njb9o5.fsf@gnu.org> <877f7zksm0.fsf@users.sourceforge.net> <83oa1a9msk.fsf@gnu.org> <83vavf73ei.fsf@gnu.org> <8360ne6v1q.fsf@gnu.org> <874m2ujh2v.fsf@users.sourceforge.net> <87wpcwkuug.fsf@users.sourceforge.net> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1495983438 18760 195.159.176.226 (28 May 2017 14:57:18 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sun, 28 May 2017 14:57:18 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.2.50 (gnu/linux) Cc: lekktu@gmail.com, johnw@gnu.org, 6991@debbugs.gnu.org, larsi@gnus.org To: Stefan Monnier Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sun May 28 16:57:09 2017 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dEzcy-0004er-Vf for geb-bug-gnu-emacs@m.gmane.org; Sun, 28 May 2017 16:57:09 +0200 Original-Received: from localhost ([::1]:44201 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dEzd4-0003ci-Ga for geb-bug-gnu-emacs@m.gmane.org; Sun, 28 May 2017 10:57:14 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:39027) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dEzcw-0003bE-2x for bug-gnu-emacs@gnu.org; Sun, 28 May 2017 10:57:08 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dEzcs-0002tb-Uu for bug-gnu-emacs@gnu.org; Sun, 28 May 2017 10:57:06 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:39132) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dEzcs-0002tX-Qh for bug-gnu-emacs@gnu.org; Sun, 28 May 2017 10:57:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dEzcs-0006h6-Jc for bug-gnu-emacs@gnu.org; Sun, 28 May 2017 10:57:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: npostavs@users.sourceforge.net Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 28 May 2017 14:57:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 6991 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: notabug Original-Received: via spool by 6991-submit@debbugs.gnu.org id=B6991.149598341325718 (code B ref 6991); Sun, 28 May 2017 14:57:02 +0000 Original-Received: (at 6991) by debbugs.gnu.org; 28 May 2017 14:56:53 +0000 Original-Received: from localhost ([127.0.0.1]:41807 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dEzcj-0006gj-0u for submit@debbugs.gnu.org; Sun, 28 May 2017 10:56:53 -0400 Original-Received: from mail-it0-f68.google.com ([209.85.214.68]:35522) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dEzcg-0006gW-St for 6991@debbugs.gnu.org; Sun, 28 May 2017 10:56:51 -0400 Original-Received: by mail-it0-f68.google.com with SMTP id 67so5307463itx.2 for <6991@debbugs.gnu.org>; Sun, 28 May 2017 07:56:50 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=sender:from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=qSgAQMfq/qAEUxCRlifb3eXlggeJnqlEQr0+imvwofI=; b=jvyUEWDmh6CS508dRjMZxuG2FtwV/+JnoKip8TyrJsbFHgE/xRt3UtVsyNWk6xi87H WE/waLvJGnubUnHvnaiI2emy+T7h21wsqsG2DPbvPvA+5kExVHhaUA3/erkllyUGw5TK lnnMSvuyOknPWlqmaGrIq0aQKj3NAqyy5CGh8YgwbKJZsZ34NcljFNmp8+ZuwctFa0ni IukByF2z7WYsKwbuZCOQJ03y+EtbJhOWLqaE8c+g9+QoMZtZIqsUwj9p0MDx9vOHg0qg XDqU/wQxOp6IQ3DP6u6z4/8J3gbfHrnz9cKhHsyoH5yXdRxawrMXDbBkHrjX1jAhV+1C NbBQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:sender:from:to:cc:subject:references:date :in-reply-to:message-id:user-agent:mime-version; bh=qSgAQMfq/qAEUxCRlifb3eXlggeJnqlEQr0+imvwofI=; b=UU7ndvoWcs+PJF8QEH8w96WUGRvEZ3/uDRnTENPQfjYMTeSuVmQz+DNqAz1oMv48g8 WzZlbVoX+qNMHYOYo1WxO6mw8BsUbEql7WBt8O/I1KVpqAc7d1CdI45g1ZFFRuCIntqS qWG/n/QeQqw//EuxXZdYkZG4tFtvgKkYYua8icSUkLJ/8/dvubC0bT3sW3p4dsgiExw6 PurqJiC6R2PwaOg9uN8tbHvNdrYHjZo2E66N7Bks5f9v/rVdzf/bZqZWfWCfWAkIZKOd xPSmb2wD9nJjAxozH8WN11rTQmTrNsPpNvBBRhDwFVFTWtKbV7L6Rqa/V7OVdio5fG6u z2kQ== X-Gm-Message-State: AODbwcCYxSX07r5mxnX5N9ILSAjocPRZZSmlzPUSYJpRWvkiPvor7prC 5p5Cx0xNR5YS4A== X-Received: by 10.36.107.201 with SMTP id v192mr10931324itc.81.1495983405224; Sun, 28 May 2017 07:56:45 -0700 (PDT) Original-Received: from zony ([45.2.7.65]) by smtp.googlemail.com with ESMTPSA id 78sm2950651iou.36.2017.05.28.07.56.43 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Sun, 28 May 2017 07:56:44 -0700 (PDT) In-Reply-To: <87wpcwkuug.fsf@users.sourceforge.net> (npostavs@users.sourceforge.net's message of "Sat, 11 Feb 2017 21:26:31 -0500") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:132951 Archived-At: --=-=-= Content-Type: text/plain 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). --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=v2-0001-Operate-on-frame-list-instead-of-printed-backtrac.patch Content-Description: patch >From 92415966acf8ba30869b11d7ee81e88d96253a40 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 11 Feb 2017 09:19:00 -0500 Subject: [PATCH v2 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))) + +(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 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=v2-0002-Improve-ert-backtrace-recording.patch Content-Description: patch >From 2308506a4cc49e934a9b358737d54cb2932583ab Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 11 Feb 2017 17:19:41 -0500 Subject: [PATCH v2 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 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=v2-0003-Escape-control-characters-in-backtraces-Bug-6991.patch Content-Description: patch >From f740346aeffaa2b5c70727ef0fe83c8f1e2e0d33 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 11 Feb 2017 18:13:54 -0500 Subject: [PATCH v2 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 8d5d2a779c..c8036665db 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 49408bbeb4..dd95507624 100644 --- a/src/print.c +++ b/src/print.c @@ -1839,21 +1839,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); @@ -2298,6 +2313,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.) @@ -2387,6 +2407,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 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=v2-0004-Hide-byte-code-in-backtraces-Bug-6991.patch Content-Description: patch >From e5499ea5fdb3b4aad76b4d38f4d657b034778711 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 11 Feb 2017 19:00:19 -0500 Subject: [PATCH v2 4/6] Hide byte code in backtraces (Bug#6991) * lisp/emacs-lisp/cl-print.el: Autoload `disassemble-1'. (cl-print-compiled-button): New variable. (help-byte-code): New button type, calls `disassemble' in its action. (cl-print-object): Use it if `cl-print-compiled-button' is non-nil. (debugger-insert-backtrace): Use `cl-print' with `cl-print-compiled-button' let-bound to t. * lisp/emacs-lisp/cl-print.el --- lisp/emacs-lisp/cl-print.el | 33 +++++++++++++++++++++++++++++---- lisp/emacs-lisp/debug.el | 11 ++++++++--- 2 files changed, 37 insertions(+), 7 deletions(-) diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 65c86d2b65..44c6a4312d 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -33,6 +33,8 @@ ;;; Code: +(require 'button) + (defvar cl-print-readably nil "If non-nil, try and make sure the result can be `read'.") @@ -74,13 +76,27 @@ (cl-defmethod cl-print-object ((object vector) stream) (cl-print-object (aref object i) stream)) (princ "]" stream)) +(define-button-type 'help-byte-code + 'follow-link t + 'action (lambda (button) + (disassemble (button-get button 'byte-code-function))) + 'help-echo (purecopy "mouse-2, RET: disassemble this function")) + (defvar cl-print-compiled nil "Control how to print byte-compiled functions. Can be: - `static' to print the vector of constants. - `disassemble' to print the disassembly of the code. - nil to skip printing any details about the code.") +(defvar cl-print-compiled-button nil + "Control how to print byte-compiled functions into buffers. +When the stream is a buffer, make the bytecode part of the output +into a button whose action shows the function's disassembly.") + +(autoload 'disassemble-1 "disass") + (cl-defmethod cl-print-object ((object compiled-function) stream) + (unless stream (setq stream standard-output)) ;; We use "#f(...)" rather than "#<...>" so that pp.el gives better results. (princ "#f(compiled-function " stream) (let ((args (help-function-arglist object 'preserve-names))) @@ -108,10 +124,19 @@ (cl-defmethod cl-print-object ((object compiled-function) stream) (disassemble-1 object 0) (buffer-string)) stream) - (princ " #" stream) - (when (eq cl-print-compiled 'static) - (princ " " stream) - (cl-print-object (aref object 2) stream))) + (princ " " stream) + (let ((button-start (and cl-print-compiled-button + (bufferp stream) + (with-current-buffer stream (point))))) + (princ "#" stream) + (when (eq cl-print-compiled 'static) + (princ " " stream) + (cl-print-object (aref object 2) stream)) + (when button-start + (with-current-buffer stream + (make-text-button button-start (point) + :type 'help-byte-code + 'byte-code-function object))))) (princ ")" stream)) ;; This belongs in nadvice.el, of course, but some load-ordering issues make it diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index effe7f0cb3..83c206e163 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -265,10 +265,15 @@ (defun debug (&rest args) debugger-value))) +(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 nil) + (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 +283,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 "()"))) + (cl-prin1 fun) + (if args (cl-prin1 args) (princ "()"))) (t - (prin1 (cons fun args)) + (cl-prin1 (cons fun args)) (cl-incf fun-pt))) (when fun-file (make-text-button fun-pt (+ fun-pt (length (symbol-name fun))) -- 2.11.1 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=v2-0005-Escape-NUL-bytes-in-X-selections-Bug-6991.patch Content-Description: patch >From 57e94182464e6d6fec3e0f7dccdda8a45abf38df Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 11 Feb 2017 19:47:55 -0500 Subject: [PATCH v2 5/6] Escape NUL bytes in X selections (Bug#6991) * lisp/select.el (xselect--encode-string): Replace NUL bytes with "\0". --- lisp/select.el | 3 +++ 1 file changed, 3 insertions(+) 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)))) -- 2.11.1 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=v2-0006-Don-t-redundantly-cl-print-arglist-in-function-do.patch Content-Description: patch >From 2ad16d82d8d5e521b646c2ca53a047e30b05c1c8 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 27 May 2017 22:40:46 -0400 Subject: [PATCH v2 6/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. --- lisp/emacs-lisp/cl-print.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 44c6a4312d..3958ee80a3 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -103,10 +103,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) -- 2.11.1 --=-=-=--