branch: externals/taxy
commit ad1cea3383dd1d4aa38b5e47a212f882cc8d7eb3
Author: Adam Porter <a...@alphapapa.net>
Commit: Adam Porter <a...@alphapapa.net>
Examples: Add elispy.el
---
examples/elispy.el | 244 ++++++++++++++++++++++++++++++++++++++++++++++++++
taxy-magit-section.el | 4 +-
taxy.el | 5 +-
3 files changed, 249 insertions(+), 4 deletions(-)
diff --git a/examples/elispy.el b/examples/elispy.el
new file mode 100644
index 0000000..704f82c
--- /dev/null
+++ b/examples/elispy.el
@@ -0,0 +1,244 @@
+;;; elispy.el --- Show symbols defined in an Elisp project -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Author: Adam Porter <a...@alphapapa.net>
+;; Keywords: convenience, lisp
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'taxy-magit-section)
+
+(defgroup elispy nil
+ "Show an overview of symbols defined in an Emacs Lisp project."
+ :group 'emacs-lisp-mode)
+
+;;;; Keys
+
+(taxy-define-key-definer elispy-define-key elispy-keys "elispy"
+ "FIXME: Docstring.")
+
+(elispy-define-key file ()
+ (file-relative-name (plist-get item :file) elispy-directory))
+
+(elispy-define-key type ()
+ (let* ((form (plist-get item :form))
+ (type (pcase form
+ (`(,(or 'defun 'cl-defun) . ,_)
+ (if (cl-find-if (lambda (form)
+ (pcase form
+ (`(interactive . ,_) t)))
+ form)
+ 'command
+ 'function))
+ (`(,(or 'defmacro 'cl-defmacro) . ,_)
+ 'macro)
+ (`(,car . ,_) car))))
+ (when type
+ (format "%s" type))))
+
+(defvar elispy-taxy-default-keys
+ '(type file))
+
+;;;; Columns
+
+(taxy-magit-section-define-column-definer "elispy")
+
+(elispy-define-column "Definition" (:max-width 45 :face
font-lock-function-name-face)
+ (let ((form-defines (pcase-exhaustive (cadr (plist-get item :form))
+ ((and (pred atom) it) it)
+ (`(quote ,it) it)
+ (`(,it . ,_) it))))
+ (format "%s" form-defines)))
+
+(elispy-define-column "Type" (:max-width 25 :face font-lock-type-face)
+ (format "%s" (car (plist-get item :form))))
+
+(elispy-define-column "Docstring" (:max-width nil :face font-lock-doc-face)
+ (when-let ((docstring
+ (pcase (plist-get item :form)
+ (`(,(or 'defun 'cl-defun 'defmacro 'cl-defmacro) ,_name ,_args
+ ,(and (pred stringp) docstring) . ,_)
+ docstring)
+ (`(,(or 'defvar 'defvar-local 'defcustom) ,_name ,_value
+ ,(and (pred stringp) docstring) . ,_)
+ docstring)
+ (_ ;; Use the first string found, if any.
+ (cl-find-if #'stringp (plist-get item :form))))))
+ (replace-regexp-in-string "\n" " " docstring)))
+
+(unless elispy-columns
+ ;; TODO: Automate this or document it
+ (setq-default elispy-columns
+ (get 'elispy-columns 'standard-value)))
+
+;;;; Variables
+
+(defvar elispy-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "RET") #'elispy-RET)
+ (define-key map [mouse-1] #'elispy-mouse-1)
+ map))
+
+(defvar-local elispy-directory nil
+ "Directory relative to which filenames should be expanded.")
+
+(defvar-local elispy-files nil
+ "Files shown in the current Elispy buffer.")
+
+;;;; Commands
+
+(cl-defun elispy (&key (project (or (project-current)
+ (cons 'transient default-directory)))
+ (keys elispy-taxy-default-keys)
+ (files elispy-files)
+ (buffer-name (format "*Elispy: %s*"
+ (if files
+ (string-join (mapcar
#'file-relative-name files) ", ")
+ (file-name-nondirectory
+ (directory-file-name
(project-root project))))))
+ visibility-fn display-buffer-action)
+ "Show definitions defined in PROJECT or FILES.
+Interactively, with PREFIX, show only definitions in current
+buffer."
+ (interactive (list :files (when current-prefix-arg
+ (list (buffer-file-name)))
+ :keys (if current-prefix-arg
+ (remove 'file elispy-taxy-default-keys)
+ elispy-taxy-default-keys)))
+ (let (format-table column-sizes)
+ (cl-labels (;; (heading-face
+ ;; (depth) (list :inherit (list 'bufler-group
(bufler-level-face depth))))
+ (elisp-file-p (file) (string-match-p (rx ".el" (optional ".gz")
eos) file))
+ (file-visible-p (file) (not (string-match-p (rx bos ".") file)))
+ (format-item (item) (gethash item format-table))
+ (make-fn (&rest args)
+ (apply #'make-taxy-magit-section
+ :make #'make-fn
+ :format-fn #'format-item
+ :heading-indent elispy-taxy-level-indent
+ :visibility-fn visibility-fn
+ ;; :heading-face-fn #'heading-face
+ args))
+ (form-name
+ (form) (format "%s" (cl-second (plist-get form :form)))))
+ (when (get-buffer buffer-name)
+ (kill-buffer buffer-name))
+ (with-current-buffer (get-buffer-create buffer-name)
+ (elispy-mode)
+ (setq-local elispy-taxy-default-keys keys
+ elispy-directory (project-root project)
+ elispy-files files
+ default-directory elispy-directory)
+ (setf files (cl-reduce #'cl-remove-if-not (list #'elisp-file-p
#'file-visible-p)
+ :initial-value (or files (project-files project))
+ :from-end t))
+ (cl-assert files nil "No files to show")
+ (let* ((forms (apply #'append (mapcar #'elispy--file-forms files)))
+ (taxy (thread-last
+ (make-fn
+ :name "Elispy"
+ :description (format "Definitions in %s:"
+ (if files
+ (string-join (mapcar
#'file-relative-name files) ", ")
+ (file-name-nondirectory
+ (directory-file-name
(project-root project)))))
+ :take (taxy-make-take-function keys elispy-keys))
+ (taxy-fill forms)
+ (taxy-sort* #'string< #'taxy-name)
+ (taxy-sort #'string< #'form-name)))
+ (taxy-magit-section-insert-indent-items nil)
+ format-cons)
+ (setf format-cons (taxy-magit-section-format-items
+ elispy-columns elispy-column-formatters taxy)
+ format-table (car format-cons)
+ column-sizes (cdr format-cons)
+ ;; NOTE: The first column is handled differently.
+ header-line-format (taxy-magit-section-format-header
column-sizes elispy-column-formatters))
+ (let ((inhibit-read-only t))
+ (save-excursion
+ (taxy-magit-section-insert taxy :items 'last
+ ;; :initial-depth bufler-taxy-initial-depth
+ ;; :blank-between-depth bufler-taxy-blank-between-depth
+ )))))
+ (pop-to-buffer buffer-name display-buffer-action))))
+
+(defun elispy-revert (_ignore-auto _noconfirm)
+ "Revert current Elispy buffer."
+ (interactive)
+ (elispy :display-buffer-action '((display-buffer-same-window))))
+
+(defun elispy-goto-form ()
+ "Go to form at point."
+ (interactive)
+ (pcase-let* (((map :file :pos) (oref (magit-current-section) value)))
+ (pop-to-buffer (or (find-buffer-visiting file)
+ (find-file-noselect file)))
+ (goto-char pos)
+ (backward-sexp 1)))
+
+(defun elispy-mouse-1 (event)
+ (interactive "e")
+ (mouse-set-point event)
+ (call-interactively #'elispy-RET))
+
+(defun elispy-RET ()
+ (interactive)
+ (cl-typecase (oref (magit-current-section) value)
+ (taxy-magit-section (call-interactively #'magit-section-cycle))
+ (null nil)
+ (t (call-interactively #'elispy-goto-form))))
+
+(define-derived-mode elispy-mode magit-section-mode "Elispy"
+ :global nil
+ (setq-local bookmark-make-record-function #'elispy--bookmark-make-record
+ revert-buffer-function #'elispy-revert))
+
+;;;; Functions
+
+(cl-defun elispy--file-forms (file)
+ "Return forms defined in FILE."
+ (with-temp-buffer
+ (save-excursion
+ (insert-file-contents file))
+ (cl-loop for form = (ignore-errors
+ (read (current-buffer)))
+ while form
+ when (listp form)
+ collect (list :file file :pos (point) :form form))))
+
+;;;;; Bookmark support
+
+(defvar bookmark-make-record-function)
+
+(defun elispy--bookmark-make-record ()
+ "Return a bookmark record for current Elispy buffer."
+ (list (concat "Elispy: %s" elispy-directory)
+ (cons 'directory elispy-directory)
+ (cons 'handler #'elispy--bookmark-handler)))
+
+(defun elispy--bookmark-handler (record)
+ "Show Elispy buffer for bookmark RECORD."
+ (pcase-let* ((`(,_ . ,(map directory)) record))
+ (elispy :project (project-current nil directory))
+ (current-buffer)))
+
+(provide 'elispy)
+;;; elispy.el ends here
diff --git a/taxy-magit-section.el b/taxy-magit-section.el
index e1c1cfe..4c05b31 100644
--- a/taxy-magit-section.el
+++ b/taxy-magit-section.el
@@ -197,10 +197,10 @@ PLIST may be a plist setting the following options:
`:max-width' defines a customization option for the column's
maximum width with the specified value as its default: an
integer limits the width, while nil does not."))
- (level-indent-variable-name (intern (format "%s-taxy-level-indent"
prefix)))
+ (level-indent-variable-name (intern (format "%s-level-indent" prefix)))
(level-indent-docstring (format "Indentation applied to each level of
depth for `%s' columns."
prefix))
- (item-indent-variable-name (intern (format "%s-taxy-item-indent"
prefix)))
+ (item-indent-variable-name (intern (format "%s-item-indent" prefix)))
(item-indent-docstring (format "Indentation applied to each item for
`%s' columns."
prefix))
(columns-variable-name (intern (format "%s-columns" prefix)))
diff --git a/taxy.el b/taxy.el
index 40b66e3..231fa27 100644
--- a/taxy.el
+++ b/taxy.el
@@ -300,8 +300,9 @@ item being tested, bound within the function to `item'."
(declare (indent defun)
(debug (&define symbolp listp &rest def-form)))
(let* ((fn-symbol (intern (format "%s-%s" ,prefix name)))
- (fn `(lambda (item ,@args)
- ,@body)))
+ (fn `(cl-function
+ (lambda (item ,@args)
+ ,@body))))
`(progn
(fset ',fn-symbol ,fn)
(setf (map-elt ,variable ',name) ',fn-symbol))))))
