3af8313c8d330c9f5e02fdc9eadfe15e4f8676da
1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;; eproject.el --- project workspaces for emacs
5 ;; Copyright (C) 2008-2010 grischka
7 ;; Author: grischka -- grischka@users.sourceforge.net
8 ;; Created: 24 Jan 2008
11 ;; This program is free software, released under the GNU General
12 ;; Public License (GPL, version 2). For details see:
14 ;; http://www.fsf.org/licenses/gpl.html
16 ;; This program is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
21 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24 ;; User-configurable items:
25 (defgroup prj-group
'()
26 "Group for eproject customization")
29 (defcustom prj-keybindings
'(
30 ([f5] eproject-setup-toggle always)
31 ([M-right] eproject-nextfile)
32 ([M-left] eproject-prevfile)
33 ([C-f5] eproject-dired)
35 "Key bindings in eproject"
41 :match-alternatives (vectorp stringp))
43 (choice :format "%[Always provide%] %v"
44 (const :tag "yes" always)
45 (const :tag "no" nil))))
49 (defcustom prj-default-config
52 ("Clean" "make clean" "C-f9")
53 ("Run" "echo run what" "f8")
54 ("Stop" "-e eproject-killtool" "C-f8")
56 ("Configure" "./configure")
58 ("Explore Project" "nautilus --browser `pwd` &")
59 ("XTerm In Project" "xterm &"))
60 "*The default tools menu for new projects in eproject."
64 (const :tag "--- Item separator ---" ("---"))
67 (string :tag "shell command")
68 (choice :format "%[Toggle%] %v"
71 :match-alternatives (vectorp stringp))
72 (const :inline t :tag "No key sequence" nil)))))
76 (defcustom prj-autotracking t
77 "*Should eproject automatically add/remove files to/from the project (nil/t)"
80 ; To apply, close and reopen the project.
82 (defcustom prj-rename-buffers t
83 "*Should eproject rename buffers to project-relative filenames (nil/t)"
87 (defcustom prj-set-default-directory nil
88 "*Should eproject set the project directory as default-directory
89 for all project files (nil/t)."
93 (defcustom prj-set-framepos nil
94 "*Should eproject restore the last frame position/size (nil/t)."
98 (defcustom prj-set-compilation-frame nil
99 "*Should eproject show compilation output in the other frame (nil/t)."
103 (defcustom prj-set-multi-isearch nil
104 "*Should eproject setup multi-isearch in the project files (nil/t)."
108 ;; End of user-configurable items
109 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
111 ;; There is a global file (~/.emacs.d/eproject.lst)
112 (defun prj-globalfile ()
113 (expand-file-name "eproject.lst"
114 (if (boundp 'user-emacs-directory)
119 ;; with the list of all projects
122 ;; and the project that was open in the last session (if any)
123 (defvar prj-last-open nil)
125 ;; and the frame coords from last session
126 (defvar prj-frame-pos nil)
128 ;; eproject version that created the config file
129 (defvar prj-version nil)
131 ;; Here is a function to reset these
133 (setq prj-version nil)
135 (setq prj-last-open nil)
136 (setq prj-frame-pos nil)
139 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
140 ;; Each project has a directory
142 (defvar prj-directory)
144 ;; with a configuration files in it
145 (defvar prj-default-cfg "eproject.cfg")
147 ;; This file defines:
155 ;; an alist of settings
161 ;; a list of utility functions (feature incomplete)
162 (defvar prj-functions nil)
164 ;; directory to run commands, default to prj-directory
165 (defvar prj-exec-directory)
167 ;; The current project
170 ;; A list with generated functions for each tool
171 (defvar prj-tools-fns)
173 ;; A list with files removed from the project
174 (defvar prj-removed-files)
176 ;; Here is a function to reset/close the project
178 (setq prj-version nil)
179 (setq prj-current nil)
180 (setq prj-directory nil)
181 (setq prj-exec-directory nil)
183 (setq prj-removed-files nil)
184 (setq prj-curfile nil)
185 (setq prj-config nil)
186 (setq prj-tools-fns nil)
187 (setq prj-tools (copy-tree prj-default-config))
188 (prj-reset-functions)
191 (defun prj-reset-functions ()
192 (dolist (l prj-functions)
193 (if (eq (car l) 'setq)
194 (makunbound (cadr l))
195 (fmakunbound (cadr l))
197 (setq prj-functions nil)
200 (defun prj-set-functions (s)
201 (prj-reset-functions)
202 (setq prj-functions s)
203 (dolist (l s) (eval l))
206 ;; Some more variables:
208 ;; the frame that exists on startup
209 (defvar prj-initial-frame nil)
211 ;; this is put into minor-mode-alist
212 (defvar eproject-mode t)
214 ;; where this file is in
215 (defvar eproject-directory)
217 ;; eproject version that created the files
218 (defvar eproject-version "0.4")
222 (defun eproject-setup-toggle () (interactive))
223 (defun eproject-setup-quit () (interactive))
224 (defun prj-config-get-result (s))
225 (defun prj-config-reset ())
226 (defun prj-config-print ())
227 (defun prj-config-parse ())
230 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
233 (defun caddr (l) (car (cddr l)))
235 (defun prj-del-list (l e)
236 (let ((a (assoc (car e) l)))
241 (defun prj-add-list (l e)
242 (nconc (prj-del-list l e) (list e))
245 (defun prj-next-file (l e)
246 (and (setq e (assoc (car e) l))
250 (defun prj-prev-file (l e)
251 (prj-next-file (reverse l) e)
254 ; replace a closed file, either by the previous or the next.
255 (defun prj-otherfile (l f)
256 (or (prj-prev-file l f)
260 ;; make relative path, but only up to the second level of ..
261 (defun prj-relative-path (f)
262 (let ((r (file-relative-name f prj-directory)))
263 (if (string-match "^\\.\\.[/\\]\\.\\.[/\\]\\.\\.[/\\]" r)
268 ;; friendly truncate filename
269 (defun prj-shortname (s)
270 (let ((l (length s)) (x 30) n)
274 (setq n (length (file-name-nondirectory s)))
275 (if (< n l) (setq n (1+ n)))
278 (concat (substring s 0 (- x n)) "..." (substring s (- n)))
281 (concat (substring s 0 x) "...")
284 (concat "..." (substring s (- n) (- (- x 3) n)) "...")
287 (defun prj-settitle ()
288 (modify-frame-parameters
292 (format "emacs - %s" (car prj-current))
295 (defun eproject-addon (f)
296 (concat eproject-directory f)
299 (defun prj-goto-line (n)
301 (beginning-of-line n)
304 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
305 ;; Write configuration to file
307 (defun prj-print-list (s fp)
309 (setq v (list 'setq s
310 (if (and (atom v) (null (and (symbolp v) v)))
315 (pp v fp) (princ "\n" fp)
318 (defun prj-create-file (filename)
319 (let ((fp (generate-new-buffer filename)))
320 (princ ";; -*- mode: Lisp; -*-\n\n" fp)
323 (defun prj-close-file (fp)
324 (with-current-buffer fp
326 (and t (write-region nil nil (buffer-name fp) nil 0))
332 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
333 ;; Load/Save global project list and initial frame sizes
335 (defun prj-loadlist ()
337 (load (prj-globalfile) t t)
338 (setq prj-version eproject-version)
341 (defun prj-get-frame-pos (f)
343 (lambda (parm) (cons parm (frame-parameter f parm)))
344 '(top left width height)
347 (defun prj-savelist ()
348 (let ((g (prj-globalfile)) fp)
349 (unless (file-exists-p g)
350 (make-directory (file-name-directory g) t)
352 (setq prj-last-open (car prj-current))
353 (when (frame-live-p prj-initial-frame)
354 (setq prj-frame-pos (prj-get-frame-pos prj-initial-frame))
356 (setq fp (prj-create-file g))
358 (prj-print-list 'prj-version fp)
359 (prj-print-list 'prj-list fp)
360 (prj-print-list 'prj-last-open fp)
361 (prj-print-list 'prj-frame-pos fp)
365 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
366 ;; Load/Save local per-project configuration file
368 (defun prj-update-config ()
369 (let ((d (prj-get-directory prj-current))
370 (e (prj-getconfig "exec-root"))
372 (if e (setq d (expand-file-name e d)))
373 (setq prj-exec-directory (file-name-as-directory d))
376 (defun prj-get-directory (a)
377 (file-name-as-directory (expand-file-name (cadr a)))
380 (defun prj-get-cfg ()
381 (expand-file-name (or (caddr prj-current) prj-default-cfg) prj-directory)
384 (defun prj-get-buffer (a)
385 (cond ((buffer-live-p (cdr a))
389 (get-file-buffer (expand-file-name (car a) prj-directory))
392 (defun prj-loadconfig (a)
396 (setq prj-directory (prj-get-directory a))
397 (when (file-regular-p (setq lf (prj-get-cfg)))
400 (or (assoc prj-curfile prj-files)
404 (if (setq e (prj-getconfig "project-name"))
406 (prj-setconfig "project-name" (car a))
409 (prj-set-functions prj-functions)
410 (setq prj-version eproject-version)
413 (defun prj-saveconfig ()
417 (setq w (selected-window))
418 (setq c (window-buffer w))
419 (dolist (a prj-files)
420 (setq b (prj-get-buffer a))
422 (set-window-buffer w b t)
423 (with-current-buffer b
424 (let ((s (line-number-at-pos (window-start w)))
425 (p (line-number-at-pos (window-point w)))
427 (push (list (car a) s p) files)
433 (push (list (car a)) files)
435 (set-window-buffer w c t)
437 (let ((fp (prj-create-file (prj-get-cfg)))
438 (prj-curfile (car prj-curfile))
439 (prj-files (nreverse files))
442 (prj-print-list 'prj-version fp)
443 (prj-print-list 'prj-config fp)
444 (prj-print-list 'prj-tools fp)
445 (prj-print-list 'prj-files fp)
446 (prj-print-list 'prj-curfile fp)
447 (prj-print-list 'prj-functions fp)
452 (defun prj-saveall ()
457 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
458 ;; The core functions: Open / Close / Add / Remove Project
460 (defun eproject-open (a)
461 "Open another project."
464 (or (prj-config-get-result 'p)
465 (completing-read "Open Project: " (mapcar 'car prj-list))
468 (let ((b (assoc a prj-list)))
470 (error "No such project: %s" a)
474 (setq a (or (car (member a prj-list)) a))
475 (unless (eq a prj-current)
476 (unless (file-directory-p (prj-get-directory a))
477 (error "No such directory: %s" (cadr a))
479 (setq prj-list (cons a (delq a prj-list)))
486 (unless (prj-edit-file prj-curfile)
490 (defun eproject-close ()
491 "Close the current project."
499 (save-some-buffers nil)
500 (eproject-killbuffers t)
503 (or f (prj-addhooks))
511 (defun eproject-killbuffers (&optional from-project)
512 "If called interactively kills all buffers that do not belong to project files"
515 (dolist (a prj-files)
516 (setq b (prj-get-buffer a))
517 (if b (setq l (cons (list b) l)))
519 (dolist (b (buffer-list))
520 (when (eq (consp (assoc b l)) from-project)
524 (defun eproject-add (dir &optional name cfg)
525 "Add a new or existing project to the list."
528 (setq d (read-directory-name "Add project in directory: " prj-directory nil t))
529 (setq n (file-name-nondirectory (directory-file-name d)))
530 (setq n (read-string "Project name: " n))
531 (setq f (read-string "Project file: " prj-default-cfg))
535 (setq dir (directory-file-name dir))
537 (setq name (file-name-nondirectory dir))
539 (when (and cfg (string-equal cfg prj-default-cfg))
542 (let ((a (if cfg (list name dir cfg) (list name dir))))
547 (defun eproject-remove (a)
548 "Remove a project from the list."
551 (or (prj-config-get-result 'p)
552 (completing-read "Remove project: " (mapcar 'car prj-list))
555 (let ((b (assoc a prj-list)))
557 (error "No such project: %s" a)
563 (prog1 (y-or-n-p (format "Remove \"%s\"? " (car a)))
566 (setq prj-list (prj-del-list prj-list a))
570 (defun eproject-save ()
571 "Save the project configuration to file."
578 (defun eproject-revert ()
579 "Reload the project configuration from file."
583 (prj-loadconfig prj-current)
588 (defun eproject-addfile (f)
589 "Add a file to the current project."
593 (read-file-name "Add file to project: " nil nil t nil)
595 (unless prj-current (error "No project open"))
596 (prj-insert-file f (prj-config-get-result 'f))
601 (defun eproject-removefile (a)
602 "Remove a file from the current project."
603 (interactive (prj-get-existing-file-1 "Remove file from project: "))
604 (setq a (prj-get-existing-file-2 a))
608 (defun eproject-visitfile (a)
609 "Visit a file from the current project."
610 (interactive (prj-get-existing-file-1 "Visit file: "))
611 (setq a (prj-get-existing-file-2 a))
615 (defun prj-get-existing-file-1 (msg)
618 (or (prj-config-get-result 'f)
619 (completing-read msg (mapcar 'car prj-files))
622 (defun prj-get-existing-file-2 (a)
623 (unless prj-current (error "No project open"))
626 (let ((b (assoc (prj-relative-path a) prj-files)))
627 (unless b (error "No such file in project: %s" a))
631 (defun eproject-help ()
632 "Show the eproject README."
634 (view-file (eproject-addon "eproject.txt"))
637 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
638 ;; Hook functions to track opening/closing files from emacs
640 (defun prj-addhooks ()
641 (when prj-autotracking
642 (add-hook 'kill-buffer-hook 'prj-kill-buffer-hook)
643 (add-hook 'find-file-hook 'prj-find-file-hook)
644 (add-hook 'window-configuration-change-hook 'prj-wcc-hook)
647 (defun prj-removehooks ()
648 (remove-hook 'window-configuration-change-hook 'prj-wcc-hook)
649 (remove-hook 'find-file-hook 'prj-find-file-hook)
650 (remove-hook 'kill-buffer-hook 'prj-kill-buffer-hook)
653 (defun prj-wcc-hook ()
654 (dolist (w (window-list))
655 (prj-register-buffer (window-buffer w))
658 (defun prj-find-file-hook ()
659 (run-with-idle-timer 0.2 nil 'prj-wcc-hook)
662 (defun prj-kill-buffer-hook ()
663 (let ((b (current-buffer)) a)
664 (if (setq a (rassq b prj-files))
665 (prj-remove-file a t)
666 (if (setq a (rassq b prj-removed-files))
667 (setq prj-removed-files (delq a prj-removed-files))
670 (defun prj-register-buffer (b)
672 (setq f (buffer-file-name b))
673 (when (and f t) ;;(not (string-match "^\\." (file-name-nondirectory f))))
674 (setq a (rassq b prj-files))
676 (setq a (prj-insert-file f nil t))
678 (prj-init-buffer a b)
680 (when (and a (null (eq a prj-curfile)))
686 (defun prj-insert-file (f &optional after on-the-fly)
687 (let ((r (prj-relative-path f)) a m)
688 (setq a (assoc r prj-files))
689 (unless (or a (and on-the-fly (assoc r prj-removed-files)))
691 (setq m (memq (or after prj-curfile) prj-files))
693 (setcdr m (cons a (cdr m)))
694 (setq prj-files (prj-add-list prj-files a))
696 (setq prj-removed-files (prj-del-list prj-removed-files a))
697 (message "Added to project: %s" r)
701 (defun prj-remove-file (a &optional on-the-fly)
702 (let ((n (prj-otherfile prj-files a)) b)
703 (setq prj-files (prj-del-list prj-files a))
704 (when (eq prj-curfile a)
708 (setq prj-removed-files (prj-add-list prj-removed-files a))
710 (unless (prj-config-print)
711 (prj-edit-file prj-curfile)
714 (message "Removed from project: %s" (car a))
717 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
720 (defun prj-init-buffer (a b)
721 (with-current-buffer b
722 (when prj-rename-buffers
723 (rename-buffer (car a) t)
725 (when prj-set-default-directory
731 (defun prj-find-file (a)
734 (setq b (prj-get-buffer a))
737 (setq f (expand-file-name (car a) prj-directory))
738 (setq b (find-file-noselect f))
740 (when (and b (consp (cdr a)))
744 (prj-init-buffer a b)
748 (defun prj-edit-file (a)
749 (let ((f (prj-find-file a)))
751 (eproject-setup-quit)
752 (switch-to-buffer (car f))
753 (prj-restore-edit-pos (cdr f) (selected-window))
755 ;;(message "dir: %s" default-directory)
760 (defun prj-restore-edit-pos (pos w)
761 (let ((top (car pos)) (line (cadr pos)))
762 (when (and (numberp top) (numberp line))
764 (set-window-start w (point))
768 (defun prj-select-window (w)
769 (let (focus-follows-mouse)
771 (select-frame-set-input-focus (window-frame w))
774 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
775 ;; choose next/previous file
778 (defun eproject-nextfile ()
779 "Switch to the next file that belongs to the current project."
781 (prj-switch-file 'prj-next-file 'next-buffer)
785 (defun eproject-prevfile ()
786 "Switch to the previous file that belongs to the current project."
788 (prj-switch-file 'prj-prev-file 'previous-buffer)
791 (defun prj-switch-file (fn1 fn2)
792 (let ((a (rassoc (current-buffer) prj-files)))
794 (prj-edit-file (or (funcall fn1 prj-files a) a))
797 (prj-edit-file prj-curfile)
803 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
806 (defun prj-setkeys ()
807 (let ((f (consp prj-current))
808 (a (assoc 'eproject-mode minor-mode-map-alist))
809 (map (make-sparse-keymap))
813 (push (cons 'eproject-mode map) minor-mode-map-alist)
815 (dolist (k prj-keybindings)
816 (when (or f (eq (caddr k) 'always))
817 (define-key map (car k) (cadr k))
822 (dolist (a prj-tools)
823 (unless (setq fn (nth n prj-tools-fns))
824 (setq fn (list 'lambda))
825 (setq prj-tools-fns (nconc prj-tools-fns (list fn)))
827 (setcdr fn `(() (interactive) (prj-run-tool ',a)))
829 (when (setq s (caddr a))
830 (define-key map (prj-parse-key s) (and f fn))
833 (defun prj-parse-key (s)
835 (if (string-match "[a-z][a-z0-9]+$" s)
837 (concat "\"\\" s "\""))))
839 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
842 (defun prj-list-sorted ()
843 (sort (append prj-list nil)
844 '(lambda (a b) (string-lessp (car a) (car b)))
847 (defun prj-setmenu ()
848 (let ((f (consp prj-current)) m1 m2 m3)
851 `(("Open" open ,@(prj-menulist-maker prj-list prj-current 'prj-menu-open))
853 ("Add ..." "Add new or existing project to the list" . eproject-add)
854 ("Remove ..." "Remove project from the list" . eproject-remove)
855 ,@(and f '(("Close" "Close current project" . eproject-close)))
857 ("Setup" "Enter the project setup area." . eproject-setup-toggle)
858 ("Help" "View eproject.txt" . eproject-help)
862 (nconc m1 (cons '("--") (prj-menulist-maker prj-tools nil prj-tools-fns)))
864 `(("Dired" "Browse project directory in Dired - Use 'a' to add file(s) to the project" . eproject-dired)
866 ,@(prj-menulist-maker prj-files prj-curfile 'prj-menu-edit)
871 `((buffer "Project" project ,@m1)
872 (file "List" list ,@m2)
877 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
879 (defun prj-menu-edit ()
881 (let ((a (nth last-command-event prj-files)))
882 (if a (prj-edit-file a))
885 (defun prj-menu-open ()
887 (let ((a (nth last-command-event prj-list)))
888 (if a (eproject-open (car a)))
891 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
893 (defun prj-menu-maker (map l v)
894 (let ((e (list nil)))
895 (setq v (append v e))
896 (dolist (k (reverse l))
898 (when (symbolp (car k))
905 ((and (consp (cdr k)) (symbolp (cadr k)))
908 (setq k (and s (cons (car k) (make-sparse-keymap (car k)))))
911 (setcar e (intern (downcase (car k))))
914 (define-key-after map (vconcat v) k a)
915 (define-key map (vconcat v) k)
917 (if s (prj-menu-maker map s v))
920 (defun prj-copy-head (l n)
922 (while (and l (> n 0))
929 (defun prj-split-list (l n)
932 (push (prj-copy-head l n) r)
933 (setq l (nthcdr n l))
938 (defun prj-menulist-maker (l act fns)
939 (let (r (w 30) s (m 0) (n 0) k)
942 (prj-menulist-maker-1 (list l fns n) act)
945 ;; menu too long; split into submenus
946 (setq s (prj-split-list l w))
947 (setq k (prj-menulist-maker-1 (list (append (pop s) '(("--"))) fns n) act))
948 (setq r (nreverse k))
951 (setq fns (nthcdr w fns))
954 (setq k (prj-menulist-maker-1 (list l fns n) act))
955 (push (cons (concat (prj-shortname (caar l)) " ...")
956 (cons (intern (format "m_%d" (setq m (1+ m))))
962 (defun prj-menulist-maker-1 (l act)
968 (setcar (cddr l) (1+ n))
969 (setq f (if (consp (cadr l))
970 (prog1 (car (cadr l)) (setcar (cdr l) (cdr (cadr l))))
974 (unless (string-match "^ *#" i)
975 (setq s (if (and (consp (cdr a)) (stringp (cadr a))) (cadr a) i))
977 (setq e (cons s (cons (intern s) (prj-menulist-maker-1 l act))))
984 (setq i (prj-shortname i))
985 (setq e (cons n (if (eq a act)
986 `(menu-item ,i ,f :button (:toggle . t) :help ,s)
987 (cons i (cons s f)))))
994 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
995 ;; Run make and other commands
997 (defun prj-compilation-in-frame (cmd)
998 (let ((bn "*compilation*") w h b c f)
999 (unless (get-buffer-window bn t)
1000 (setq b (get-buffer-create bn))
1001 (setq f (frame-list))
1003 (setq w (frame-first-window (car f)))
1004 (delete-other-windows w)
1007 (setq h (/ (* 70 (frame-height)) 100))
1008 (delete-other-windows w)
1009 (setq w (split-window w h))
1011 (set-window-buffer w b)
1013 (let ((display-buffer-reuse-frames t) (f (selected-frame)))
1015 (select-frame-set-input-focus f)
1018 (defun prj-run (cmd)
1019 (cond ((string-match "^-e +" cmd)
1020 (setq cmd (read (substring cmd (match-end 0))))
1021 (unless (commandp cmd)
1022 (setq cmd `(lambda () (interactive) ,cmd))
1024 (command-execute cmd)
1026 ((let ((b (current-buffer))
1027 (old-dir default-directory)
1030 (when (string-match "^-in +\\([^[:space:]]+\\) +" cmd)
1031 (setq new-dir (match-string-no-properties 1 cmd))
1032 (setq cmd (substring cmd (match-end 0)))
1034 (when prj-exec-directory
1035 (setq new-dir (expand-file-name new-dir prj-exec-directory))
1038 (cond ((string-match "\\(.+\\)& *$" cmd)
1039 (start-process-shell-command
1040 "eproject-async" nil (match-string 1 cmd))
1041 (message (match-string 1 cmd))
1043 (prj-set-compilation-frame
1044 (prj-compilation-in-frame cmd)
1049 (with-current-buffer b (cd old-dir))
1052 (defun prj-run-tool (a)
1053 (unless (string-match "^--+$" (car a))
1054 (prj-run (or (cadr a) (car a)))
1057 (defun eproject-killtool ()
1059 (let ((bn "*compilation*") w0 w1)
1060 (when (setq w1 (get-buffer-window bn t))
1061 (when (fboundp 'kill-compilation)
1062 (setq w0 (selected-window))
1068 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1069 ;; run grep on project files
1071 (defun eproject-grep (command-args)
1072 "Run the grep command on all the project files."
1076 (grep-compute-defaults)
1077 (let ((default (grep-default-command)))
1078 (list (read-from-minibuffer
1079 "Run grep on project files: "
1080 (if current-prefix-arg default grep-command)
1084 (if current-prefix-arg nil default)
1086 (let ((b (current-buffer)) (old-dir default-directory))
1087 (dolist (f (mapcar 'car prj-files))
1088 (setq command-args (concat command-args " " f))
1090 (when prj-directory (cd prj-directory))
1092 (with-current-buffer b (cd old-dir))
1095 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1096 ;; add files to the project with dired
1101 (defun prj-dired-addfiles ()
1105 (dolist (f (dired-get-marked-files))
1106 (setq a (prj-insert-file f))
1109 (setq prj-curfile a)
1111 (if (> n 1) (message "Added to project: %d file(s)" n))
1116 (defun eproject-dired ()
1117 "Start a dired window with the project directory."
1120 (eproject-setup-quit)
1121 ;;(message "Use 'a' to add marked or single files to the project.")
1122 (dired prj-directory)
1123 (let ((map dired-mode-map))
1124 (define-key map "a" 'prj-dired-addfiles)
1125 (define-key map [menu-bar operate command] '("Add to Project"
1126 "Add current or marked file(s) to project" . prj-dired-addfiles))
1129 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1131 (defun prj-setup-all ()
1138 (defun prj-getconfig (n)
1139 (let ((a (cdr (assoc n prj-config))))
1143 (defun prj-setconfig (n v)
1144 (let ((a (assoc n prj-config)))
1147 (setq prj-config (nconc prj-config (list a)))
1152 (defun prj-on-kill ()
1156 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1157 ;; isearch in all project files
1159 (defun prj-isearch-function (b wrap)
1161 (or b (setq b (current-buffer)))
1164 (setq a (car prj-files))
1165 (setq a (car (last prj-files)))
1167 ((setq a (rassoc b prj-files))
1169 (setq a (prj-next-file prj-files a))
1170 (setq a (prj-prev-file prj-files a))
1173 (car (prj-find-file a))
1174 ;; (print `(prj-isearch (wrap . ,wrap) ,b ,d) (get-buffer "*Messages*"))
1177 (defun prj-isearch-setup ()
1178 (cond ((and prj-set-multi-isearch prj-current)
1179 (setq multi-isearch-next-buffer-function 'prj-isearch-function)
1180 (setq multi-isearch-pause 'initial)
1181 (add-hook 'isearch-mode-hook 'multi-isearch-setup)
1184 (remove-hook 'isearch-mode-hook 'multi-isearch-setup)
1187 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1190 (defun prj-startup-delayed ()
1192 (load (eproject-addon "eproject-config") nil t)
1194 ;; When no projects are specified yet, load the eproject project itself.
1196 (load (eproject-addon prj-default-cfg))
1199 ;; no project so far
1202 (add-hook 'kill-emacs-hook 'prj-on-kill)
1204 ;; inhibit open last project when a file was on the commandline
1205 (unless (buffer-file-name (window-buffer))
1208 ;; open last project
1209 (eproject-open prj-last-open)
1211 ;; emacs bug: deferred jit-lock is dropped if run from idle timer
1212 (and jit-lock-mode jit-lock-defer-time (jit-lock-function (point)))
1214 ;; restore frame position
1215 (when (and prj-set-framepos prj-frame-pos prj-initial-frame)
1216 (modify-frame-parameters prj-initial-frame prj-frame-pos)
1217 ;; emacs bug: when it's too busy it doesn't set frames correctly.
1221 (defun prj-command-line-switch (option)
1222 (setq prj-last-open (pop argv))
1223 (setq inhibit-startup-screen t)
1226 (defun eproject-startup ()
1227 ;; where is this file
1229 (setq eproject-directory (file-name-directory load-file-name)))
1230 (if (boundp 'prj-list)
1232 (load (eproject-addon "eproject-config"))
1236 (when prj-last-open (setq inhibit-startup-screen t))
1237 (when (display-graphic-p) (setq prj-initial-frame (selected-frame)))
1238 (push '("project" . prj-command-line-switch) command-switch-alist)
1239 (run-with-idle-timer 0.1 nil 'prj-startup-delayed)
1242 ;;;###autoload(require 'eproject)
1246 ;;; eproject-populate
1248 ; TODO: Add support for skipping common "untracked" directories,
1249 ; e.g. .hg, .svn, etc.
1251 ; TODO: Some sort of auto-populate? Picks up everything that matches
1252 ; common source-file extensions
1254 (defun prj-walk-path (dir action)
1255 "walk DIR executing ACTION with (dir file)"
1256 (cond ((file-directory-p dir)
1257 (or (char-equal ?/ (aref dir(1- (length dir))))
1258 (setq dir (file-name-as-directory dir)))
1259 (let ((lst (directory-files dir nil nil t))
1262 (setq file (car lst))
1263 (setq lst (cdr lst))
1264 (cond ((member file '("." "..")))
1266 (and (funcall action dir file)
1267 (setq fullname (concat dir file))
1268 (file-directory-p fullname)
1269 (prj-walk-path fullname action)))))))
1272 (file-name-directory dir)
1273 (file-name-nondirectory dir)))))
1275 (defun prj-add-if (p dir file)
1276 "If `file` matches the regex `p`, dir+file is added to the project."
1277 (if (string-match p file)
1278 (prj-insert-file (concat dir file) (prj-config-get-result 'f))
1281 (defun eproject-populate (dir p)
1282 "Add all files under DIR which match regex P to the project."
1285 (read-directory-name "Directory: " prj-directory)
1286 (read-string "Pattern: " "*")))
1287 (unless prj-current (error "No project open"))
1289 ; TODO: Verify that `dir` is under prj-directory? Is this required?
1293 (lambda (dir file) (prj-add-if p dir file)))))
1295 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1296 ;; eproject.el ends here