Last edit
Summary: Uploaded mk-project 1.5.1
Changed:
< ;; http://http://github.com/mattkeller/mk-project
to
> ;; http://github.com/mattkeller/mk-project
Changed:
< (defvar mk-proj-version "1.4.0"
to
> (defvar mk-proj-version "1.5.1"
Changed:
< "Shell command to build the entire project. Optional. Example: make -k.")
to
> "Command to build the entire project. Can be either a string specifying
> a shell command or the name of a function. Optional. Example: make -k.")
Changed:
< (hg . "'*/.hg/*'"))
to
> (hg . "'*/.hg/*'")
> (darcs . "'*/_darcs/*'"))
Changed:
< (defcustom mk-proj-ack-cmd (if (string-equal system-type "windows-nt") "ack.pl" "ack")
to
> (defcustom mk-proj-ack-cmd (if (eq system-type 'windows-nt) "ack.pl" "ack")
Added:
> (defcustom mk-proj-menu-on t
> "If non-nil, define the 'mk-project' menu in the menu-bar at
> load time. See also `project-menu-remove'."
> :type 'boolean
> :group 'mk-project)
Changed:
< (defun project-load ()
to
> (defun project-load (&optional name)
Changed:
< (name (if (mk-proj-use-ido)
< (ido-completing-read "Project Name (ido): " (mk-proj-names))
< (completing-read "Project Name: " (mk-proj-names)))))
to
> (name (or name
> (if (mk-proj-use-ido)
> (ido-completing-read "Project Name (ido): "
> (mk-proj-names))
> (completing-read "Project Name: " (mk-proj-names))))))
Changed:
< "View project's variables."
< (interactive)
< (if mk-proj-basedir
< (let ((msg))
< (dolist (v mk-proj-proj-vars)
< (setq msg (concat msg (format "%-24s = %s\n" v (symbol-value v)))))
< (message msg))
< (message "No project loaded.")))
to
> "View project's variables."
> (interactive)
> (if mk-proj-basedir
> (let ((b (get-buffer-create "*project-status*")))
> (with-current-buffer b
> (kill-region (point-min) (point-max))
> (dolist (v mk-proj-proj-vars)
> (insert (format "%-24s = %s\n" v (symbol-value v)))))
> (when (not (eq b (current-buffer)))
> (switch-to-buffer-other-window b)))
> (message "No project loaded.")))
Changed:
< (defun project-grep ()
< "Run find-grep on the project's basedir, excluding files in mk-proj-ignore-patterns, tag files, etc.
< With C-u prefix, start from the current directory."
to
> (defun project-grep (&optional phrase from-current-dir)
> "Run find-grep on the project's basedir, excluding files in
> mk-proj-ignore-patterns, tag files, etc.
> If the phrase argument is not included, it will prompt for a
> search phrase. If the from-current-dir argument is true, or with
> C-u prefix, start from the current directory."
Changed:
< (regex (if wap (read-string (concat "Grep project for (default \"" wap "\"): ") nil nil wap)
< (read-string "Grep project for: ")))
to
> (regex (or phrase
> (if wap (read-string (concat "Grep project for (default \"" wap "\"): ") nil nil wap)
> (read-string "Grep project for: "))))
Changed:
< (if (mk-proj-has-univ-arg)
to
> (if (or from-current-dir (mk-proj-has-univ-arg))
Changed:
< (defun project-ack ()
to
> (defun project-ack (&optional phrase from-current-dir)
Changed:
< (regex (if wap (read-string (concat "Ack project for (default \"" wap "\"): ") nil nil wap)
< (read-string "Ack project for: ")))
to
> (regex (or phrase
> (if wap (read-string (concat "Ack project for (default \"" wap "\"): ") nil nil wap)
> (read-string "Ack project for: "))))
Changed:
< (if (mk-proj-has-univ-arg)
to
> (if (or from-current-dir (mk-proj-has-univ-arg))
Changed:
< (defun project-compile (opts)
< "Run the compile command for this project."
< (interactive "sCompile options: ")
< (mk-proj-assert-proj)
< (project-home)
< (compile (concat mk-proj-compile-cmd " " opts)))
to
> (defun project-compile (&optional opts)
> "Run the compile command (string or function) for this project."
> (interactive)
> (mk-proj-assert-proj)
> (let ((default-directory mk-proj-basedir))
> (cond ((stringp mk-proj-compile-cmd)
> (when (and (null opts) (called-interactively-p))
> (setq opts (read-string "Compile options: ")))
> (compile (concat mk-proj-compile-cmd " " opts)))
> ((fboundp mk-proj-compile-cmd)
> (cond ((commandp mk-proj-compile-cmd)
> (call-interactively mk-proj-compile-cmd))
> (opts
> (funcall mk-proj-compile-cmd opts))
> (t (funcall mk-proj-compile-cmd))))
> (t (message "No compile command defined.")))))
Changed:
< ;; Home and Dired
to
> ;; Dired
Deleted:
< (defun project-home ()
< "cd to the basedir of the current project"
< (interactive)
< (mk-proj-assert-proj)
< (cd mk-proj-basedir))
Changed:
< "Return list of files in *file-index* matching regex.
to
> "Return list of files in *file-index* matching regex.
Changed:
< (while
< (progn
< (let ((raw-file (buffer-substring (line-beginning-position) (line-end-position))))
< (when (> (length raw-file) 0)
< ;; file names in buffer can be absolute or relative to basedir
< (let ((file (if (file-name-absolute-p raw-file)
< (file-relative-name raw-file mk-proj-basedir)
< raw-file)))
< (if regex
< (when (string-match regex file) (add-to-list 'files file))
< (add-to-list 'files file)))
< (= (forward-line) 0))))) ; loop test
< files)))
to
> (while
> (progn
> (let ((raw-file (mk-proj-normalize-drive-letter
> (buffer-substring
> (line-beginning-position) (line-end-position)))))
> (when (> (length raw-file) 0)
> ;; file names in buffer can be absolute or relative to basedir
> (let ((file (if (file-name-absolute-p raw-file)
> (file-relative-name raw-file mk-proj-basedir)
> raw-file)))
> (if regex
> (when (string-match regex file) (add-to-list 'files file))
> (add-to-list 'files file)))
> (= (forward-line) 0))))) ; loop test
> (sort files #'string-lessp))))
> (defun mk-proj-normalize-drive-letter (file)
> "Convert drive letters to lowercase to be compatible with
> file-relative-name, file-name-as-directory"
> (if (or (null file) (< (length file) 2))
> file
> (let ((c1 (aref file 0))
> (c2 (aref file 1)))
> (if (and (= (aref ":" 0) c2)
> (and (>= c1 (aref "A" 0)) (<= c1 (aref "Z" 0))))
> (concat (char-to-string (+ c1 32)) (substring file 1))
> file))))
Added:
> ;; ---------------------------------------------------------------------
> ;; Menus
> ;; ---------------------------------------------------------------------
> (defun mk-proj-menu-item (key label fn &optional always-enabled-p)
> "Define a mk-project menu item that may not be enabled if a
> project is not loaded."
> (let ((whole-key `[menu-bar mkproject ,key]))
> (define-key global-map whole-key
> `(menu-item ,label ,fn :enable ,(if always-enabled-p 't 'mk-proj-name)))))
> (defun mk-proj-menu-item-separator (key)
> "Define a separator line in the mk-project menu."
> (define-key global-map `[menu-bar mkproject ,key] '(menu-item "--")))
> (defun project-menu ()
> "Define a menu for mk-project operations."
> (interactive)
> ;; define a menu in the top-level menu
> (define-key-after
> global-map
> [menu-bar mkproject]
> (cons "mk-project" (make-sparse-keymap))
> 'tools)
> ;; define the menu items in reverse order
> (mk-proj-menu-item 'tags "Build TAGS" 'project-tags)
> (mk-proj-menu-item 'index "Build Index" 'project-index)
> (mk-proj-menu-item-separator 's2)
> (mk-proj-menu-item 'dired "Browse (dired)" 'project-dired)
> (mk-proj-menu-item 'comp "Compile " 'project-compile)
> (mk-proj-menu-item 'occur "Multi-occur" 'project-multi-occur)
> (mk-proj-menu-item 'ack "Ack" 'project-ack)
> (mk-proj-menu-item 'grep "Grep" 'project-grep)
> (mk-proj-menu-item-separator 's1)
> (mk-proj-menu-item 'status "Status" 'project-status)
> (mk-proj-menu-item 'unload "Unload Project" 'project-unload)
> (mk-proj-menu-item 'load "Load Project" 'project-load t))
> (defun project-menu-remove ()
> "Remove the mk-project menu from the menu bar"
> (interactive)
> (global-unset-key [menu-bar mkproject]))
> (when mk-proj-menu-on
> (project-menu))
;;; mk-project.el --- Lightweight project handling ;; Copyright (C) 2010 Matt Keller <mattkeller at gmail dot com> ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as ;; published by the Free Software Foundation; either version 2, or ;; (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; Quickly switch between projects and perform operations on a ;; per-project basis. A 'project' in this sense is a directory of ;; related files, usually a directory of source files. Projects are ;; defined in pure elisp with the 'project-def' function. No ;; mk-project-specific files are required in the project's base ;; directory. ;; More information about this library, including the most recent ;; version and a comprehensive README, is available at ;; http://github.com/mattkeller/mk-project ;;; Code: (require 'grep) (require 'thingatpt) (require 'cl) (defvar mk-proj-version "1.5.1" "As tagged at http://github.com/mattkeller/mk-project/tree/master") ;; --------------------------------------------------------------------- ;; Project Variables ;; ;; These variables are set when a project is loaded and nil'd out when ;; unloaded. These symbols are the same as defined in the 2nd parameter ;; to project-def except for their "mk-proj-" prefix. ;; --------------------------------------------------------------------- (defvar mk-proj-name nil "Name of the current project. Required. First argument to project-def.") (defvar mk-proj-basedir nil "Base directory of the current project. Required. Value is expanded with expand-file-name. Example: ~me/my-proj/.") (defvar mk-proj-src-patterns nil "List of shell patterns to include in the TAGS file. Optional. Example: '(\"*.java\" \"*.jsp\"). This value is not used when `mk-proj-src-find-cmd' is set.") (defvar mk-proj-ignore-patterns nil "List of shell patterns to avoid searching for with project-find-file and project-grep. Optional. Example: '(\"*.class\"). This value is not used in indexing when `mk-proj-index-find-cmd' is set -- or in grepping when `mk-proj-grep-find-cmd' is set.") (defvar mk-proj-ack-args nil "String of arguments to pass to the `ack' command. Optional. Example: \"--java\".") (defvar mk-proj-vcs nil "When set to one of the VCS types in `mk-proj-vcs-path', grep and index commands will ignore the VCS's private files (e.g., .CVS/). Example: 'git. This value is not used in indexing when `mk-proj-index-find-cmd' is set -- or in grepping when `mk-proj-grep-find-cmd' is set.") ; TODO: support multiple tags file via tags-table-list (defvar mk-proj-tags-file nil "Path to the TAGS file for this project. Optional. Use an absolute path, not one relative to basedir. Value is expanded with expand-file-name.") (defvar mk-proj-compile-cmd nil "Command to build the entire project. Can be either a string specifying a shell command or the name of a function. Optional. Example: make -k.") (defvar mk-proj-startup-hook nil "Hook function to run after the project is loaded. Optional. Project variables (e.g. mk-proj-basedir) will be set and can be referenced from this function.") (defvar mk-proj-shutdown-hook nil "Hook function to run after the project is unloaded. Optional. Project variables (e.g. mk-proj-basedir) will still be set and can be referenced from this function.") (defvar mk-proj-file-list-cache nil "Cache *file-index* buffer to this file. Optional. If set, the *file-index* buffer will take its initial value from this file and updates to the buffer via 'project-index' will save to this file. Value is expanded with expand-file-name.") (defvar mk-proj-open-files-cache nil "Cache the names of open project files in this file. Optional. If set, project-load will open all files listed in this file and project-unload will write all open project files to this file. Value is expanded with expand-file-name.") (defvar mk-proj-src-find-cmd nil "Specifies a custom \"find\" command to locate all files to be included in the TAGS file (see `project-tags'). Optional. The value is either a string or a function of one argument that returns a string. The argument to the function will be the symbol \"'src\". If non-null (or if the function returns non-null), the custom find command will be used and the `mk-proj-src-patterns' and `mk-proj-vcs' settings are ignored when finding files to include in TAGS.") (defvar mk-proj-grep-find-cmd nil "Specifies a custom \"find\" command to use as the default when running `project-grep'. Optional. The value is either a string or a function of one argument that returns a string. The argument to the function will be the symbol \"'grep\". The string or returned string MUST use find's \"-print0\" argument as the results of this command are piped to \"xargs -0 ...\". If non-null (or if the function returns non-null), the custom find command will be used and the `mk-proj-ignore-patterns' and `mk-proj-vcs' settings will not be used in the grep command. The custom find command should use \".\" (current directory) as the path that find starts at -- this will allow the C-u argument to `project-grep' to run the command from the current buffer's directory.") (defvar mk-proj-index-find-cmd nil "Specifies a custom \"find\" command to use when building an listing of all files in the project (to be used by `project-find-file'). Optional. The value is either a string or a function of one argument that returns a string. The argument to the function will be the symbol \"'index\". If non-null (or if the function returns non-null), the custom find command will be used and the `mk-proj-ignore-patterns' and `mk-proj-vcs' settings are not used when in the grep command.") (defconst mk-proj-fib-name "*file-index*" "Buffer name of the file-list cache. This buffer contains a list of all the files under the project's basedir (minus those matching ignore-patterns) or, if index-find-cmd is set, the list of files found by calling the custom find command. The list is used by `project-find-file' to quickly locate project files.") (defconst mk-proj-vcs-path '((git . "'*/.git/*'") (cvs . "'*/.CVS/*'") (svn . "'*/.svn/*'") (bzr . "'*/.bzr/*'") (hg . "'*/.hg/*'") (darcs . "'*/_darcs/*'")) "When `mk-proj-vcs' is one of the VCS types listed here, ignore the associated paths when greping or indexing the project. This value is not used if a custom find command is set in `mk-proj-grep-find-cmd' or `mk-proj-index-find-cmd'") (defconst mk-proj-proj-vars '(mk-proj-name mk-proj-basedir mk-proj-src-patterns mk-proj-ignore-patterns mk-proj-ack-args mk-proj-vcs mk-proj-tags-file mk-proj-compile-cmd mk-proj-startup-hook mk-proj-shutdown-hook mk-proj-file-list-cache mk-proj-open-files-cache mk-proj-src-find-cmd mk-proj-grep-find-cmd mk-proj-index-find-cmd) "List of all our project settings") ;; --------------------------------------------------------------------- ;; Customization ;; --------------------------------------------------------------------- (defgroup mk-project nil "A programming project management library." :group 'tools) (defcustom mk-proj-ack-respect-case-fold t "If on and case-fold-search is true, project-ack will ignore case by passing \"-i\" to ack." :type 'boolean :group 'mk-project) (defcustom mk-proj-use-ido-selection nil "If ido-mode is available, use ido selection where appropriate." :type 'boolean :group 'mk-project) (defcustom mk-proj-ack-cmd (if (eq system-type 'windows-nt) "ack.pl" "ack") "Name of the ack program to run. Defaults to \"ack\" (or \"ack.pl\" on Windows)." :type 'string :group 'mk-project) (defcustom mk-proj-file-index-relative-paths t "If non-nil, generate relative path names in the file-index buffer" :type 'boolean :group 'mk-project) (defcustom mk-proj-menu-on t "If non-nil, define the 'mk-project' menu in the menu-bar at load time. See also `project-menu-remove'." :type 'boolean :group 'mk-project) ;; --------------------------------------------------------------------- ;; Utils ;; --------------------------------------------------------------------- (defun mk-proj-replace-tail (str tail-str replacement) (if (string-match (concat tail-str "$") str) (replace-match replacement t t str) str)) (defun mk-proj-assert-proj () (unless mk-proj-name (error "No project is set!"))) (defun mk-proj-maybe-kill-buffer (bufname) (let ((b (get-buffer bufname))) (when b (kill-buffer b)))) (defun mk-proj-get-vcs-path () (if mk-proj-vcs (cdr (assoc mk-proj-vcs mk-proj-vcs-path)) nil)) (defun mk-proj-has-univ-arg () (eql (prefix-numeric-value current-prefix-arg) 4)) (defun mk-proj-names () (let ((names nil)) (maphash (lambda (k v) (add-to-list 'names k)) mk-proj-list) names)) (defun mk-proj-use-ido () (and (boundp 'ido-mode) mk-proj-use-ido-selection)) (defun mk-proj-find-cmd-val (context) (let ((cmd (ecase context ('src mk-proj-src-find-cmd) ('grep mk-proj-grep-find-cmd) ('index mk-proj-index-find-cmd)))) (if cmd (cond ((stringp cmd) cmd) ((functionp cmd) (funcall cmd context)) (t (error "find-cmd is neither a string or a function"))) nil))) (defun mk-proj-filter (condp lst) (delq nil (mapcar (lambda (x) (and (funcall condp x) x)) lst))) ;; --------------------------------------------------------------------- ;; Project Configuration ;; --------------------------------------------------------------------- (defvar mk-proj-list (make-hash-table :test 'equal)) (defun mk-proj-find-config (proj-name) (gethash proj-name mk-proj-list)) (defun project-def (proj-name config-alist) "Associate the settings in <config-alist> with project <proj-name>" (puthash proj-name config-alist mk-proj-list)) (defun mk-proj-defaults () "Set all default values for project variables" (dolist (var mk-proj-proj-vars) (set var nil))) (defun mk-proj-load-vars (proj-name proj-alist) "Set project variables from proj-alist" (labels ((config-val (key) (if (assoc key proj-alist) (car (cdr (assoc key proj-alist))) nil)) (maybe-set-var (var &optional fn) (let ((proj-var (intern (concat "mk-proj-" (symbol-name var)))) (val (config-val var))) (when val (setf (symbol-value proj-var) (if fn (funcall fn val) val)))))) (mk-proj-defaults) ;; required vars (setq mk-proj-name proj-name) (setq mk-proj-basedir (expand-file-name (config-val 'basedir))) ;; optional vars (dolist (v '(src-patterns ignore-patterns ack-args vcs tags-file compile-cmd src-find-cmd grep-find-cmd index-find-cmd startup-hook shutdown-hook)) (maybe-set-var v)) (maybe-set-var 'tags-file #'expand-file-name) (maybe-set-var 'file-list-cache #'expand-file-name) (maybe-set-var 'open-files-cache #'expand-file-name))) (defun project-load (&optional name) "Load a project's settings." (interactive) (catch 'project-load (let ((oldname mk-proj-name) (name (or name (if (mk-proj-use-ido) (ido-completing-read "Project Name (ido): " (mk-proj-names)) (completing-read "Project Name: " (mk-proj-names)))))) (unless (string= oldname name) (project-unload)) (let ((proj-config (mk-proj-find-config name))) (if proj-config (mk-proj-load-vars name proj-config) (message "Project %s does not exist!" name) (throw 'project-load t))) (when (not (file-directory-p mk-proj-basedir)) (message "Base directory %s does not exist!" mk-proj-basedir) (throw 'project-load t)) (when (and mk-proj-vcs (not (mk-proj-get-vcs-path))) (message "Invalid VCS setting!") (throw 'project-load t)) (message "Loading project %s ..." name) (cd mk-proj-basedir) (mk-proj-tags-load) (mk-proj-fib-init) (mk-proj-visit-saved-open-files) (add-hook 'kill-emacs-hook 'mk-proj-kill-emacs-hook) (when mk-proj-startup-hook (run-hooks 'mk-proj-startup-hook)) (message "Loading project %s done" name)))) (defun mk-proj-kill-emacs-hook () "Ensure we save the open-files-cache info on emacs exit" (when (and mk-proj-name mk-proj-open-files-cache) (mk-proj-save-open-file-info))) (defun project-unload () "Unload the current project's settings after running the shutdown hook." (interactive) (when mk-proj-name (message "Unloading project %s" mk-proj-name) (mk-proj-tags-clear) (mk-proj-maybe-kill-buffer mk-proj-fib-name) (mk-proj-save-open-file-info) (when (and (mk-proj-buffers) (y-or-n-p (concat "Close all " mk-proj-name " project files? ")) (project-close-files))) (when mk-proj-shutdown-hook (run-hooks 'mk-proj-shutdown-hook))) (mk-proj-defaults) (message "Project settings have been cleared")) (defun project-close-files () "Close all unmodified files that reside in the project's basedir" (interactive) (mk-proj-assert-proj) (let ((closed nil) (dirty nil) (basedir-len (length mk-proj-basedir))) (dolist (b (mk-proj-buffers)) (cond ((buffer-modified-p b) (push (buffer-name) dirty)) (t (kill-buffer b) (push (buffer-name) closed)))) (message "Closed %d buffers, %d modified buffers where left open" (length closed) (length dirty)))) (defun mk-proj-buffer-name (buf) "Return buffer's name based on filename or dired's location" (let ((file-name (or (buffer-file-name buf) (with-current-buffer buf list-buffers-directory)))) (if file-name (expand-file-name file-name) nil))) (defun mk-proj-buffer-p (buf) "Is the given buffer in our project based on filename? Also detects dired buffers open to basedir/*" (let ((file-name (mk-proj-buffer-name buf))) (if (and file-name (string-match (concat "^" (regexp-quote mk-proj-basedir)) file-name)) t nil))) (defun mk-proj-buffers () "Get a list of buffers that reside in this project's basedir" (let ((buffers nil)) (dolist (b (buffer-list)) (when (mk-proj-buffer-p b) (push b buffers))) buffers)) (defun project-status () "View project's variables." (interactive) (if mk-proj-basedir (let ((b (get-buffer-create "*project-status*"))) (with-current-buffer b (kill-region (point-min) (point-max)) (dolist (v mk-proj-proj-vars) (insert (format "%-24s = %s\n" v (symbol-value v))))) (when (not (eq b (current-buffer))) (switch-to-buffer-other-window b))) (message "No project loaded."))) ;; --------------------------------------------------------------------- ;; Save/Restore open files ;; --------------------------------------------------------------------- (defun mk-proj-save-open-file-info () "Write the list of `files' to a file" (when mk-proj-open-files-cache (with-temp-buffer (dolist (f (mapcar (lambda (b) (mk-proj-buffer-name b)) (mk-proj-buffers))) (when f (unless (string-equal mk-proj-tags-file f) (insert f "\n")))) (if (file-writable-p mk-proj-open-files-cache) (progn (write-region (point-min) (point-max) mk-proj-open-files-cache) (message "Wrote open files to %s" mk-proj-open-files-cache)) (message "Cannot write to %s" mk-proj-open-files-cache))))) (defun mk-proj-visit-saved-open-files () (when mk-proj-open-files-cache (when (file-readable-p mk-proj-open-files-cache) (message "Reading open files from %s" mk-proj-open-files-cache) (with-temp-buffer (insert-file-contents mk-proj-open-files-cache) (goto-char (point-min)) (while (not (eobp)) (let ((start (point))) (while (not (eolp)) (forward-char)) ; goto end of line (let ((line (buffer-substring start (point)))) (message "Attempting to open %s" line) (find-file-noselect line t))) (forward-line)))))) ;; --------------------------------------------------------------------- ;; Etags ;; --------------------------------------------------------------------- (defun mk-proj-tags-load () "Load TAGS file (if tags-file set)" (mk-proj-tags-clear) (setq tags-file-name mk-proj-tags-file tags-table-list nil) (when (and mk-proj-tags-file (file-readable-p mk-proj-tags-file)) (visit-tags-table mk-proj-tags-file))) (defun mk-proj-tags-clear () "Clear the TAGS file (if tags-file set)" (when (and mk-proj-tags-file (get-file-buffer mk-proj-tags-file)) (mk-proj-maybe-kill-buffer (get-file-buffer mk-proj-tags-file))) (setq tags-file-name nil tags-table-list nil)) (defun mk-proj-etags-cb (process event) "Visit tags table when the etags process finishes." (message "Etags process %s received event %s" process event) (kill-buffer (get-buffer "*etags*")) (cond ((string= event "finished\n") (mk-proj-tags-load) (message "Refreshing TAGS file %s...done" mk-proj-tags-file)) (t (message "Refreshing TAGS file %s...failed" mk-proj-tags-file)))) (defun project-tags () "Regenerate the project's TAG file. Runs in the background." (interactive) (mk-proj-assert-proj) (if mk-proj-tags-file (let* ((tags-file-name (file-name-nondirectory mk-proj-tags-file)) ;; If the TAGS file is in the basedir, we can generate ;; relative filenames which will allow the TAGS file to ;; be relocatable if moved with the source. Otherwise, ;; run the command from the TAGS file's directory and ;; generate absolute filenames. (relative-tags (string= (file-name-as-directory mk-proj-basedir) (file-name-directory mk-proj-tags-file))) (default-directory (file-name-as-directory (file-name-directory mk-proj-tags-file))) (default-find-cmd (concat "find '" (if relative-tags "." mk-proj-basedir) "' -type f " (mk-proj-find-cmd-src-args mk-proj-src-patterns))) (etags-cmd (concat (or (mk-proj-find-cmd-val 'src) default-find-cmd) " | etags -o '" tags-file-name "' - ")) (proc-name "etags-process")) (message "project-tags default-dir %s" default-directory) (message "project-tags cmd \"%s\"" etags-cmd) (message "Refreshing TAGS file %s..." mk-proj-tags-file) (start-process-shell-command proc-name "*etags*" etags-cmd) (set-process-sentinel (get-process proc-name) 'mk-proj-etags-cb)) (message "mk-proj-tags-file is not set"))) (defun mk-proj-find-cmd-src-args (src-patterns) "Generate the ( -name <pat1> -o -name <pat2> ...) pattern for find cmd" (if src-patterns (let ((name-expr " \\(")) (dolist (pat src-patterns) (setq name-expr (concat name-expr " -name \"" pat "\" -o "))) (concat (mk-proj-replace-tail name-expr "-o " "") "\\) ")) "")) (defun mk-proj-find-cmd-ignore-args (ignore-patterns) "Generate the -not ( -name <pat1> -o -name <pat2> ...) pattern for find cmd" (if ignore-patterns (concat " -not " (mk-proj-find-cmd-src-args ignore-patterns)) "")) ;; --------------------------------------------------------------------- ;; Grep ;; --------------------------------------------------------------------- (defun project-grep (&optional phrase from-current-dir) "Run find-grep on the project's basedir, excluding files in mk-proj-ignore-patterns, tag files, etc. If the phrase argument is not included, it will prompt for a search phrase. If the from-current-dir argument is true, or with C-u prefix, start from the current directory." (interactive) (mk-proj-assert-proj) (let* ((wap (word-at-point)) (regex (or phrase (if wap (read-string (concat "Grep project for (default \"" wap "\"): ") nil nil wap) (read-string "Grep project for: ")))) (find-cmd "find . -type f") (grep-cmd (concat "grep -i -n \"" regex "\"")) (default-directory (file-name-as-directory (if (or from-current-dir (mk-proj-has-univ-arg)) default-directory mk-proj-basedir)))) (when mk-proj-ignore-patterns (setq find-cmd (concat find-cmd (mk-proj-find-cmd-ignore-args mk-proj-ignore-patterns)))) (when mk-proj-tags-file (setq find-cmd (concat find-cmd " -not -name 'TAGS'"))) (when (mk-proj-get-vcs-path) (setq find-cmd (concat find-cmd " -not -path " (mk-proj-get-vcs-path)))) (let* ((whole-cmd (concat (or (mk-proj-find-cmd-val 'grep) (concat find-cmd " -print0")) " | xargs -0 -e " grep-cmd)) (confirmed-cmd (read-string "Grep command: " whole-cmd nil whole-cmd))) (message "project-grep cmd: \"%s\"" confirmed-cmd) (grep-find confirmed-cmd)))) ;; --------------------------------------------------------------------- ;; Ack (betterthangrep.com) ;; --------------------------------------------------------------------- (define-compilation-mode ack-mode "Ack" "Ack compilation mode." nil) (defvar mk-proj-ack-default-args "--nocolor --nogroup") (defun mk-proj-ack-cmd (regex) "Generate the ack command string given a regex to search for." (concat mk-proj-ack-cmd " " mk-proj-ack-default-args " " (if (and mk-proj-ack-respect-case-fold case-fold-search) "-i " "") mk-proj-ack-args " " regex)) (defun project-ack (&optional phrase from-current-dir) "Run ack from project's basedir, using the `ack-args' configuration. With C-u prefix, start ack from the current directory." (interactive) (mk-proj-assert-proj) (let* ((wap (word-at-point)) (regex (or phrase (if wap (read-string (concat "Ack project for (default \"" wap "\"): ") nil nil wap) (read-string "Ack project for: ")))) (whole-cmd (mk-proj-ack-cmd regex)) (confirmed-cmd (read-string "Ack command: " whole-cmd nil whole-cmd)) (default-directory (file-name-as-directory (if (or from-current-dir (mk-proj-has-univ-arg)) default-directory mk-proj-basedir)))) (compilation-start confirmed-cmd 'ack-mode))) ;; --------------------------------------------------------------------- ;; Compile ;; --------------------------------------------------------------------- (defun project-compile (&optional opts) "Run the compile command (string or function) for this project." (interactive) (mk-proj-assert-proj) (let ((default-directory mk-proj-basedir)) (cond ((stringp mk-proj-compile-cmd) (when (and (null opts) (called-interactively-p)) (setq opts (read-string "Compile options: "))) (compile (concat mk-proj-compile-cmd " " opts))) ((fboundp mk-proj-compile-cmd) (cond ((commandp mk-proj-compile-cmd) (call-interactively mk-proj-compile-cmd)) (opts (funcall mk-proj-compile-cmd opts)) (t (funcall mk-proj-compile-cmd)))) (t (message "No compile command defined."))))) ;; --------------------------------------------------------------------- ;; Dired ;; --------------------------------------------------------------------- (defun project-dired () "Open dired in the project's basedir (or jump to the existing dired buffer)" (interactive) (mk-proj-assert-proj) (dired mk-proj-basedir)) ;; --------------------------------------------------------------------- ;; Find-file ;; --------------------------------------------------------------------- (defun mk-proj-fib-init () "Either load the *file-index* buffer from the file cache, or create it afresh." (if (and mk-proj-file-list-cache (file-readable-p mk-proj-file-list-cache)) (with-current-buffer (find-file-noselect mk-proj-file-list-cache) (with-current-buffer (rename-buffer mk-proj-fib-name) (setq buffer-read-only t) (set-buffer-modified-p nil) (message "Loading *file-index* from %s" mk-proj-file-list-cache))) (project-index))) (defun mk-proj-fib-clear () "Clear the contents of the fib buffer" (let ((buf (get-buffer mk-proj-fib-name))) (when buf (with-current-buffer buf (setq buffer-read-only nil) (kill-region (point-min) (point-max)) (setq buffer-read-only t))))) (defun mk-proj-fib-cb (process event) "Handle failure to complete fib building" (cond ((string= event "finished\n") (with-current-buffer (get-buffer mk-proj-fib-name) (setq buffer-read-only t) (when mk-proj-file-list-cache (write-file mk-proj-file-list-cache) (rename-buffer mk-proj-fib-name))) (message "Refreshing %s buffer...done" mk-proj-fib-name)) (t (mk-proj-fib-clear) (message "Failed to generate the %s buffer!" mk-proj-fib-name)))) (defun project-index () "Regenerate the *file-index* buffer that is used for project-find-file" (interactive) (mk-proj-assert-proj) (when mk-proj-file-list-cache (mk-proj-fib-clear) (let* ((default-directory (file-name-as-directory mk-proj-basedir)) (start-dir (if mk-proj-file-index-relative-paths "." mk-proj-basedir)) (find-cmd (concat "find '" start-dir "' -type f " (mk-proj-find-cmd-ignore-args mk-proj-ignore-patterns))) (proc-name "index-process")) (when (mk-proj-get-vcs-path) (setq find-cmd (concat find-cmd " -not -path " (mk-proj-get-vcs-path)))) (setq find-cmd (or (mk-proj-find-cmd-val 'index) find-cmd)) (with-current-buffer (get-buffer-create mk-proj-fib-name) (buffer-disable-undo) ;; this is a large change we don't need to undo (setq buffer-read-only nil)) (message "project-index cmd: \"%s\"" find-cmd) (message "Refreshing %s buffer..." mk-proj-fib-name) (start-process-shell-command proc-name mk-proj-fib-name find-cmd) (set-process-sentinel (get-process proc-name) 'mk-proj-fib-cb)))) (defun mk-proj-fib-matches (regex) "Return list of files in *file-index* matching regex. If regex is nil, return all files. Returned file paths are relative to the project's basedir." (let ((files '())) (with-current-buffer mk-proj-fib-name (goto-char (point-min)) (while (progn (let ((raw-file (mk-proj-normalize-drive-letter (buffer-substring (line-beginning-position) (line-end-position))))) (when (> (length raw-file) 0) ;; file names in buffer can be absolute or relative to basedir (let ((file (if (file-name-absolute-p raw-file) (file-relative-name raw-file mk-proj-basedir) raw-file))) (if regex (when (string-match regex file) (add-to-list 'files file)) (add-to-list 'files file))) (= (forward-line) 0))))) ; loop test (sort files #'string-lessp)))) (defun mk-proj-normalize-drive-letter (file) "Convert drive letters to lowercase to be compatible with file-relative-name, file-name-as-directory" (if (or (null file) (< (length file) 2)) file (let ((c1 (aref file 0)) (c2 (aref file 1))) (if (and (= (aref ":" 0) c2) (and (>= c1 (aref "A" 0)) (<= c1 (aref "Z" 0)))) (concat (char-to-string (+ c1 32)) (substring file 1)) file)))) (defun* project-find-file (regex) "Find file in the current project matching the given regex. The files listed in buffer *file-index* are scanned for regex matches. If only one match is found, the file is opened automatically. If more than one match is found, prompt for completion. See also: `project-index', `project-find-file-ido'." (interactive "sFind file in project matching: ") (mk-proj-assert-proj) (unless (get-buffer mk-proj-fib-name) (message "Please use project-index to create the index before running project-find-file") (return-from "project-find-file" nil)) (let* ((matches (mk-proj-fib-matches regex)) (match-cnt (length matches))) (cond ((= 0 match-cnt) (message "No matches for \"%s\" in this project" regex)) ((= 1 match-cnt ) (find-file (car matches))) (t (let ((file (if (mk-proj-use-ido) (ido-completing-read "Multiple matches, pick one (ido): " matches) (completing-read "Multiple matches, pick one: " matches)))) (when file (find-file (concat (file-name-as-directory mk-proj-basedir) file)))))))) (defun* project-find-file-ido () "Find file in the current project using 'ido'. Choose a file to open from among the files listed in buffer *file-index*. The ordinary 'ido' methods allow advanced selection of the file. See also: `project-index', `project-find-file'." (interactive) (mk-proj-assert-proj) (unless (get-buffer mk-proj-fib-name) (message "Please use project-index to create the index before running project-find-file-ido") (return-from "project-find-file-ido" nil)) (let ((file (ido-completing-read "Find file in project matching (ido): " (mk-proj-fib-matches nil)))) (when file (find-file (concat (file-name-as-directory mk-proj-basedir) file))))) (defun project-multi-occur (regex) "Search all open project files for 'regex' using `multi-occur'" (interactive "sRegex: ") (multi-occur (mk-proj-filter (lambda (b) (if (buffer-file-name b) b nil)) (mk-proj-buffers)) regex)) ;; --------------------------------------------------------------------- ;; Menus ;; --------------------------------------------------------------------- (defun mk-proj-menu-item (key label fn &optional always-enabled-p) "Define a mk-project menu item that may not be enabled if a project is not loaded." (let ((whole-key `[menu-bar mkproject ,key])) (define-key global-map whole-key `(menu-item ,label ,fn :enable ,(if always-enabled-p 't 'mk-proj-name))))) (defun mk-proj-menu-item-separator (key) "Define a separator line in the mk-project menu." (define-key global-map `[menu-bar mkproject ,key] '(menu-item "--"))) (defun project-menu () "Define a menu for mk-project operations." (interactive) ;; define a menu in the top-level menu (define-key-after global-map [menu-bar mkproject] (cons "mk-project" (make-sparse-keymap)) 'tools) ;; define the menu items in reverse order (mk-proj-menu-item 'tags "Build TAGS" 'project-tags) (mk-proj-menu-item 'index "Build Index" 'project-index) (mk-proj-menu-item-separator 's2) (mk-proj-menu-item 'dired "Browse (dired)" 'project-dired) (mk-proj-menu-item 'comp "Compile " 'project-compile) (mk-proj-menu-item 'occur "Multi-occur" 'project-multi-occur) (mk-proj-menu-item 'ack "Ack" 'project-ack) (mk-proj-menu-item 'grep "Grep" 'project-grep) (mk-proj-menu-item-separator 's1) (mk-proj-menu-item 'status "Status" 'project-status) (mk-proj-menu-item 'unload "Unload Project" 'project-unload) (mk-proj-menu-item 'load "Load Project" 'project-load t)) (defun project-menu-remove () "Remove the mk-project menu from the menu bar" (interactive) (global-unset-key [menu-bar mkproject])) (when mk-proj-menu-on (project-menu)) (provide 'mk-project) ;;; mk-project.el ends here