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, 25 Jun 2017 23:34:56 -0400 Message-ID: <87mv8vo1zz.fsf@users.sourceforge.net> References: <8739tm9vzl.fsf@jidanni.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> <87zidx3u5u.fsf@users.sourceforge.net> <87o9tdowbh.fsf@users.sourceforge.net> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1498448059 15354 195.159.176.226 (26 Jun 2017 03:34:19 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Mon, 26 Jun 2017 03:34:19 +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 Mon Jun 26 05:34:10 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 1dPKmv-0003UO-Sw for geb-bug-gnu-emacs@m.gmane.org; Mon, 26 Jun 2017 05:34:10 +0200 Original-Received: from localhost ([::1]:44545 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dPKn1-0006tZ-1W for geb-bug-gnu-emacs@m.gmane.org; Sun, 25 Jun 2017 23:34:15 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:53166) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dPKms-0006tT-BF for bug-gnu-emacs@gnu.org; Sun, 25 Jun 2017 23:34:09 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dPKmp-0002Pu-3k for bug-gnu-emacs@gnu.org; Sun, 25 Jun 2017 23:34:06 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:35183) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dPKmo-0002Pm-UL for bug-gnu-emacs@gnu.org; Sun, 25 Jun 2017 23:34:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dPKmo-0005Ts-IP for bug-gnu-emacs@gnu.org; Sun, 25 Jun 2017 23:34: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: Mon, 26 Jun 2017 03:34: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.149844801121031 (code B ref 6991); Mon, 26 Jun 2017 03:34:02 +0000 Original-Received: (at 6991) by debbugs.gnu.org; 26 Jun 2017 03:33:31 +0000 Original-Received: from localhost ([127.0.0.1]:37860 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dPKmI-0005T8-F0 for submit@debbugs.gnu.org; Sun, 25 Jun 2017 23:33:31 -0400 Original-Received: from mail-io0-f193.google.com ([209.85.223.193]:34222) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dPKmF-0005Ss-IU for 6991@debbugs.gnu.org; Sun, 25 Jun 2017 23:33:28 -0400 Original-Received: by mail-io0-f193.google.com with SMTP id m19so11950453ioe.1 for <6991@debbugs.gnu.org>; Sun, 25 Jun 2017 20:33:27 -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=XqHcrgo+tpj/EGqLeP+JC9LBvUGrCuH19rGZbOcLv5Y=; b=pK+VRBE9vN5KnAtqGLY5x+jxb17AMkYjhbLSTJPsqMKZhaiOyK3P2QzBKHJS/lOfvt 0hhJoOZQ3Qh2wuXbf0lqBwwFtpJ1zoGMNiQmgaVGNaaAx/at3dyONlyD1LPAg0IRtgUr i32J+iUkZ7nKxZTLawwSiHCB/wxWpT2aMoFxwDnhBUCzv2v5tM8LjJMGMWLaoi4IVQ99 jLek9ncYCka35WLdpP73nloLNz0Nsh0Z29yfevq4eNUpGGMvKeD5WgstrAT92QiSso43 07qWBQlWCtkf+3QlrWyBqpgLB0U3yBB3BXHB+/w7pTioFFgjY987tji/S85ILrtzhSeC tZ4A== 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=XqHcrgo+tpj/EGqLeP+JC9LBvUGrCuH19rGZbOcLv5Y=; b=SO3JGAbrEHQyAeE9Q8TR25sKMq62UV723tMFkeegfJYfammrBdrr6vHu85XbM9SdGr Gemk42ojN3JmeKUDNDtJ+179voo1fxNyDRSoS7ZlgDfRzfHOYQUc3UkQuutecWE8Ol1c LHGrvcWwud/cqsnSRLAWlKMUdsROrMAQXDKhJp9gFstfVQzCTiJZI7PCZvLzbiHXa82j vyN8GYDFbJQoTC7WMvSL8u0oM7UxYf07XphZhqeEEESyrS44UniLm8v+VuHmSc726PfR qgcZ+aRvgxhYfPZb+87XtzaWoNzzWSdK4zpaFix6WXmlWyaNzeD+NQs4masZQFBHlw4O 5YEw== X-Gm-Message-State: AKS2vOyWknkcJsOh4Y1spKmDehqa6Y+DrWSAgEjM2WEZlJ4Rm9RMMhDb NiOWxfKG11CNuA== X-Received: by 10.107.169.28 with SMTP id s28mr22807924ioe.1.1498448002007; Sun, 25 Jun 2017 20:33:22 -0700 (PDT) Original-Received: from zony ([45.2.7.65]) by smtp.googlemail.com with ESMTPSA id r124sm6718629iod.38.2017.06.25.20.33.19 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Sun, 25 Jun 2017 20:33:20 -0700 (PDT) In-Reply-To: (Stefan Monnier's message of "Sun, 25 Jun 2017 15:11:02 -0400") 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:133909 Archived-At: --=-=-= Content-Type: text/plain Stefan Monnier 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! --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=v4-0001-Operate-on-frame-list-instead-of-printed-backtrac.patch Content-Description: patch >From a4bd2230a428560338afd4b5f2e74eccba9c4afc Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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))) + +(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/plain Content-Disposition: attachment; filename=v4-0002-Improve-ert-backtrace-recording.patch Content-Description: patch >From 65b27e283c7037a049969ba03098b59018ff3553 Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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 --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=v4-0003-Escape-control-characters-in-backtraces-Bug-6991.patch Content-Description: patch >From dc941652d3b7f37fbe950b68bfbea00e0a626513 Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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 --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=v4-0004-Don-t-redundantly-cl-print-arglist-in-function-do.patch Content-Description: patch >From db0b3569a4baac81c40c86da88e93f4ae6561b79 Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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 --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=v4-0005-Hide-byte-code-in-backtraces-Bug-6991.patch Content-Description: patch >From f4a9c861f2b14f9958925d328c7ce19f6eca0e2a Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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))) +(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 --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=v4-0006-Escape-NUL-bytes-in-X-selections-Bug-6991.patch Content-Description: patch >From bd576ed162cd3379cb945d8796d158d9563aa48e Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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 --=-=-=--