isearch in all project files
[eproject.git] / eproject.el
blob9c11ef20aaf78a54c213874fc99ddc0e510a3aec
1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2 ;;
3 ;; eproject.el --- project workspaces for emacs
4 ;;
5 ;; Copyright (C) 2008,2009 grischka
6 ;;
7 ;; Author: grischka -- grischka@users.sourceforge.net
8 ;; Created: 24 Jan 2008
9 ;; Version: 0.3
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 ;; There is a global file
24 (defun prj-globalfile ()
25 (unless (boundp 'user-emacs-directory)
26 (setq user-emacs-directory "~/.emacs.d/")
28 (let ((d (expand-file-name user-emacs-directory)))
29 (make-directory d t)
30 (concat d "eproject.lst")
33 ;; with the list of all projects
34 (defvar prj-list)
36 ;; and the project that was open in the last session (if any)
37 (defvar prj-last-open nil)
39 ;; and the frame coords from last session
40 (defvar prj-frame-pos nil)
42 ;; eproject version that created the config file
43 (defvar prj-version nil)
45 ;; Here is a function to reset these
46 (defun prj-init ()
47 (setq prj-version nil)
48 (setq prj-list nil)
49 (setq prj-last-open nil)
50 (setq prj-frame-pos nil)
53 ;; Each project has a directory
54 (defvar prj-directory)
56 ;; with a configuration files in it
57 (defun prj-localfile ()
58 (expand-file-name "eproject.cfg" prj-directory)
61 ;; This file defines:
63 ;; the list of files
64 (defvar prj-files)
66 ;; the current file
67 (defvar prj-curfile)
69 ;; an alist of settings
70 (defvar prj-config)
72 ;; a list of tools
73 (defvar prj-tools)
75 ;; a list of utility functions (feature incomplete)
76 (defvar prj-functions nil)
78 ;; directory to run commands, default to prj-directory
79 (defvar prj-directory-run)
81 ;; Here are some default tools for new projects,
82 ;; (which you might want to adjust to your needs)
84 (defun prj-default-config ()
85 (setq prj-tools (copy-tree '(
86 ("Make" "make" "f9")
87 ("Clean" "make clean" "C-f9")
88 ("Run" "echo run what" "f8")
89 ("Stop" "-e eproject-killtool" "C-f8")
90 ("---")
91 ("Configure" "./configure")
92 ("---")
93 ("Explore Project" "nautilus --browser `pwd` &")
94 ("XTerm In Project" "xterm &")
95 )))
98 ;; This defines the current project
99 (defvar prj-current)
101 ;; There is an internal list with generated functions
102 ;; for each tool
103 (defvar prj-tools-fns)
105 ;; and a list with files removed from the project
106 (defvar prj-removed-files)
108 ;; Here is a function to reset/close the project
109 (defun prj-reset ()
110 (setq prj-version nil)
111 (setq prj-current nil)
112 (setq prj-directory nil)
113 (setq prj-directory-run nil)
114 (setq prj-files nil)
115 (setq prj-removed-files nil)
116 (setq prj-curfile nil)
117 (setq prj-config nil)
118 (setq prj-tools nil)
119 (setq prj-tools-fns nil)
120 (prj-reset-functions)
121 (prj-default-config)
124 (defun prj-reset-functions ()
125 (dolist (l prj-functions)
126 (if (eq (car l) 'setq)
127 (makunbound (cadr l))
128 (fmakunbound (cadr l))
130 (setq prj-functions nil)
133 (defun prj-set-functions (s)
134 (prj-reset-functions)
135 (setq prj-functions s)
136 (dolist (l s) (eval l))
139 ;; Some more variables
141 ;; the frame that exists on startup
142 (defvar prj-initial-frame nil)
144 ;; this is put into minor-mode-alist
145 (defvar eproject-mode t)
147 ;; where this file is in
148 (defvar eproject-directory)
150 ;; eproject version that created the files
151 (defvar eproject-version "0.3")
153 ;; Configuration UI
154 (eval-and-compile
155 (defun eproject-setup-toggle () (interactive))
156 (defun eproject-setup-quit () (interactive))
157 (defun prj-config-get-result (s))
158 (defun prj-config-reset ())
159 (defun prj-config-print ())
160 (defun prj-config-parse ())
163 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
164 ;; Small functions
166 (defun caddr (l) (car (cddr l)))
168 (defun prj-del-list (l e)
169 (let ((a (assoc (car e) l)))
170 (if a
171 (delq a l)
172 l)))
174 (defun prj-add-list (l e)
175 (nconc (prj-del-list l e) (list e))
178 (defun prj-next-file (l e)
179 (and (setq e (assoc (car e) l))
180 (cadr (memq e l))
183 (defun prj-prev-file (l e)
184 (prj-next-file (reverse l) e)
187 ; replace a closed file, either by the previous or the next.
188 (defun prj-otherfile (l f)
189 (or (prj-prev-file l f)
190 (prj-next-file l f)
193 ;; make relative path, but only up to the second level of ..
194 (defun prj-relative-path (f)
195 (let ((r (file-relative-name f prj-directory)))
196 (if (string-match "^\\.\\.[/\\]\\.\\.[/\\]\\.\\.[/\\]" r)
201 ;; friendly truncate filename
202 (defun prj-shortname (s)
203 (let ((l (length s)) (x 30) n)
204 (cond ((>= x l) s)
205 ((progn
206 (setq x (- x 3))
207 (setq n (length (file-name-nondirectory s)))
208 (if (< n l) (setq n (1+ n)))
209 (>= x n)
211 (concat (substring s 0 (- x n)) "..." (substring s (- n)))
213 ((= n l)
214 (concat (substring s 0 x) "...")
217 (concat "..." (substring s (- n) (- (- x 3) n)) "...")
218 ))))
220 (defun prj-settitle ()
221 (modify-frame-parameters
223 (list (cons 'title
224 (and prj-current
225 (format "emacs - %s" (car prj-current))
226 )))))
228 (defun eproject-addon (f)
229 (concat eproject-directory f)
232 (defun prj-goto-line (n)
233 (goto-char 1)
234 (beginning-of-line n)
237 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
238 ;; Write configuration to file
240 (defun prj-print-list (s fp)
241 (let ((v (eval s)))
242 (setq v (list 'setq s
243 (if (and (atom v) (null (and (symbolp v) v)))
245 (list 'quote v)
247 ;;(print v fp)
248 (pp v fp) (princ "\n" fp)
251 (defun prj-create-file (filename)
252 (let ((fp (generate-new-buffer filename)))
253 (princ ";; -*- mode: Lisp; -*-\n\n" fp)
254 fp))
256 (defun prj-close-file (fp)
257 (with-current-buffer fp
258 (condition-case nil
259 (write-region nil nil (buffer-name fp) nil 0)
260 (error nil)
262 (kill-buffer fp)
265 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
266 ;; Load/Save global project list and initial frame sizes
268 (defun prj-loadlist ()
269 (prj-init)
270 (load (prj-globalfile) t t)
271 (setq prj-version eproject-version)
274 (defun prj-get-frame-pos (f)
275 (mapcar
276 (lambda (parm) (cons parm (frame-parameter f parm)))
277 '(top left width height)
280 (defun prj-savelist ()
281 (let ((g (prj-globalfile))
284 (unless (file-exists-p g)
285 (make-directory (file-name-directory g) t)
287 (setq prj-last-open (car prj-current))
288 (when (frame-live-p prj-initial-frame)
289 (setq prj-frame-pos (prj-get-frame-pos prj-initial-frame))
291 (setq fp (prj-create-file g))
292 (when fp
293 (prj-print-list 'prj-version fp)
294 (prj-print-list 'prj-list fp)
295 (prj-print-list 'prj-last-open fp)
296 (prj-print-list 'prj-frame-pos fp)
297 (prj-close-file fp)
300 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
301 ;; Load/Save local per-project configuration file
303 (defun prj-update-config ()
304 (setq prj-directory-run
305 (file-name-as-directory
306 (expand-file-name
307 (or (prj-getconfig "run-directory") ".")
308 prj-directory
312 (defun prj-loadconfig (a)
313 (let (lf e)
314 (prj-reset)
315 (setq prj-current a)
316 (setq prj-directory
317 (file-name-as-directory
318 (expand-file-name (cadr a))
321 (when (file-exists-p (setq lf (prj-localfile)))
322 (load lf nil t)
323 (setq prj-curfile
324 (or (assoc prj-curfile prj-files)
325 (car prj-files)
328 (if (setq e (prj-getconfig "project-name"))
329 (setcar a e)
330 (prj-setconfig "project-name" (car a))
332 (prj-update-config)
333 (prj-set-functions prj-functions)
334 (setq prj-version eproject-version)
337 (defun prj-saveconfig ()
338 (when prj-current
339 (let (w c b files)
340 (prj-removehooks)
341 (setq w (selected-window))
342 (setq c (window-buffer w))
343 (dolist (f prj-files)
344 (cond ((setq b (get-buffer (car f)))
345 (set-window-buffer w b t)
346 (with-current-buffer b
347 (let ((s (line-number-at-pos (window-start w)))
348 (p (line-number-at-pos (window-point w)))
350 (push (list (car f) s p) files)
352 ((consp (cdr f))
353 (push f files)
355 (set-window-buffer w c t)
356 (prj-addhooks)
357 (let ((fp (prj-create-file (prj-localfile)))
358 (prj-curfile (car prj-curfile))
359 (prj-files (nreverse files))
361 (when fp
362 (prj-print-list 'prj-version fp)
363 (prj-print-list 'prj-config fp)
364 (prj-print-list 'prj-tools fp)
365 (prj-print-list 'prj-files fp)
366 (prj-print-list 'prj-curfile fp)
367 (prj-print-list 'prj-functions fp)
368 (prj-close-file fp)
372 (defun prj-saveall ()
373 (prj-saveconfig)
374 (prj-savelist)
377 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
378 ;; The core functions: Open / Close / Add / Remove Project
380 (defun eproject-open (a)
381 "Open another project."
382 (interactive
383 (list
384 (or (prj-config-get-result 'p)
385 (completing-read "Open Project: " (mapcar 'car prj-list))
387 (unless (consp a)
388 (let ((b (assoc a prj-list)))
389 (unless b
390 (error "No such project: %s" a)
392 (setq a b)
394 (setq a (or (car (member a prj-list)) a))
395 (unless (eq a prj-current)
396 (unless (file-directory-p (cadr a))
397 (error "Error: No such directory: %s" (cadr a))
399 (setq prj-list (cons a (delq a prj-list)))
400 (eproject-close)
401 (prj-loadconfig a)
403 (prj-addhooks)
404 (prj-setup-all)
405 (prj-isearch-setup)
406 (cd prj-directory)
407 (unless (prj-edit-file prj-curfile)
408 (eproject-dired)
411 (defun eproject-close ()
412 "Close the current project."
413 (interactive)
414 (when prj-current
415 (prj-saveconfig)
416 (prj-removehooks)
417 (let (f)
418 (unwind-protect
419 (progn
420 (save-some-buffers nil)
421 (eproject-killbuffers t)
422 (setq f t)
424 (or f (prj-addhooks))
426 (prj-reset)
427 (prj-config-reset)
428 (prj-setup-all)
429 (prj-isearch-setup)
432 (defun eproject-killbuffers (&optional from-project)
433 "If called interactively kills all buffers that
434 do not belong to project files"
435 (interactive)
436 (let (a b)
437 (dolist (f prj-files)
438 (setq b (get-buffer (car f)))
439 (if b
440 (setq a (cons (list b) a))
442 (dolist (b (buffer-list))
443 (when (eq (consp (assoc b a)) from-project)
444 (kill-buffer b)
445 ))))
447 (defun eproject-add (d)
448 "Add a new or existing project to the list."
449 (interactive
450 (list
451 (read-directory-name "Add project in directory: " prj-directory nil t)
453 (when d
454 (setq d (directory-file-name d))
456 (when (= 0 (length d))
457 (error "Error: Empty directory name.")
459 (let (n a)
460 (setq n (file-name-nondirectory d))
461 (setq a (list n d))
462 (push a prj-list)
463 (prj-setup-all)
466 (defun eproject-remove (a)
467 "Remove a project from the list."
468 (interactive
469 (list
470 (or (prj-config-get-result 'p)
471 (completing-read "Remove project: " (mapcar 'car prj-list))
473 (unless (consp a)
474 (let ((b (assoc a prj-list)))
475 (unless b
476 (error "No such project: %s" a)
478 (setq a b)
480 (when (progn
481 (beep)
482 (prog1 (y-or-n-p (format "Remove \"%s\"? " (car a)))
483 (message "")
485 (setq prj-list (prj-del-list prj-list a))
486 (prj-setup-all)
489 (defun eproject-save ()
490 "Save the project configuration to file."
491 (interactive)
492 (prj-config-parse)
493 (prj-config-print)
494 (prj-saveall)
497 (defun eproject-revert ()
498 "Reload the project configuration from file."
499 (interactive)
500 (prj-loadlist)
501 (if prj-current
502 (prj-loadconfig prj-current)
504 (prj-setup-all)
507 (defun eproject-addfile (f)
508 "Add a file to the current project."
509 (interactive
510 (and prj-current
511 (list
512 (read-file-name "Add file to project: " nil nil t nil)
514 (unless prj-current (error "No project open"))
515 (let ((a (prj-insert-file f (prj-config-get-result 'f))))
516 (unless (cdr a)
517 (message "Added to project: %s" (car a))
519 (prj-config-print)
520 (prj-setmenu)
523 (defun eproject-removefile (a)
524 "Remove a file from the current project."
525 (interactive (prj-get-existing-file-1 "Remove file from project: "))
526 (setq a (prj-get-existing-file-2 a))
527 (prj-remove-file a)
530 (defun eproject-visitfile (a)
531 "Visit a file from the current project."
532 (interactive (prj-get-existing-file-1 "Visit file: "))
533 (setq a (prj-get-existing-file-2 a))
534 (prj-edit-file a)
537 (defun prj-get-existing-file-1 (msg)
538 (and prj-current
539 (list
540 (or (prj-config-get-result 'f)
541 (completing-read msg (mapcar 'car prj-files))
542 ))))
544 (defun prj-get-existing-file-2 (a)
545 (unless prj-current (error "No project open"))
546 (if (consp a)
548 (let ((b (assoc (prj-relative-path a) prj-files)))
549 (unless b (error "No such file in project: %s" a))
553 (defun eproject-help ()
554 "Show the eproject README."
555 (interactive)
556 (view-file (eproject-addon "eproject.txt"))
559 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
560 ;; Hook functions to track opening/closing files from emacs
562 (defun prj-addhooks ()
563 (add-hook 'kill-buffer-hook 'prj-kill-buffer-hook)
564 (add-hook 'find-file-hook 'prj-find-file-hook)
565 (add-hook 'window-configuration-change-hook 'prj-wcc-hook)
568 (defun prj-removehooks ()
569 (remove-hook 'window-configuration-change-hook 'prj-wcc-hook)
570 (remove-hook 'find-file-hook 'prj-find-file-hook)
571 (remove-hook 'kill-buffer-hook 'prj-kill-buffer-hook)
574 (defun prj-wcc-hook ()
575 (let ((w (selected-window)) (b (window-buffer (selected-window))))
576 ;; (message "wcc-hook: %s" (prin1-to-string (list wcc-count w b n)))
577 (prj-register-buffer b)
580 (defun prj-find-file-hook ()
581 (run-with-idle-timer
584 `(lambda () (prj-register-buffer ,(current-buffer)))
587 (defun prj-kill-buffer-hook ()
588 (let ((b (current-buffer)) a)
589 (if (setq a (rassq b prj-files))
590 (prj-remove-file a t)
591 (if (setq a (rassq b prj-removed-files))
592 (setq prj-removed-files (delq a prj-removed-files))
593 ))))
595 (defun prj-register-buffer (b)
596 (let (f a i)
597 (setq f (buffer-file-name b))
598 (when f
599 (setq a (rassq b prj-files))
600 (unless a
601 (setq a (prj-insert-file f nil t))
602 (when a
603 (unless (cdr a)
604 (message "Added to project: %s" (car a))
606 (setcdr a b)
607 (with-current-buffer b
608 (rename-buffer (car a) t)
610 (when (and a (null (eq a prj-curfile)))
611 (setq prj-curfile a)
612 (prj-setmenu)
616 (defun prj-insert-file (f &optional after on-the-fly)
617 (let ((r (prj-relative-path f)) a m)
618 (setq a (assoc r prj-files))
619 (unless (or a (and on-the-fly (assoc r prj-removed-files)))
620 (setq a (list r))
621 (setq m (memq (or after prj-curfile) prj-files))
622 (if m
623 (setcdr m (cons a (cdr m)))
624 (setq prj-files (prj-add-list prj-files a))
626 (setq prj-removed-files (prj-del-list prj-removed-files a))
630 (defun prj-remove-file (a &optional on-the-fly)
631 (let ((n (prj-otherfile prj-files a)) b)
632 (setq prj-files (prj-del-list prj-files a))
633 (when (eq prj-curfile a)
634 (setq prj-curfile n)
636 (unless on-the-fly
637 (setq prj-removed-files (prj-add-list prj-removed-files a))
639 (unless (prj-config-print)
640 (prj-edit-file prj-curfile)
642 (prj-setmenu)
643 (message "Removed from project: %s" (car a))
646 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
647 ;; Edit another file
649 (defun prj-find-file (a)
650 (when a
651 (let ((n (car a)) f b pos)
652 (setq f (expand-file-name n prj-directory))
653 (setq b (get-file-buffer f))
654 (unless b
655 (prj-removehooks)
656 (setq b (find-file-noselect f))
657 (prj-addhooks)
658 (when b
659 (with-current-buffer b
660 (rename-buffer n t)
662 (setq pos (cdr a))
664 (when b
665 (setcdr a b)
666 (cons b pos)
667 ))))
669 (defun prj-edit-file (a)
670 (let ((f (prj-find-file a)))
671 (when f
672 (eproject-setup-quit)
673 (switch-to-buffer (car f))
674 (prj-restore-edit-pos (cdr f) (selected-window))
675 (prj-setmenu)
677 (setq prj-curfile a)
680 (defun prj-restore-edit-pos (pos w)
681 (when (consp pos)
682 (let ((top (car pos)) (line (cadr pos)))
683 (when (and (numberp top) (numberp line))
684 (prj-goto-line top)
685 (set-window-start w (point))
686 (prj-goto-line line)
687 ))))
689 (defun prj-select-window (w)
690 (let (focus-follows-mouse)
691 (select-window w)
692 (select-frame-set-input-focus (window-frame w))
695 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
696 ;; choose next/previous file
698 (defun eproject-nextfile ()
699 "Switch to the next file that belongs to the current project."
700 (interactive)
701 (prj-switch-file 'prj-next-file 'next-buffer)
704 (defun eproject-prevfile ()
705 "Switch to the previous file that belongs to the current project."
706 (interactive)
707 (prj-switch-file 'prj-prev-file 'previous-buffer)
710 (defun prj-switch-file (fn1 fn2)
711 (let ((a (rassoc (current-buffer) prj-files)))
712 (cond (a
713 (prj-edit-file (or (funcall fn1 prj-files a) a))
715 (prj-curfile
716 (prj-edit-file prj-curfile)
719 (funcall fn2)
720 ))))
722 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
723 ;; Set key shortcuts
725 (defun prj-setkeys ()
726 (let ((f (consp prj-current))
727 (a (assoc 'eproject-mode minor-mode-map-alist))
728 (map (make-sparse-keymap))
730 (if a
731 (setcdr a map)
732 (push (cons 'eproject-mode map) minor-mode-map-alist)
734 (when f
735 (define-key map [M-right] 'eproject-nextfile)
736 (define-key map [M-left] 'eproject-prevfile)
737 (define-key map [C-f5] 'eproject-dired)
738 (let ((n 0) fn s)
739 (dolist (a prj-tools)
740 (unless (setq fn (nth n prj-tools-fns))
741 (setq fn (list 'lambda))
742 (setq prj-tools-fns (nconc prj-tools-fns (list fn)))
744 (setcdr fn `(() (interactive) (prj-run-tool ',a)))
745 (setq n (1+ n))
746 (when (setq s (caddr a))
747 (define-key map (prj-parse-key s) (and f fn))
748 ))))
749 (define-key map [f5] 'eproject-setup-toggle)
752 (defun prj-parse-key (s)
753 (read
754 (if (string-match "[a-z][a-z0-9]+$" s)
755 (concat "[" s "]")
756 (concat "\"\\" s "\""))))
758 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
759 ;; Set menus
761 (defun prj-list-sorted ()
762 (sort (append prj-list nil)
763 '(lambda (a b) (string-lessp (car a) (car b)))
766 (defun prj-setmenu ()
767 (let ((f (consp prj-current)) m1 m2 m3)
769 (setq m1
770 `(("Open" open ,@(prj-menulist-maker prj-list prj-current 'prj-menu-open))
771 ("Add/Remove" other
772 ("Add ..." "Add new or existing project to the list" . eproject-add)
773 ("Remove ..." "Remove project from the list" . eproject-remove)
774 ,@(and f '(("Close" "Close current project" . eproject-close)))
775 ("--")
776 ("Setup" "Enter the project setup area." . eproject-setup-toggle)
777 ("Help" "View eproject.txt" . eproject-help)
780 (when f
781 (nconc m1 (cons '("--") (prj-menulist-maker prj-tools nil prj-tools-fns)))
782 (setq m2
783 `(("Dired" "Browse project directory in Dired - Use 'a' to add file(s) to the project" . eproject-dired)
784 ("--")
785 ,@(prj-menulist-maker prj-files prj-curfile 'prj-menu-edit)
788 (prj-menu-maker
789 global-map
790 `((buffer "Project" project ,@m1)
791 (file "List" list ,@m2)
793 '(menu-bar)
796 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
798 (defun prj-menu-edit ()
799 (interactive)
800 (let ((a (nth last-command-event prj-files)))
801 (if a (prj-edit-file a))
804 (defun prj-menu-open ()
805 (interactive)
806 (let ((a (nth last-command-event prj-list)))
807 (if a (eproject-open (car a)))
810 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
812 (defun prj-menu-maker (map l v)
813 (let ((e (list nil)))
814 (setq v (append v e))
815 (dolist (k (reverse l))
816 (let (s a)
817 (when (symbolp (car k))
818 (setq a (pop k))
820 (cond
821 ((numberp (car k))
822 (setcar e (pop k))
824 ((and (consp (cdr k)) (symbolp (cadr k)))
825 (setcar e (cadr k))
826 (setq s (cddr k))
827 (setq k (and s (cons (car k) (make-sparse-keymap (car k)))))
830 (setcar e (intern (downcase (car k))))
832 (if a
833 (define-key-after map (vconcat v) k a)
834 (define-key map (vconcat v) k)
836 (if s (prj-menu-maker map s v))
837 ))))
839 (defun prj-copy-head (l n)
840 (let (r)
841 (while (and l (> n 0))
842 (push (pop l) r)
843 (setq n (1- n))
845 (nreverse r)
848 (defun prj-split-list (l n)
849 (let (r)
850 (while l
851 (push (prj-copy-head l n) r)
852 (setq l (nthcdr n l))
854 (nreverse r)
857 (defun prj-menulist-maker (l act fns)
858 (let (r (w 30) s (m 0) (n 0) k)
859 (cond
860 ((< (length l) w)
861 (prj-menulist-maker-1 (list l fns n) act)
864 ;; menu too long; split into submenus
865 (setq s (prj-split-list l w))
866 (setq k (prj-menulist-maker-1 (list (append (pop s) '(("--"))) fns n) act))
867 (setq r (nreverse k))
868 (dolist (l s)
869 (when (consp fns)
870 (setq fns (nthcdr w fns))
872 (setq n (+ n w))
873 (setq k (prj-menulist-maker-1 (list l fns n) act))
874 (push (cons (concat (prj-shortname (caar l)) " ...")
875 (cons (intern (format "m_%d" (setq m (1+ m))))
876 k)) r)
878 (nreverse r)
879 ))))
881 (defun prj-menulist-maker-1 (l act)
882 (let (r e f s i n a)
883 (while (car l)
884 (setq a (caar l))
885 (setcar l (cdar l))
886 (setq n (caddr l))
887 (setcar (cddr l) (1+ n))
888 (setq f (if (consp (cadr l))
889 (prog1 (car (cadr l)) (setcar (cdr l) (cdr (cadr l))))
890 (cadr l)))
892 (setq i (car a))
893 (unless (string-match "^ *#" i)
894 (setq s (if (and (consp (cdr a)) (stringp (cadr a))) (cadr a) i))
895 (cond ((equal ">" i)
896 (setq e (cons s (cons (intern s) (prj-menulist-maker-1 l act))))
897 (setq r (cons e r))
899 ((equal "<" i)
900 (setq l nil)
903 (setq i (prj-shortname i))
904 (setq e (cons n (if (eq a act)
905 `(menu-item ,i ,f :button (:toggle . t) :help ,s)
906 (cons i (cons s f)))))
907 (setq r (cons e r))
910 (nreverse r)
913 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
914 ;; Run make and other commands
916 (defun prj-setup-tool-window ()
917 (let ((bn "*compilation*") w h b c f)
918 (unless (get-buffer-window bn t)
919 (setq b (get-buffer-create bn))
920 (setq f (frame-list))
921 (cond ((cdr f)
922 (setq w (frame-first-window (car f)))
923 (delete-other-windows w)
926 (setq h (/ (* 70 (frame-height)) 100))
927 (delete-other-windows w)
928 (setq w (split-window w h))
930 (set-window-buffer w b)
933 (defun prj-run (cmd)
934 (let (dir)
935 (when (string-match "^-in +\\([^[:space:]]+\\) +" cmd)
936 (setq dir (match-string-no-properties 1 cmd))
937 (setq cmd (substring cmd (match-end 0)))
939 (when prj-directory-run
940 (setq dir (expand-file-name (or dir ".") prj-directory-run))
942 (if dir (cd dir))
943 (cond ((string-match "^-e +" cmd)
944 (setq cmd (read (substring cmd (match-end 0))))
945 (unless (commandp cmd)
946 (setq cmd `(lambda () (interactive) ,cmd))
948 (command-execute cmd)
950 ((string-match "\\(.+\\)& *$" cmd)
951 (start-process-shell-command "eproject-async" nil (match-string 1 cmd))
952 (message (match-string 1 cmd))
955 (unless (or (fboundp 'ecb-activate) (fboundp 'ewm-init))
956 (prj-setup-tool-window)
958 (let ((display-buffer-reuse-frames t))
959 (compile cmd)
960 )))))
962 (defun prj-run-tool (a)
963 (unless (string-match "^--+$" (car a))
964 (prj-run (or (cadr a) (car a)))
967 (defun eproject-killtool ()
968 (interactive)
969 (let ((bn "*compilation*") w0 w1)
970 (when (setq w1 (get-buffer-window bn t))
971 (when (fboundp 'kill-compilation)
972 (setq w0 (selected-window))
973 (select-window w1)
974 (kill-compilation)
975 (select-window w0)
976 ))))
978 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
979 ;; run grep on project files
981 (require 'grep)
983 (defun eproject-grep (command-args)
984 "Run the grep command on all the project files."
985 (interactive
986 (progn
987 (grep-compute-defaults)
988 (let ((default (grep-default-command)))
989 (list (read-from-minibuffer
990 "Run grep on project files: "
991 (if current-prefix-arg default grep-command)
994 'grep-history
995 (if current-prefix-arg nil default)
996 )))))
997 (let ((default-directory prj-directory))
998 (dolist (f (mapcar 'car prj-files))
999 (setq command-args (concat command-args " " f))
1001 (grep command-args)
1004 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1005 ;; add files to the project with dired
1007 (require 'dired)
1009 (defun prj-dired-addfiles ()
1010 (interactive)
1011 (when prj-current
1012 (let ((n 0) a)
1013 (dolist (f (dired-get-marked-files))
1014 (setq a (prj-insert-file f))
1015 (unless (cdr a)
1016 (setq n (1+ n))
1017 (setq prj-curfile a)
1019 (message "Added to project: %d file(s)" n)
1020 (prj-setmenu)
1023 (defun prj-dired-run ()
1024 (interactive)
1025 (let ((f (dired-get-marked-files)) c)
1026 (and (setq c (pop f))
1027 (null f)
1028 (let ((prj-directory (file-name-directory c)))
1029 (prj-run c)))))
1031 (defun eproject-dired ()
1032 "Start a dired window with the project directory."
1033 (interactive)
1034 (when prj-directory-run
1035 (eproject-setup-quit)
1036 ;;(message "Use 'a' to add marked or single files to the project.")
1037 (dired prj-directory-run)
1038 (let ((map dired-mode-map))
1039 (define-key map [mouse-2] 'dired-find-file)
1040 (define-key map "a" 'prj-dired-addfiles)
1041 (define-key map "r" 'prj-dired-run)
1042 (define-key map [menu-bar operate command] '("Add to Project"
1043 "Add current or marked file(s) to project" . prj-dired-addfiles))
1046 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1048 (defun prj-setup-all ()
1049 (prj-setkeys)
1050 (prj-setmenu)
1051 (prj-settitle)
1052 (prj-config-print)
1055 (defun prj-getconfig (n)
1056 (let ((a (cdr (assoc n prj-config))))
1057 (and (stringp a) a)
1060 (defun prj-setconfig (n v)
1061 (let ((a (assoc n prj-config)))
1062 (unless a
1063 (setq a (list n))
1064 (setq prj-config (nconc prj-config (list a)))
1066 (setcdr a v)
1069 (defun prj-on-kill ()
1070 (save-some-buffers t)
1071 (prj-saveall)
1074 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1075 ;; isearch in all project files
1077 (defun prj-isearch-function (b wrap)
1078 (let (a d)
1079 (or b (setq b (current-buffer)))
1080 (cond (wrap
1081 (if isearch-forward
1082 (setq a (car prj-files))
1083 (setq a (car (last prj-files)))
1085 ((setq a (rassoc b prj-files))
1086 (if isearch-forward
1087 (setq a (prj-next-file prj-files a))
1088 (setq a (prj-prev-file prj-files a))
1091 (when a
1092 (if (buffer-live-p (cdr a))
1093 (setq d (cdr a))
1094 (setq d (car (prj-find-file a)))
1096 ;; (print `(prj-isearch (wrap . ,wrap) ,b ,d) (get-buffer "*Messages*"))
1100 (defun prj-isearch-setup ()
1101 (cond (prj-current
1102 (setq multi-isearch-next-buffer-function 'prj-isearch-function)
1103 (setq multi-isearch-pause 'initial)
1104 (add-hook 'isearch-mode-hook 'multi-isearch-setup)
1107 (remove-hook 'isearch-mode-hook 'multi-isearch-setup)
1110 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1111 ;; Initialize
1113 (defun prj-startup-delayed ()
1114 ;; where is this file
1115 (setq eproject-directory
1116 (file-name-directory (symbol-file 'eproject-startup)))
1118 ;; load UI support
1119 (load (eproject-addon "eproject-config") nil t)
1121 ;; When no projects are specified yet, load the eproject project itself.
1122 (unless prj-list
1123 (load (eproject-addon "eproject.cfg"))
1126 ;; no project so far
1127 (prj-reset)
1128 (prj-setup-all)
1129 (add-hook 'kill-emacs-hook 'prj-on-kill)
1131 ;; inhibit open last project when a file was on the commandline
1132 (unless (buffer-file-name (window-buffer))
1133 (when prj-last-open
1135 ;; open last project
1136 (eproject-open prj-last-open)
1138 ;; restore frame position
1139 (unless (fboundp 'ewm-init)
1140 (when (and prj-frame-pos prj-initial-frame)
1141 (modify-frame-parameters prj-initial-frame prj-frame-pos)
1142 ;; emacs bug: when it's too busy it doesn't set frames correctly.
1143 (sit-for 0.2)
1144 ))))
1146 (when (fboundp 'ecb-activate)
1147 (ecb-activate)
1151 (defun prj-command-line-switch (option)
1152 (setq prj-last-open (pop argv))
1153 (setq inhibit-startup-screen t)
1156 (defun eproject-startup ()
1157 (if (boundp 'prj-list)
1158 (progn
1159 (load (eproject-addon "eproject-config"))
1160 (prj-setup-all))
1161 (progn
1162 (prj-loadlist)
1163 (when prj-last-open (setq inhibit-startup-screen t))
1164 (when (display-graphic-p) (setq prj-initial-frame (selected-frame)))
1165 (push '("project" . prj-command-line-switch) command-switch-alist)
1166 (run-with-idle-timer 0.1 nil 'prj-startup-delayed)
1169 ;;;###autoload(require 'eproject)
1170 (provide 'eproject)
1171 (eproject-startup)
1173 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1174 ;; eproject.el ends here