diff options
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/acdw.el | 116 |
1 files changed, 114 insertions, 2 deletions
diff --git a/lisp/acdw.el b/lisp/acdw.el index 03e4a62..7f0145c 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el | |||
@@ -35,7 +35,7 @@ directory." | |||
35 | (let ((f (expand-file-name (convert-standard-filename file) | 35 | (let ((f (expand-file-name (convert-standard-filename file) |
36 | acdw/dir))) | 36 | acdw/dir))) |
37 | (when make-directory | 37 | (when make-directory |
38 | (make-directory (file-name-directory) 'parents)) | 38 | (make-directory (file-name-directory file) 'parents)) |
39 | f)) | 39 | f)) |
40 | 40 | ||
41 | ;;; Settings | 41 | ;;; Settings |
@@ -45,7 +45,7 @@ directory." | |||
45 | 45 | ||
46 | ASSIGNMENTS is a list where each element is of the form | 46 | ASSIGNMENTS is a list where each element is of the form |
47 | (VARIABLE VALUE [COMMENT])." | 47 | (VARIABLE VALUE [COMMENT])." |
48 | (dolist (assn assignments) | 48 | (dolist (assignment assignments) |
49 | (customize-set-variable (car assignment) | 49 | (customize-set-variable (car assignment) |
50 | (cadr assignment) | 50 | (cadr assignment) |
51 | (if (and (caddr assignment) | 51 | (if (and (caddr assignment) |
@@ -53,6 +53,118 @@ ASSIGNMENTS is a list where each element is of the form | |||
53 | (caddr assignment) | 53 | (caddr assignment) |
54 | "Customized by `acdw/set'.")))) | 54 | "Customized by `acdw/set'.")))) |
55 | 55 | ||
56 | ;;; Faces | ||
57 | |||
58 | (defun acdw/set-face (face spec) | ||
59 | "Customize FACE according to SPEC, and register it with `customize'. | ||
60 | SPEC is as for `defface'." | ||
61 | (put face 'customized-face spec) | ||
62 | (face-spec-set face spec)) | ||
63 | |||
64 | (defmacro acdw/set-faces (face-specs) | ||
65 | "Run `acdw/set-face' over each face in FACE-SPECS." | ||
66 | (let (face-list) | ||
67 | (dolist (face face-specs) | ||
68 | (push `(acdw/set-face ',(car face) ',(cdr face)) face-list)) | ||
69 | `(progn | ||
70 | ,@face-list))) | ||
71 | |||
72 | ;;; Hooks | ||
73 | |||
74 | ;; XXX NOT WORKING | ||
75 | (defmacro acdw/defun-hook (hook docstring &optional depth local &rest forms) | ||
76 | "Add FORMS to a function described by DOCSTRING, then add that | ||
77 | function to HOOK. DOCSTRING is converted to a function name by | ||
78 | calling `docstring-to-symbol', if it's a string, or used as-is | ||
79 | otherwise. The optional DEPTH and LOCAL are passed to | ||
80 | `add-hook', if they're present (i.e., not a list). | ||
81 | |||
82 | This macro aims to split the difference between the syntax of | ||
83 | lambdas in hooks and the ability to easily disable hooks." | ||
84 | (declare (indent 2)) | ||
85 | (let ((name (if (stringp docstring) | ||
86 | (docstring-to-symbol docstring "hook-") | ||
87 | docstring))) | ||
88 | (when (listp local) (push local forms) (setq local nil)) | ||
89 | (when (listp depth) (push depth forms) (setq depth 0)) | ||
90 | `(progn | ||
91 | (defun ,name () ,@forms) | ||
92 | (add-hook ,hook #',name ,depth ,local)))) | ||
93 | |||
94 | (defmacro acdw/hooks (hooks funcs &optional depth local) | ||
95 | "Add FUNCS to HOOKS. | ||
96 | |||
97 | Either HOOKS or FUNCS can be a list, in which case they're mapped | ||
98 | over to add all FUNCS to all HOOKS. They can also be singletons, | ||
99 | in which case `acdw/hooks' acts pretty much like `add-hook'. | ||
100 | |||
101 | DEPTH and LOCAL apply to all HOOKS defined here. If you need | ||
102 | more fine-grained control, just use `add-hook'." | ||
103 | (let ((hooks (if (listp hooks) hooks (list hooks))) | ||
104 | (funcs (if (listp funcs) funcs (list funcs))) | ||
105 | (depth (if depth depth 0)) | ||
106 | (hook-list)) | ||
107 | (dolist (hook hooks) | ||
108 | (dolist (func funcs) | ||
109 | (push `(add-hook ',hook #',func ,depth ,local) hook-list))) | ||
110 | `(progn | ||
111 | ,@hook-list))) | ||
112 | |||
113 | ;; Utilities | ||
114 | (defun docstring-to-symbol (docstring &optional prefix) | ||
115 | "Convert a DOCSTRING to a symbol by lowercasing the string, | ||
116 | converting non-symbol-safe characters to '-', and calling | ||
117 | `intern'. Returns the created symbol." | ||
118 | (let ((str (split-string (downcase docstring) "[ \f\t\n\r\v'\"`,]+" | ||
119 | :omit-nulls))) | ||
120 | (when prefix (push prefix str)) | ||
121 | (intern (mapconcat #'identity str "-")))) | ||
122 | |||
123 | ;;; Keybindings | ||
124 | |||
125 | (defvar acdw/bind-default-map 'acdw/map | ||
126 | "The default keymap to use with `acdw/bind'.") | ||
127 | |||
128 | (defmacro acdw/bind (key command &rest args) | ||
129 | "A simple key-binding macro to take care of the repetitive stuff | ||
130 | automatically. | ||
131 | |||
132 | If KEY is a vector, it's passed directly to `define-key', | ||
133 | otherwise it's wrapped in `read-kbd-macro'. | ||
134 | |||
135 | The following keywords are recognized: | ||
136 | |||
137 | :autoload ARGS .. call `autoload' on COMMAND using ARGS before | ||
138 | binding the key. ARGS can be just the filename to load; in | ||
139 | that case it's wrapped in a list. | ||
140 | :map KEYMAP .. define KEY in KEYMAP instead of the | ||
141 | default `acdw/bind-default-map'." | ||
142 | (let ((autoload (when-let (sym (plist-get args :autoload)) | ||
143 | (if (not (listp sym)) | ||
144 | (list sym) | ||
145 | sym))) | ||
146 | (keymap (or (plist-get args :map) acdw/bind-default-map)) | ||
147 | (keycode (if (vectorp key) key (kbd key))) | ||
148 | (command-list)) | ||
149 | (push `(define-key ,keymap ,keycode ,command) command-list) | ||
150 | (when autoload | ||
151 | (push `(autoload ,command ,@autoload) command-list)) | ||
152 | `(progn | ||
153 | ,@command-list))) | ||
154 | |||
155 | ;; convenience | ||
156 | (defmacro acdw/bind-after-map (file keymap &rest bindings) | ||
157 | "Wrap multiple calls of `acdw/bind' after FILE and with KEYMAP. | ||
158 | KEYMAP can be nil." | ||
159 | (declare (indent 2)) | ||
160 | (let (bind-list) | ||
161 | (dolist (binding bindings) | ||
162 | (if keymap | ||
163 | (push `(acdw/bind ,@binding :after ,file :map ,keymap) bind-list) | ||
164 | (push `(acdw/bind ,@binding :after ,file) bind-list))) | ||
165 | `(progn | ||
166 | ,@bind-list))) | ||
167 | |||
56 | ;;; Keymap & Mode | 168 | ;;; Keymap & Mode |
57 | 169 | ||
58 | (defvar acdw/map (make-sparse-keymap) | 170 | (defvar acdw/map (make-sparse-keymap) |