From: Leo Liu <sdl.web@gmail.com>
To: Stefan Monnier <monnier@iro.umontreal.ca>
Cc: "Óscar Fuentes" <ofv@wanadoo.es>, Bastien <bzg@altern.org>,
15525@debbugs.gnu.org
Subject: bug#15525: 24.3; register-read-with-preview
Date: Sun, 06 Oct 2013 10:01:05 +0800 [thread overview]
Message-ID: <m11u3z5fa6.fsf@gmail.com> (raw)
In-Reply-To: <jwvr4bzk7m5.fsf-monnier+emacsbugs@gnu.org> (Stefan Monnier's message of "Sat, 05 Oct 2013 12:30:10 -0400")
[-- Attachment #1: Type: text/plain, Size: 813 bytes --]
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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: reg3.diff --]
[-- Type: text/x-patch, Size: 8635 bytes --]
=== 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
next prev parent reply other threads:[~2013-10-06 2:01 UTC|newest]
Thread overview: 10+ messages / expand[flat|nested] mbox.gz Atom feed top
2013-10-04 5:57 bug#15525: 24.3; register-read-with-preview Leo Liu
2013-10-04 13:57 ` Stefan Monnier
2013-10-04 16:02 ` Bastien
2013-10-05 3:19 ` Leo Liu
2013-10-05 16:30 ` Stefan Monnier
2013-10-06 2:01 ` Leo Liu [this message]
2013-10-06 16:59 ` Stefan Monnier
2013-10-07 2:35 ` Leo Liu
2013-10-07 4:13 ` Stefan Monnier
2013-10-10 12:56 ` Leo Liu
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=m11u3z5fa6.fsf@gmail.com \
--to=sdl.web@gmail.com \
--cc=15525@debbugs.gnu.org \
--cc=bzg@altern.org \
--cc=monnier@iro.umontreal.ca \
--cc=ofv@wanadoo.es \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.