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:
26 (defvar prj-keybindings
'(
27 ([f5] eproject-setup-toggle always)
28 ([M-right] eproject-nextfile)
29 ([M-left] eproject-prevfile)
30 ([C-f5] eproject-dired)
32 "Key bindings in eproject"
35 (defvar prj-default-config '(
37 ("Clean" "make clean" "C-f9")
38 ("Run" "echo run what" "f8")
39 ("Stop" "-e eproject-killtool" "C-f8")
41 ("Configure" "./configure")
43 ("Explore Project" "nautilus --browser `pwd` &")
44 ("XTerm In Project" "xterm &")
46 "*The default tools menu for new projects in eproject."
49 (defvar prj-set-default-directory nil
50 "*Should eproject set the project directory as default-directory
51 for all project files (nil/t).")
53 (defvar prj-set-framepos nil
54 "*Should eproject restore the last frame position/size (nil/t).")
56 (defvar prj-set-compilation-frame nil
57 "*Should eproject show compilation output in the other frame (nil/t).")
59 (defvar prj-set-multi-isearch nil
60 "*Should eproject setup multi-isearch in the project files (nil/t).")
62 ;; End of user-configurable items
63 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
65 ;; There is a global file (~/.emacs.d/eproject.lst)
66 (defun prj-globalfile ()
67 (expand-file-name "eproject.lst"
68 (if (boundp 'user-emacs-directory)
73 ;; with the list of all projects
76 ;; and the project that was open in the last session (if any)
77 (defvar prj-last-open nil)
79 ;; and the frame coords from last session
80 (defvar prj-frame-pos nil)
82 ;; eproject version that created the config file
83 (defvar prj-version nil)
85 ;; Here is a function to reset these
87 (setq prj-version nil)
89 (setq prj-last-open nil)
90 (setq prj-frame-pos nil)
93 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
94 ;; Each project has a directory
96 (defvar prj-directory)
98 ;; with a configuration files in it
99 (defvar prj-default-cfg "eproject.cfg")
101 ;; This file defines:
109 ;; an alist of settings
115 ;; a list of utility functions (feature incomplete)
116 (defvar prj-functions nil)
118 ;; directory to run commands, default to prj-directory
119 (defvar prj-exec-directory)
121 ;; The current project
124 ;; A list with generated functions for each tool
125 (defvar prj-tools-fns)
127 ;; A list with files removed from the project
128 (defvar prj-removed-files)
130 ;; Here is a function to reset/close the project
132 (setq prj-version nil)
133 (setq prj-current nil)
134 (setq prj-directory nil)
135 (setq prj-exec-directory nil)
137 (setq prj-removed-files nil)
138 (setq prj-curfile nil)
139 (setq prj-config nil)
140 (setq prj-tools-fns nil)
141 (setq prj-tools (copy-tree prj-default-config))
142 (prj-reset-functions)
145 (defun prj-reset-functions ()
146 (dolist (l prj-functions)
147 (if (eq (car l) 'setq)
148 (makunbound (cadr l))
149 (fmakunbound (cadr l))
151 (setq prj-functions nil)
154 (defun prj-set-functions (s)
155 (prj-reset-functions)
156 (setq prj-functions s)
157 (dolist (l s) (eval l))
160 ;; Some more variables:
162 ;; the frame that exists on startup
163 (defvar prj-initial-frame nil)
165 ;; this is put into minor-mode-alist
166 (defvar eproject-mode t)
168 ;; where this file is in
169 (defvar eproject-directory)
171 ;; eproject version that created the files
172 (defvar eproject-version "0.4")
176 (defun eproject-setup-toggle () (interactive))
177 (defun eproject-setup-quit () (interactive))
178 (defun prj-config-get-result (s))
179 (defun prj-config-reset ())
180 (defun prj-config-print ())
181 (defun prj-config-parse ())
184 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
187 (defun caddr (l) (car (cddr l)))
189 (defun prj-del-list (l e)
190 (let ((a (assoc (car e) l)))
195 (defun prj-add-list (l e)
196 (nconc (prj-del-list l e) (list e))
199 (defun prj-next-file (l e)
200 (and (setq e (assoc (car e) l))
204 (defun prj-prev-file (l e)
205 (prj-next-file (reverse l) e)
208 ; replace a closed file, either by the previous or the next.
209 (defun prj-otherfile (l f)
210 (or (prj-prev-file l f)
214 ;; make relative path, but only up to the second level of ..
215 (defun prj-relative-path (f)
216 (let ((r (file-relative-name f prj-directory)))
217 (if (string-match "^\\.\\.[/\\]\\.\\.[/\\]\\.\\.[/\\]" r)
222 ;; friendly truncate filename
223 (defun prj-shortname (s)
224 (let ((l (length s)) (x 30) n)
228 (setq n (length (file-name-nondirectory s)))
229 (if (< n l) (setq n (1+ n)))
232 (concat (substring s 0 (- x n)) "..." (substring s (- n)))
235 (concat (substring s 0 x) "...")
238 (concat "..." (substring s (- n) (- (- x 3) n)) "...")
241 (defun prj-settitle ()
242 (modify-frame-parameters
246 (format "emacs - %s" (car prj-current))
249 (defun eproject-addon (f)
250 (concat eproject-directory f)
253 (defun prj-goto-line (n)
255 (beginning-of-line n)
258 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
259 ;; Write configuration to file
261 (defun prj-print-list (s fp)
263 (setq v (list 'setq s
264 (if (and (atom v) (null (and (symbolp v) v)))
269 (pp v fp) (princ "\n" fp)
272 (defun prj-create-file (filename)
273 (let ((fp (generate-new-buffer filename)))
274 (princ ";; -*- mode: Lisp; -*-\n\n" fp)
277 (defun prj-close-file (fp)
278 (with-current-buffer fp
280 (and t (write-region nil nil (buffer-name fp) nil 0))
286 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
287 ;; Load/Save global project list and initial frame sizes
289 (defun prj-loadlist ()
291 (load (prj-globalfile) t t)
292 (setq prj-version eproject-version)
295 (defun prj-get-frame-pos (f)
297 (lambda (parm) (cons parm (frame-parameter f parm)))
298 '(top left width height)
301 (defun prj-savelist ()
302 (let ((g (prj-globalfile)) fp)
303 (unless (file-exists-p g)
304 (make-directory (file-name-directory g) t)
306 (setq prj-last-open (car prj-current))
307 (when (frame-live-p prj-initial-frame)
308 (setq prj-frame-pos (prj-get-frame-pos prj-initial-frame))
310 (setq fp (prj-create-file g))
312 (prj-print-list 'prj-version fp)
313 (prj-print-list 'prj-list fp)
314 (prj-print-list 'prj-last-open fp)
315 (prj-print-list 'prj-frame-pos fp)
319 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
320 ;; Load/Save local per-project configuration file
322 (defun prj-update-config ()
323 (let ((d (prj-get-directory prj-current))
324 (e (prj-getconfig "exec-root"))
326 (if e (setq d (expand-file-name e d)))
327 (setq prj-exec-directory (file-name-as-directory d))
330 (defun prj-get-directory (a)
331 (file-name-as-directory (expand-file-name (cadr a)))
334 (defun prj-get-cfg ()
335 (expand-file-name (or (caddr prj-current) prj-default-cfg) prj-directory)
338 (defun prj-loadconfig (a)
342 (setq prj-directory (prj-get-directory a))
343 (when (file-regular-p (setq lf (prj-get-cfg)))
346 (or (assoc prj-curfile prj-files)
350 (if (setq e (prj-getconfig "project-name"))
352 (prj-setconfig "project-name" (car a))
355 (prj-set-functions prj-functions)
356 (setq prj-version eproject-version)
359 (defun prj-saveconfig ()
363 (setq w (selected-window))
364 (setq c (window-buffer w))
365 (dolist (f prj-files)
366 (cond ((setq b (get-buffer (car f)))
367 (set-window-buffer w b t)
368 (with-current-buffer b
369 (let ((s (line-number-at-pos (window-start w)))
370 (p (line-number-at-pos (window-point w)))
372 (push (list (car f) s p) files)
377 (set-window-buffer w c t)
379 (let ((fp (prj-create-file (prj-get-cfg)))
380 (prj-curfile (car prj-curfile))
381 (prj-files (nreverse files))
384 (prj-print-list 'prj-version fp)
385 (prj-print-list 'prj-config fp)
386 (prj-print-list 'prj-tools fp)
387 (prj-print-list 'prj-files fp)
388 (prj-print-list 'prj-curfile fp)
389 (prj-print-list 'prj-functions fp)
394 (defun prj-saveall ()
399 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
400 ;; The core functions: Open / Close / Add / Remove Project
402 (defun eproject-open (a)
403 "Open another project."
406 (or (prj-config-get-result 'p)
407 (completing-read "Open Project: " (mapcar 'car prj-list))
410 (let ((b (assoc a prj-list)))
412 (error "No such project: %s" a)
416 (setq a (or (car (member a prj-list)) a))
417 (unless (eq a prj-current)
418 (unless (file-directory-p (prj-get-directory a))
419 (error "No such directory: %s" (cadr a))
421 (setq prj-list (cons a (delq a prj-list)))
428 (unless (prj-edit-file prj-curfile)
432 (defun eproject-close ()
433 "Close the current project."
441 (save-some-buffers nil)
442 (eproject-killbuffers t)
445 (or f (prj-addhooks))
453 (defun eproject-killbuffers (&optional from-project)
454 "If called interactively kills all buffers that
455 do not belong to project files"
458 (dolist (f prj-files)
459 (setq b (get-buffer (car f)))
461 (setq a (cons (list b) a))
463 (dolist (b (buffer-list))
464 (when (eq (consp (assoc b a)) from-project)
468 (defun eproject-add (dir &optional name cfg)
469 "Add a new or existing project to the list."
472 (setq d (read-directory-name "Add project in directory: " prj-directory nil t))
473 (setq n (file-name-nondirectory (directory-file-name d)))
474 (setq n (read-string "Project name: " n))
475 (setq f (read-string "Project file: " prj-default-cfg))
479 (setq dir (directory-file-name dir))
481 (setq name (file-name-nondirectory dir))
483 (when (and cfg (string-equal cfg prj-default-cfg))
486 (let ((a (if cfg (list name dir cfg) (list name dir))))
491 (defun eproject-remove (a)
492 "Remove a project from the list."
495 (or (prj-config-get-result 'p)
496 (completing-read "Remove project: " (mapcar 'car prj-list))
499 (let ((b (assoc a prj-list)))
501 (error "No such project: %s" a)
507 (prog1 (y-or-n-p (format "Remove \"%s\"? " (car a)))
510 (setq prj-list (prj-del-list prj-list a))
514 (defun eproject-save ()
515 "Save the project configuration to file."
522 (defun eproject-revert ()
523 "Reload the project configuration from file."
527 (prj-loadconfig prj-current)
532 (defun eproject-addfile (f)
533 "Add a file to the current project."
537 (read-file-name "Add file to project: " nil nil t nil)
539 (unless prj-current (error "No project open"))
540 (let ((a (prj-insert-file f (prj-config-get-result 'f))))
542 (message "Added to project: %s" (car a))
548 (defun eproject-removefile (a)
549 "Remove a file from the current project."
550 (interactive (prj-get-existing-file-1 "Remove file from project: "))
551 (setq a (prj-get-existing-file-2 a))
555 (defun eproject-visitfile (a)
556 "Visit a file from the current project."
557 (interactive (prj-get-existing-file-1 "Visit file: "))
558 (setq a (prj-get-existing-file-2 a))
562 (defun prj-get-existing-file-1 (msg)
565 (or (prj-config-get-result 'f)
566 (completing-read msg (mapcar 'car prj-files))
569 (defun prj-get-existing-file-2 (a)
570 (unless prj-current (error "No project open"))
573 (let ((b (assoc (prj-relative-path a) prj-files)))
574 (unless b (error "No such file in project: %s" a))
578 (defun eproject-help ()
579 "Show the eproject README."
581 (view-file (eproject-addon "eproject.txt"))
584 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
585 ;; Hook functions to track opening/closing files from emacs
587 (defun prj-addhooks ()
588 (add-hook 'kill-buffer-hook 'prj-kill-buffer-hook)
589 (add-hook 'find-file-hook 'prj-find-file-hook)
590 (add-hook 'window-configuration-change-hook 'prj-wcc-hook)
593 (defun prj-removehooks ()
594 (remove-hook 'window-configuration-change-hook 'prj-wcc-hook)
595 (remove-hook 'find-file-hook 'prj-find-file-hook)
596 (remove-hook 'kill-buffer-hook 'prj-kill-buffer-hook)
599 (defun prj-wcc-hook ()
600 (dolist (w (window-list))
601 (prj-register-buffer (window-buffer w))
604 (defun prj-find-file-hook ()
605 (run-with-idle-timer 0.2 nil 'prj-wcc-hook)
608 (defun prj-kill-buffer-hook ()
609 (let ((b (current-buffer)) a)
610 (if (setq a (rassq b prj-files))
611 (prj-remove-file a t)
612 (if (setq a (rassq b prj-removed-files))
613 (setq prj-removed-files (delq a prj-removed-files))
616 (defun prj-register-buffer (b)
618 (setq f (buffer-file-name b))
619 (when (and f t) ;;(not (string-match "^\\." (file-name-nondirectory f))))
620 (setq a (rassq b prj-files))
622 (setq a (prj-insert-file f nil t))
625 (message "Added to project: %s" (car a))
627 (prj-init-buffer a b)
629 (when (and a (null (eq a prj-curfile)))
635 (defun prj-insert-file (f &optional after on-the-fly)
636 (let ((r (prj-relative-path f)) a m)
637 (setq a (assoc r prj-files))
638 (unless (or a (and on-the-fly (assoc r prj-removed-files)))
640 (setq m (memq (or after prj-curfile) prj-files))
642 (setcdr m (cons a (cdr m)))
643 (setq prj-files (prj-add-list prj-files a))
645 (setq prj-removed-files (prj-del-list prj-removed-files a))
649 (defun prj-remove-file (a &optional on-the-fly)
650 (let ((n (prj-otherfile prj-files a)) b)
651 (setq prj-files (prj-del-list prj-files a))
652 (when (eq prj-curfile a)
656 (setq prj-removed-files (prj-add-list prj-removed-files a))
658 (unless (prj-config-print)
659 (prj-edit-file prj-curfile)
662 (message "Removed from project: %s" (car a))
665 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
668 (defun prj-init-buffer (a b)
669 (with-current-buffer b
670 (rename-buffer (car a) t)
671 (when prj-set-default-directory
677 (defun prj-find-file (a)
681 (setq f (expand-file-name (car a) prj-directory))
682 (setq b (get-file-buffer f))
685 (setq b (find-file-noselect f))
687 (when (and b (consp (cdr a)))
691 (prj-init-buffer a b)
695 (defun prj-edit-file (a)
696 (let ((f (prj-find-file a)))
698 (eproject-setup-quit)
699 (switch-to-buffer (car f))
700 (prj-restore-edit-pos (cdr f) (selected-window))
702 ;;(message "dir: %s" default-directory)
707 (defun prj-restore-edit-pos (pos w)
708 (let ((top (car pos)) (line (cadr pos)))
709 (when (and (numberp top) (numberp line))
711 (set-window-start w (point))
715 (defun prj-select-window (w)
716 (let (focus-follows-mouse)
718 (select-frame-set-input-focus (window-frame w))
721 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
722 ;; choose next/previous file
724 (defun eproject-nextfile ()
725 "Switch to the next file that belongs to the current project."
727 (prj-switch-file 'prj-next-file 'next-buffer)
730 (defun eproject-prevfile ()
731 "Switch to the previous file that belongs to the current project."
733 (prj-switch-file 'prj-prev-file 'previous-buffer)
736 (defun prj-switch-file (fn1 fn2)
737 (let ((a (rassoc (current-buffer) prj-files)))
739 (prj-edit-file (or (funcall fn1 prj-files a) a))
742 (prj-edit-file prj-curfile)
748 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
751 (defun prj-setkeys ()
752 (let ((f (consp prj-current))
753 (a (assoc 'eproject-mode minor-mode-map-alist))
754 (map (make-sparse-keymap))
758 (push (cons 'eproject-mode map) minor-mode-map-alist)
760 (dolist (k prj-keybindings)
761 (when (or f (eq (caddr k) 'always))
762 (define-key map (car k) (cadr k))
767 (dolist (a prj-tools)
768 (unless (setq fn (nth n prj-tools-fns))
769 (setq fn (list 'lambda))
770 (setq prj-tools-fns (nconc prj-tools-fns (list fn)))
772 (setcdr fn `(() (interactive) (prj-run-tool ',a)))
774 (when (setq s (caddr a))
775 (define-key map (prj-parse-key s) (and f fn))
778 (defun prj-parse-key (s)
780 (if (string-match "[a-z][a-z0-9]+$" s)
782 (concat "\"\\" s "\""))))
784 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
787 (defun prj-list-sorted ()
788 (sort (append prj-list nil)
789 '(lambda (a b) (string-lessp (car a) (car b)))
792 (defun prj-setmenu ()
793 (let ((f (consp prj-current)) m1 m2 m3)
796 `(("Open" open ,@(prj-menulist-maker prj-list prj-current 'prj-menu-open))
798 ("Add ..." "Add new or existing project to the list" . eproject-add)
799 ("Remove ..." "Remove project from the list" . eproject-remove)
800 ,@(and f '(("Close" "Close current project" . eproject-close)))
802 ("Setup" "Enter the project setup area." . eproject-setup-toggle)
803 ("Help" "View eproject.txt" . eproject-help)
807 (nconc m1 (cons '("--") (prj-menulist-maker prj-tools nil prj-tools-fns)))
809 `(("Dired" "Browse project directory in Dired - Use 'a' to add file(s) to the project" . eproject-dired)
811 ,@(prj-menulist-maker prj-files prj-curfile 'prj-menu-edit)
816 `((buffer "Project" project ,@m1)
817 (file "List" list ,@m2)
822 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
824 (defun prj-menu-edit ()
826 (let ((a (nth last-command-event prj-files)))
827 (if a (prj-edit-file a))
830 (defun prj-menu-open ()
832 (let ((a (nth last-command-event prj-list)))
833 (if a (eproject-open (car a)))
836 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
838 (defun prj-menu-maker (map l v)
839 (let ((e (list nil)))
840 (setq v (append v e))
841 (dolist (k (reverse l))
843 (when (symbolp (car k))
850 ((and (consp (cdr k)) (symbolp (cadr k)))
853 (setq k (and s (cons (car k) (make-sparse-keymap (car k)))))
856 (setcar e (intern (downcase (car k))))
859 (define-key-after map (vconcat v) k a)
860 (define-key map (vconcat v) k)
862 (if s (prj-menu-maker map s v))
865 (defun prj-copy-head (l n)
867 (while (and l (> n 0))
874 (defun prj-split-list (l n)
877 (push (prj-copy-head l n) r)
878 (setq l (nthcdr n l))
883 (defun prj-menulist-maker (l act fns)
884 (let (r (w 30) s (m 0) (n 0) k)
887 (prj-menulist-maker-1 (list l fns n) act)
890 ;; menu too long; split into submenus
891 (setq s (prj-split-list l w))
892 (setq k (prj-menulist-maker-1 (list (append (pop s) '(("--"))) fns n) act))
893 (setq r (nreverse k))
896 (setq fns (nthcdr w fns))
899 (setq k (prj-menulist-maker-1 (list l fns n) act))
900 (push (cons (concat (prj-shortname (caar l)) " ...")
901 (cons (intern (format "m_%d" (setq m (1+ m))))
907 (defun prj-menulist-maker-1 (l act)
913 (setcar (cddr l) (1+ n))
914 (setq f (if (consp (cadr l))
915 (prog1 (car (cadr l)) (setcar (cdr l) (cdr (cadr l))))
919 (unless (string-match "^ *#" i)
920 (setq s (if (and (consp (cdr a)) (stringp (cadr a))) (cadr a) i))
922 (setq e (cons s (cons (intern s) (prj-menulist-maker-1 l act))))
929 (setq i (prj-shortname i))
930 (setq e (cons n (if (eq a act)
931 `(menu-item ,i ,f :button (:toggle . t) :help ,s)
932 (cons i (cons s f)))))
939 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
940 ;; Run make and other commands
942 (defun prj-compilation-in-frame (cmd)
943 (let ((bn "*compilation*") w h b c f)
944 (unless (get-buffer-window bn t)
945 (setq b (get-buffer-create bn))
946 (setq f (frame-list))
948 (setq w (frame-first-window (car f)))
949 (delete-other-windows w)
952 (setq h (/ (* 70 (frame-height)) 100))
953 (delete-other-windows w)
954 (setq w (split-window w h))
956 (set-window-buffer w b)
958 (let ((display-buffer-reuse-frames t) (f (selected-frame)))
960 (select-frame-set-input-focus f)
964 (cond ((string-match "^-e +" cmd)
965 (setq cmd (read (substring cmd (match-end 0))))
966 (unless (commandp cmd)
967 (setq cmd `(lambda () (interactive) ,cmd))
969 (command-execute cmd)
971 ((let ((b (current-buffer))
972 (old-dir default-directory)
975 (when (string-match "^-in +\\([^[:space:]]+\\) +" cmd)
976 (setq new-dir (match-string-no-properties 1 cmd))
977 (setq cmd (substring cmd (match-end 0)))
979 (when prj-exec-directory
980 (setq new-dir (expand-file-name new-dir prj-exec-directory))
983 (cond ((string-match "\\(.+\\)& *$" cmd)
984 (start-process-shell-command
985 "eproject-async" nil (match-string 1 cmd))
986 (message (match-string 1 cmd))
988 (prj-set-compilation-frame
989 (prj-compilation-in-frame cmd)
994 (with-current-buffer b (cd old-dir))
997 (defun prj-run-tool (a)
998 (unless (string-match "^--+$" (car a))
999 (prj-run (or (cadr a) (car a)))
1002 (defun eproject-killtool ()
1004 (let ((bn "*compilation*") w0 w1)
1005 (when (setq w1 (get-buffer-window bn t))
1006 (when (fboundp 'kill-compilation)
1007 (setq w0 (selected-window))
1013 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1014 ;; run grep on project files
1016 (defun eproject-grep (command-args)
1017 "Run the grep command on all the project files."
1021 (grep-compute-defaults)
1022 (let ((default (grep-default-command)))
1023 (list (read-from-minibuffer
1024 "Run grep on project files: "
1025 (if current-prefix-arg default grep-command)
1029 (if current-prefix-arg nil default)
1031 (let ((b (current-buffer)) (old-dir default-directory))
1032 (dolist (f (mapcar 'car prj-files))
1033 (setq command-args (concat command-args " " f))
1035 (when prj-directory (cd prj-directory))
1037 (with-current-buffer b (cd old-dir))
1040 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1041 ;; add files to the project with dired
1045 (defun prj-dired-addfiles ()
1049 (dolist (f (dired-get-marked-files))
1050 (setq a (prj-insert-file f))
1053 (setq prj-curfile a)
1055 (message "Added to project: %d file(s)" n)
1059 (defun prj-dired-run ()
1061 (let ((f (dired-get-marked-files)) c)
1062 (and (setq c (pop f))
1064 (let ((prj-directory (file-name-directory c)))
1067 (defun eproject-dired ()
1068 "Start a dired window with the project directory."
1071 (eproject-setup-quit)
1072 ;;(message "Use 'a' to add marked or single files to the project.")
1073 (dired prj-directory)
1074 (let ((map dired-mode-map))
1075 (define-key map [mouse-2] 'dired-find-file)
1076 (define-key map "a" 'prj-dired-addfiles)
1077 (define-key map "r" 'prj-dired-run)
1078 (define-key map [menu-bar operate command] '("Add to Project"
1079 "Add current or marked file(s) to project" . prj-dired-addfiles))
1082 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1084 (defun prj-setup-all ()
1091 (defun prj-getconfig (n)
1092 (let ((a (cdr (assoc n prj-config))))
1096 (defun prj-setconfig (n v)
1097 (let ((a (assoc n prj-config)))
1100 (setq prj-config (nconc prj-config (list a)))
1105 (defun prj-on-kill ()
1109 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1110 ;; isearch in all project files
1112 (defun prj-isearch-function (b wrap)
1114 (or b (setq b (current-buffer)))
1117 (setq a (car prj-files))
1118 (setq a (car (last prj-files)))
1120 ((setq a (rassoc b prj-files))
1122 (setq a (prj-next-file prj-files a))
1123 (setq a (prj-prev-file prj-files a))
1127 (if (buffer-live-p (cdr a))
1129 (setq d (car (prj-find-file a)))
1131 ;; (print `(prj-isearch (wrap . ,wrap) ,b ,d) (get-buffer "*Messages*"))
1135 (defun prj-isearch-setup ()
1136 (cond ((and prj-set-multi-isearch prj-current)
1137 (setq multi-isearch-next-buffer-function 'prj-isearch-function)
1138 (setq multi-isearch-pause 'initial)
1139 (add-hook 'isearch-mode-hook 'multi-isearch-setup)
1142 (remove-hook 'isearch-mode-hook 'multi-isearch-setup)
1145 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1148 (defun prj-startup-delayed ()
1150 (load (eproject-addon "eproject-config") nil t)
1152 ;; When no projects are specified yet, load the eproject project itself.
1154 (load (eproject-addon prj-default-cfg))
1157 ;; no project so far
1160 (add-hook 'kill-emacs-hook 'prj-on-kill)
1162 ;; inhibit open last project when a file was on the commandline
1163 (unless (buffer-file-name (window-buffer))
1166 ;; open last project
1167 (eproject-open prj-last-open)
1169 ;; restore frame position
1170 (when (and prj-set-framepos prj-frame-pos prj-initial-frame)
1171 (modify-frame-parameters prj-initial-frame prj-frame-pos)
1172 ;; emacs bug: when it's too busy it doesn't set frames correctly.
1176 (defun prj-command-line-switch (option)
1177 (setq prj-last-open (pop argv))
1178 (setq inhibit-startup-screen t)
1181 (defun eproject-startup ()
1182 ;; where is this file
1184 (setq eproject-directory (file-name-directory load-file-name)))
1185 (if (boundp 'prj-list)
1187 (load (eproject-addon "eproject-config"))
1191 (when prj-last-open (setq inhibit-startup-screen t))
1192 (when (display-graphic-p) (setq prj-initial-frame (selected-frame)))
1193 (push '("project" . prj-command-line-switch) command-switch-alist)
1194 (run-with-idle-timer 0.1 nil 'prj-startup-delayed)
1197 ;;;###autoload(require 'eproject)
1201 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1202 ;; eproject.el ends here