[Arcana] Because it just kills me to type C-x b *com TAB RET when I don't really have to.

Jim Blandy jimb at red-bean.com
Tue Mar 10 16:24:44 CDT 2009


What I expect from this list is at least two alternate
implementations, previously written.

But I confess I'd be tickled if folks found it useful, too.

Just finished a few minutes ago, probably buggy.

;;;; jimb-compile.el --- front end for M-x compile that finds objdirs
;;;;
;;;; A front end for M-x compile that, when invoked from a source
;;;; file, switches to the object directory most recently used with
;;;; that source file, and then invokes M-x compile.

(defun jc-parent-or-nil (dir)
  "Return the parent directory of DIR, or nil if DIR is a root."
  (let ((parent (file-name-directory (directory-file-name dir))))
    (if (string= parent dir)
        nil
      parent)))

(defun jc-find-config-status (objdir)
  "Return the path of the config.status file for OBJDIR.
This is either in OBJDIR or one of its parents."
  (let ((dir objdir)
        config-status)
    (while dir
      (setq config-status (expand-file-name "config.status" dir))
      (if (file-exists-p config-status)
          (setq dir nil)
        (setq config-status nil
              dir (jc-parent-or-nil dir))))
    config-status))

(defun jc-config-status-srcdir (config-status)
  "Return the source directory of the config.status file CONFIG-STATUS."
  (save-current-buffer
    (set-buffer (find-file-noselect config-status))
    (prog1
        (save-excursion
          (goto-char (point-min))
          (unless (re-search-forward "^ac_given_srcdir=" nil t)
            (error "couldn't get source directory from config.status file: %s"
                   config-status))
          (file-name-as-directory
           (expand-file-name
            (buffer-substring (point) (progn (end-of-line) (point))))))
      ;; Don't leave the buffer around if the user has never visited
      ;; it explicitly.  Disabled for now, for speed and since
      ;; config.status files aren't that big (100k for all firefox).
      '(unless buffer-display-time
        (kill-buffer)))))

(defvar jc-objdir-alist nil
  "Association list mapping source dirs to the most recent objdirs.
The source directories listed all contain 'configure' scripts; the
corresponding object directories contain 'config.status' scripts
pointing to them.

This is populated by 'js-compilation-finish-function', which is added to
'compilation-finish-functions'.")

(defun jc-set-assoc (symbol key value)
  "Set KEY to VALUE in the association list which is the value of SYMBOL.
Compare keys using 'equal'."
  (let* ((alist (symbol-value symbol))
         (assoc (assoc key alist)))
    (if assoc (setcdr assoc value)
      (set symbol (cons (cons key value) alist)))))

(defun jc-compilation-finish-function (buffer status)
  (save-excursion
    (set-buffer buffer)
    (let ((config-status (jc-find-config-status default-directory)))
      (when config-status
        (let* ((config-status-dir (file-name-directory config-status))
               (config-status-srcdir (jc-config-status-srcdir config-status)))
          (jc-set-assoc 'jc-objdir-alist
                        config-status-srcdir config-status-dir))))))

(add-hook 'compilation-finish-functions 'jc-compilation-finish-function)

(defun jc-find-objdir (srcdir)
  "Find the object directory for SRCDIR, based on past use of M-x compile.
Return 'nil' if there is no plausible match.
This consults 'jc-objdir-alist'."
  (setq srcdir (expand-file-name srcdir))
  ;; Look for any parent of SRCDIR in jc-objdir-alist.
  (let ((alist jc-objdir-alist)
        src-parent obj-parent)
    (while alist
      (when (string-match (concat "^" (regexp-quote (caar alist))) srcdir)
        (setq src-parent (caar alist)
              obj-parent (cdar alist)
              alist nil))
      (setq alist (cdr alist)))
    (when src-parent
      ;; Since srcdir is a directory name (ending in '/'), this will
      ;; be, too.
      (expand-file-name (file-relative-name srcdir src-parent) obj-parent))))

(defun jc-compile ()
  "Like M-x compile, but choose a compilation directory based on past compiles.
Each time a compilation finishes, we record the object directory
and its associated source directory.  Then, running 'jc-compile'
in a source directory switches to the object directory most
recently used with that source directory, and does the
compilation there.
We identify the top of the object tree by looking for a
'config.status' file.  We use the directory containing the
'configure' script that generated that as the top of the source
tree."
  (interactive)
  (let ((objdir (jc-find-objdir default-directory)))
    (if (and objdir
             (file-directory-p objdir))
        (let ((default-directory objdir))
          (call-interactively 'compile))
      (call-interactively 'compile))))

(provide 'jimb-compile)




More information about the Arcana mailing list