From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Leo Liu Newsgroups: gmane.emacs.bugs Subject: bug#15525: 24.3; register-read-with-preview Date: Sun, 06 Oct 2013 10:01:05 +0800 Message-ID: References: NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1381024941 12645 80.91.229.3 (6 Oct 2013 02:02:21 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sun, 6 Oct 2013 02:02:21 +0000 (UTC) Cc: =?UTF-8?Q?=C3=93scar?= Fuentes , Bastien , 15525@debbugs.gnu.org To: Stefan Monnier Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sun Oct 06 04:02:22 2013 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1VSdfp-0004Wu-M1 for geb-bug-gnu-emacs@m.gmane.org; Sun, 06 Oct 2013 04:02:21 +0200 Original-Received: from localhost ([::1]:53557 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VSdfp-0005vJ-BO for geb-bug-gnu-emacs@m.gmane.org; Sat, 05 Oct 2013 22:02:21 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:35781) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VSdfe-0005u3-Gg for bug-gnu-emacs@gnu.org; Sat, 05 Oct 2013 22:02:18 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VSdfX-0007A6-4p for bug-gnu-emacs@gnu.org; Sat, 05 Oct 2013 22:02:10 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:48623) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VSdfW-0007A2-W5 for bug-gnu-emacs@gnu.org; Sat, 05 Oct 2013 22:02:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1VSdfW-0004EK-Bv for bug-gnu-emacs@gnu.org; Sat, 05 Oct 2013 22:02:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Leo Liu Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 06 Oct 2013 02:02:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 15525 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 15525-submit@debbugs.gnu.org id=B15525.138102487516206 (code B ref 15525); Sun, 06 Oct 2013 02:02:02 +0000 Original-Received: (at 15525) by debbugs.gnu.org; 6 Oct 2013 02:01:15 +0000 Original-Received: from localhost ([127.0.0.1]:56916 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1VSdej-0004DJ-HK for submit@debbugs.gnu.org; Sat, 05 Oct 2013 22:01:14 -0400 Original-Received: from mail-pd0-f171.google.com ([209.85.192.171]:47618) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1VSdef-0004D8-Ih for 15525@debbugs.gnu.org; Sat, 05 Oct 2013 22:01:10 -0400 Original-Received: by mail-pd0-f171.google.com with SMTP id g10so5601597pdj.30 for <15525@debbugs.gnu.org>; Sat, 05 Oct 2013 19:01:08 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=from:to:cc:subject:references:face:date:in-reply-to:message-id :user-agent:mime-version:content-type; bh=4acWHe9DnMwgEGe8vAIcqCib8PCtuJSeGXMNPNDQq50=; b=JQ9HYfCFtgdQbSqVkxtrGUF97822TFe88mgbirampUewtYvTQUeYlPzlTFyZbPLLfH utfhJLToKhaZLmy94X/DQhPgiUs/1xlMhxSB9E4JXnz0CmQIjDGO91f6OCv8BmK6M1z4 MYchpP5+84Jd5pM7amFuXlUyjh58eUdMt8f+U+WnEp5Ligne3FAbtyy55jI7B1f0oLH5 S2fRYzKnu+eQ7iMgtd+qUJE2VVB34ucXnLHlCFNMQg1+AAkjSy+A8XexBeQ3URN00gBp Mw+wTteCzIx/L0BP053BVkWO6Qznjij80tl8+agu5rPL7pO/6e/szqB8BKAU+46I/GbY bONQ== X-Received: by 10.68.255.229 with SMTP id at5mr706952pbd.130.1381024868217; Sat, 05 Oct 2013 19:01:08 -0700 (PDT) Original-Received: from localhost ([123.123.199.153]) by mx.google.com with ESMTPSA id 7sm28734884paf.22.1969.12.31.16.00.00 (version=TLSv1.2 cipher=RC4-SHA bits=128/128); Sat, 05 Oct 2013 19:01:07 -0700 (PDT) Face: iVBORw0KGgoAAAANSUhEUgAAACgAAAAoBAMAAAB+0KVeAAAAG1BMVEUAAAA9Cgm3Hx1WWFWA gn+WmJWsrqv4+vcCAwCRl2MkAAAAAXRSTlMAQObYZgAAAAFiS0dEAIgFHUgAAAAJcEhZcwAAAYoA AAGKATOXMFgAAAAHdElNRQfXAQwDNR+ZJmElAAABIklEQVQoz22SPW+DQAyGWUq65qasd9PNUSX4 AZHK2C1rJy5jpDS4IwRVup9dn7GNafpKIPPgzztXFSujqq1eM2n8h22oMkvxI/i9C97kRfMRUN55 dS3BrsAwBXUtMLAO4lryh8kTjOxKpQNniNxAgZOEe4bZwsDTFhKdqZRLNII4OQNHhEuq/RMkm6Cj TnnEA/fk0BorcYn5qA3oaeAxbaBOLrX+9G48NZ2Fzc2tzDM8Q+tMypEOqYHh8mAWaaK3U/cDMOT5 aMZMABgPXc7zPMs1A8DXO756GFJ/4fMEq47hTsAdn5avoxZ4ywl0c2w4Flu2Ybeyb3S+EqxX2DYA H8veJGEDTnHnrXvRaPyt+2kSfK6rfBZ2tUtfP/mR+pR6sX8BUZ/cDV7tvkoAAAAASUVORK5CYII= In-Reply-To: (Stefan Monnier's message of "Sat, 05 Oct 2013 12:30:10 -0400") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3 (OS X 10.8.5) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 140.186.70.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-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:78949 Archived-At: --=-=-= Content-Type: text/plain On 2013-10-06 00:30 +0800, Stefan Monnier wrote: > Good (I'd have used nil rather than t, but it doesn't matter). Done. > I wonder if the default shouldn't be "infinite delay", so as to preserve > existing behavior? Done. (If it is OK I like to turn it on for a month or two for some testing and then turn it off eventually) > I think the only valid reason to disable the help-char here is if it > prevents access to an existing register. So we can get rid of this > custom var and instead make sure we only obey help-char if there is no > existing register by that name. The trouble is when you create new registers. But I remove that custom variable anyway since it won't be used much. It is unlikely C-h be used as a register. If no one objects I would like to install the attached patch. Thanks, Leo --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=reg3.diff Content-Description: reg3.diff === modified file 'lisp/register.el' --- lisp/register.el 2013-08-09 00:30:24 +0000 +++ lisp/register.el 2013-10-06 01:56:29 +0000 @@ -1,4 +1,4 @@ -;;; register.el --- register commands for Emacs +;;; register.el --- register commands for Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1985, 1993-1994, 2001-2013 Free Software Foundation, ;; Inc. @@ -89,6 +89,11 @@ :type '(choice (const :tag "None" nil) (character :tag "Use register" :value ?+))) +(defcustom register-preview-delay nil + "If non-nil delay in seconds to pop up the preview window." + :type '(choice number (const :tag "Indefinitely" nil)) + :group 'register) + (defun get-register (register) "Return contents of Emacs register named REGISTER, or nil if none." (cdr (assq register register-alist))) @@ -102,12 +107,66 @@ (push (cons register value) register-alist)) value)) +(defun register-describe-oneline (c) + "One-line description of register C." + (let ((d (replace-regexp-in-string + "\n[ \t]*" " " + (with-output-to-string (describe-register-1 c))))) + (if (string-match "Register.+? contains \\(?:an? \\|the \\)?" d) + (substring d (match-end 0)) + d))) + +(defvar register-preview-functions nil) + +(defun register-preview (buffer) + "Pop up a window to show register preview in BUFFER." + (when (consp register-alist) + (let ((split-height-threshold 0)) + (with-temp-buffer-window + buffer + (cons 'display-buffer-below-selected + '((window-height . fit-window-to-buffer))) + nil + (with-current-buffer standard-output + (setq cursor-in-non-selected-windows nil) + (mapc + (lambda (r) + (insert (or (run-hook-with-args-until-success + 'register-preview-functions r) + (format "%s %s\n" + (concat (single-key-description (car r)) ":") + (register-describe-oneline (car r)))))) + register-alist)))))) + +(defun register-read-with-preview (prompt) + "Read an event with register preview using PROMPT. +Pop up a register preview window if the input is help-char but is +not a register. Alternatively if `register-preview-delay' is a +number the preview window is popped up after some delay." + (let* ((buffer "*Register Preview*") + (timer (when (numberp register-preview-delay) + (run-with-timer register-preview-delay nil + #'register-preview buffer))) + (help-char (and (not (get-register help-char)) help-char))) + (unwind-protect + (progn + (while (eq (read-event (propertize prompt 'face 'minibuffer-prompt)) + help-char) + (unless (get-buffer-window buffer) + (register-preview buffer))) + last-input-event) + (and (timerp timer) (cancel-timer timer)) + (let ((w (get-buffer-window buffer))) + (and (window-live-p w) (delete-window w))) + (and (get-buffer buffer) (kill-buffer buffer))))) + (defun point-to-register (register &optional arg) "Store current location of point in register REGISTER. With prefix argument, store current frame configuration. Use \\[jump-to-register] to go to that location or restore that configuration. Argument is a character, naming the register." - (interactive "cPoint to register: \nP") + (interactive (list (register-read-with-preview "Point to register: ") + current-prefix-arg)) ;; Turn the marker into a file-ref if the buffer is killed. (add-hook 'kill-buffer-hook 'register-swap-out nil t) (set-register register @@ -118,7 +177,9 @@ "Store the window configuration of the selected frame in register REGISTER. Use \\[jump-to-register] to restore the configuration. Argument is a character, naming the register." - (interactive "cWindow configuration to register: \nP") + (interactive (list (register-read-with-preview + "Window configuration to register: ") + current-prefix-arg)) ;; current-window-configuration does not include the value ;; of point in the current buffer, so record that separately. (set-register register (list (current-window-configuration) (point-marker)))) @@ -127,7 +188,9 @@ "Store the window configuration of all frames in register REGISTER. Use \\[jump-to-register] to restore the configuration. Argument is a character, naming the register." - (interactive "cFrame configuration to register: \nP") + (interactive (list (register-read-with-preview + "Frame configuration to register: ") + current-prefix-arg)) ;; current-frame-configuration does not include the value ;; of point in the current buffer, so record that separately. (set-register register (list (current-frame-configuration) (point-marker)))) @@ -143,7 +206,8 @@ Optional second arg non-nil (interactively, prefix argument) says to delete any existing frames that the frameset doesn't mention. \(Otherwise, these frames are iconified.)" - (interactive "cJump to register: \nP") + (interactive (list (register-read-with-preview "Jump to register: ") + current-prefix-arg)) (let ((val (get-register register))) (cond ((registerv-p val) @@ -190,7 +254,8 @@ If NUMBER is nil, a decimal number is read from the buffer starting at point, and point moves to the end of that number. Interactively, NUMBER is the prefix arg (none means nil)." - (interactive "P\ncNumber to register: ") + (interactive (list current-prefix-arg + (register-read-with-preview "Number to register: "))) (set-register register (if number (prefix-numeric-value number) @@ -222,7 +287,7 @@ (defun view-register (register) "Display what is contained in register named REGISTER. The Lisp value REGISTER is a character." - (interactive "cView register: ") + (interactive (list (register-read-with-preview "View register: "))) (let ((val (get-register register))) (if (null val) (message "Register %s is empty" (single-key-description register)) @@ -323,7 +388,10 @@ Normally puts point before and mark after the inserted text. If optional second arg is non-nil, puts mark before and point after. Interactively, second arg is non-nil if prefix arg is supplied." - (interactive "*cInsert register: \nP") + (interactive (progn + (barf-if-buffer-read-only) + (register-read-with-preview "Insert register: ") + current-prefix-arg)) (push-mark) (let ((val (get-register register))) (cond @@ -349,7 +417,10 @@ With prefix arg, delete as well. Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions indicating what to copy." - (interactive "cCopy to register: \nr\nP") + (interactive (list (register-read-with-preview "Copy to register: ") + (region-beginning) + (region-end) + current-prefix-arg)) (set-register register (filter-buffer-substring start end)) (setq deactivate-mark t) (cond (delete-flag @@ -362,7 +433,10 @@ With prefix arg, delete as well. Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions indicating what to append." - (interactive "cAppend to register: \nr\nP") + (interactive (list (register-read-with-preview "Append to register: ") + (region-beginning) + (region-end) + current-prefix-arg)) (let ((reg (get-register register)) (text (filter-buffer-substring start end)) (separator (and register-separator (get-register register-separator)))) @@ -381,7 +455,10 @@ With prefix arg, delete as well. Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions indicating what to prepend." - (interactive "cPrepend to register: \nr\nP") + (interactive (list (register-read-with-preview "Prepend to register: ") + (region-beginning) + (region-end) + current-prefix-arg)) (let ((reg (get-register register)) (text (filter-buffer-substring start end)) (separator (and register-separator (get-register register-separator)))) @@ -402,7 +479,11 @@ Called from a program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions giving two corners of rectangle." - (interactive "cCopy rectangle to register: \nr\nP") + (interactive (list (register-read-with-preview + "Copy rectangle to register: ") + (region-beginning) + (region-end) + current-prefix-arg)) (let ((rectangle (if delete-flag (delete-extract-rectangle start end) (extract-rectangle start end)))) @@ -412,6 +493,5 @@ (setq deactivate-mark t) (indicate-copied-region (length (car rectangle)))))) - (provide 'register) ;;; register.el ends here --=-=-=--