fileset-whole.el

   1 ;;;_ fileset-whole.el --- Commands and data applying to filesets as a whole
   2
   3 ;;;_. Headers
   4 ;;;_ , License
   5 ;; Copyright (C) 2011  Tom Breton (Tehom)
   6
   7 ;; Author: Tom Breton (Tehom) <tehom@panix.com>
   8 ;; Keywords: convenience
   9
  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.
  14
  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.
  19
  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.
  24
  25 ;;;_ , Commentary:
  26
  27 ;;
  28
  29
  30 ;;;_ , Requires
  31
  32 (require 'filesets)
  33
  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)
  49
  50 ;;;_  . fileset-whole-commands
  51 (defcustom fileset-whole-commands
  52    '(("gdb"
  53         gdb ((gud-query-cmdline 'gdb)))
  54        ("git"
  55           magit-status (default-directory))
  56        ("eshell"
  57           eshell nil)
  58        ("Build"
  59           fileset-whole-apply-compile
  60           ("make -C" default-directory))
  61        ("test"
  62           emt:fileset
  63           (fileset-name)))
  64
  65    "List of commands that apply to whole filesets.
  66
  67 Before the command is applied, each arg is evalled with the
  68 following bindings:
  69
  70   `fileset' - the fileset.
  71   `fileset-name' - the name of the fileset
  72   `fileset-whole' - other data associated with the fileset, if any.
  73   `default-directory' the root directory of the project, if any.
  74
  75 Then the command is applied to the list of args."
  76    :group 'filesets
  77    ;;$$IMPROVE ME Add a hotkey and put it into some keymap
  78    ;;$$IMPROVE ME Add a field saying how to find the buffers it
  79    ;;creates, given its return value.
  80    :type '(repeat :tag "Commands"
  81              (list :tag "Definition" :value ("")
  82                 (string "Name")
  83                 (choice :tag "Command"
  84                    (function :tag "Function"))
  85                 (repeat :tag "Argument List"
  86                    (choice :tag "Arguments"
  87                       ;;$$IMPROVE ME List the bound symbols as options
  88                       (sexp :tag "Sexp"
  89                          :value nil))))))
  90
  91 (put 'fileset-whole-commands 'risky-local-variable t)
  92 ;;;_ , Variables
  93 ;;For now, we don't contemplate multiple filesets applying to one
  94 ;;buffer.  Could treat a list of them differently.
  95 (defvar fileset-whole-name-here nil
  96    "The fileset that contains this buffer, if any." )
  97 (make-variable-buffer-local 'fileset-whole-name-here)
  98 ;;;_ , Setting up fileset stuff
  99 ;;;_  . fileset-whole-setup-menu
 100 ;;;###autoload
 101 (defun fileset-whole-setup-menu ()
 102    "Add the commands in fileset-whole-commands to fileset menu."
 103    ;;When is this triggered?
 104    ;;And see `filesets-get-cmd-menu'
 105    (let*
 106       ()
 107
 108       ))
 109 ;;;_  . fileset-whole-add-buffer
 110
 111 ;;Add a "created" buffer such as gdb, eshell, or magit make to the
 112 ;;menus about files.
 113
 114 ;;;_  . fileset-whole-setup-files
 115 ;;;###autoload
 116 (defun fileset-whole-setup-files ()
 117    "Run a hook in each currently open buffer that any fileset applies to."
 118    ;;$$WRITE ME
 119    ;;$$FACTOR ME Several parts: Running something in all relevant
 120    ;;buffers (parms: fileset-name).  The hook.  Running the hook this
 121    ;;way.
 122    ;;$$DESIGN ABOUT ME How and when to trigger this.  There are no
 123    ;;obvious hooks in fileset.
 124    (interactive)
 125    (let*
 126       ()
 127       ;;For each fileset
 128       ;;Get list of files
 129       ;;For each one that's already open, with that buffer current,
 130       ;;run hooks.  Default hook will just set `fileset-whole-name-here'.
 131       ))
 132
 133 ;;;_ , Structuring
 134 ;;;_  . fileset-whole-cmd->fn
 135 (defun fileset-whole-cmd->fn (cmd)
 136    "Return the function field of CMD"
 137    (nth 1 cmd))
 138 ;;;_  . fileset-whole-cmd->args
 139 (defun fileset-whole-cmd->args (cmd)
 140    "Return the args field of CMD"
 141    (nth 2 cmd))
 142 ;;;_  . fileset-whole-entry->alist
 143 (defun fileset-whole-entry->alist (entry)
 144    "Return the alist of ENTRY"
 145    (cdr entry))
 146 ;;;_  . filesets-whole-data-get
 147 (defun filesets-whole-data-get (entry key &optional default carp)
 148   "Extract the value for KEY in the data part of fileset ENTRY.
 149 Return DEFAULT if not found.  Return (car VALUE) if CARP is non-nil."
 150   (filesets-alist-get
 151      (fileset-whole-entry->alist entry) key default carp))
 152
 153 ;;;_ , Running commands
 154 ;;;_  . fileset-whole-read-cmd
 155 (defun fileset-whole-read-cmd ()
 156    "Interactively get the name of a fileset command.
 157 Either a whole command or a command on individual files."
 158
 159    (completing-read "Select command: "
 160       (append filesets-commands fileset-whole-commands)
 161       nil t))
 162 ;;;_  . fileset-whole-read-fileset
 163 (defun fileset-whole-read-fileset (&optional ask)
 164    "Interactively get the name of a fileset"
 165    (or
 166       (unless ask fileset-whole-name-here)
 167       (let
 168          ((name
 169              (completing-read "Select fileset: "
 170                 filesets-data nil t
 171                 nil nil fileset-whole-name-here)))
 172          ;;Record it so we won't have to ask again wrt this buffer
 173          ;;(`fileset-whole-name-here' is buffer-local)
 174
 175          ;;$$IMPROVE ME Allow some way(s) to not set it:
 176          ;;User preference, and a buffer-local variable.
 177          (unless (eq name fileset-whole-name-here)
 178             (setq fileset-whole-name-here name))
 179          ;;$$IMPROVE ME If buffer is not associated with
 180          ;;any file, ask to add it (consult user preference)
 181          ;;`filesets-add-buffer'
 182          name)))
 183 ;;;_  . fileset-whole-get-dir
 184 (defun fileset-whole-get-dir (fileset-whole)
 185    "Return the root dir of FILESET-WHOLE if it exists."
 186    (filesets-whole-data-get fileset-whole :root-dir nil t))
 187
 188 ;;;_  . fileset-whole-run-cmd
 189 ;;;###autoload
 190 (defun fileset-whole-run-cmd (cmd-name fileset-name)
 191    "Pick a command and run it."
 192    (interactive
 193       (list
 194          (fileset-whole-read-cmd)
 195          (fileset-whole-read-fileset)))
 196    (let
 197       ((cmd-on-whole (assoc cmd-name fileset-whole-commands)))
 198       (cond
 199          (cmd-on-whole
 200             (let*
 201                (
 202                   (fileset
 203                      (filesets-get-fileset-from-name fileset-name))
 204                   (fileset-whole
 205                      (assoc fileset-name fileset-whole-alist))
 206                   (default-directory
 207                      (fileset-whole-get-dir fileset-whole))
 208                   (fn
 209                      (fileset-whole-cmd->fn cmd-on-whole))
 210                   (args-spec
 211                      (fileset-whole-cmd->args cmd-on-whole))
 212                   (args
 213                      (mapcar #'eval args-spec)))
 214
 215                ;;$$IMPROVE ME Maybe open the fileset first, as
 216                ;;filesets-run-cmd does.  Do this according to some
 217                ;;property of the command. `filesets-open'.
 218
 219                ;;$$IMPROVE ME When command makes another buffer
 220                ;;(if we can tell it did), associate that buffer
 221                ;;with FILESET.  Set `fileset-whole-name-here' in
 222                ;;it.  Add it as an associated buffer (Possibly
 223                ;;in another menu area).
 224                (apply fn args)))
 225
 226          ;;If not, call the filesets command (which presumably
 227          ;;exists since we found it earlier)
 228          (t
 229             (filesets-run-cmd cmd-name fileset-name)))))
 230
 231 ;;;_ , Fileset extras
 232 ;;;_  . filesets-whole->fileset
 233 (defun filesets-whole->fileset (fileset)
 234    "Return a fileset object corresponding to FILESET.
 235 If FILESET is a string, return the fileset of that name."
 236
 237    (cond
 238       ((stringp fileset)
 239          (filesets-get-fileset-from-name fileset))
 240       ((listp fileset)
 241          fileset)
 242       (t
 243          (error "Can't convert to fileset: %s" fileset))))
 244 ;;;_  . fileset-whole-pick-file
 245 ;;This is suitable as a destination-file function for
 246 ;;`org-remember-templates'
 247 (defun fileset-whole-pick-file (&optional fileset-name filter)
 248    "Interactively pick a single file name from a fileset.
 249 If FILESET-NAME if not given, prompt for it.
 250
 251 If FILTER is given, it must be a function of 1 arg.  Only present
 252 files that satisfy it."
 253
 254    (interactive)
 255    (let*
 256       ((fileset-name
 257           (or
 258              fileset-name
 259              (fileset-whole-read-fileset t)))
 260          (fileset
 261             (filesets-get-fileset-from-name fileset-name))
 262          (files
 263             (filesets-get-filelist fileset nil nil))
 264          (files
 265             ;;$$IMPROVE ME  Support filtering by extension, by
 266             ;;mode-symbol, or by regexp.
 267             (if filter
 268                (filesets-filter-list files filter)
 269                files)))
 270
 271       (completing-read "File: " files nil t)))
 272
 273 ;;;_  . fileset-whole-root-dir
 274 (defun fileset-whole-root-dir (fileset)
 275    "Return a fileset's smallest enclosing directory."
 276
 277    (let*
 278       ((fileset (filesets-whole->fileset fileset))
 279          (files (filesets-get-filelist fileset nil nil)))
 280       (reduce
 281          #'fill-common-string-prefix
 282          files)))
 283
 284 ;;
 285 ;;For giving root-dir its initial value.
 286
 287 ;;;_ , Populating the alist
 288
 289 ;;;_  . fileset-whole-populate-alist
 290 ;;YAGNI
 291 ;;Populate `fileset-whole-alist' with fileset names and whatever data
 292 ;;can be deduced about them, such as :root-dir
 293 ;;;_ , Support
 294 ;;;_  . fileset-whole-apply-compile
 295 (defun fileset-whole-apply-compile (&rest args)
 296    "Like `compile', but applied to the concatenation of ARGS"
 297    (compile
 298       (mapconcat #'identity args " ")))
 299 ;;;_ , To set up bindings
 300 ;;;###autoload (global-set-key "\C-cp" #'fileset-whole-run-cmd)
 301
 302 ;;;_. Footers
 303 ;;;_ , Provides
 304
 305 (provide 'fileset-whole)
 306
 307 ;;;_ * Local emacs vars.
 308 ;;;_  + Local variables:
 309 ;;;_  + mode: allout
 310 ;;;_  + End:
 311
 312 ;;;_ , End
 313 ;;; fileset-whole.el ends here