:type 'boolean)
(defcustom hydra-verbose nil
- "When non-nil, hydra will issue some non-essential style warnings."
+ "When non-nil, hydra will issue some non essential style warnings."
:type 'boolean)
-(defcustom hydra-key-format-spec "% 3s"
+(defcustom hydra-key-format-spec "%s"
"Default `format'-style specifier for _a_ syntax in docstrings.
When nil, you can specify your own at each location like this: _ 5a_.")
(interactive "P")
(let ((universal-argument-map hydra-curr-map))
(negative-argument arg)))
+;;* Repeat
+(defvar hydra-repeat--prefix-arg nil
+ "Prefix arg to use with `hydra-repeat'.")
+
+(defvar hydra-repeat--command nil
+ "Command to use with `hydra-repeat'.")
+
+(defun hydra-repeat ()
+ "Repeat last command with last prefix arg."
+ (interactive)
+ (unless (string-match "hydra-repeat$" (symbol-name last-command))
+ (setq hydra-repeat--command last-command)
+ (setq hydra-repeat--prefix-arg (or last-prefix-arg 1)))
+ (setq current-prefix-arg hydra-repeat--prefix-arg)
+ (funcall hydra-repeat--command))
;;* Misc internals
(defvar hydra-last nil
offset)
(while (setq start
(string-match
- "\\(?:%\\( ?-?[0-9]*\\)\\(`[a-z-A-Z/0-9]+\\|(\\)\\)\\|\\(?:_\\( ?-?[0-9]*\\)\\([a-z-~A-Z0-9/]+\\)_\\)"
+ "\\(?:%\\( ?-?[0-9]*\\)\\(`[a-z-A-Z/0-9]+\\|(\\)\\)\\|\\(?:_\\( ?-?[0-9]*\\)\\([a-z-~A-Z0-9/|?<>={}]+\\)_\\)"
docstring start))
(cond ((eq ?_ (aref (match-string 0 docstring) 0))
(let* ((key (match-string 4 docstring))
(concat "lambda-" (car h))))))
(defun hydra--delete-duplicates (heads)
- "Delete heads calling the same thing from HEADS."
- (let (lst res)
- (mapc (lambda (h)
- (unless (member (cadr h) lst)
- (push h res))
- (push (cadr h) lst))
- heads)
+ "Return HEADS without entries that have the same CMD part.
+In duplicate HEADS, :cmd-name is modified to whatever they duplicate."
+ (let ((ali '(((hydra-repeat . red) . hydra-repeat)))
+ res entry)
+ (dolist (h heads)
+ (if (setq entry (assoc (cons (cadr h)
+ (hydra--head-color h '(nil nil)))
+ ali))
+ (setf (cl-cdddr h) (plist-put (cl-cdddr h) :cmd-name (cdr entry)))
+ (push (cons (cons (cadr h)
+ (hydra--head-color h '(nil nil)))
+ (plist-get (cl-cdddr h) :cmd-name))
+ ali)
+ (push h res)))
+ (nreverse res)))
+
+(defun hydra--pad (lst n)
+ "Pad LST with nil until length N."
+ (let ((len (length lst)))
+ (if (= len n)
+ lst
+ (append lst (make-list (- n len) nil)))))
+
+(defun hydra--matrix (lst rows cols)
+ "Create a matrix from elements of LST.
+The matrix size is ROWS times COLS."
+ (let ((ls (copy-sequence lst))
+ res)
+ (dotimes (c cols)
+ (push (hydra--pad (hydra-multipop ls rows) rows) res))
(nreverse res)))
+(defun hydra--cell (fstr names)
+ "Format a rectangular cell based on FSTR and NAMES.
+FSTR is a format-style string with two string inputs: one for the
+doc and one for the symbol name.
+NAMES is a list of variables."
+ (let ((len (cl-reduce
+ (lambda (acc it) (max (length (symbol-name it)) acc))
+ names
+ :initial-value 0)))
+ (mapconcat
+ (lambda (sym)
+ (if sym
+ (format fstr
+ (documentation-property sym 'variable-documentation)
+ (let ((name (symbol-name sym)))
+ (concat name (make-string (- len (length name)) ?^)))
+ sym)
+ ""))
+ names
+ "\n")))
+
+(defun hydra--vconcat (strs &optional joiner)
+ "Glue STRS vertically. They must be the same height.
+JOINER is a function similar to `concat'."
+ (setq joiner (or joiner #'concat))
+ (mapconcat
+ (lambda (s)
+ (if (string-match " +$" s)
+ (replace-match "" nil nil s)
+ s))
+ (apply #'cl-mapcar joiner
+ (mapcar
+ (lambda (s) (split-string s "\n"))
+ strs))
+ "\n"))
+
+(defcustom hydra-cell-format "% -20s %% -8`%s"
+ "The default format for docstring cells."
+ :type 'string)
+
+(defun hydra--table (names rows cols &optional cell-formats)
+ "Format a `format'-style table from variables in NAMES.
+The size of the table is ROWS times COLS.
+CELL-FORMATS are `format' strings for each column.
+If CELL-FORMATS is a string, it's used for all columns.
+If CELL-FORMATS is nil, `hydra-cell-format' is used for all columns."
+ (setq cell-formats
+ (cond ((null cell-formats)
+ (make-list cols hydra-cell-format))
+ ((stringp cell-formats)
+ (make-list cols cell-formats))
+ (t
+ cell-formats)))
+ (hydra--vconcat
+ (cl-mapcar
+ #'hydra--cell
+ cell-formats
+ (hydra--matrix names rows cols))
+ (lambda (&rest x)
+ (mapconcat #'identity x " "))))
+
+(defun hydra-reset-radios (names)
+ "Set varibles NAMES to their defaults.
+NAMES should be defined by `defhydradio' or similar."
+ (dolist (n names)
+ (set n (aref (get n 'range) 0))))
+
;;* Macros
;;** defhydra
;;;###autoload
generated NAME/body command. This command is also the return
result of `defhydra'."
(declare (indent defun))
- (unless (stringp docstring)
- (setq heads (cons docstring heads))
- (setq docstring "hydra"))
+ (cond ((stringp docstring))
+ ((and (consp docstring)
+ (memq (car docstring) '(hydra--table concat format)))
+ (setq docstring (concat "\n" (eval docstring))))
+ (t
+ (setq heads (cons docstring heads))
+ (setq docstring "hydra")))
(when (keywordp (car body))
(setq body (cons nil (cons nil body))))
(dolist (h heads)
- (cond ((< (length h) 2)
- (error "Each head should have at least two items: %S" h))
- ((= (length h) 2)
- (setcdr (cdr h) '("")))
- ((or (null (cl-caddr h))
- (stringp (cl-caddr h))))
- (t
- (setcdr (cdr h) (cons "" (cddr h))))))
+ (let ((len (length h))
+ (cmd-name (hydra--head-name h name)))
+ (cond ((< len 2)
+ (error "Each head should have at least two items: %S" h))
+ ((= len 2)
+ (setcdr (cdr h) `("" :cmd-name ,cmd-name)))
+ (t
+ (let ((hint (cl-caddr h)))
+ (unless (or (null hint)
+ (stringp hint))
+ (setcdr (cdr h) (cons "" (cddr h))))
+ (setcdr (cddr h) `(:cmd-name ,cmd-name ,@(cl-cdddr h))))))))
(let* ((keymap (copy-keymap hydra-base-map))
(body-name (intern (format "%S/body" name)))
(body-key (unless (hydra--callablep body)
(body-post (plist-get (cddr body) :post))
(method (or (plist-get body :bind)
(car body)))
- (doc (hydra--doc body-key body-name heads)))
+ (doc (hydra--doc body-key body-name heads))
+ (heads-nodup (hydra--delete-duplicates heads)))
(mapc
(lambda (x)
(define-key keymap (kbd (car x))
- (hydra--head-name x name)))
+ (plist-get (cl-cdddr x) :cmd-name)))
heads)
(when (and body-pre (symbolp body-pre))
(setq body-pre `(funcall #',body-pre)))
(lambda (head)
(hydra--make-defun name body doc head keymap
body-pre body-post))
- (hydra--delete-duplicates heads))
+ heads-nodup)
,@(unless (or (null body-key)
(null method)
(hydra--callablep method))
,@(delq nil
(cl-mapcar
(lambda (head)
- (let ((name (hydra--head-name head name)))
- (when (or body-key method)
- (let ((bind (hydra--head-property head :bind 'default))
- (final-key
- (if body-key
- (vconcat (kbd body-key) (kbd (car head)))
- (kbd (car head)))))
- (cond ((null bind) nil)
-
- ((eq bind 'default)
- (list
- (if (hydra--callablep method)
- 'funcall
- 'define-key)
- method
- final-key
- (list 'function name)))
-
- ((hydra--callablep bind)
- `(funcall (function ,bind)
- ,final-key
- (function ,name)))
-
- (t
- (error "Invalid :bind property %S" head)))))))
+ (let ((name (hydra--head-property head :cmd-name)))
+ (when (cadr head)
+ (when (or body-key method)
+ (let ((bind (hydra--head-property head :bind 'default))
+ (final-key
+ (if body-key
+ (vconcat (kbd body-key) (kbd (car head)))
+ (kbd (car head)))))
+ (cond ((null bind) nil)
+
+ ((eq bind 'default)
+ (list
+ (if (hydra--callablep method)
+ 'funcall
+ 'define-key)
+ method
+ final-key
+ (list 'function name)))
+
+ ((hydra--callablep bind)
+ `(funcall (function ,bind)
+ ,final-key
+ (function ,name)))
+
+ (t
+ (error "Invalid :bind property %S" head))))))))
heads))
(defun ,(intern (format "%S/hint" name)) ()
,(hydra--message name body docstring heads))
(mapcar (lambda (h)
(hydra--radio name h))
heads))
- (defun ,(intern (format "%S/reset-radios" name)) ()
- ,@(mapcar
- (lambda (h)
- (let ((full-name (intern (format "%S/%S" name (car h))))
- )
- `(setq ,full-name ,(hydra--quote-maybe
- (and (cadr h) (aref (cadr h) 0))))))
- heads))))
+ (defvar ,(intern (format "%S/names" name))
+ ',(mapcar (lambda (h) (intern (format "%S/%S" name (car h))))
+ heads))))
+
+(defmacro hydra-multipop (lst n)
+ "Return LST's first N elements while removing them."
+ `(if (<= (length ,lst) ,n)
+ (prog1 ,lst
+ (setq ,lst nil))
+ (prog1 ,lst
+ (setcdr
+ (nthcdr (1- ,n) (prog1 ,lst (setq ,lst (nthcdr ,n ,lst))))
+ nil))))
(defun hydra--radio (parent head)
"Generate a hydradio with PARENT from HEAD."
(let* ((name (car head))
(full-name (intern (format "%S/%S" parent name)))
- (val (or (cadr head) [nil t]))
- (doc (or (cl-caddr head)
- (mapconcat #'capitalize
- (split-string (symbol-name name) "-")
- " "))))
+ (doc (cadr head))
+ (val (or (cl-caddr head) [nil t])))
`((defvar ,full-name ,(hydra--quote-maybe (aref val 0)) ,doc)
(put ',full-name 'range ,val)
(defun ,full-name ()