Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add counsel-register command. #2056

Closed
wants to merge 18 commits into from
Closed

Add counsel-register command. #2056

wants to merge 18 commits into from

Conversation

@mnewt
Copy link
Contributor

@mnewt mnewt commented May 9, 2019

Search for and perform actions on registers. Resolves #2037. Happy to make any modifications you like.

counsel.el Outdated
@@ -2202,6 +2202,55 @@ current value of `default-directory'."
(call-interactively #'find-file)))
"find-file")))

;;** `counsel-register'
Copy link
Collaborator

@basil-conto basil-conto May 10, 2019

I think this should go under ;;* Misc. Emacs, right before ;;** `counsel-evil-registers', not under ;;* File.

counsel.el Outdated
("\\`a keyboard macro" . jump-to-register))
"Alist of (regexp . function)
pairs. `counsel-register' uses these to
determine which action to take on a given register.")
Copy link
Collaborator

@basil-conto basil-conto May 10, 2019

Please follow the Emacs docstring conventions documented under (elisp) Documentation Tips. In particular: the first sentence should be a brief summary that fits on one line, the rest of the docstring should not be indented, sentences should be followed by two spaces, and metasyntactic variables should be uppercased, as in (REGEXP . FUNCTION). For example:

  "Alist of (REGEXP . FUNCTION) pairs for `counsel-register'.
Selecting a register whose description matches REGEXP specifies
FUNCTION as the action to take on the register."

(Feel free to reword it as you see fit.)

counsel.el Outdated
("\\`text" . insert-register)
("\\`a rectangle" . insert-register)
("\\`a window configuration" . jump-to-register)
("\\`\\(\+\\|-\\)?[0-9]+\\(\\.[0-9]+\\)?\\'" . insert-register)
Copy link
Collaborator

@basil-conto basil-conto May 10, 2019

Capturing groups \\(...\\) aren't actually needed here, are they? I suggest you use shy groups \\(?:...\\) instead.

There is also a missing backslash before the plus sign, but I suggest you write [-+]? instead of \\(\\+\\|-\\)?.

The result would look like:

"\\`[-+]?[0-9]+\\(?:\\.[0-9]\\)?\\'"

counsel.el Outdated
;;;###autoload
(defun counsel-register ()
"Interactively choose a register and perform a default action
on it."
Copy link
Collaborator

@basil-conto basil-conto May 10, 2019

Ditto re: keeping the first sentence on a single line. Is the part about performing a default action really necessary? Seems to me like it raises more questions than it answers (i.e. "what is this default action?").

counsel.el Outdated
on it."
(interactive)
(ivy-read "Register: "
(mapcar (lambda (r) (string-trim (funcall register-preview-function r)))
Copy link
Collaborator

@basil-conto basil-conto May 10, 2019

string-trim is defined in subr-x.el, which Counsel does not load and which was only added in Emacs 24.4. One possible alternative is replace-regexp-in-string:

            (mapcar (lambda (reg)
                      (replace-regexp-in-string
                       "\\`[[:blank:]]+\\(\\(?:.\\|\n\\)*\\)[[:blank:]]+\\'"
                       "\\1" (funcall register-preview-function reg) t))
                    register-alist)

counsel.el Outdated
(ivy-read "Register: "
(mapcar (lambda (r) (string-trim (funcall register-preview-function r)))
register-alist)
:preselect 0
Copy link
Collaborator

@basil-conto basil-conto May 10, 2019

No need for this, it's the default.

counsel.el Outdated
register-alist)
:preselect 0
:history 'counsel-register-history
:action #'counsel-register-action))
Copy link
Collaborator

@basil-conto basil-conto May 10, 2019

This needs :caller 'counsel-register and :sort t, and I think also :require-match t, no?

counsel.el Outdated
(defun counsel-register-action (s)
"Default action for `counsel-register'.
Call a function on a register. The function is determined by
Copy link
Collaborator

@basil-conto basil-conto May 10, 2019

Ditto re: sentence followed by two spaces (see the dir-locals-file setting of sentence-end-double-space).

counsel.el Outdated
`counsel-register-actions'."
(let* ((r (string-to-char s))
(v (get-register r))
(f (cl-some (apply-partially #'counsel-register--match r)
Copy link
Collaborator

@basil-conto basil-conto May 10, 2019

Using apply-partially in your configuration is fine, but it's frowned upon in Elisp libraries, as it's implemented quite inefficiently.

Copy link
Collaborator

@basil-conto basil-conto May 10, 2019

Also, counsel-register--match seems unnecessarily complex: it recomputes the same register's description in each iteration, and there's no need for cl-defun for such a trivial function (it's also missing a docstring). Given my comments above, I suggest the following simplification:

(defun counsel-register-action (register)
  "Default action for `counsel-register'.

Call a function on REGISTER.  The function is determined by
matching the register's value description against a regexp in
`counsel-register-actions'."
  (setq register (string-to-char register))
  (let* ((desc (with-output-to-string
                 (register-val-describe (get-register register) nil)))
         (action (cl-assoc-if (lambda (re)
                                (string-match-p re desc))
                              counsel-register-actions)))
    ;; In the case where we don't find a match, insert the register.
    (funcall (or (cdr action) #'insert-register) register)))

You can then delete counsel-register--match.

counsel.el Outdated
matching the register's value description against a regexp in
`counsel-register-actions'."
(let* ((r (string-to-char s))
(v (get-register r))
Copy link
Collaborator

@basil-conto basil-conto May 10, 2019

This value is unused.

@basil-conto
Copy link
Collaborator

@basil-conto basil-conto commented May 10, 2019

Thanks for working on this! Other than my minor comments, looks good.

@mnewt
Copy link
Contributor Author

@mnewt mnewt commented May 11, 2019

@basil-conto Thank you for the thorough review. I learned some things.

Everything should be as you suggested except for the string-trim replacement. For some reason it didn't work for me so I basically copied string-trim-right. We only need to trim on the right side anyway.

Copy link
Collaborator

@basil-conto basil-conto left a comment

Everything should be as you suggested except for the string-trim replacement. For some reason it didn't work for me so I basically copied string-trim-right.

I would be interested to know why it didn't work, and how you tested it (I didn't test it much), but it's not important.

Apart from my last minor comment, LGTM, thanks.

counsel.el Outdated
(ivy-read "Register: "
(mapcar (lambda (reg)
(let* ((s (funcall register-preview-function reg))
(i (string-match-p "\\(?:[ \t\n\r]+\\)\\'" s)))
Copy link
Collaborator

@basil-conto basil-conto May 11, 2019

No need for the shy group: "[ \t\n\r]+\\'"

I think a comment like the following would also be nice:

diff --git a/counsel.el b/counsel.el
index bd1a4aa..b69b52f 100644
--- a/counsel.el
+++ b/counsel.el
@@ -3927,6 +3927,7 @@ counsel-register
   (interactive)
   (ivy-read "Register: "
             (mapcar (lambda (reg)
+                      ;; `string-trim' was only added in Emacs 24.4.
                       (let* ((s (funcall register-preview-function reg))
                              (i (string-match-p "\\(?:[ \t\n\r]+\\)\\'" s)))
                         (if i (substring s 0 i) s)))

Alternatively you could define a compatibility shim, but it's probably overkill:

(defalias 'counsel--trim-right
  (if (and (require 'subr-x nil t)
           (fboundp 'string-trim-right))
      #'string-trim-right
    (lambda (string)
      (let ((i (string-match-p "[ \t\n\r]+\\'" string)))
        (if i (substring string 0 i) string))))
  "Trim STRING of trailing whitespace.

\(fn STRING)")

@basil-conto basil-conto self-requested a review May 11, 2019
Copy link
Collaborator

@basil-conto basil-conto left a comment

Sorry for the noise, I was trying to approve the changes.

@abo-abo
Copy link
Owner

@abo-abo abo-abo commented May 13, 2019

@mnewt

Is :sort t really necessary?

I got let: Symbol's function definition is void: register-val-describe when trying to jump to a point position stored in a register. I did (require 'register), which didn't fix this. Only doing load-buffer in register.el fixed it. Can anyone reproduce?

Do you have an Emacs CA?

@basil-conto
Copy link
Collaborator

@basil-conto basil-conto commented May 13, 2019

Is :sort t really necessary?

If we don't add it, then users can't customise the ordering of candidates.

Can anyone reproduce?

Not in Emacs 27:

  1. make plain

  2. M-<

  3. C-xrSPCa

  4. M->

  5. M-xcounsel-registerRET

    2019-05-13-135904_1600x900_scrot

  6. RET

    Echo area displays "Mark set", and point is moved to BOB.

But step (6) in Emacs 26.3 indeed results in the following error:

Debugger entered--Lisp error: (void-function register-val-describe)
  (register-val-describe (get-register register) nil)
  (let ((standard-output standard-output)) (register-val-describe (get-register register) nil))
  (progn (let ((standard-output standard-output)) (register-val-describe (get-register register) nil)) (save-current-buffer (set-buffer standard-output) (buffer-string)))
  (unwind-protect (progn (let ((standard-output standard-output)) (register-val-describe (get-register register) nil)) (save-current-buffer (set-buffer standard-output) (buffer-string))) (kill-buffer standard-output))
  (let ((standard-output (get-buffer-create (generate-new-buffer-name " *string-output*")))) (unwind-protect (progn (let ((standard-output standard-output)) (register-val-describe (get-register register) nil)) (save-current-buffer (set-buffer standard-output) (buffer-string))) (kill-buffer standard-output)))
  (let* ((desc (let ((standard-output (get-buffer-create (generate-new-buffer-name " *string-output*")))) (unwind-protect (progn (let (...) (register-val-describe ... nil)) (save-current-buffer (set-buffer standard-output) (buffer-string))) (kill-buffer standard-output)))) (action (cl-assoc-if (function (lambda (re) (string-match-p re desc))) counsel-register-actions))) (if (cdr action) (funcall (cdr action) register) (error "No action was found for register %c" register)))
  counsel-register-action("a: buffer position: buffer *scratch*, position 1")
  ...

As expected, digging around shows that this function was added in Emacs 27: https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=cd1d9e79f74f137511d49eb9b0ae7ba750ba6c3c

Only doing load-buffer in register.el fixed it.

What is load-buffer? Like I said, register-val-describe does not exist in Emacs 26, so you must have evaluated an Emacs 27 checkout of register.el.

Do you have an Emacs CA?

You asked this in #2037 (comment) and the answer was yes.

counsel.el Outdated
`counsel-register-actions'."
(setq register (string-to-char register))
(let* ((desc (with-output-to-string
(register-val-describe (get-register register) nil)))
Copy link
Collaborator

@basil-conto basil-conto May 13, 2019

As @abo-abo discovered, register-val-describe exists only in the currently unreleased development version of Emacs, so I propose you write a compatibility shim using defalias which falls back to a manual implementation if register-val-describe is unbound. If you can come up with a simpler workaround that works in any version, so much the better.

Copy link
Contributor Author

@mnewt mnewt May 20, 2019

Here is register-val-describe:

(cl-defgeneric register-val-describe (val verbose)
  "Print description of register value VAL to `standard-output'."
  (princ "Garbage:\n")
  (if verbose (prin1 val)))

(cl-defmethod register-val-describe ((val registerv) _verbose)
  (if (registerv-print-func val)
      (funcall (registerv-print-func val) (registerv-data val))
    (princ "[UNPRINTABLE CONTENTS].")))

(cl-defmethod register-val-describe ((val number) _verbose)
  (princ val))

(cl-defmethod register-val-describe ((val marker) _verbose)
  (let ((buf (marker-buffer val)))
    (if (null buf)
	(princ "a marker in no buffer")
      (princ "a buffer position:\n    buffer ")
      (princ (buffer-name buf))
      (princ ", position ")
      (princ (marker-position val)))))

(cl-defmethod register-val-describe ((val cons) verbose)
  (cond
   ((window-configuration-p (car val))
    (let* ((stored-window-config (car val))
           (window-config-frame (window-configuration-frame stored-window-config))
           (current-frame (selected-frame)))
      (princ (format "a window configuration: %s."
                     (if (frame-live-p window-config-frame)
                         (with-selected-frame window-config-frame
                           (save-window-excursion
                             (set-window-configuration stored-window-config)
                             (concat
                              (mapconcat (lambda (w) (buffer-name (window-buffer w)))
                                         (window-list (selected-frame)) ", ")
                              (unless (eq current-frame window-config-frame)
                                " in another frame"))))
                       "dead frame")))))

   ((frame-configuration-p (car val))
    (princ "a frame configuration."))

   ((eq (car val) 'file)
    (princ "the file ")
    (prin1 (cdr val))
    (princ "."))

   ((eq (car val) 'file-query)
    (princ "a file-query reference:\n    file ")
    (prin1 (car (cdr val)))
    (princ ",\n    position ")
    (princ (car (cdr (cdr val))))
    (princ "."))

   (t
    (if verbose
	(progn
	  (princ "the rectangle:\n")
	  (while val
	    (princ "    ")
	    (princ (car val))
	    (terpri)
	    (setq val (cdr val))))
      (princ "a rectangle starting with ")
      (princ (car val))))))

(cl-defmethod register-val-describe ((val string) verbose)
  (setq val (copy-sequence val))
  (if (eq yank-excluded-properties t)
      (set-text-properties 0 (length val) nil val)
    (remove-list-of-text-properties 0 (length val)
				    yank-excluded-properties val))
  (if verbose
      (progn
	(princ "the text:\n")
	(princ val))
    (cond
     ;; Extract first N characters starting with first non-whitespace.
     ((string-match (format "[^ \t\n].\\{,%d\\}"
			    ;; Deduct 6 for the spaces inserted below.
			    (min 20 (max 0 (- (window-width) 6))))
		    val)
      (princ "text starting with\n    ")
      (princ (match-string 0 val)))
     ((string-match "^[ \t\n]+$" val)
      (princ "whitespace"))
     (t
      (princ "the empty string")))))

How do you feel about adding all this to counsel.el?

Copy link
Collaborator

@basil-conto basil-conto May 20, 2019

How do you feel about adding all this to counsel.el?

Not particularly excited, to say the least. :)

My suggestion was not to copy-paste the entire current implementation of register-val-describe, with all its methods. Rather, it's to fall back to something sensible and good enough when register-val-describe does not exist. Perhaps looking at the pre-cl-generic implementation in Emacs 26 will provide some inspiration. Besides, cl-generic was only added in Emacs 25.

counsel.el Outdated
Call a function on REGISTER. The function is determined by
matching the register's value description against a regexp in
`counsel-register-actions'."
(setq register (string-to-char register))
Copy link
Collaborator

@basil-conto basil-conto May 13, 2019

There is a bug here:

  1. make plain

  2. C-xrSPCC-n

  3. M-xcounsel-registerRET

    2019-05-13-141702_1600x900_scrot

  4. RET

Debugger entered--Lisp error: (error "No action was found for register C")
  signal(error ("No action was found for register C"))
  error("No action was found for register %c" 67)
  (if (cdr action) (funcall (cdr action) register) (error "No action was found for register %c" register))
  (let* ((desc (let ((standard-output (get-buffer-create (generate-new-buffer-name " *string-output*")))) (unwind-protect (progn (let (...) (register-val-describe ... nil)) (save-current-buffer (set-buffer standard-output) (buffer-string))) (kill-buffer standard-output)))) (action (cl-assoc-if #'(lambda (re) (string-match-p re desc)) counsel-register-actions))) (if (cdr action) (funcall (cdr action) register) (error "No action was found for register %c" register)))
  counsel-register-action("C-n: buffer position: buffer *scratch*, position 1...")
  funcall(counsel-register-action "C-n: buffer position: buffer *scratch*, position 1...")

Here's how I propose to fix it:

diff --git a/counsel.el b/counsel.el
index bd1a4aa..b32d508 100644
--- a/counsel.el
+++ b/counsel.el
@@ -3911,7 +3911,7 @@ counsel-register-action
 Call a function on REGISTER.  The function is determined by
 matching the register's value description against a regexp in
 `counsel-register-actions'."
-  (setq register (string-to-char register))
+  (setq register (get-text-property 0 'register register))
   (let* ((desc (with-output-to-string
                  (register-val-describe (get-register register) nil)))
          (action (cl-assoc-if (lambda (re)
@@ -3926,11 +3926,14 @@ counsel-register
   "Interactively choose a register."
   (interactive)
   (ivy-read "Register: "
-            (mapcar (lambda (reg)
-                      (let* ((s (funcall register-preview-function reg))
-                             (i (string-match-p "\\(?:[ \t\n\r]+\\)\\'" s)))
-                        (if i (substring s 0 i) s)))
-                    register-alist)
+            (cl-mapcan
+             (lambda (reg)
+               (let ((s (funcall register-preview-function reg)))
+                 (setq s (substring s 0 (string-match-p "[ \t\n\r]+\\'" s)))
+                 (unless (string= s "")
+                   (put-text-property 0 1 'register (car reg) s)
+                   (list s))))
+             register-alist)
             :require-match t
             :sort t
             :history 'counsel-register-history

@abo-abo
Copy link
Owner

@abo-abo abo-abo commented May 13, 2019

@basil-conto Thanks for checking. I meant eval-buffer. And I did load the Git master branch of Emacs from 26.2.

Ergus and others added 16 commits May 20, 2019
avy-read et al. can return values that do not correspond to
particular candidates, such as the symbol 'exit'.  This is handled
in avy-process, which sadly doesn't seem reusable in this case.
Ideally, swiper-avy could reuse a higher-level avy API.

Fixes #2062
Have `completion--done' obey the :exit-function logic for us.
See `completion--do-completion'.

Use case: the :exit-function in `eglot-completion-at-point' will erase
the inserted annotation, which holds e.g. the function argument list,
leaving only the function name.
@mnewt
Copy link
Contributor Author

@mnewt mnewt commented May 22, 2019

@basil-conto OK, I think I incorporated all your feedback. Please have a look and tell me what you think.

@abo-abo abo-abo closed this in a18de2f May 22, 2019
@abo-abo
Copy link
Owner

@abo-abo abo-abo commented May 22, 2019

@mnewt Merged, thanks. Nice job.

basil-conto added a commit that referenced this issue May 22, 2019
Register names can be characters such as ?\C-n, so pretty-print them
as register-preview-function would.

Re: #2056
@basil-conto
Copy link
Collaborator

@basil-conto basil-conto commented May 22, 2019

Thanks @mnewt, I only followed up with a minor cleanup to the error message: 19ff7cf

astoff added a commit to astoff/swiper that referenced this issue Jan 1, 2021
astoff added a commit to astoff/swiper that referenced this issue Jan 1, 2021
Register names can be characters such as ?\C-n, so pretty-print them
as register-preview-function would.

Re: abo-abo#2056
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Linked issues

Successfully merging this pull request may close these issues.

5 participants