Skip to content

Commit 4b47c07

Browse files
mkcmsmkcms
committed
bdx: Improve occur by calling `ivy-read' with an :action function
This way, the action is saved as part of `ivy-state' and we can use that in the occur buffer. Buttons are also added to the occur buffer, that invoke the action for item that was clicked. * README.md: (bdx.el): Modify doc for `bdx-query'. * bdx.el: Modify doc in commentary. (bdx-query): Add `action' argument, pass it to `ivy-read' and save as extra prop. (bdx--occur): Use that action retrieved from extra-props to add buttons for each candidate that invoke the action. (bdx-disassemble, bdx-find-definition): Pass self as :action.
1 parent a4d699d commit 4b47c07

File tree

2 files changed

+108
-90
lines changed

2 files changed

+108
-90
lines changed

‎README.md‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -55,8 +55,7 @@ It also provides these API functions:
5555

5656
- `bdx-query`
5757

58-
Read a bdx query from the user, interactively displaying results, and return
59-
symbol data.
58+
Read a bdx query from the user, interactively displaying results.
6059

6160
- `bdx-generate-graph`
6261

‎bdx.el‎

Lines changed: 107 additions & 88 deletions
Original file line numberDiff line numberDiff line change
@@ -53,8 +53,7 @@
5353
;;
5454
;; - `bdx-query'
5555
;;
56-
;; Read a bdx query from the user, interactively displaying results, and
57-
;; return symbol data.
56+
;; Read a bdx query from the user, interactively displaying results.
5857
;;
5958
;; - `bdx-generate-graph'
6059
;;
@@ -383,15 +382,19 @@ selecting all possible completions for section that start with
383382
(defvar bdx--show-templates)
384383
(defvar bdx--show-sections)
385384

386-
(cl-defun bdx-query (prompt &key initial-input history require-match)
385+
(cl-defun bdx-query (prompt &key initial-input history require-match
386+
action)
387387
"Search for single symbol with PROMPT.
388388
INITIAL-INPUT if non-nil is inserted into the minibuffer as the
389389
initial input string.
390390
391391
HISTORY can be a history variable.
392392
393393
REQUIRE-MATCH if non-nil will disallow exiting without selecting
394-
a symbol."
394+
a symbol.
395+
396+
ACTION can be a function taking one argument that will be called
397+
with SYMBOL-PLIST for the selected symbol."
395398
;; Exit early if index does not exist
396399
(with-temp-buffer
397400
(let* ((command (bdx--command "search" "--check-index-exists"))
@@ -406,23 +409,26 @@ a symbol."
406409
(setq bdx--show-sections t)
407410
(setq bdx--query-buffer (current-buffer))
408411
(setq bdx--last-error nil)
409-
(bdx-data
410-
(ivy-read prompt #'bdx--ivy-collection-function
411-
:require-match require-match
412-
:dynamic-collection t
413-
:keymap bdx-search-keymap
414-
:caller 'bdx
415-
:history history
416-
:initial-input initial-input
417-
:unwind (lambda ()
418-
(setq bdx--query-buffer nil)
419-
(setq bdx--callback #'ignore)
420-
(setq bdx--done-callback #'ignore)
421-
(setq bdx--error-callback #'ignore)
422-
(setq bdx--all-candidates nil)
423-
(when (processp bdx--last-process)
424-
(delete-process bdx--last-process)
425-
(accept-process-output bdx--last-process 0.1))))))
412+
(ivy-read prompt #'bdx--ivy-collection-function
413+
:require-match require-match
414+
:dynamic-collection t
415+
:keymap bdx-search-keymap
416+
:caller 'bdx
417+
:history history
418+
:initial-input initial-input
419+
:action (lambda (selection)
420+
(when action
421+
(funcall action (bdx-data selection))))
422+
:unwind (lambda ()
423+
(setq bdx--query-buffer nil)
424+
(setq bdx--callback #'ignore)
425+
(setq bdx--done-callback #'ignore)
426+
(setq bdx--error-callback #'ignore)
427+
(setq bdx--all-candidates nil)
428+
(when (processp bdx--last-process)
429+
(delete-process bdx--last-process)
430+
(accept-process-output bdx--last-process 0.1)))
431+
:extra-props `(:bdx-action ,action)))
426432

427433
(cl-defun bdx-get-query (prompt &key history)
428434
"Get a search query from the user, with results preview, using PROMPT.
@@ -533,7 +539,9 @@ This turns a string of the form \\='function<type<T>>\\=' into
533539

534540
(let ((inhibit-read-only t)
535541
(total-found
536-
(or (and cands (plist-get (bdx-data (car cands)) :total)) 0)))
542+
(or (and cands (plist-get (bdx-data (car cands)) :total)) 0))
543+
(action (plist-get (ivy-state-extra-props ivy-last)
544+
:bdx-action)))
537545
(erase-buffer)
538546
(setq buffer-read-only t)
539547

@@ -568,8 +576,11 @@ This turns a string of the form \\='function<type<T>>\\=' into
568576
:size :section :address :type)
569577
(bdx-data cand)))
570578
(insert (propertize (or demangled name "(ERROR: No name)")
571-
'face 'font-lock-constant-face)
572-
":\n")
579+
'face 'font-lock-constant-face))
580+
(make-button (line-beginning-position) (line-end-position)
581+
'action (lambda (&rest _args)
582+
(funcall action (bdx-data cand))))
583+
(insert ":\n")
573584
(cond
574585
(binary-outdated
575586
(insert " " (propertize "Warning:" 'face 'warning)
@@ -662,46 +673,49 @@ IGNORE-AUTO and NOCONFIRM are unused."
662673
"Disassemble the symbol encoded in SYMBOL-PLIST.
663674
Interactively, prompts for a query and allows selecting a single
664675
symbol."
665-
(interactive (list (bdx-query "Disassemble symbol: "
666-
:require-match t)))
667-
(with-current-buffer (bdx--disassembly-buffer)
668-
(pcase-let (((map :name :demangled :path :section) symbol-plist))
669-
(let ((command
670-
(apply #'bdx--command "disass"
671-
(append (and bdx-disassembler (list "-D" bdx-disassembler))
672-
(and bdx-disassembler-options
673-
(list "-M" bdx-disassembler-options))
674-
(and bdx-disassembly-results-limit
675-
(list "-n" (number-to-string
676-
bdx-disassembly-results-limit)))
677-
(list
678-
(and name (format "fullname:\"%s\"" name))
679-
(and demangled
680-
(format "demangled:\"%s\"" demangled))
681-
(and path (format "path:\"%s\"" path))
682-
(and section
683-
(format "section:\"%s\"" section))))))
684-
(current-state
685-
(and bdx-disassembly-current-symbol
686-
(list bdx-disassembly-current-symbol
687-
(point) (window-start))))
688-
(inhibit-read-only t))
689-
(erase-buffer)
676+
(interactive (list 'interactive))
677+
(if (eq symbol-plist 'interactive)
678+
(bdx-query "Disassemble symbol: " :require-match t
679+
:action #'bdx-disassemble)
680+
(with-current-buffer (bdx--disassembly-buffer)
681+
(pcase-let (((map :name :demangled :path :section) symbol-plist))
682+
(let ((command
683+
(apply #'bdx--command "disass"
684+
(append (and bdx-disassembler
685+
(list "-D" bdx-disassembler))
686+
(and bdx-disassembler-options
687+
(list "-M" bdx-disassembler-options))
688+
(and bdx-disassembly-results-limit
689+
(list "-n" (number-to-string
690+
bdx-disassembly-results-limit)))
691+
(list
692+
(and name (format "fullname:\"%s\"" name))
693+
(and demangled
694+
(format "demangled:\"%s\"" demangled))
695+
(and path (format "path:\"%s\"" path))
696+
(and section
697+
(format "section:\"%s\"" section))))))
698+
(current-state
699+
(and bdx-disassembly-current-symbol
700+
(list bdx-disassembly-current-symbol
701+
(point) (window-start))))
702+
(inhibit-read-only t))
703+
(erase-buffer)
690704

691-
(pop-to-buffer (current-buffer))
692-
(apply #'call-process (car command)
693-
nil (current-buffer) nil (cdr command))
705+
(pop-to-buffer (current-buffer))
706+
(apply #'call-process (car command)
707+
nil (current-buffer) nil (cdr command))
694708

695-
(run-hooks 'bdx-disassembly-hook)
709+
(run-hooks 'bdx-disassembly-hook)
696710

697-
(setq buffer-read-only t)
698-
(setq buffer-undo-list t)
711+
(setq buffer-read-only t)
712+
(setq buffer-undo-list t)
699713

700-
(when current-state (push current-state bdx-disassembly-stack))
701-
(setq bdx-disassembly-current-symbol symbol-plist)
714+
(when current-state (push current-state bdx-disassembly-stack))
715+
(setq bdx-disassembly-current-symbol symbol-plist)
702716

703-
(when (equal symbol-plist (caar bdx-disassembly-forward-stack))
704-
(pop bdx-disassembly-forward-stack))))))
717+
(when (equal symbol-plist (caar bdx-disassembly-forward-stack))
718+
(pop bdx-disassembly-forward-stack)))))))
705719

706720
(defun bdx-disassemble-name (name)
707721
"Disassemble the symbol named NAME.
@@ -800,36 +814,41 @@ to the length of `bdx-disassembly-stack'."
800814

801815
(defun bdx-find-definition (symbol-plist)
802816
"Find file containing definition of SYMBOL-PLIST and go to definition line.
803-
The return value is a cons (FILE . LINE)."
804-
(interactive (list (bdx-query "Find definition: "
805-
:require-match t)))
806-
(pcase-let (((map :name :demangled :path :section) symbol-plist))
807-
(let ((command
808-
(apply #'bdx--command "find-definition"
809-
(append (list "-n" "1")
810-
(list
811-
(and name (format "fullname:\"%s\"" name))
812-
(and path (format "path:\"%s\"" path))
813-
(and section
814-
(format "section:\"%s\"" section))))))
815-
file line sym)
816-
(with-temp-buffer
817-
(apply #'call-process (car command)
818-
nil (current-buffer) nil (cdr command))
819-
820-
(goto-char (point-min))
821-
(if (looking-at "^\\(.*\\):\\([0-9]+\\): \\(.*\\)")
822-
(setq file (match-string 1)
823-
line (string-to-number (match-string 2))
824-
sym (match-string 3))
825-
(error "No definition found")))
826-
(when (equal sym name)
827-
(with-current-buffer (find-file-noselect file)
817+
The return value is a cons (FILE . LINE).
818+
If SYMBOL-PLIST is the symbol \\='interactive, then prompt for the symbol."
819+
(interactive (list 'interactive))
820+
(if (eq symbol-plist 'interactive)
821+
(list (bdx-query "Find definition: " :require-match t
822+
:action #'bdx-find-definition))
823+
(pcase-let (((map :name :path :section) symbol-plist))
824+
(let ((command
825+
(apply #'bdx--command "find-definition"
826+
(append (list "-n" "1")
827+
(list
828+
(and name (format "fullname:\"%s\"" name))
829+
(and path (format "path:\"%s\"" path))
830+
(and section
831+
(format "section:\"%s\"" section))))))
832+
file line sym)
833+
(with-temp-buffer
834+
(apply #'call-process (car command)
835+
nil (current-buffer) nil (cdr command))
836+
828837
(goto-char (point-min))
829-
(forward-line (1- line))
830-
(pop-to-buffer (current-buffer))
831-
(pulse-momentary-highlight-one-line)
832-
(cons file line))))))
838+
(if (looking-at "^\\(.*\\):\\([0-9]+\\): \\(.*\\)")
839+
(setq file (match-string 1)
840+
line (string-to-number (match-string 2))
841+
sym (match-string 3))
842+
(error "No definition found")))
843+
(when (equal sym name)
844+
(with-current-buffer (or (find-buffer-visiting file)
845+
(find-file-noselect file))
846+
(pop-to-buffer (current-buffer))
847+
(goto-char (point-min))
848+
(forward-line (1- line))
849+
(pulse-momentary-highlight-one-line)
850+
(recenter-top-bottom)
851+
(cons file line)))))))
833852

834853

835854
;; Graphs

0 commit comments

Comments
 (0)