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