;; Author: Oleh Krehel <ohwoeowho@gmail.com>
;; Maintainer: Oleh Krehel <ohwoeowho@gmail.com>
;; URL: https://github.com/abo-abo/hydra
-;; Version: 0.13.2
+;; Version: 0.13.4
;; Keywords: bindings
;; Package-Requires: ((cl-lib "0.5"))
"Disable the current Hydra."
(setq hydra-deactivate nil)
(remove-hook 'pre-command-hook 'hydra--clearfun)
+ (if (fboundp 'remove-function)
+ (remove-function input-method-function #'hydra--imf)
+ (when hydra--input-method-function
+ (setq input-method-function hydra--input-method-function)
+ (setq hydra--input-method-function nil)))
(dolist (frame (frame-list))
(with-selected-frame frame
(when overriding-terminal-local-map
- (internal-pop-keymap hydra-curr-map 'overriding-terminal-local-map)
- (unless hydra--ignore
- (if (fboundp 'remove-function)
- (remove-function input-method-function #'hydra--imf)
- (when hydra--input-method-function
- (setq input-method-function hydra--input-method-function)
- (setq hydra--input-method-function nil)))
- (when hydra-curr-on-exit
- (let ((on-exit hydra-curr-on-exit))
- (setq hydra-curr-on-exit nil)
- (funcall on-exit))))))))
+ (internal-pop-keymap hydra-curr-map 'overriding-terminal-local-map))))
+ (unless hydra--ignore
+ (when hydra-curr-on-exit
+ (let ((on-exit hydra-curr-on-exit))
+ (setq hydra-curr-on-exit nil)
+ (funcall on-exit)))))
(unless (fboundp 'internal-push-keymap)
(defun internal-push-keymap (keymap symbol)
(1 font-lock-keyword-face)
(2 font-lock-type-face)))))
+;;* Find Function
+(eval-after-load 'find-func
+ '(defadvice find-function-search-for-symbol
+ (around hydra-around-find-function-search-for-symbol-advice
+ (symbol type library) activate)
+ "Navigate to hydras with `find-function-search-for-symbol'."
+ ad-do-it
+ ;; The orignial function returns (cons (current-buffer) (point))
+ ;; if it found the point.
+ (unless (cdr ad-return-value)
+ (with-current-buffer (find-file-noselect library)
+ (let ((sn (symbol-name symbol)))
+ (when (and (null type)
+ (string-match "\\`\\(hydra-[a-z-A-Z0-9]+\\)/\\(.*\\)\\'" sn)
+ (re-search-forward (concat "(defhydra " (match-string 1 sn))
+ nil t))
+ (goto-char (match-beginning 0)))
+ (cons (current-buffer) (point)))))))
+
;;* Universal Argument
(defvar hydra-base-map
(let ((map (make-sparse-keymap)))
"Generate a callable symbol from X.
If X is a function symbol or a lambda, return it. Otherwise, it
should be a single statement. Wrap it in an interactive lambda."
- (if (or (symbolp x) (functionp x))
- x
- `(lambda ()
- (interactive)
- ,x)))
+ (cond ((or (symbolp x) (functionp x))
+ x)
+ ((and (consp x) (eq (car x) 'function))
+ (cadr x))
+ (t
+ `(lambda ()
+ (interactive)
+ ,x))))
(defun hydra-plist-get-default (plist prop default)
"Extract a value from a property list.
(format (format "%%%ds: %%%ds" key-width (- -1 doc-width))
key doc))
+(defun hydra--to-string (x)
+ (if (stringp x)
+ x
+ (eval x)))
+
(defun hydra--hint (body heads)
"Generate a hint for the echo area.
BODY, and HEADS are parameters to `defhydra'."
(cons (cadr h)
(cons pstr (cl-caddr h)))
alist)))))
-
(let ((keys (nreverse (mapcar #'cdr alist)))
- (n-cols (plist-get (cddr body) :columns)))
- (if n-cols
- (let ((n-rows (1+ (/ (length keys) n-cols)))
- (max-key-len (apply #'max (mapcar (lambda (x) (length (car x))) keys)))
- (max-doc-len (apply #'max (mapcar (lambda (x) (length (cdr x))) keys))))
- (concat
- "\n"
- (mapconcat #'identity
- (mapcar
- (lambda (x)
- (mapconcat
- (lambda (y)
- (and y
- (funcall hydra-key-doc-function
- (car y)
- max-key-len
- (cdr y)
- max-doc-len))) x ""))
- (hydra--matrix keys n-cols n-rows))
- "\n")))
-
-
- (concat
- (mapconcat
- (lambda (x)
- (format
- (if (> (length (cdr x)) 0)
- (concat hydra-head-format (cdr x))
- "%s")
- (car x)))
- keys
- ", ")
- (if keys "." ""))))))
+ (n-cols (plist-get (cddr body) :columns))
+ res)
+ (setq res
+ (if n-cols
+ (let ((n-rows (1+ (/ (length keys) n-cols)))
+ (max-key-len (apply #'max (mapcar (lambda (x) (length (car x))) keys)))
+ (max-doc-len (apply #'max (mapcar (lambda (x)
+ (length (hydra--to-string (cdr x)))) keys))))
+ `(concat
+ "\n"
+ (mapconcat #'identity
+ (mapcar
+ (lambda (x)
+ (mapconcat
+ (lambda (y)
+ (and y
+ (funcall hydra-key-doc-function
+ (car y)
+ ,max-key-len
+ (hydra--to-string (cdr y))
+ ,max-doc-len))) x ""))
+ ',(hydra--matrix keys n-cols n-rows))
+ "\n")))
+
+
+ `(concat
+ (mapconcat
+ (lambda (x)
+ (let ((str (hydra--to-string (cdr x))))
+ (format
+ (if (> (length str) 0)
+ (concat hydra-head-format str)
+ "%s")
+ (car x))))
+ ',keys
+ ", ")
+ ,(if keys "." ""))))
+ (if (cl-every #'stringp
+ (mapcar 'cddr alist))
+ (eval res)
+ res))))
(defvar hydra-fontify-head-function nil
"Possible replacement for `hydra-fontify-head-default'.")
_NAME, BODY, DOCSTRING and HEADS are parameters of `defhydra'.
The expressions can be auto-expanded according to NAME."
(setq docstring (hydra--strip-align-markers docstring))
+ (setq docstring (replace-regexp-in-string "___" "_β_" docstring))
(let ((rest (hydra--hint body heads))
(start 0)
varlist
offset)
(while (setq start
(string-match
- "\\(?:%\\( ?-?[0-9]*s?\\)\\(`[a-z-A-Z/0-9]+\\|(\\)\\)\\|\\(?:_\\( ?-?[0-9]*?\\)\\(\\[\\|]\\|[-[:alnum:] ~.,;:/|?<>={}*+#%]+?\\)_\\)"
+ "\\(?:%\\( ?-?[0-9]*s?\\)\\(`[a-z-A-Z/0-9]+\\|(\\)\\)\\|\\(?:_\\( ?-?[0-9]*?\\)\\(\\[\\|]\\|[-[:alnum:] ~.,;:/|?<>={}*+#%@!&]+?\\)_\\)"
docstring start))
(cond ((eq ?_ (aref (match-string 0 docstring) 0))
(let* ((key (match-string 4 docstring))
+ (key (if (equal key "β") "_" key))
(head (assoc key heads)))
(if head
(progn
(if (eq ?\n (aref docstring 0))
`(concat (format ,(substring docstring 1) ,@(nreverse varlist))
,rest)
- `(format ,(replace-regexp-in-string
+ (let ((r `(replace-regexp-in-string
" +$" ""
- (concat docstring ": "
+ (concat ,docstring ": "
(replace-regexp-in-string
- "\\(%\\)" "\\1\\1" rest)))))))
+ "\\(%\\)" "\\1\\1" ,rest)))))
+ (if (stringp rest)
+ `(format ,(eval r))
+ `(format ,r))))))
(defun hydra--complain (format-string &rest args)
"Forward to (`message' FORMAT-STRING ARGS) unless `hydra-verbose' is nil."
(defun hydra--head-name (h name)
"Return the symbol for head H of hydra with NAME."
(let ((str (format "%S/%s" name
- (if (symbolp (cadr h))
- (cadr h)
- (concat "lambda-" (car h))))))
+ (cond ((symbolp (cadr h))
+ (cadr h))
+ ((and (consp (cadr h))
+ (eq (cl-caadr h) 'function))
+ (cadr (cadr h)))
+ (t
+ (concat "lambda-" (car h)))))))
(when (and (hydra--head-property h :exit)
(not (memq (cadr h) '(body nil))))
(setq str (concat str "-and-exit")))
(t
(let ((hint (cl-caddr h)))
(unless (or (null hint)
- (stringp hint))
+ (stringp hint)
+ (stringp (eval hint)))
(setcdr (cdr h) (cons
(hydra-plist-get-default body-plist :hint "")
(cddr h)))))