summary refs log tree commit diff stats
path: root/lisp/acdw.el
blob: 444f249c42d403949d2272b6402fbdd203b1e636 (plain)
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
;;; acdw.el -- bits and bobs  -*- lexical-binding: t; -*-
;; by C. Duckworth <acdw@acdw.net>
(provide 'acdw)

(require 'cl-lib)

;;; Define both a directory and a function expanding to a file in that directory

(defmacro +define-dir (name directory &optional docstring inhibit-mkdir)
  "Define a variable and function NAME expanding to DIRECTORY.
DOCSTRING is applied to the variable.  Ensure DIRECTORY exists in
the filesystem, unless INHIBIT-MKDIR is non-nil."
  (declare (indent 2)
           (doc-string 3))
  (unless inhibit-mkdir
    (make-directory (eval directory) :parents))
  `(progn
     (defvar ,name ,directory
       ,(concat docstring (when docstring "\n")
                "Defined by `/define-dir'."))
     (defun ,name (file &optional mkdir)
       ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n"
                "If MKDIR is non-nil, the directory is created.\n"
                "Defined by `/define-dir'.")
       (let ((file-name (expand-file-name (convert-standard-filename file)
                                          ,name)))
         (when mkdir
           (make-directory (file-name-directory file-name) :parents))
         file-name))))

;;; Convenience functions

(defun define-keys (maps &rest keydefs)
  "Define KEYDEFS in MAPS.
Convenience wrapper around `define-key'."
  (unless (zerop (mod (length keydefs) 2))
    (user-error "Wrong number of arguments: %S" (length keydefs)))
  (dolist (map (if (or (atom maps) (eq (car maps) 'keymap))
		   (list maps)
		 maps))
    (cl-loop for (key def) on keydefs by #'cddr
	     do (let ((key (if (stringp key) (kbd key) key)))
		  (define-key (if (symbolp map)
				  (symbol-value map)
				map)
		    key def)))))

(unless (fboundp 'ensure-list)
  ;; Just in case we're using an old version of Emacs.
  (defun ensure-list (object)
  "Return OBJECT as a list.
If OBJECT is already a list, return OBJECT itself.  If it's
not a list, return a one-element list containing OBJECT."
  (if (listp object)
      object
    (list object))))

(defun add-to-list* (lists &rest things)
  "Add THINGS to LISTS.
LISTS can be one list variable or a list.
Each thing of THINGS can be either a variablel (the thing), or a list of the form
(ELEMENT &optional APPEND COMPARE-FN), which is passed to
`add-to-list'."
  (dolist (l (ensure-list lists))
    (dolist (thing things)
      (apply #'add-to-list l (ensure-list thing)))))

(defun add-hook* (hooks &rest functions)
  "Add FUNCTIONS to HOOKS.
Each function in FUNCTIONS can be a singleton or a list of the
form (FUNCTION &optional DEPTH LOCAL)."
  (dolist (hook (ensure-list hooks))
    (dolist (fn functions)
      (apply #'add-hook hook (ensure-list fn)))))

;;; Convenience macros

(defmacro setq-local-hook (hook &rest args)
  "Run `setq-local' on ARGS when running HOOK."
  (declare (indent 1))
  (let ((fn (intern (format "%s-setq-local" hook))))
    (when (and (fboundp fn)
	       (functionp fn))
      (setq args (append (function-get fn 'setq-local-hook-settings) args)))
    (unless (and (< 0 (length args))
		 (zerop (mod (length args) 2)))
      (user-error "Wrong number of arguments: %S" (length args)))
    `(progn
       (defun ,fn ()
	 ,(format "Set local variables after `%s'." hook)
	 (setq-local ,@args))
       (function-put ',fn 'setq-local-hook-settings ',args)
       (add-hook ',hook #',fn))))

(defmacro with-message (message &rest body)
  "Execute BODY, with MESSAGE.
If body executes without errors, MESSAGE...Done will be displayed."
  (declare (indent 1))
  (let ((msg (gensym)))
    `(let ((,msg ,message))
       (condition-case e
           (progn (message "%s..." ,msg)
                  ,@body)
         (:success (message "%s...done" ,msg))
         (t (signal (car e) (cdr e)))))))