buffer-action.el

   1 ;;; buffer-action.el --- Perform actions(compile/run, etc) in buffer based on mode/filename
   2
   3 ;; Copyright (C) 2005, 2007, 2008 William Xu
   4
   5 ;; Author: William Xu <william.xwl@gmail.com>
   6 ;; Version: 3.2a
   7 ;; Url: http://xwl.appspot.com/ref/buffer-action.el
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 3, or (at your option)
  12 ;; any later version.
  13
  14 ;; EMMS is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with EMMS; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  22 ;; Boston, MA 02110-1301, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; This is a mostly rewritten based on ideas from Seiji Zenitani
  27 ;; <zenitani@mac.com>'s `smart-compile.el'. Besides compile action, i've
  28 ;; add a run action, and maybe more in the future.
  29
  30 ;; Let me illustrate it by an example. Suppose you are editing a file
  31 ;; named `foo.c'. To compile it, `M-x buffer-action-compile', it will run
  32 ;; a shell command similar to `gcc -o foo foo.c -O2'; to run the
  33 ;; executable binary `foo' , `M-x buffer-action-run', it will run a shell
  34 ;; command similar to `./foo'. Sounds neat, right?
  35
  36 ;; What kind of shell commands or lisp expressions to call for each
  37 ;; action(compile/run) is configurable through `buffer-action-table'.
  38
  39 ;; To use, add this file to your load-path and the following to your
  40 ;; .emacs:
  41 ;;       (autoload 'buffer-action-compile "buffer-action")
  42 ;;       (autoload 'buffer-action-run "buffer-action")
  43
  44 ;; TODO
  45
  46 ;; - Recongize Makefile in a directory, so don't bother me when calling
  47 ;;   the compile command from different file buffers, which all belongs
  48 ;;   to the same directory.
  49 ;; - Solve FIXME.
  50
  51 ;;; Code:
  52
  53 ;;; Customizations
  54
  55 (defgroup buffer-action nil
  56   "buffer-action extension."
  57   :prefix "buffer-action-"
  58   :group 'buffer-action)
  59
  60 (defcustom buffer-action-replace-table
  61   '(("%F" buffer-file-name)
  62     ("%f" (lambda () (file-name-nondirectory (buffer-file-name))))
  63     ("%n" (lambda () (file-name-sans-extension
  64                       (file-name-nondirectory (buffer-file-name)))))
  65     ("%e" (lambda () (file-name-extension (buffer-file-name)))))
  66   "File name shortcut format.
  67 Some special strings(like %f, %F) in `buffer-action-table', will
  68 be replaced according the following map(with an example in the
  69 end).
  70
  71   %F  absolute pathname            (/usr/local/bin/netscape.bin)
  72   %f  file name without directory  (netscape.bin)
  73   %n  file name without extention  (netscape)
  74   %e  extention of file name       (bin)"
  75   :type 'symbol
  76   :group 'buffer-action)
  77
  78 (defcustom buffer-action-table
  79   '((c-mode "gcc -O2 %f -lm -o %n" "%n" "./%n")
  80     (c++-mode "g++ -O2 %f -lm -o %n" "%n" "./%n")
  81     (java-mode "javac %n" "%n.class" "java %n")
  82     (makefile-mode "make" nil nil)
  83     ("\\.pl$" "perl -cw %f" nil "perl -s %f")
  84     ("\\.php$" nil nil "php %f")
  85     ("\\.tex$" "latex %f" "%n.dvi" "xdvi %n.dvi &")
  86     (texinfo-mode
  87      (lambda ()
  88        (save-excursion
  89          ;; (texinfo-make-menu)
  90          (texinfo-all-menus-update)
  91          (texinfo-every-node-update)
  92          (save-buffer))
  93        (makeinfo-buffer))
  94      "%n.info"
  95      (lambda ()
  96        (Info-revert-find-node
  97         (replace-regexp-in-string "\\.texinfo*$" ".info" (buffer-action-replace "%F"))
  98         (makeinfo-current-node))))
  99     (emacs-lisp-mode
 100      (lambda ()
 101        (byte-compile-file (buffer-action-replace "%f")))
 102      "%n.elc"
 103      eval-buffer)
 104     ("\\.info$" nil nil (lambda () (info (buffer-file-name))))
 105     ("\\.dot$" "dot -Tjpg %f -o %n.jpg" "%n.png" "qiv %f &")
 106     )
 107   "Each element in the table has the form:
 108
 109     '(MATCHER COMPILER-ACTION BIN RUN-ACTION)
 110
 111 MATCHER is either a filename or major mode.
 112
 113 BIN is usually a filename(string) or nil, it should be created by
 114 COMPILER-ACTION when necessary, and will be executed by
 115 RUN-ACTION.
 116
 117 COMPILER-ACTION, RUN-ACTION is either a shell command or lisp
 118 expression.
 119
 120 See also `buffer-action-replace-table'."
 121   :type 'symbol
 122   :group 'buffer-action)
 123
 124 \f
 125 ;;; Interface functions
 126
 127 (defvar buffer-action-compile-action nil)
 128 (make-variable-buffer-local 'buffer-action-compile-action)
 129
 130 (defvar buffer-action-run-action nil)
 131 (make-variable-buffer-local 'buffer-action-run-action)
 132
 133 ;;;###autoload
 134 (defun buffer-action-compile ()
 135   "Run `compile' by checking project builder(like make, ant, etc) and
 136 `buffer-action-table'.
 137
 138 When running for the first time, you can edit the command in
 139 minibuffer, else use last command without bothering you any
 140 more. If you want to edit it again, please add C-u prefix."
 141   (interactive)
 142   (let* ((row (buffer-action-match))
 143          (bin (buffer-action-replace (nth 2 row)))
 144          (up-to-date                    ; Is BIN up-to-date ?
 145           (and (stringp bin)
 146                (file-exists-p bin)
 147                (file-newer-than-file-p bin (buffer-file-name)))))
 148     (cond
 149      ;; No need to recompile.
 150      ((and up-to-date (not current-prefix-arg))
 151       (message "`%s' is already up-to-date" (or bin "Object")))
 152      ;; Reset or Setup compile command and compile with new command.
 153      ((or current-prefix-arg (not buffer-action-compile-action))
 154       (cond
 155        ((and (or (file-exists-p "Makefile") ; make
 156                  (file-exists-p "makefile"))
 157              (y-or-n-p "Found Makefile, try 'make'? "))
 158         (setq buffer-action-compile-action "make "))
 159        ((and (file-exists-p "build.xml") ; ant
 160              (y-or-n-p "Found build.xml, try 'ant'? "))
 161         (setq buffer-action-compile-action "ant "))
 162        ((let ((pro (car (directory-files "." nil "\\.pro$")))) ; qmake
 163           (and pro (y-or-n-p (format "Found %s, try 'qmake'? " pro))))
 164         (setq buffer-action-compile-action "qmake "))
 165        (t
 166         (setq buffer-action-compile-action
 167               (buffer-action-replace (nth 1 row)))))
 168       (if (stringp buffer-action-compile-action)
 169           (progn
 170             ;; First time run will be interactive.
 171             (setq compile-command buffer-action-compile-action)
 172             (call-interactively 'compile)
 173             (setq buffer-action-compile-action compile-command))
 174         (funcall buffer-action-compile-action)))
 175      ;; Compile using previous compile command.
 176      ((stringp buffer-action-compile-action)
 177       (compile buffer-action-compile-action))
 178      (t
 179       (funcall buffer-action-compile-action)))))
 180
 181 ;;;###autoload
 182 (defun buffer-action-run ()
 183   "Run the binary file according to `buffer-action-table'.
 184
 185 When running for the first time, you can edit the command in
 186 minibuffer, else use last command without bothering you any
 187 more. If you want to edit it again, please add C-u prefix."
 188   (interactive)
 189   (cond
 190    ((or current-prefix-arg (not buffer-action-run-action))
 191     (let ((run (buffer-action-replace (nth 3 (buffer-action-match)))))
 192       (if (stringp run)
 193           ;; FIXME: I'm unable to avoid using the deprecated
 194           ;; INITIAL-CONTENTS parameter.
 195           (progn
 196             (setq buffer-action-run-action
 197                   (read-from-minibuffer
 198                    "Run-action $ " (concat run " ")))
 199             (buffer-action-shell-command))
 200         (setq buffer-action-run-action run)
 201         (funcall buffer-action-run-action))))
 202    ((stringp buffer-action-run-action)
 203     (buffer-action-shell-command))
 204    (t
 205     (funcall buffer-action-run-action))))
 206
 207 \f
 208 ;;; Utilities
 209
 210 (defun buffer-action-replace (any)
 211   "If ANY is a string, update it by `buffer-action-replace-table', else
 212 return ANY unchanged."
 213   (let ((ret any))
 214     (when (stringp any)
 215       (dolist (el buffer-action-replace-table ret)
 216         (setq ret (replace-regexp-in-string
 217                    (car el) (funcall (cadr el)) ret))))
 218     ret))
 219
 220 (defun buffer-action-match ()
 221   "Retrieve the row matching against current buffer in `buffer-action-table'."
 222   (let ((table buffer-action-table)
 223         (row '())
 224         (ret nil))
 225     (condition-case nil
 226         (progn
 227           (while table
 228             (setq row (car table)
 229                   table (cdr table))
 230             (let ((matcher (nth 0 row)))
 231               (when (or (and (stringp matcher)
 232                              (string-match matcher (buffer-file-name)))
 233                         (eq matcher major-mode))
 234                 (setq table nil)
 235                 (setq ret row))))
 236           (when ret ret))
 237       (error "Action not found for current buffer"))))
 238
 239 (defun buffer-action-shell-command ()
 240   "Run shell command either synchronously or asynchronously(when
 241 with `&') with a unique output buffer, whose window will be
 242 deleted automatically."
 243   (let ((cmd buffer-action-run-action))
 244     (if (string-match "&\\ *$" cmd)
 245         (let ((buf (generate-new-buffer-name (concat "*" cmd "*"))))
 246           (message cmd)
 247           (shell-command cmd buf)
 248           (delete-window (get-buffer-window buf)))
 249       (shell-command cmd))))
 250
 251 (provide 'buffer-action)
 252
 253 ;;; buffer-action.el ends here