bui-core.el 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768
  1. ;;; bui-core.el --- Core functionality for BUI -*- lexical-binding: t -*-
  2. ;; Copyright © 2014–2017, 2021 Alex Kost <alezost@gmail.com>
  3. ;; Copyright © 2020 Joe Bloggs <vapniks@yahoo.com>
  4. ;; This program is free software; you can redistribute it and/or modify
  5. ;; it under the terms of the GNU General Public License as published by
  6. ;; the Free Software Foundation, either version 3 of the License, or
  7. ;; (at your option) any later version.
  8. ;;
  9. ;; This program is distributed in the hope that it will be useful,
  10. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. ;; GNU General Public License for more details.
  13. ;;
  14. ;; You should have received a copy of the GNU General Public License
  15. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  16. ;;; Commentary:
  17. ;; This file provides the code that is used by both `list' and `info'
  18. ;; interfaces, and the code to display defined interfaces.
  19. ;;; Code:
  20. (require 'cl-lib)
  21. (require 'dash)
  22. (require 'bui-history)
  23. (require 'bui-utils)
  24. (bui-define-groups bui
  25. :parent-group tools
  26. :parent-faces-group faces
  27. :group-doc "Settings for Buffer User Interface.")
  28. (defvar bui-map
  29. (let ((map (make-sparse-keymap)))
  30. (define-key map (kbd "C-c C-b") 'bui-history-back)
  31. (define-key map (kbd "C-c C-f") 'bui-history-forward)
  32. (define-key map (kbd "l") 'bui-history-back)
  33. (define-key map (kbd "r") 'bui-history-forward)
  34. (define-key map (kbd "g") 'revert-buffer)
  35. (define-key map (kbd "R") 'bui-redisplay)
  36. (define-key map (kbd "f") 'bui-filter-map)
  37. (define-key map (kbd "h") 'bui-show-hint)
  38. (define-key map [remap self-insert-command] 'bui-show-hint)
  39. map)
  40. "Parent keymap for all BUI modes.")
  41. (defvar bui-history-hint
  42. '("History: "
  43. ("\\[bui-history-back]") " go back, "
  44. ("\\[bui-history-forward]") " go forward;\n")
  45. "Hint with history keys.
  46. See `bui-hint' for details.")
  47. (defvar bui-common-hint
  48. '(("\\[revert-buffer]") " revert (update) buffer;\n"
  49. ("\\[bui-show-hint]") " show this hint; "
  50. ("\\[describe-mode]") " show full help.")
  51. "Hint with keys common for any buffer type.
  52. See `bui-hint' for details.")
  53. ;;; Buffer item
  54. (cl-defstruct (bui-item
  55. (:constructor nil)
  56. (:constructor bui-make-item
  57. (entries entry-type buffer-type args))
  58. (:copier nil))
  59. entries entry-type buffer-type args)
  60. (defvar-local bui-item nil
  61. "Data (structure) for the current BUI buffer.
  62. The structure consists of the following elements:
  63. - `entries': list of the currently displayed entries.
  64. Each element of the list is an alist with an entry data of the
  65. following form:
  66. ((PARAM . VAL) ...)
  67. PARAM is a name of the entry parameter.
  68. VAL is a value of this parameter.
  69. - `entry-type': type of the currently displayed entries.
  70. - `buffer-type': type of the current buffer.
  71. - `args': arguments used to get the current entries.")
  72. (put 'bui-item 'permanent-local t)
  73. (defmacro bui-with-item (item &rest body)
  74. "Evaluate BODY using buffer ITEM.
  75. The following local variables are available inside BODY:
  76. `%entries', `%buffer-type', `%entry-type', `%args'.
  77. See `bui-item' for details."
  78. (declare (indent 1) (debug t))
  79. (let ((item-var (make-symbol "item")))
  80. `(let ((,item-var ,item))
  81. (let ((%entries (bui-item-entries ,item-var))
  82. (%entry-type (bui-item-entry-type ,item-var))
  83. (%buffer-type (bui-item-buffer-type ,item-var))
  84. (%args (bui-item-args ,item-var)))
  85. ,@body))))
  86. (defmacro bui-with-current-item (&rest body)
  87. "Evaluate BODY using `bui-item'.
  88. See `bui-with-item' for details."
  89. (declare (indent 0) (debug t))
  90. `(bui-with-item bui-item
  91. ,@body))
  92. (defmacro bui-define-current-item-accessor (name)
  93. "Define `bui-current-NAME' function to access NAME
  94. element of `bui-item' structure.
  95. NAME should be a symbol."
  96. (let* ((name-str (symbol-name name))
  97. (accessor (intern (concat "bui-item-" name-str)))
  98. (fun-name (intern (concat "bui-current-" name-str)))
  99. (doc (format "\
  100. Return '%s' of the current BUI buffer.
  101. See `bui-item' for details."
  102. name-str)))
  103. `(defun ,fun-name ()
  104. ,doc
  105. (and bui-item
  106. (,accessor bui-item)))))
  107. (defmacro bui-define-current-item-accessors (&rest names)
  108. "Define `bui-current-NAME' functions for NAMES.
  109. See `bui-define-current-item-accessor' for details."
  110. `(progn
  111. ,@(mapcar (lambda (name)
  112. `(bui-define-current-item-accessor ,name))
  113. names)))
  114. (bui-define-current-item-accessors
  115. entries entry-type buffer-type args)
  116. (defmacro bui-define-current-args-accessor (n prefix name)
  117. "Define `PREFIX-NAME' function to access Nth element of 'args'
  118. field of `bui-item' structure.
  119. PREFIX and NAME should be symbols."
  120. (let* ((prefix-str (symbol-name prefix))
  121. (name-str (symbol-name name))
  122. (fun-name (intern (concat prefix-str "-" name-str)))
  123. (doc (format "\
  124. Return '%s' of the current buffer.
  125. '%s' is the element number %d in 'args' field of `bui-item'."
  126. name-str name-str n)))
  127. `(defun ,fun-name ()
  128. ,doc
  129. (nth ,n (bui-current-args)))))
  130. (defmacro bui-define-current-args-accessors (prefix &rest names)
  131. "Define `PREFIX-NAME' functions for NAMES.
  132. See `bui-define-current-args-accessor' for details."
  133. (declare (indent 1))
  134. `(progn
  135. ,@(cl-loop for name in names
  136. for i from 0
  137. collect `(bui-define-current-args-accessor
  138. ,i ,prefix ,name))))
  139. ;;; Filtering
  140. (defvar bui-filter-map
  141. (let ((map (make-sparse-keymap)))
  142. (define-key map (kbd "f") 'bui-enable-filter)
  143. (define-key map (kbd "d") 'bui-disable-filters)
  144. map)
  145. "Keymap with filter commands for BUI modes.")
  146. (fset 'bui-filter-map bui-filter-map)
  147. (defvar bui-filter-hint
  148. '(("\\[bui-enable-filter]") " enable filter; "
  149. ("\\[bui-disable-filters]") " disable filters;\n")
  150. "Hint with the default keys for filtering.
  151. See `bui-hint' for details.")
  152. (defcustom bui-filter-predicates
  153. '(bui-filter-by-regexp bui-filter-by-sexp)
  154. "List of available filter predicates.
  155. These predicates are used as completions for
  156. '\\[bui-enable-filter]' command to hide entries. See
  157. `bui-active-filter-predicates' for details."
  158. :type '(repeat function)
  159. :group 'bui)
  160. (put 'bui-filter-predicates 'permanent-local t)
  161. (defcustom bui-filter-mode-line-string "(f)"
  162. "String displayed in the mode line when filters are enabled.
  163. Set it to nil, if you don't want to display such a string."
  164. :type '(choice string (const nil))
  165. :group 'bui)
  166. (defvar-local bui-active-filter-predicates nil
  167. "List of the active filter predicates.
  168. These predicates are used to hide unneeded entries from the
  169. current buffer. Each buffer entry is passed (as a single
  170. argument) through these predicates in turn. If a predicate
  171. returns nil, the entry will be hidden (the rest predicates are
  172. not called), otherwise the entry \"survives\" this predicate and
  173. it is passed to the next one, and so on.")
  174. (put 'bui-active-filter-predicates 'permanent-local t)
  175. (defun bui-filter-current-entries (&rest predicates)
  176. "Filter the current entries using PREDICATES, and redisplay them.
  177. If PREDICATES are not specified, display all entries."
  178. (setq bui-active-filter-predicates predicates)
  179. (bui-show-entries (bui-current-entries)
  180. (bui-current-entry-type)
  181. (bui-current-buffer-type)))
  182. (defun bui-filter-by-regexp (entry param regexp)
  183. "Filter the current entries by regexp.
  184. Return non-nil, if ENTRY's parameter PARAM matches REGEXP.
  185. Interactively, prompt for PARAM and REGEXP."
  186. (interactive
  187. (list '<>
  188. (intern
  189. (completing-read "Parameter: "
  190. (mapcar #'symbol-name (bui-current-params))))
  191. (read-regexp "Regexp: ")))
  192. (string-match-p regexp
  193. (bui-get-string (bui-assq-value entry param))))
  194. (defun bui-filter-by-sexp (entry sexp)
  195. "Filter the current entries using sexp.
  196. Evaluate SEXP and return its value.
  197. SEXP can use the ENTRY's parameters as symbols, e.g.:
  198. '(or (string-match-p \"foo\" name)
  199. (string-match-p \"bar\" synopsis))
  200. "
  201. (interactive (list '<> (read--expression "sexp: ")))
  202. (dolist (param (bui-current-params))
  203. (setq sexp (cl-subst (bui-assq-value entry param)
  204. param sexp)))
  205. (eval sexp))
  206. (defun bui-enable-filter (predicate &optional single?)
  207. "Apply filter PREDICATE to the current entries.
  208. Interactively, prompt for PREDICATE, choosing candidates from the
  209. available predicates.
  210. If SINGLE? is non-nil (with prefix argument), make PREDICATE the
  211. only active one (remove the other active predicates)."
  212. (interactive
  213. (let ((predicates bui-filter-predicates))
  214. (if (null predicates)
  215. (error "Filter predicates are not specified, see '%S' variable"
  216. (bui-entry-symbol (bui-current-entry-type)
  217. 'filter-predicates))
  218. (list (intern (completing-read
  219. (if current-prefix-arg
  220. "Enable single filter: "
  221. "Add filter: ")
  222. predicates))
  223. current-prefix-arg))))
  224. (or (functionp predicate)
  225. (error "Wrong filter predicate: %S" predicate))
  226. (setq predicate (bui-apply-interactive predicate))
  227. (if (if single?
  228. (equal (list predicate) bui-active-filter-predicates)
  229. (memq predicate bui-active-filter-predicates))
  230. (message "Filter predicate '%S' already enabled" predicate)
  231. (apply #'bui-filter-current-entries
  232. (if single?
  233. (list predicate)
  234. (cons predicate bui-active-filter-predicates)))))
  235. (defun bui-disable-filters ()
  236. "Disable all active filters."
  237. (interactive)
  238. (if (null bui-active-filter-predicates)
  239. (message "There are no active filters.")
  240. (bui-filter-current-entries)))
  241. ;;; Hints
  242. (defface bui-hint-key
  243. '((t :inherit font-lock-warning-face))
  244. "Face used by `bui-show-hint' to display keys."
  245. :group 'bui-faces)
  246. (defcustom bui-hint-format "[%s]"
  247. "String used to format each key in `bui-hint'.
  248. This string should contain a single '%s' structure that will be
  249. replaced by a key string."
  250. :type 'string
  251. :group 'bui)
  252. (defvar bui-hint-key-separator ", "
  253. "String used to separate keys in `bui-hint'.")
  254. (defvar bui-hint #'bui-default-hint
  255. "Hint displayed in the echo area by \\[bui-show-hint].
  256. It can be either a string, a list, or a function returning one of
  257. those.
  258. If it is a list, its elements should have one of the following
  259. forms:
  260. STRING
  261. (KEY-STRING ...)
  262. STRING elements are displayed as is.
  263. KEY-STRING elements are highlighted with `bui-hint-key' face and
  264. are separated with `bui-hint-key-separator'. Also these strings
  265. are passed through `substitute-command-keys', so you can use any
  266. supported structure.
  267. Example of a possible value:
  268. (\"Press:\\n\" (\"a\" \"b\") \" to do something;\\n\")")
  269. (put 'bui-hint 'permanent-local t)
  270. (defun bui-format-hint-keys (key-strings)
  271. "Concatenate and highlight KEY-STRINGS.
  272. See `bui-hint' for details."
  273. (mapconcat (lambda (key)
  274. (format bui-hint-format
  275. (propertize (substitute-command-keys key)
  276. 'face 'bui-hint-key)))
  277. key-strings
  278. bui-hint-key-separator))
  279. (defun bui-format-hint (hint)
  280. "Return string from HINT that has `bui-hint' form."
  281. (pcase hint
  282. ((pred null) "")
  283. ((pred stringp) hint)
  284. ((pred functionp) (funcall hint))
  285. ((pred listp)
  286. (mapconcat (lambda (list-or-string)
  287. (if (listp list-or-string)
  288. (bui-format-hint-keys list-or-string)
  289. list-or-string))
  290. hint ""))
  291. (_ (error "Unknown hint type: %S" hint))))
  292. (defun bui-format-hints (&rest hints)
  293. "Call `bui-format-hint' on all HINTS and concatenate results."
  294. (mapconcat #'bui-format-hint hints ""))
  295. (defun bui-default-hint ()
  296. "Return default hint structure for the current buffer."
  297. (let* ((buffer-type-hint-fun (bui-make-symbol
  298. 'bui (bui-current-buffer-type) 'hint))
  299. (buffer-type-hint (and (fboundp buffer-type-hint-fun)
  300. (funcall buffer-type-hint-fun))))
  301. (apply #'bui-format-hints
  302. (delq nil
  303. (list buffer-type-hint
  304. (and bui-filter-predicates
  305. bui-filter-hint)
  306. bui-history-hint
  307. bui-common-hint)))))
  308. (defun bui-show-hint ()
  309. "Show `bui-hint' in the echo area."
  310. (interactive)
  311. (message (bui-format-hint bui-hint)))
  312. ;;; General variables
  313. (defcustom bui-titles nil
  314. "Alist of titles of parameters."
  315. :type '(alist :key-type symbol :value-type string)
  316. :group 'bui)
  317. (put 'bui-titles 'permanent-local t)
  318. (defvar bui-boolean-params nil
  319. "List of boolean parameters.
  320. These parameters are displayed using `bui-false-string' for
  321. nil values (unlike usual parameters which are displayed using
  322. `bui-empty-string').")
  323. (put 'bui-boolean-params 'permanent-local t)
  324. (defvar bui-get-entries-function nil
  325. "Function used to receive entries.")
  326. (put 'bui-get-entries-function 'permanent-local t)
  327. (defvar bui-show-entries-function nil
  328. "Function used to show entries.
  329. This function is called with a list of entries as a single
  330. argument. If nil, `bui-show-entries-default' is called with
  331. appropriate ENTRY-TYPE and BUFFER-TYPE.")
  332. (put 'bui-show-entries-function 'permanent-local t)
  333. (defvar bui-mode-initialize-function nil
  334. "Function used to set up the current BUI buffer.
  335. This function is called without arguments after enabling the
  336. mode (right before running mode hooks).
  337. It can also be nil.")
  338. (put 'bui-mode-initialize-function 'permanent-local t)
  339. (defvar bui-message-function nil
  340. "Function used to display a message after showing entries.
  341. If nil, do not display messages.")
  342. (put 'bui-message-function 'permanent-local t)
  343. (defcustom bui-buffer-name nil
  344. "Default name of a buffer for displaying entries.
  345. May be nil, a string or a function returning a string. The
  346. function is called with the same arguments as the function used
  347. to get entries. If nil, the name is defined automatically."
  348. :type '(choice string function (const nil))
  349. :group 'bui)
  350. (put 'bui-buffer-name 'permanent-local t)
  351. (defcustom bui-revert-confirm t
  352. "If non-nil, ask to confirm for reverting the buffer."
  353. :type 'boolean
  354. :group 'bui)
  355. (put 'bui-revert-confirm 'permanent-local t)
  356. ;;; Overriding variables
  357. (defconst bui-entry-symbol-specifications
  358. '((:true-string true-string t)
  359. (:false-string false-string t)
  360. (:empty-string empty-string t)
  361. (:list-separator list-separator t)
  362. (:time-format time-format t)
  363. (:filter-predicates filter-predicates t)
  364. (:boolean-params boolean-params))
  365. "Specifications for generating entry variables.
  366. See `bui-symbol-specifications' for details.")
  367. (defconst bui-symbol-specifications
  368. '((:get-entries-function get-entries-function)
  369. (:show-entries-function show-entries-function)
  370. (:mode-init-function mode-initialize-function)
  371. (:message-function message-function)
  372. (:buffer-name buffer-name t)
  373. (:titles titles always)
  374. (:hint hint)
  375. (:history-size history-size t)
  376. (:revert-confirm? revert-confirm t))
  377. "Specifications for generating interface variables.
  378. Each specification has the following form:
  379. (KEYWORD SYMBOL-SUFFIX [GENERATE])
  380. KEYWORD is what can be specified in `bui-define-interface' macro.
  381. SYMBOL-SUFFIX defines the name of a generated variable (it is
  382. prefixed with ENTRY-TYPE-BUFFER-TYPE).
  383. If GENERATE is nil, generate the variable only if a keyword/value
  384. pair is specified in the macro. If it is t, generate the
  385. variable, unless the defined interface is reduced. If it is a
  386. symbol `always', generate the variable even for the reduced
  387. interface.")
  388. (defalias 'bui-symbol-specification-keyword #'cl-first
  389. "Return keyword from symbol specification.")
  390. (defalias 'bui-symbol-specification-suffix #'cl-second
  391. "Return symbol suffix from symbol specification.")
  392. (defalias 'bui-symbol-specification-generate #'cl-third
  393. "Return 'generate' value from symbol specification.")
  394. (defun bui-symbol-generate? (generate &optional reduced?)
  395. "Return non-nil if a symbol should be generated.
  396. See `bui-symbol-specifications' for the meaning of GENERATE.
  397. If REDUCED? is non-nil, it means a reduced interface should be defined."
  398. (or (eq generate 'always)
  399. (and generate (not reduced?))))
  400. (defun bui-map-symbol-specifications (function specifications)
  401. "Map through SPECIFICATIONS using FUNCTION.
  402. SPECIFICATIONS should have a form of `bui-symbol-specifications'."
  403. (mapcar (lambda (spec)
  404. (funcall function
  405. (bui-symbol-specification-keyword spec)
  406. (bui-symbol-specification-suffix spec)
  407. (bui-symbol-specification-generate spec)))
  408. specifications))
  409. (defun bui-set-local-variable-maybe (symbol value)
  410. "Set SYMBOL's value to VALUE if SYMBOL is bound and VALUE is non-nil."
  411. (when (and value (boundp symbol))
  412. (set (make-local-variable symbol) value)))
  413. (defun bui-set-local-variables (entry-type buffer-type)
  414. "Set BUI variables according to ENTRY-TYPE/BUFFER-TYPE variables."
  415. ;; General variables.
  416. (dolist (suffix (mapcar #'bui-symbol-specification-suffix
  417. (append bui-entry-symbol-specifications
  418. bui-symbol-specifications)))
  419. (bui-set-local-variable-maybe
  420. (bui-make-symbol 'bui suffix)
  421. (bui-symbol-value entry-type buffer-type suffix)))
  422. ;; Variables specific to BUFFER-TYPE.
  423. (dolist (suffix (mapcar #'bui-symbol-specification-suffix
  424. (symbol-value
  425. (bui-symbol-if-bound
  426. (bui-make-symbol
  427. 'bui buffer-type 'symbol-specifications)))))
  428. (bui-set-local-variable-maybe
  429. (bui-make-symbol 'bui buffer-type suffix)
  430. (bui-symbol-value entry-type buffer-type suffix))))
  431. ;;; Wrappers for defined variables
  432. (defalias 'bui-entry-symbol #'bui-make-symbol)
  433. (defalias 'bui-symbol #'bui-make-symbol)
  434. (defun bui-entry-symbol-value (entry-type symbol)
  435. "Return SYMBOL's value for ENTRY-TYPE."
  436. (symbol-value
  437. (bui-symbol-if-bound (bui-entry-symbol entry-type symbol))))
  438. (defun bui-symbol-value (entry-type buffer-type symbol)
  439. "Return SYMBOL's value for ENTRY-TYPE/BUFFER-TYPE."
  440. (or (symbol-value (bui-symbol-if-bound
  441. (bui-symbol entry-type buffer-type symbol)))
  442. (bui-entry-symbol-value entry-type symbol)))
  443. (defun bui-get-entries (entry-type buffer-type &optional args)
  444. "Return ENTRY-TYPE entries.
  445. Call an appropriate 'get-entries' function using ARGS as its arguments."
  446. (apply (bui-symbol-value entry-type buffer-type 'get-entries-function)
  447. args))
  448. (defun bui-mode-enable (entry-type buffer-type)
  449. "Turn on major mode to display ENTRY-TYPE ENTRIES in BUFFER-TYPE buffer."
  450. (funcall (bui-symbol entry-type buffer-type 'mode)))
  451. (define-obsolete-function-alias 'bui-mode-initialize-default
  452. 'ignore "1.1.0")
  453. (defun bui-mode-initialize (_entry-type _buffer-type)
  454. "Set up the current BUI buffer."
  455. (setq-local revert-buffer-function 'bui-revert)
  456. (when bui-mode-initialize-function
  457. (funcall bui-mode-initialize-function)))
  458. (defun bui-insert-entries (entries entry-type buffer-type)
  459. "Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer."
  460. (funcall (bui-make-symbol 'bui buffer-type 'insert-entries)
  461. entries entry-type))
  462. (defun bui-show-entries-default (entries entry-type buffer-type)
  463. "Default function to show ENTRY-TYPE ENTRIES in the BUFFER-TYPE buffer."
  464. (let ((inhibit-read-only t))
  465. (erase-buffer)
  466. (bui-mode-enable entry-type buffer-type)
  467. (let ((filtered-entries (apply #'bui-filter
  468. entries bui-active-filter-predicates)))
  469. (if filtered-entries
  470. (bui-insert-entries filtered-entries entry-type buffer-type)
  471. (when entries
  472. (message (substitute-command-keys
  473. "Everything is filtered out :-)
  474. Use '\\[bui-disable-filters]' to remove filters")))))
  475. (goto-char (point-min))))
  476. (defun bui-show-entries (entries entry-type buffer-type)
  477. "Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer."
  478. (--if-let (bui-symbol-value entry-type buffer-type
  479. 'show-entries-function)
  480. (funcall it entries)
  481. (bui-show-entries-default entries entry-type buffer-type)))
  482. (defun bui-message (entries entry-type buffer-type &optional args)
  483. "Display a message for BUFFER-ITEM after showing entries."
  484. (--when-let (bui-symbol-value entry-type buffer-type
  485. 'message-function)
  486. (apply it entries args)))
  487. (defun bui-buffer-name (entry-type buffer-type &optional args)
  488. "Return name of BUFFER-TYPE buffer for displaying ENTRY-TYPE entries."
  489. (let ((val (bui-symbol-value entry-type buffer-type 'buffer-name)))
  490. (cond
  491. ((stringp val)
  492. val)
  493. ((functionp val)
  494. (apply val args))
  495. (t
  496. (concat "*"
  497. (capitalize (symbol-name entry-type))
  498. " "
  499. (capitalize (symbol-name buffer-type))
  500. "*")))))
  501. (defun bui-param-title (entry-type buffer-type param)
  502. "Return PARAM title for ENTRY-TYPE/BUFFER-TYPE."
  503. (or (bui-assq-value (bui-symbol-value entry-type buffer-type 'titles)
  504. param)
  505. (bui-assq-value (bui-entry-symbol-value entry-type 'titles)
  506. param)
  507. (bui-symbol-title param)))
  508. (defun bui-current-param-title (param)
  509. "Return PARAM title for the current ENTRY-TYPE/BUFFER-TYPE."
  510. (bui-param-title (bui-current-entry-type)
  511. (bui-current-buffer-type)
  512. param))
  513. (defun bui-boolean-param? (entry-type buffer-type param)
  514. "Return non-nil if PARAM for ENTRY-TYPE/BUFFER-TYPE is boolean."
  515. (memq param (bui-symbol-value entry-type buffer-type 'boolean-params)))
  516. (defun bui-current-params ()
  517. "Return parameter names of the current buffer."
  518. (mapcar #'car
  519. (bui-symbol-value (bui-current-entry-type)
  520. (bui-current-buffer-type)
  521. 'format)))
  522. ;;; Displaying entries
  523. (defun bui-display (buffer)
  524. "Switch to a BUI BUFFER."
  525. (pop-to-buffer buffer
  526. '((display-buffer-reuse-window
  527. display-buffer-same-window))))
  528. (defun bui-history-item (buffer-item)
  529. "Make and return a history item for displaying BUFFER-ITEM."
  530. (list #'bui-set buffer-item 'no))
  531. (defun bui-set (buffer-item &optional history)
  532. "Set up the current buffer for displaying BUFFER-ITEM.
  533. HISTORY should be one of the following:
  534. `nil' or `add' - add it to history,
  535. `no' - do not save BUFFER-ITEM in history,
  536. `replace' - replace the current history item."
  537. (bui-with-item buffer-item
  538. (when %entries
  539. ;; At first, set buffer item so that its value can be used by the
  540. ;; code for displaying entries.
  541. (setq bui-item buffer-item)
  542. (bui-set-local-variables %entry-type %buffer-type)
  543. ;; History should be set after setting local variables (after
  544. ;; setting `bui-history-size'), but before showing entries (before
  545. ;; inserting history buttons).
  546. (unless (eq history 'no)
  547. (funcall (cl-ecase history
  548. ((nil add) #'bui-history-add)
  549. (replace #'bui-history-replace))
  550. (bui-history-item buffer-item)))
  551. (bui-show-entries %entries %entry-type %buffer-type))
  552. (bui-message %entries %entry-type %buffer-type %args)))
  553. (defun bui-display-entries-current (entries entry-type buffer-type
  554. &optional args history)
  555. "Show ENTRIES in the current BUI buffer.
  556. See `bui-item' for the meaning of BUFFER-TYPE, ENTRY-TYPE
  557. and ARGS, and `bui-set' for the meaning of HISTORY."
  558. (bui-set (bui-make-item entries entry-type buffer-type args)
  559. history))
  560. (defun bui-get-display-entries-current (entry-type buffer-type
  561. &optional args history)
  562. "Search for entries and show them in the current BUI buffer.
  563. See `bui-display-entries-current' for details."
  564. (bui-display-entries-current
  565. (bui-get-entries entry-type buffer-type args)
  566. entry-type buffer-type args history))
  567. (defun bui-display-entries (entries entry-type buffer-type
  568. &optional args history)
  569. "Show ENTRIES in a BUFFER-TYPE buffer.
  570. See `bui-display-entries-current' for details."
  571. (if entries
  572. (let ((buffer (get-buffer-create
  573. (bui-buffer-name entry-type buffer-type args))))
  574. (with-current-buffer buffer
  575. (bui-display-entries-current
  576. entries entry-type buffer-type args history))
  577. (bui-display buffer))
  578. (bui-message entries entry-type buffer-type args)))
  579. (defun bui-get-display-entries (entry-type buffer-type
  580. &optional args history)
  581. "Search for entries and show them in a BUFFER-TYPE buffer.
  582. See `bui-display-entries-current' for details."
  583. (bui-display-entries
  584. (bui-get-entries entry-type buffer-type args)
  585. entry-type buffer-type args history))
  586. (defun bui-revert (_ignore-auto noconfirm)
  587. "Update the data in the current BUI buffer.
  588. This function is suitable for `revert-buffer-function'.
  589. See `revert-buffer' for the meaning of NOCONFIRM."
  590. (bui-with-current-item
  591. (ignore %entries) ; to avoid compilation warning
  592. (when (or noconfirm
  593. (not bui-revert-confirm)
  594. (y-or-n-p "Update the current buffer? "))
  595. (bui-get-display-entries-current
  596. %entry-type %buffer-type %args 'replace))))
  597. (defvar bui-after-redisplay-hook nil
  598. "Hook run by `bui-redisplay'.
  599. This hook is called before setting up a window position.")
  600. (defun bui-redisplay ()
  601. "Redisplay the current BUI buffer.
  602. Restore the point and window positions after redisplaying.
  603. This function does not update the buffer data, use
  604. '\\[revert-buffer]' if you want the full update."
  605. (interactive)
  606. (let* ((old-point (point))
  607. ;; For simplicity, ignore an unlikely case when multiple
  608. ;; windows display the same buffer.
  609. (window (car (get-buffer-window-list (current-buffer) nil t)))
  610. (window-start (and window (window-start window))))
  611. (bui-set bui-item 'no)
  612. (goto-char old-point)
  613. (run-hooks 'bui-after-redisplay-hook)
  614. (when window
  615. (set-window-point window (point))
  616. (set-window-start window window-start))))
  617. (defun bui-redisplay-goto-button ()
  618. "Redisplay the current buffer and go to the next button, if needed."
  619. (let ((bui-after-redisplay-hook
  620. (cons (lambda ()
  621. (unless (button-at (point))
  622. (forward-button 1)))
  623. bui-after-redisplay-hook)))
  624. (bui-redisplay)))
  625. ;; Interfaces
  626. (defvar bui-interfaces nil
  627. "List of defined interfaces.")
  628. (defalias 'bui-interface-id #'bui-make-symbol
  629. "Return some kind of identifier for ENTRY-TYPE/BUFFER-TYPE interface.")
  630. (defun bui-interface-defined? (entry-type buffer-type)
  631. "Return non-nil if ENTRY-TYPE/BUFFER-TYPE interface is defined."
  632. (member (bui-interface-id entry-type buffer-type)
  633. bui-interfaces))
  634. (defun bui-register-interface (entry-type buffer-type)
  635. "Add new ENTRY-TYPE/BUFFER-TYPE interface to `bui-interfaces'."
  636. (cl-pushnew (bui-interface-id entry-type buffer-type)
  637. bui-interfaces))
  638. (provide 'bui-core)
  639. ;;; bui-core.el ends here