Move init from autoloads to actual load. fileset-whole-alist is not risky.
[fileset-whole.git] / fileset-whole.el
blob37a72b370809441b52decff8061afdfd57a6e30d
1 ;;;_ fileset-whole.el --- Commands and data applying to filesets as a whole
3 ;;;_. Headers
4 ;;;_ , License
5 ;; Copyright (C) 2011 Tom Breton (Tehom)
7 ;; Author: Tom Breton (Tehom) <tehom@panix.com>
8 ;; Keywords: convenience
10 ;; This file is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
15 ;; This file is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
25 ;;;_ , Commentary:
27 ;;
30 ;;;_ , Requires
32 (require 'filesets)
34 ;;;_. Body
35 ;;;_ , Customizations
36 ;;;_ . fileset-whole-alist
37 (defcustom fileset-whole-alist
38 '()
39 "Alist associating fileset names to keyed data"
40 :group 'filesets
41 :type '(repeat
42 (cons :tag "Fileset"
43 (string :tag "Name" :value "")
44 (repeat :tag "Data"
45 (list
46 symbol
47 sexp)))))
48 (put 'fileset-whole-alist 'risky-local-variable t)
50 ;;;_ . fileset-whole-commands
51 (defcustom fileset-whole-commands
53 ("git"
54 magit-status (default-directory))
55 ("eshell"
56 eshell nil)
57 ("Build"
58 fileset-whole-apply-compile
59 ("make -C" default-directory))
60 ("test"
61 emt:fileset
62 (fileset-name))
63 ("retest"
64 emt:fileset-all
65 (fileset-name))
66 ("find-file"
67 (lambda (name)
68 (find-file
69 (fileset-whole-pick-file name)))
70 (fileset-name)))
72 "List of commands that apply to whole filesets.
74 Before the command is applied, each arg is evalled with the
75 following bindings:
77 `fileset' - the fileset.
78 `fileset-name' - the name of the fileset
79 `fileset-whole' - other data associated with the fileset, if any.
80 `default-directory' the root directory of the project, if any.
82 Then the command is applied to the list of args.
84 It is the user's resposibility to ensure that commands and
85 functions called in arguments are available; consider using
86 autoloads."
88 :group 'filesets
89 ;;$$IMPROVE ME Add a hotkey and put it into some keymap
90 ;;$$IMPROVE ME Add a field saying how to find the buffers it
91 ;;creates, given its return value.
92 :type '(repeat :tag "Commands"
93 (list :tag "Definition" :value ("")
94 (string "Name")
95 (choice :tag "Command"
96 (function :tag "Function"))
97 (repeat :tag "Argument List"
98 (choice :tag "Arguments"
99 ;;$$IMPROVE ME List the bound symbols as options
100 (sexp :tag "Sexp"
101 :value nil))))))
103 (put 'fileset-whole-commands 'risky-local-variable t)
104 ;;;_ , Variables
105 ;;For now, we don't contemplate multiple filesets applying to one
106 ;;buffer. Could treat a list of them differently.
107 (defvar fileset-whole-name-here nil
108 "The fileset that contains this buffer, if any." )
109 (make-variable-buffer-local 'fileset-whole-name-here)
110 (put 'fileset-whole-name-here 'permanent-local t)
111 (put 'fileset-whole-alist 'risky-local-variable nil)
112 ;;;_ , Setting up menus
113 ;;;_ . fileset-whole-setup-menu
114 (defun fileset-whole-setup-menu ()
115 "Add the commands in fileset-whole-commands to fileset menu."
116 ;;When is this triggered?
117 ;;And see `filesets-get-cmd-menu'. Either add to it or add another
118 ;;menu.
120 (easy-menu-add-item
121 nil ;;Should this be `filesets-menu-in-menu'?
122 (append filesets-menu-path (list filesets-menu-name "# Filesets"))
123 ["Edit Filesets' Data" fileset-whole-edit]
124 "Save Filesets"))
126 ;;;_ . fileset-whole-cmds-to-menu
127 (defun fileset-whole-cmds-to-menu ()
128 "Add fileset-whole commands to filesets command menu."
129 (mapcar
130 #'(lambda (this)
131 (let
132 ((name (car this)))
133 (easy-menu-add-item
134 nil ;;Should this be `filesets-menu-in-menu'?
135 (append filesets-menu-path (list filesets-menu-name "+ Commands"))
136 `[,name (fileset-whole-run-cmd
137 ,name
138 (fileset-whole-read-fileset))])))
139 fileset-whole-commands)
142 ;;;_ . fileset-whole-add-buffer
144 ;;Add a "created" buffer such as gdb, eshell, or magit make to the
145 ;;menus, in a section paralleling the list of files.
147 ;;;_ . fileset-whole-setup-files
148 ;;;###autoload
149 (defun fileset-whole-setup-files ()
150 "Run a hook in each currently open buffer that any fileset applies to."
151 ;;$$WRITE ME
152 ;;$$FACTOR ME Several parts: Running something in all relevant
153 ;;buffers (parms: fileset-name). The hook. Running the hook this
154 ;;way.
155 ;;$$DESIGN ABOUT ME How and when to trigger this. There are no
156 ;;obvious hooks in fileset.
157 (interactive)
158 (let*
160 ;;For each fileset
161 ;;Get list of files
162 ;;For each one that's already open, with that buffer current,
163 ;;run hooks. Default hook will just set `fileset-whole-name-here'.
165 ;;;_ . fileset-whole-init
166 ;;;###autoload
167 (defun fileset-whole-init ()
168 "Set up fileset-whole on top of filesets"
169 (filesets-init)
170 (fileset-whole-setup-menu)
171 (fileset-whole-cmds-to-menu))
172 ;;;_ , Structuring
173 ;;;_ . fileset-whole-cmd->fn
174 (defun fileset-whole-cmd->fn (cmd)
175 "Return the function field of CMD"
176 (nth 1 cmd))
177 ;;;_ . fileset-whole-cmd->args
178 (defun fileset-whole-cmd->args (cmd)
179 "Return the args field of CMD"
180 (nth 2 cmd))
181 ;;;_ . fileset-whole-entry->alist
182 (defun fileset-whole-entry->alist (entry)
183 "Return the alist of ENTRY"
184 (cdr entry))
185 ;;;_ . fileset-whole-data-get
186 (defun fileset-whole-data-get (entry key &optional default carp)
187 "Extract the value for KEY in the data part of fileset ENTRY.
188 Return DEFAULT if not found. Return (car VALUE) if CARP is non-nil."
189 (filesets-alist-get
190 (fileset-whole-entry->alist entry) key default carp))
192 ;;;_ , Running commands
193 ;;;_ . fileset-whole-read-cmd
194 (defun fileset-whole-read-cmd ()
195 "Interactively get the name of a fileset command.
196 Either a whole command or a command on individual files."
198 (completing-read "Select command: "
199 (append filesets-commands fileset-whole-commands)
200 nil t))
201 ;;;_ . fileset-whole-read-fileset
202 (defun fileset-whole-read-fileset (&optional ask)
203 "Interactively get the name of a fileset.
204 Called interactively, it's useful for changing a buffer's default
205 fileset"
206 (interactive (list t))
208 (unless ask fileset-whole-name-here)
209 (let
210 ((name
211 (completing-read "Select fileset: "
212 filesets-data nil t
213 nil nil fileset-whole-name-here)))
214 ;;Record it so we won't have to ask again wrt this buffer
215 ;;(`fileset-whole-name-here' is buffer-local)
217 ;;$$IMPROVE ME Allow some way(s) to not set it:
218 ;;User preference, and a buffer-local variable.
219 (unless (eq name fileset-whole-name-here)
220 (setq fileset-whole-name-here name))
221 ;;$$IMPROVE ME If buffer is not associated with
222 ;;any file, ask to add it (consult user preference)
223 ;;`filesets-add-buffer'
224 name)))
225 ;;;_ . fileset-whole-set-fileset
226 (defalias 'fileset-whole-set-fileset 'fileset-whole-read-fileset)
227 ;;;_ . fileset-whole-get-dir
228 (defun fileset-whole-get-dir (fileset-whole fileset)
229 "Return the root dir of FILESET-WHOLE if it exists."
230 ;;$$IMPROVE ME Store a :root-dir property if we made one.
232 (fileset-whole-data-get fileset-whole :root-dir nil t)
233 (fileset-whole-root-dir fileset)))
236 ;;;_ . fileset-whole-run-cmd
237 ;;;###autoload
238 (defun fileset-whole-run-cmd (cmd-name &optional fileset-name)
239 "Run command CMD-NAME on whole fileset FILESET-NAME.
240 If prefix arg is given, don't use FILESET-NAME default."
241 (interactive
242 (list
243 (fileset-whole-read-cmd)
244 (fileset-whole-read-fileset current-prefix-arg)))
245 (let
246 ((cmd-on-whole (assoc cmd-name fileset-whole-commands)))
247 (cond
248 (cmd-on-whole
249 (let*
251 (fileset
252 (filesets-get-fileset-from-name fileset-name))
253 (fileset-whole
254 (assoc fileset-name fileset-whole-alist))
255 (default-directory
256 (fileset-whole-get-dir fileset-whole fileset))
258 (fileset-whole-cmd->fn cmd-on-whole))
259 (args-spec
260 (fileset-whole-cmd->args cmd-on-whole))
261 (args
262 (mapcar #'eval args-spec)))
264 ;;$$IMPROVE ME Maybe open the fileset first, as
265 ;;filesets-run-cmd does. Do this according to some
266 ;;property of the command. `filesets-open'.
268 ;;$$IMPROVE ME When command makes another buffer
269 ;;(if we can tell it did), associate that buffer
270 ;;with FILESET. Set `fileset-whole-name-here' in
271 ;;it. Add it as an associated buffer (Possibly
272 ;;in another menu area).
273 (apply fn args)))
275 ;;If not, call the filesets command (which presumably
276 ;;exists since we found it earlier)
278 (filesets-run-cmd cmd-name fileset-name)))))
280 ;;;_ , Fileset extras
281 ;;;_ . fileset-whole->fileset
282 (defun fileset-whole->fileset (fileset)
283 "Return a fileset object corresponding to FILESET.
284 If FILESET is a string, return the fileset of that name."
286 (cond
287 ((stringp fileset)
288 (filesets-get-fileset-from-name fileset))
289 ((listp fileset)
290 fileset)
292 (error "Can't convert to fileset: %s" fileset))))
293 ;;;_ . fileset-whole-get-filelist
295 ;;This may be a bugfix towards filesets, because
296 ;;`filesets-get-filelist' fails on :pattern or :tree. It's also an
297 ;;extension, to allow multiple :files-type clauses.
298 (defun fileset-whole-get-filelist (fileset)
299 "Return a list of all files in FILESET.
300 Use instead of `filesets-get-filelist'."
302 (let*
304 (entries (cdr fileset))
305 (files
306 (apply #'nconc
307 (mapcar
308 #'(lambda (entry)
309 (mapcar
310 #'expand-file-name
311 (case (car entry)
312 ((:pattern :tree :ingroup)
313 (filesets-get-filelist
314 (cdr entry) (car entry) nil))
315 (:files (cdr entry))
316 (:file
317 (list (cdr entry)))
318 ;;Anything else: nil
319 (t ())
321 entries))))
322 files))
325 ;;;_ . fileset-whole-pick-file
326 ;;This is suitable as a destination-file function for
327 ;;`org-remember-templates'
328 (defun fileset-whole-pick-file (&optional fileset-name filter)
329 "Interactively pick a single file name from a fileset.
330 If FILESET-NAME if not given, prompt for it.
332 If FILTER is given, it must be a function of 1 arg. Only present
333 files that satisfy it."
335 (interactive)
336 (let*
337 ((fileset-name
338 (or
339 fileset-name
340 (fileset-whole-read-fileset t)))
341 (fileset
342 (filesets-get-fileset-from-name fileset-name))
343 (files
344 (fileset-whole-get-filelist fileset))
345 (files
346 ;;$$IMPROVE ME Support filtering by extension, by
347 ;;mode-symbol, or by regexp.
348 (if filter
349 (filesets-filter-list files filter)
350 files)))
352 (completing-read "File: " files nil t
353 (fileset-whole-root-dir fileset))))
356 ;;;_ . fileset-whole-root-dir
357 (defun fileset-whole-root-dir (fileset)
358 "Return a fileset's smallest enclosing directory."
360 (let*
361 ((fileset (fileset-whole->fileset fileset))
362 (files (fileset-whole-get-filelist fileset))
363 (prefix
364 (if files
365 (reduce
366 #'fill-common-string-prefix
367 files)
368 (error "No files found for %s" fileset))))
369 (file-name-directory prefix)))
373 ;;;_ , Maintaining fileset-whole data
374 ;;;_ . fileset-whole-edit
375 (defun fileset-whole-edit ()
376 "Customize `fileset-whole-alist'."
377 (interactive)
378 ;;$$IMPROVE ME Populate it first from fileset-data
379 (customize-variable 'fileset-whole-alist))
381 ;;;_ . fileset-whole-populate-alist
382 ;;YAGNI
383 ;;Populate `fileset-whole-alist' with fileset names and whatever data
384 ;;can be deduced about them, such as :root-dir
385 ;;;_ , Support
386 ;;;_ . fileset-whole-apply-compile
387 (defun fileset-whole-apply-compile (&rest args)
388 "Like `compile', but applied to the concatenation of ARGS"
389 (compile
390 (mapconcat #'identity args " ")))
391 ;;;_ , To set up bindings
392 ;;;###autoload (global-set-key "\C-cp" #'fileset-whole-run-cmd)
394 ;;;_ , To set up menus
395 (fileset-whole-init)
397 ;;;_. Footers
398 ;;;_ , Provides
400 (provide 'fileset-whole)
402 ;;;_ * Local emacs vars.
403 ;;;_ + Local variables:
404 ;;;_ + mode: allout
405 ;;;_ + End:
407 ;;;_ , End
408 ;;; fileset-whole.el ends here