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