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: Sat, 24 Jun 2017 18:27:46 -0400 Message-ID: <87o9tdowbh.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> <87zidx3u5u.fsf@users.sourceforge.net> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1498343241 2376 195.159.176.226 (24 Jun 2017 22:27:21 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sat, 24 Jun 2017 22:27:21 +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 Jun 25 00:27:16 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 1dOtWM-0000EF-Cv for geb-bug-gnu-emacs@m.gmane.org; Sun, 25 Jun 2017 00:27:14 +0200 Original-Received: from localhost ([::1]:40624 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dOtWP-0006Sc-Qw for geb-bug-gnu-emacs@m.gmane.org; Sat, 24 Jun 2017 18:27:17 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:55608) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dOtWE-0006SL-2L for bug-gnu-emacs@gnu.org; Sat, 24 Jun 2017 18:27:08 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dOtWA-0007zg-Q7 for bug-gnu-emacs@gnu.org; Sat, 24 Jun 2017 18:27:06 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:33390) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dOtWA-0007zU-L4 for bug-gnu-emacs@gnu.org; Sat, 24 Jun 2017 18:27:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dOtWA-0006JW-55 for bug-gnu-emacs@gnu.org; Sat, 24 Jun 2017 18:27: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: Sat, 24 Jun 2017 22:27: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.149834317924216 (code B ref 6991); Sat, 24 Jun 2017 22:27:02 +0000 Original-Received: (at 6991) by debbugs.gnu.org; 24 Jun 2017 22:26:19 +0000 Original-Received: from localhost ([127.0.0.1]:36067 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dOtVS-0006IW-Do for submit@debbugs.gnu.org; Sat, 24 Jun 2017 18:26:19 -0400 Original-Received: from mail-it0-f66.google.com ([209.85.214.66]:34715) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dOtVQ-0006II-5U for 6991@debbugs.gnu.org; Sat, 24 Jun 2017 18:26:17 -0400 Original-Received: by mail-it0-f66.google.com with SMTP id y134so10528017itc.1 for <6991@debbugs.gnu.org>; Sat, 24 Jun 2017 15:26:16 -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=IXlsJVPV36pGabWuMDWZxkWap+Kc/ZkRs9W3an6P1JQ=; b=TxFcMUSghwQGSv9tK07ld7GpZYta/zNkmxIm9YYf7/my1xdOssbsA7EUMlhYXIWVZ+ 5PVogeuYIfDXt/ko6cX5N4QArrXXd6iUYhrjju3FxEB2AvKQX2zZnzowokKea9zJ283V Hn/A1uZE39wMEUFLMZk2A0KImaHnjTSNPrnYzrFoD7ij5u7gzkCaE5UGGQU+6Yr5x68N SELp0KSJH9I2nGQCwfzMr1ZQi/PUz7BEJMtHsZEsMxRx61BInr1dxRVgIJHWNH2RTd1b ohECEXXs3AnGEnvrR4sld7iHVr1+F/N26cTrNnvvdlVwrTzyXmtJVMvxcSZmWDs+UkY5 29lg== 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=IXlsJVPV36pGabWuMDWZxkWap+Kc/ZkRs9W3an6P1JQ=; b=CfaM3fVcUvgANhkL5PuwJDVYze8RJ1G8ybjeU8r8QsRtFdeSDRmAbQwAH/Aaww/RGY 8TmZl/PVo0vj3pGToP9qwQ2oNXAOLlt8d2Vym8ZSPv5MIbmD9NdiGleP9JFcM5qru6/H R4iHU8WXrJEndf1VCUz5HViwetDK55jbedRkprcLnklhqFHR3y5DkD/mvvxqELezPkby i9kUqzogAFfw/d1NM7QGQfXLTSPkKX7Df29BIjYqg15t6aQZuQhmF/mVkgn+G+RdDQD5 reiKaS1Z3xsCjjqFAA+K1iOSUivlmLPqa1k9/1+jLyHlTNMRLrh0xADOuFGVW8PaNgHc 06qA== X-Gm-Message-State: AKS2vOxl96/XDVaqLaV/urp+p6trEsLNJf3qUN6MvMovZXSTdrz6liIb lRy7Ui9V5qEOBw== X-Received: by 10.36.48.146 with SMTP id q140mr15085534itq.59.1498343170633; Sat, 24 Jun 2017 15:26:10 -0700 (PDT) Original-Received: from zony ([45.2.7.65]) by smtp.googlemail.com with ESMTPSA id b62sm5398506itd.2.2017.06.24.15.26.08 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Sat, 24 Jun 2017 15:26:09 -0700 (PDT) In-Reply-To: <87zidx3u5u.fsf@users.sourceforge.net> (npostavs@users.sourceforge.net's message of "Sun, 28 May 2017 10:58:21 -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:133855 Archived-At: --=-=-= Content-Type: text/plain 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. --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=v3-0001-Operate-on-frame-list-instead-of-printed-backtrac.patch Content-Description: patch >From c3aaaccb31bf926ce08cb0dc17b36ffc01ce7e7d Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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))) + +(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=v3-0002-Improve-ert-backtrace-recording.patch Content-Description: patch >From aae0b062d707ec490b909b0dec4017483b630dc3 Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=v3-0003-Escape-control-characters-in-backtraces-Bug-6991.patch Content-Description: patch >From ff73e5a06cb943dcb58ee24213e82316b8594061 Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=v3-0004-Don-t-redundantly-cl-print-arglist-in-function-do.patch Content-Description: patch >From 1a6b3342b1f2f401bb1c9e5bcf14a66ae2d7c472 Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=v3-0005-Hide-byte-code-in-backtraces-Bug-6991.patch Content-Description: patch >From f6f929626abfff951dcf66d8014a7664a8e4f8c9 Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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))) +(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 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=v3-0006-Escape-NUL-bytes-in-X-selections-Bug-6991.patch Content-Description: patch >From ad896373f17c52806638fcf12a5bb6a86b390f45 Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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 --=-=-=--