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: Fri, 04 Oct 2013 13:57:26 +0800 Message-ID: NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1380866361 29138 80.91.229.3 (4 Oct 2013 05:59:21 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Fri, 4 Oct 2013 05:59:21 +0000 (UTC) Cc: =?UTF-8?Q?=C3=93scar?= Fuentes To: 15525@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Fri Oct 04 07:59:24 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 1VRyQ7-0000Bq-DB for geb-bug-gnu-emacs@m.gmane.org; Fri, 04 Oct 2013 07:59:23 +0200 Original-Received: from localhost ([::1]:46466 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VRyQ7-00047n-4R for geb-bug-gnu-emacs@m.gmane.org; Fri, 04 Oct 2013 01:59:23 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:51189) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VRyPv-00041u-SZ for bug-gnu-emacs@gnu.org; Fri, 04 Oct 2013 01:59:20 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VRyPn-0003BD-DY for bug-gnu-emacs@gnu.org; Fri, 04 Oct 2013 01:59:11 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:44689) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VRyPn-0003B9-9e for bug-gnu-emacs@gnu.org; Fri, 04 Oct 2013 01:59:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1VRyPm-0004K4-Ac; Fri, 04 Oct 2013 01:59:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Leo Liu Original-Sender: "Debbugs-submit" Resent-CC: monnier@iro.umontreal.ca, ofv@wanadoo.es, bug-gnu-emacs@gnu.org Resent-Date: Fri, 04 Oct 2013 05:59:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 15525 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: X-Debbugs-Original-To: bug-gnu-emacs@gnu.org X-Debbugs-Original-Xcc: Stefan Monnier , =?UTF-8?Q?=C3=93scar?= Fuentes Original-Received: via spool by submit@debbugs.gnu.org id=B.138086628716544 (code B ref -1); Fri, 04 Oct 2013 05:59:02 +0000 Original-Received: (at submit) by debbugs.gnu.org; 4 Oct 2013 05:58:07 +0000 Original-Received: from localhost ([127.0.0.1]:52980 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1VRyOs-0004Il-4P for submit@debbugs.gnu.org; Fri, 04 Oct 2013 01:58:06 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:49317) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1VRyOp-0004Ib-K6 for submit@debbugs.gnu.org; Fri, 04 Oct 2013 01:58:04 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VRyOg-00032e-Sa for submit@debbugs.gnu.org; Fri, 04 Oct 2013 01:58:03 -0400 Original-Received: from lists.gnu.org ([2001:4830:134:3::11]:48069) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VRyOg-00032a-PC for submit@debbugs.gnu.org; Fri, 04 Oct 2013 01:57:54 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:50881) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VRyOX-0003uV-5f for bug-gnu-emacs@gnu.org; Fri, 04 Oct 2013 01:57:54 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VRyOO-0002wd-M5 for bug-gnu-emacs@gnu.org; Fri, 04 Oct 2013 01:57:45 -0400 Original-Received: from mail-pa0-x22c.google.com ([2607:f8b0:400e:c03::22c]:34237) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VRyOO-0002wX-9p for bug-gnu-emacs@gnu.org; Fri, 04 Oct 2013 01:57:36 -0400 Original-Received: by mail-pa0-f44.google.com with SMTP id lf10so3668217pab.17 for ; Thu, 03 Oct 2013 22:57:34 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=from:to:subject:date:message-id:mime-version:content-type; bh=4LiYaUWtY0a9qQMzzzg78DwjwGFp4klCWwTfCPLO2Fs=; b=OzrsAtka5lAHXWoytSmJBauaMic9xUyYjmz29xMoEbLLqlUQ50uQJXhyZPgjHnF6n+ RsTCrZ7IfP3QqZxBJ02qPXJ6FirGcB1dU/YLoudpsBGJ0IlSWgp9wpjldcrgEPEvSId3 fFjcOGT0yKy7KrfMyiklYDDvvy0y7mN1oohfGKQcBOZyArPgjXUmMOIL70PAk0HUQ28R ZnEhWquhUssunBKmnn/lEbLGZeyNSm7sE2/mXewAnPMv9kMH6ISkQIF5OiIVEmbGdVVG szI4KeUE6xBNxJyyzSMCPfagq56zBxeJFG3VkNOMgB9eKX1MptUp0jxeIfPd3aei9N7M XaDw== X-Received: by 10.66.7.68 with SMTP id h4mr9879289paa.0.1380866254471; Thu, 03 Oct 2013 22:57:34 -0700 (PDT) Original-Received: from localhost ([123.115.243.110]) by mx.google.com with ESMTPSA id vz4sm15359827pab.11.1969.12.31.16.00.00 (version=TLSv1.2 cipher=RC4-SHA bits=128/128); Thu, 03 Oct 2013 22:57:33 -0700 (PDT) X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). 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:78914 Archived-At: --=-=-= Content-Type: text/plain register-read-with-preview pops up a window showing existing registers and brief description. Any comments? --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=reg.diff Content-Description: reg.diff === modified file 'lisp/register.el' --- lisp/register.el 2013-08-09 00:30:24 +0000 +++ lisp/register.el 2013-10-04 05:48:34 +0000 @@ -89,6 +89,11 @@ :type '(choice (const :tag "None" nil) (character :tag "Use register" :value ?+))) +(defcustom register-preview-delay 0.5 + "Delay in seconds before popping up the preview window." + :type 'number + :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,54 @@ (push (cons register value) register-alist)) value)) +(defun register-describe-oneline (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 + (format + "%s %s\n" + (concat (single-key-description (car r)) ":") + (or (run-hook-with-args 'register-preview-functions (cdr r)) + (register-describe-oneline (car r)))))) + register-alist)))))) + +(defun register-read-with-preview (prompt) + (let* ((buffer "*Register Preview*") + (timer (run-with-timer register-preview-delay nil + #'register-preview buffer))) + (unwind-protect + (read-event (propertize prompt 'face 'minibuffer-prompt)) + (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 +165,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 +176,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 +194,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 +242,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 +275,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 +376,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 +405,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 +421,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 +443,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 +467,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 +481,5 @@ (setq deactivate-mark t) (indicate-copied-region (length (car rectangle)))))) - (provide 'register) ;;; register.el ends here --=-=-=--