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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1247 ;; eproject.el ends here