about summary refs log tree commit diff stats
path: root/lisp/def.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/def.el')
-rw-r--r--lisp/def.el142
1 files changed, 0 insertions, 142 deletions
diff --git a/lisp/def.el b/lisp/def.el deleted file mode 100644 index 0bf91b2..0000000 --- a/lisp/def.el +++ /dev/null
@@ -1,142 +0,0 @@
1;;; def.el --- defining macros -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'cl-lib)
6
7;;; Utility
8
9(defun def--assert-args (pred args &optional error-type &rest error-args)
10 "Assert that ARGS follows PRED.
11If it doesn't, raise an error. ERROR-TYPE will be the type of
12that error (defaults to `user-error'), and it and ERROR-ARGS are
13passed in a list to `signal'."
14 (unless (funcall pred args)
15 (funcall #'signal
16 (or error-type 'user-error)
17 (or error-args
18 (list "Wrong arguments" args)))))
19
20(defmacro o (&rest fns)
21 "Compose FNS into a new function for one argument."
22 (if (null fns)
23 `(lambda (&rest args) args)
24 `(lambda (&rest args)
25 (apply
26 #',(car fns)
27 (ensure-list (apply (o ,@(cdr fns)) args))))))
28
29;; TODO: I need to figure out where this function goes.
30(defun def--delete2 (list &rest elems)
31 "Delete each element of ELEMS, and the next item, from LIST."
32 (let ((r nil))
33 (while (consp list)
34 (if (member (car list) elems)
35 (setf list (cdr list))
36 (setf r (cons (car list) r)))
37 (setf list (cdr list)))
38 (reverse r)))
39
40;;; Keybindings
41
42(defmacro defkeys (maps &rest bindings)
43 "Define key BINDINGS in MAPS.
44If MAPS is nil or t, bind to `current-global-map'. Otherwise,
45bind each of BINDINGS to the map or list of maps provided.
46
47BINDINGS is a `setq'-style list of pairs of keys and definitions.
48The key part of each binding can be a string, in which case it's
49passed to `kbd', or a vector or anything else `define-key'
50accepts in the KEY position. The definition part, likewise, can
51be any form `define-key' accepts in that position, with this
52addition: if the form is a `defun' form, it will be defined
53before any keys are bound."
54 (declare (indent 1))
55 (def--assert-args (o cl-evenp length) bindings
56 'wrong-number-of-arguments 'defkeys 'evenp (length bindings))
57 `(progn
58 ,@(cl-loop
59 for map in (ensure-list maps)
60 for first-map-p = t then nil
61 append
62 (cl-loop
63 for (keys def) on bindings by #'cddr
64 for defp = (memq (car-safe def) '(defmap defun defmacro))
65 if (and defp first-map-p) collect def into defuns
66 append
67 (cl-loop
68 for key in (ensure-list keys)
69 collect (list 'define-key
70 (if (memq map '(t nil))
71 '(current-global-map)
72 (or (car-safe map) map))
73 (if (stringp key)
74 `(kbd ,key)
75 key)
76 (if defp
77 (cl-case (car def)
78 ((defmap) (cadr def))
79 ((defun defmacro) `#',(cadr def))
80 (otherwise (error "Bad def type: %S"
81 (car def))))
82 def)))
83 into keydefs
84 finally return
85 (let ((all (append defuns keydefs)))
86 (if-let ((after (plist-get (cdr-safe map) :after)))
87 `((eval-after ,after
88 ,@all))
89 all))))))
90
91(defmacro defmap (name docstring &rest bindings)
92 "Define a keymap named NAME, with BINDINGS."
93 (declare (indent 1) (doc-string 2))
94 `(,(if (boundp name) 'setq 'defvar) ,name
95 ;;; ^ probably a terrible hack
96 (let ((map (make-sparse-keymap)))
97 (defkeys map ,@bindings)
98 map)
99 ,@(unless (boundp name) (list docstring))))
100
101;;; Hooks
102
103(defmacro defhook (hooks &rest body)
104 "Define a function to hook into HOOKS.
105NAME and ARGS are passed to the generated `defun' form.
106Each hook in HOOKS can be the name of a hook or a list of the form
107(HOOK DEPTH LOCAL), where each argument is the same as in
108`add-hook'."
109 (declare (indent 1))
110 (let* ((name (or (plist-get body :name)
111 (intern (format "%s/h"
112 (mapconcat
113 (lambda (h)
114 (string-remove-suffix
115 "-hook" (symbol-name (or (car-safe h)
116 h))))
117 (ensure-list hooks)
118 "|")))))
119 (args (or (plist-get body :args) nil))
120 (doc (or (plist-get body :doc) nil))
121 (forms ; (DEFUN . FUNCS)
122 (cl-loop for form in (def--delete2 body :name :args :doc)
123 if (eq (car form) 'function)
124 collect form into funcs
125 else collect form into defuns
126 finally return (cons defuns funcs)))
127 (defun-forms (car forms))
128 (func-forms (cdr forms)))
129 `(progn
130 ,@(when defun-forms
131 `((defun ,name ,args ,@(when doc (list doc)) ,@defun-forms)))
132 ,@(cl-loop for hook in (ensure-list hooks)
133 for h = (or (car-safe hook) hook)
134 for ha = (cdr-safe hook)
135 if defun-forms
136 collect `(add-hook ',h #',name ,@ha)
137 append
138 (cl-loop for fn in func-forms
139 collect `(add-hook ',h ,fn ,@ha))))))
140
141(provide 'def)
142;;; def.el ends here