| blob | b882aa2bbd71cd062ccd20cbc215af54bacf17ad |
1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2 ;;
3 ;; eproject.el --- project workspaces for emacs
4 ;;
5 ;; Copyright (C) 2008-2010 grischka
6 ;;
7 ;; Author: grischka -- grischka@users.sourceforge.net
8 ;; Created: 24 Jan 2008
9 ;; Version: 0.4
10 ;;
11 ;; This program is free software, released under the GNU General
12 ;; Public License (GPL, version 2). For details see:
13 ;;
14 ;; http://www.fsf.org/licenses/gpl.html
15 ;;
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.
20 ;;
21 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24 ;; User-configurable items:
28 ([M-right] eproject-nextfile)
29 ([M-left] eproject-prevfile)
30 ([C-f5] eproject-dired)
31 )
32 "Key bindings in eproject"
33 )
35 (defvar prj-default-config '(
36 ("Make" "make" "f9")
37 ("Clean" "make clean" "C-f9")
38 ("Run" "echo run what" "f8")
39 ("Stop" "-e eproject-killtool" "C-f8")
40 ("---")
41 ("Configure" "./configure")
42 ("---")
43 ("Explore Project" "nautilus --browser `pwd` &")
44 ("XTerm In Project" "xterm &")
45 )
46 "*The default tools menu for new projects in eproject."
47 )
49 (defvar prj-autotracking t
50 "*Should eproject automatically add/remove files to/from the project (nil/t)")
51 ; To apply, close and reopen the project.
53 (defvar prj-rename-buffers t
54 "*Should eproject rename buffers to project-relative filenames (nil/t)")
56 (defvar prj-set-default-directory nil
57 "*Should eproject set the project directory as default-directory
58 for all project files (nil/t).")
60 (defvar prj-set-framepos nil
61 "*Should eproject restore the last frame position/size (nil/t).")
63 (defvar prj-set-compilation-frame nil
64 "*Should eproject show compilation output in the other frame (nil/t).")
66 (defvar prj-set-multi-isearch nil
67 "*Should eproject setup multi-isearch in the project files (nil/t).")
69 ;; End of user-configurable items
70 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
72 ;; There is a global file (~/.emacs.d/eproject.lst)
73 (defun prj-globalfile ()
74 (expand-file-name "eproject.lst"
75 (if (boundp 'user-emacs-directory)
76 user-emacs-directory
77 "~/.emacs.d/"
78 )))
80 ;; with the list of all projects
81 (defvar prj-list)
83 ;; and the project that was open in the last session (if any)
84 (defvar prj-last-open nil)
86 ;; and the frame coords from last session
87 (defvar prj-frame-pos nil)
89 ;; eproject version that created the config file
90 (defvar prj-version nil)
92 ;; Here is a function to reset these
93 (defun prj-init ()
94 (setq prj-version nil)
95 (setq prj-list nil)
96 (setq prj-last-open nil)
97 (setq prj-frame-pos nil)
98 )
100 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
101 ;; Each project has a directory
103 (defvar prj-directory)
105 ;; with a configuration files in it
106 (defvar prj-default-cfg "eproject.cfg")
108 ;; This file defines:
110 ;; the list of files
111 (defvar prj-files)
113 ;; the current file
114 (defvar prj-curfile)
116 ;; an alist of settings
117 (defvar prj-config)
119 ;; a list of tools
120 (defvar prj-tools)
122 ;; a list of utility functions (feature incomplete)
123 (defvar prj-functions nil)
125 ;; directory to run commands, default to prj-directory
126 (defvar prj-exec-directory)
128 ;; The current project
129 (defvar prj-current)
131 ;; A list with generated functions for each tool
132 (defvar prj-tools-fns)
134 ;; A list with files removed from the project
135 (defvar prj-removed-files)
137 ;; Here is a function to reset/close the project
138 (defun prj-reset ()
139 (setq prj-version nil)
140 (setq prj-current nil)
141 (setq prj-directory nil)
142 (setq prj-exec-directory nil)
143 (setq prj-files nil)
144 (setq prj-removed-files nil)
145 (setq prj-curfile nil)
146 (setq prj-config nil)
147 (setq prj-tools-fns nil)
148 (setq prj-tools (copy-tree prj-default-config))
149 (prj-reset-functions)
150 )
152 (defun prj-reset-functions ()
153 (dolist (l prj-functions)
154 (if (eq (car l) 'setq)
155 (makunbound (cadr l))
156 (fmakunbound (cadr l))
157 ))
158 (setq prj-functions nil)
159 )
161 (defun prj-set-functions (s)
162 (prj-reset-functions)
163 (setq prj-functions s)
164 (dolist (l s) (eval l))
165 )
167 ;; Some more variables:
169 ;; the frame that exists on startup
170 (defvar prj-initial-frame nil)
172 ;; this is put into minor-mode-alist
173 (defvar eproject-mode t)
175 ;; where this file is in
176 (defvar eproject-directory)
178 ;; eproject version that created the files
179 (defvar eproject-version "0.4")
181 ;; Configuration UI
182 (eval-and-compile
183 (defun eproject-setup-toggle () (interactive))
184 (defun eproject-setup-quit () (interactive))
185 (defun prj-config-get-result (s))
186 (defun prj-config-reset ())
187 (defun prj-config-print ())
188 (defun prj-config-parse ())
189 )
191 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
192 ;; Small functions
194 (defun caddr (l) (car (cddr l)))
196 (defun prj-del-list (l e)
197 (let ((a (assoc (car e) l)))
198 (if a
199 (delq a l)
200 l)))
202 (defun prj-add-list (l e)
203 (nconc (prj-del-list l e) (list e))
204 )
206 (defun prj-next-file (l e)
207 (and (setq e (assoc (car e) l))
208 (cadr (memq e l))
209 ))
211 (defun prj-prev-file (l e)
212 (prj-next-file (reverse l) e)
213 )
215 ; replace a closed file, either by the previous or the next.
216 (defun prj-otherfile (l f)
217 (or (prj-prev-file l f)
218 (prj-next-file l f)
219 ))
221 ;; make relative path, but only up to the second level of ..
222 (defun prj-relative-path (f)
223 (let ((r (file-relative-name f prj-directory)))
225 f
226 r
227 )))
229 ;; friendly truncate filename
230 (defun prj-shortname (s)
231 (let ((l (length s)) (x 30) n)
232 (cond ((>= x l) s)
233 ((progn
234 (setq x (- x 3))
235 (setq n (length (file-name-nondirectory s)))
236 (if (< n l) (setq n (1+ n)))
237 (>= x n)
238 )
239 (concat (substring s 0 (- x n)) "..." (substring s (- n)))
240 )
241 ((= n l)
242 (concat (substring s 0 x) "...")
243 )
244 (t
245 (concat "..." (substring s (- n) (- (- x 3) n)) "...")
246 ))))
248 (defun prj-settitle ()
249 (modify-frame-parameters
250 nil
251 (list (cons 'title
252 (and prj-current
253 (format "emacs - %s" (car prj-current))
254 )))))
256 (defun eproject-addon (f)
257 (concat eproject-directory f)
258 )
260 (defun prj-goto-line (n)
261 (goto-char 1)
262 (beginning-of-line n)
263 )
265 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
266 ;; Write configuration to file
268 (defun prj-print-list (s fp)
269 (let ((v (eval s)))
270 (setq v (list 'setq s
271 (if (and (atom v) (null (and (symbolp v) v)))
272 v
273 (list 'quote v)
274 )))
275 ;;(print v fp)
277 ))
279 (defun prj-create-file (filename)
280 (let ((fp (generate-new-buffer filename)))
282 fp))
284 (defun prj-close-file (fp)
285 (with-current-buffer fp
286 (condition-case nil
287 (and t (write-region nil nil (buffer-name fp) nil 0))
288 (error nil)
289 ))
290 (kill-buffer fp)
291 )
293 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
294 ;; Load/Save global project list and initial frame sizes
296 (defun prj-loadlist ()
297 (prj-init)
298 (load (prj-globalfile) t t)
299 (setq prj-version eproject-version)
300 )
302 (defun prj-get-frame-pos (f)
303 (mapcar
304 (lambda (parm) (cons parm (frame-parameter f parm)))
305 '(top left width height)
306 ))
308 (defun prj-savelist ()
309 (let ((g (prj-globalfile)) fp)
310 (unless (file-exists-p g)
311 (make-directory (file-name-directory g) t)
312 )
313 (setq prj-last-open (car prj-current))
314 (when (frame-live-p prj-initial-frame)
315 (setq prj-frame-pos (prj-get-frame-pos prj-initial-frame))
316 )
317 (setq fp (prj-create-file g))
318 (when fp
319 (prj-print-list 'prj-version fp)
320 (prj-print-list 'prj-list fp)
321 (prj-print-list 'prj-last-open fp)
322 (prj-print-list 'prj-frame-pos fp)
323 (prj-close-file fp)
324 )))
326 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
327 ;; Load/Save local per-project configuration file
329 (defun prj-update-config ()
330 (let ((d (prj-get-directory prj-current))
331 (e (prj-getconfig "exec-root"))
332 )
333 (if e (setq d (expand-file-name e d)))
334 (setq prj-exec-directory (file-name-as-directory d))
335 ))
337 (defun prj-get-directory (a)
338 (file-name-as-directory (expand-file-name (cadr a)))
339 )
341 (defun prj-get-cfg ()
342 (expand-file-name (or (caddr prj-current) prj-default-cfg) prj-directory)
343 )
345 (defun prj-get-buffer (a)
346 (cond ((buffer-live-p (cdr a))
347 (cdr a)
348 )
349 (prj-directory
350 (get-file-buffer (expand-file-name (car a) prj-directory))
351 )))
353 (defun prj-loadconfig (a)
354 (let (lf e)
355 (prj-reset)
356 (setq prj-current a)
357 (setq prj-directory (prj-get-directory a))
358 (when (file-regular-p (setq lf (prj-get-cfg)))
359 (load lf nil t)
360 (setq prj-curfile
361 (or (assoc prj-curfile prj-files)
362 (car prj-files)
363 ))
364 )
365 (if (setq e (prj-getconfig "project-name"))
366 (setcar a e)
367 (prj-setconfig "project-name" (car a))
368 )
369 (prj-update-config)
370 (prj-set-functions prj-functions)
371 (setq prj-version eproject-version)
372 ))
374 (defun prj-saveconfig ()
375 (when prj-current
376 (let (w c b files)
377 (prj-removehooks)
378 (setq w (selected-window))
379 (setq c (window-buffer w))
380 (dolist (a prj-files)
381 (setq b (prj-get-buffer a))
382 (cond (b
383 (set-window-buffer w b t)
384 (with-current-buffer b
385 (let ((s (line-number-at-pos (window-start w)))
386 (p (line-number-at-pos (window-point w)))
387 )
388 (push (list (car a) s p) files)
389 )))
390 ((consp (cdr a))
391 (push a files)
392 )
393 (t
394 (push (list (car a)) files)
395 )))
396 (set-window-buffer w c t)
397 (prj-addhooks)
398 (let ((fp (prj-create-file (prj-get-cfg)))
399 (prj-curfile (car prj-curfile))
400 (prj-files (nreverse files))
401 )
402 (when fp
403 (prj-print-list 'prj-version fp)
404 (prj-print-list 'prj-config fp)
405 (prj-print-list 'prj-tools fp)
406 (prj-print-list 'prj-files fp)
407 (prj-print-list 'prj-curfile fp)
408 (prj-print-list 'prj-functions fp)
409 (prj-close-file fp)
410 ))
411 )))
413 (defun prj-saveall ()
414 (prj-saveconfig)
415 (prj-savelist)
416 )
418 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
419 ;; The core functions: Open / Close / Add / Remove Project
421 (defun eproject-open (a)
422 "Open another project."
423 (interactive
424 (list
425 (or (prj-config-get-result 'p)
426 (completing-read "Open Project: " (mapcar 'car prj-list))
427 )))
428 (unless (consp a)
429 (let ((b (assoc a prj-list)))
430 (unless b
431 (error "No such project: %s" a)
432 )
433 (setq a b)
434 ))
435 (setq a (or (car (member a prj-list)) a))
436 (unless (eq a prj-current)
437 (unless (file-directory-p (prj-get-directory a))
438 (error "No such directory: %s" (cadr a))
439 )
440 (setq prj-list (cons a (delq a prj-list)))
441 (eproject-close)
442 (prj-loadconfig a)
443 )
444 (prj-addhooks)
445 (prj-setup-all)
446 (prj-isearch-setup)
447 (unless (prj-edit-file prj-curfile)
448 (eproject-dired)
449 ))
451 (defun eproject-close ()
452 "Close the current project."
453 (interactive)
454 (when prj-current
455 (prj-saveconfig)
456 (prj-removehooks)
457 (let (f)
458 (unwind-protect
459 (progn
460 (save-some-buffers nil)
461 (eproject-killbuffers t)
462 (setq f t)
463 )
464 (or f (prj-addhooks))
465 ))
466 (prj-reset)
467 (prj-config-reset)
468 (prj-setup-all)
469 (prj-isearch-setup)
470 ))
472 (defun eproject-killbuffers (&optional from-project)
473 "If called interactively kills all buffers that do not belong to project files"
474 (interactive)
475 (let (l b)
476 (dolist (a prj-files)
477 (setq b (prj-get-buffer a))
478 (if b (setq l (cons (list b) l)))
479 )
480 (dolist (b (buffer-list))
481 (when (eq (consp (assoc b l)) from-project)
482 (kill-buffer b)
483 ))))
485 (defun eproject-add (dir &optional name cfg)
486 "Add a new or existing project to the list."
487 (interactive
488 (let (d n f)
489 (setq d (read-directory-name "Add project in directory: " prj-directory nil t))
490 (setq n (file-name-nondirectory (directory-file-name d)))
491 (setq n (read-string "Project name: " n))
492 (setq f (read-string "Project file: " prj-default-cfg))
493 (list d n f)
494 ))
495 (when dir
496 (setq dir (directory-file-name dir))
497 (unless name
498 (setq name (file-name-nondirectory dir))
499 )
500 (when (and cfg (string-equal cfg prj-default-cfg))
501 (setq cfg nil)
502 )
503 (let ((a (if cfg (list name dir cfg) (list name dir))))
504 (push a prj-list)
505 (eproject-open a)
506 )))
508 (defun eproject-remove (a)
509 "Remove a project from the list."
510 (interactive
511 (list
512 (or (prj-config-get-result 'p)
513 (completing-read "Remove project: " (mapcar 'car prj-list))
514 )))
515 (unless (consp a)
516 (let ((b (assoc a prj-list)))
517 (unless b
518 (error "No such project: %s" a)
519 )
520 (setq a b)
521 ))
522 (when (progn
523 (beep)
525 (message "")
526 ))
527 (setq prj-list (prj-del-list prj-list a))
528 (prj-setup-all)
529 ))
531 (defun eproject-save ()
532 "Save the project configuration to file."
533 (interactive)
534 (prj-config-parse)
535 (prj-config-print)
536 (prj-saveall)
537 )
539 (defun eproject-revert ()
540 "Reload the project configuration from file."
541 (interactive)
542 (prj-loadlist)
543 (if prj-current
544 (prj-loadconfig prj-current)
545 )
546 (prj-setup-all)
547 )
549 (defun eproject-addfile (f)
550 "Add a file to the current project."
551 (interactive
552 (and prj-current
553 (list
554 (read-file-name "Add file to project: " nil nil t nil)
555 )))
556 (unless prj-current (error "No project open"))
557 (prj-insert-file f (prj-config-get-result 'f))
558 (prj-config-print)
559 (prj-setmenu)
560 )
562 (defun eproject-removefile (a)
563 "Remove a file from the current project."
564 (interactive (prj-get-existing-file-1 "Remove file from project: "))
565 (setq a (prj-get-existing-file-2 a))
566 (prj-remove-file a)
567 )
569 (defun eproject-visitfile (a)
570 "Visit a file from the current project."
571 (interactive (prj-get-existing-file-1 "Visit file: "))
572 (setq a (prj-get-existing-file-2 a))
573 (prj-edit-file a)
574 )
576 (defun prj-get-existing-file-1 (msg)
577 (and prj-current
578 (list
579 (or (prj-config-get-result 'f)
580 (completing-read msg (mapcar 'car prj-files))
581 ))))
583 (defun prj-get-existing-file-2 (a)
584 (unless prj-current (error "No project open"))
585 (if (consp a)
586 a
587 (let ((b (assoc (prj-relative-path a) prj-files)))
588 (unless b (error "No such file in project: %s" a))
589 b
590 )))
592 (defun eproject-help ()
593 "Show the eproject README."
594 (interactive)
595 (view-file (eproject-addon "eproject.txt"))
596 )
598 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
599 ;; Hook functions to track opening/closing files from emacs
601 (defun prj-addhooks ()
602 (when prj-autotracking
603 (add-hook 'kill-buffer-hook 'prj-kill-buffer-hook)
604 (add-hook 'find-file-hook 'prj-find-file-hook)
605 (add-hook 'window-configuration-change-hook 'prj-wcc-hook)
606 ))
608 (defun prj-removehooks ()
609 (remove-hook 'window-configuration-change-hook 'prj-wcc-hook)
610 (remove-hook 'find-file-hook 'prj-find-file-hook)
611 (remove-hook 'kill-buffer-hook 'prj-kill-buffer-hook)
612 )
614 (defun prj-wcc-hook ()
615 (dolist (w (window-list))
616 (prj-register-buffer (window-buffer w))
617 ))
619 (defun prj-find-file-hook ()
620 (run-with-idle-timer 0.2 nil 'prj-wcc-hook)
621 )
623 (defun prj-kill-buffer-hook ()
624 (let ((b (current-buffer)) a)
625 (if (setq a (rassq b prj-files))
626 (prj-remove-file a t)
627 (if (setq a (rassq b prj-removed-files))
628 (setq prj-removed-files (delq a prj-removed-files))
629 ))))
631 (defun prj-register-buffer (b)
632 (let (f a)
633 (setq f (buffer-file-name b))
635 (setq a (rassq b prj-files))
636 (unless a
637 (setq a (prj-insert-file f nil t))
638 (when a
639 (prj-init-buffer a b)
640 ))
641 (when (and a (null (eq a prj-curfile)))
642 (setq prj-curfile a)
643 (prj-setmenu)
644 ))
645 a))
647 (defun prj-insert-file (f &optional after on-the-fly)
648 (let ((r (prj-relative-path f)) a m)
649 (setq a (assoc r prj-files))
650 (unless (or a (and on-the-fly (assoc r prj-removed-files)))
651 (setq a (list r))
652 (setq m (memq (or after prj-curfile) prj-files))
653 (if m
654 (setcdr m (cons a (cdr m)))
655 (setq prj-files (prj-add-list prj-files a))
656 )
657 (setq prj-removed-files (prj-del-list prj-removed-files a))
658 (message "Added to project: %s" r)
659 )
660 a))
662 (defun prj-remove-file (a &optional on-the-fly)
663 (let ((n (prj-otherfile prj-files a)) b)
664 (setq prj-files (prj-del-list prj-files a))
665 (when (eq prj-curfile a)
666 (setq prj-curfile n)
667 )
668 (unless on-the-fly
669 (setq prj-removed-files (prj-add-list prj-removed-files a))
670 )
671 (unless (prj-config-print)
672 (prj-edit-file prj-curfile)
673 )
674 (prj-setmenu)
675 (message "Removed from project: %s" (car a))
676 ))
678 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
679 ;; Edit another file
681 (defun prj-init-buffer (a b)
682 (with-current-buffer b
683 (when prj-rename-buffers
684 (rename-buffer (car a) t)
685 )
686 (when prj-set-default-directory
687 (cd prj-directory)
688 ))
689 (setcdr a b)
690 )
692 (defun prj-find-file (a)
693 (when a
694 (let (b pos f)
695 (setq b (prj-get-buffer a))
696 (unless b
697 (prj-removehooks)
698 (setq f (expand-file-name (car a) prj-directory))
699 (setq b (find-file-noselect f))
700 (prj-addhooks)
701 (when (and b (consp (cdr a)))
702 (setq pos (cdr a))
703 ))
704 (when b
705 (prj-init-buffer a b)
706 (cons b pos)
707 ))))
709 (defun prj-edit-file (a)
710 (let ((f (prj-find-file a)))
711 (when f
712 (eproject-setup-quit)
713 (switch-to-buffer (car f))
714 (prj-restore-edit-pos (cdr f) (selected-window))
715 (prj-setmenu)
716 ;;(message "dir: %s" default-directory)
717 )
718 (setq prj-curfile a)
719 ))
721 (defun prj-restore-edit-pos (pos w)
722 (let ((top (car pos)) (line (cadr pos)))
723 (when (and (numberp top) (numberp line))
724 (prj-goto-line top)
725 (set-window-start w (point))
726 (prj-goto-line line)
727 )))
729 (defun prj-select-window (w)
730 (let (focus-follows-mouse)
731 (select-window w)
732 (select-frame-set-input-focus (window-frame w))
733 ))
735 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
736 ;; choose next/previous file
738 (defun eproject-nextfile ()
739 "Switch to the next file that belongs to the current project."
740 (interactive)
741 (prj-switch-file 'prj-next-file 'next-buffer)
742 )
744 (defun eproject-prevfile ()
745 "Switch to the previous file that belongs to the current project."
746 (interactive)
747 (prj-switch-file 'prj-prev-file 'previous-buffer)
748 )
750 (defun prj-switch-file (fn1 fn2)
751 (let ((a (rassoc (current-buffer) prj-files)))
752 (cond (a
753 (prj-edit-file (or (funcall fn1 prj-files a) a))
754 )
755 (prj-curfile
756 (prj-edit-file prj-curfile)
757 )
758 (t
759 (funcall fn2)
760 ))))
762 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
763 ;; Set key shortcuts
765 (defun prj-setkeys ()
766 (let ((f (consp prj-current))
767 (a (assoc 'eproject-mode minor-mode-map-alist))
768 (map (make-sparse-keymap))
769 )
770 (if a
771 (setcdr a map)
772 (push (cons 'eproject-mode map) minor-mode-map-alist)
773 )
774 (dolist (k prj-keybindings)
775 (when (or f (eq (caddr k) 'always))
776 (define-key map (car k) (cadr k))
777 ))
779 (when f
780 (let ((n 0) fn s)
781 (dolist (a prj-tools)
782 (unless (setq fn (nth n prj-tools-fns))
783 (setq fn (list 'lambda))
784 (setq prj-tools-fns (nconc prj-tools-fns (list fn)))
785 )
786 (setcdr fn `(() (interactive) (prj-run-tool ',a)))
787 (setq n (1+ n))
788 (when (setq s (caddr a))
789 (define-key map (prj-parse-key s) (and f fn))
790 ))))))
792 (defun prj-parse-key (s)
793 (read
794 (if (string-match "[a-z][a-z0-9]+$" s)
795 (concat "[" s "]")
798 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
799 ;; Set menus
801 (defun prj-list-sorted ()
802 (sort (append prj-list nil)
803 '(lambda (a b) (string-lessp (car a) (car b)))
804 ))
806 (defun prj-setmenu ()
807 (let ((f (consp prj-current)) m1 m2 m3)
809 (setq m1
810 `(("Open" open ,@(prj-menulist-maker prj-list prj-current 'prj-menu-open))
811 ("Add/Remove" other
812 ("Add ..." "Add new or existing project to the list" . eproject-add)
813 ("Remove ..." "Remove project from the list" . eproject-remove)
814 ,@(and f '(("Close" "Close current project" . eproject-close)))
815 ("--")
816 ("Setup" "Enter the project setup area." . eproject-setup-toggle)
817 ("Help" "View eproject.txt" . eproject-help)
818 )
819 ))
820 (when f
821 (nconc m1 (cons '("--") (prj-menulist-maker prj-tools nil prj-tools-fns)))
822 (setq m2
823 `(("Dired" "Browse project directory in Dired - Use 'a' to add file(s) to the project" . eproject-dired)
824 ("--")
825 ,@(prj-menulist-maker prj-files prj-curfile 'prj-menu-edit)
826 )))
828 (prj-menu-maker
829 global-map
830 `((buffer "Project" project ,@m1)
831 (file "List" list ,@m2)
832 )
833 '(menu-bar)
834 )))
836 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
838 (defun prj-menu-edit ()
839 (interactive)
840 (let ((a (nth last-command-event prj-files)))
841 (if a (prj-edit-file a))
842 ))
844 (defun prj-menu-open ()
845 (interactive)
846 (let ((a (nth last-command-event prj-list)))
847 (if a (eproject-open (car a)))
848 ))
850 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
852 (defun prj-menu-maker (map l v)
853 (let ((e (list nil)))
854 (setq v (append v e))
855 (dolist (k (reverse l))
856 (let (s a)
857 (when (symbolp (car k))
858 (setq a (pop k))
859 )
860 (cond
861 ((numberp (car k))
862 (setcar e (pop k))
863 )
864 ((and (consp (cdr k)) (symbolp (cadr k)))
865 (setcar e (cadr k))
866 (setq s (cddr k))
867 (setq k (and s (cons (car k) (make-sparse-keymap (car k)))))
868 )
869 (t
870 (setcar e (intern (downcase (car k))))
871 ))
872 (if a
873 (define-key-after map (vconcat v) k a)
874 (define-key map (vconcat v) k)
875 )
876 (if s (prj-menu-maker map s v))
877 ))))
879 (defun prj-copy-head (l n)
880 (let (r)
881 (while (and l (> n 0))
882 (push (pop l) r)
883 (setq n (1- n))
884 )
885 (nreverse r)
886 ))
888 (defun prj-split-list (l n)
889 (let (r)
890 (while l
891 (push (prj-copy-head l n) r)
892 (setq l (nthcdr n l))
893 )
894 (nreverse r)
895 ))
897 (defun prj-menulist-maker (l act fns)
898 (let (r (w 30) s (m 0) (n 0) k)
899 (cond
900 ((< (length l) w)
901 (prj-menulist-maker-1 (list l fns n) act)
902 )
903 (t
904 ;; menu too long; split into submenus
905 (setq s (prj-split-list l w))
906 (setq k (prj-menulist-maker-1 (list (append (pop s) '(("--"))) fns n) act))
907 (setq r (nreverse k))
908 (dolist (l s)
909 (when (consp fns)
910 (setq fns (nthcdr w fns))
911 )
912 (setq n (+ n w))
913 (setq k (prj-menulist-maker-1 (list l fns n) act))
914 (push (cons (concat (prj-shortname (caar l)) " ...")
915 (cons (intern (format "m_%d" (setq m (1+ m))))
916 k)) r)
917 )
918 (nreverse r)
919 ))))
921 (defun prj-menulist-maker-1 (l act)
922 (let (r e f s i n a)
923 (while (car l)
924 (setq a (caar l))
925 (setcar l (cdar l))
926 (setq n (caddr l))
927 (setcar (cddr l) (1+ n))
928 (setq f (if (consp (cadr l))
929 (prog1 (car (cadr l)) (setcar (cdr l) (cdr (cadr l))))
930 (cadr l)))
932 (setq i (car a))
933 (unless (string-match "^ *#" i)
934 (setq s (if (and (consp (cdr a)) (stringp (cadr a))) (cadr a) i))
935 (cond ((equal ">" i)
936 (setq e (cons s (cons (intern s) (prj-menulist-maker-1 l act))))
937 (setq r (cons e r))
938 )
939 ((equal "<" i)
940 (setq l nil)
941 )
942 (t
943 (setq i (prj-shortname i))
944 (setq e (cons n (if (eq a act)
945 `(menu-item ,i ,f :button (:toggle . t) :help ,s)
946 (cons i (cons s f)))))
947 (setq r (cons e r))
948 )))
949 )
950 (nreverse r)
951 ))
953 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
954 ;; Run make and other commands
956 (defun prj-compilation-in-frame (cmd)
957 (let ((bn "*compilation*") w h b c f)
958 (unless (get-buffer-window bn t)
959 (setq b (get-buffer-create bn))
960 (setq f (frame-list))
961 (cond ((cdr f)
962 (setq w (frame-first-window (car f)))
963 (delete-other-windows w)
964 )
965 (t
966 (setq h (/ (* 70 (frame-height)) 100))
967 (delete-other-windows w)
968 (setq w (split-window w h))
969 ))
970 (set-window-buffer w b)
971 ))
972 (let ((display-buffer-reuse-frames t) (f (selected-frame)))
973 (compile cmd)
974 (select-frame-set-input-focus f)
975 ))
977 (defun prj-run (cmd)
978 (cond ((string-match "^-e +" cmd)
979 (setq cmd (read (substring cmd (match-end 0))))
980 (unless (commandp cmd)
981 (setq cmd `(lambda () (interactive) ,cmd))
982 )
983 (command-execute cmd)
984 )
985 ((let ((b (current-buffer))
986 (old-dir default-directory)
987 (new-dir ".")
988 )
990 (setq new-dir (match-string-no-properties 1 cmd))
991 (setq cmd (substring cmd (match-end 0)))
992 )
993 (when prj-exec-directory
994 (setq new-dir (expand-file-name new-dir prj-exec-directory))
995 )
996 (cd new-dir)
998 (start-process-shell-command
999 "eproject-async" nil (match-string 1 cmd))
1000 (message (match-string 1 cmd))
1001 )
1002 (prj-set-compilation-frame
1003 (prj-compilation-in-frame cmd)
1004 )
1005 (t
1006 (compile cmd)
1007 ))
1008 (with-current-buffer b (cd old-dir))
1009 ))))
1011 (defun prj-run-tool (a)
1012 (unless (string-match "^--+$" (car a))
1013 (prj-run (or (cadr a) (car a)))
1014 ))
1016 (defun eproject-killtool ()
1017 (interactive)
1018 (let ((bn "*compilation*") w0 w1)
1019 (when (setq w1 (get-buffer-window bn t))
1020 (when (fboundp 'kill-compilation)
1021 (setq w0 (selected-window))
1022 (select-window w1)
1023 (kill-compilation)
1024 (select-window w0)
1025 ))))
1027 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1028 ;; run grep on project files
1030 (defun eproject-grep (command-args)
1031 "Run the grep command on all the project files."
1032 (interactive
1033 (progn
1034 (require 'grep)
1035 (grep-compute-defaults)
1036 (let ((default (grep-default-command)))
1037 (list (read-from-minibuffer
1038 "Run grep on project files: "
1039 (if current-prefix-arg default grep-command)
1040 nil
1041 nil
1042 'grep-history
1043 (if current-prefix-arg nil default)
1044 )))))
1045 (let ((b (current-buffer)) (old-dir default-directory))
1046 (dolist (f (mapcar 'car prj-files))
1047 (setq command-args (concat command-args " " f))
1048 )
1049 (when prj-directory (cd prj-directory))
1050 (grep command-args)
1051 (with-current-buffer b (cd old-dir))
1052 ))
1054 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1055 ;; add files to the project with dired
1057 (require 'dired)
1059 (defun prj-dired-addfiles ()
1060 (interactive)
1061 (when prj-current
1062 (let ((n 0) a)
1063 (dolist (f (dired-get-marked-files))
1064 (setq a (prj-insert-file f))
1065 (unless (cdr a)
1066 (setq n (1+ n))
1067 (setq prj-curfile a)
1068 ))
1069 (if (> n 1) (message "Added to project: %d file(s)" n))
1070 (prj-setmenu)
1071 )))
1073 (defun eproject-dired ()
1074 "Start a dired window with the project directory."
1075 (interactive)
1076 (when prj-directory
1077 (eproject-setup-quit)
1078 ;;(message "Use 'a' to add marked or single files to the project.")
1079 (dired prj-directory)
1080 (let ((map dired-mode-map))
1081 (define-key map "a" 'prj-dired-addfiles)
1082 (define-key map [menu-bar operate command] '("Add to Project"
1083 "Add current or marked file(s) to project" . prj-dired-addfiles))
1084 )))
1086 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1088 (defun prj-setup-all ()
1089 (prj-setkeys)
1090 (prj-setmenu)
1091 (prj-settitle)
1092 (prj-config-print)
1093 )
1095 (defun prj-getconfig (n)
1096 (let ((a (cdr (assoc n prj-config))))
1097 (and (stringp a) a)
1098 ))
1100 (defun prj-setconfig (n v)
1101 (let ((a (assoc n prj-config)))
1102 (unless a
1103 (setq a (list n))
1104 (setq prj-config (nconc prj-config (list a)))
1105 )
1106 (setcdr a v)
1107 ))
1109 (defun prj-on-kill ()
1110 (prj-saveall)
1111 )
1113 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1114 ;; isearch in all project files
1116 (defun prj-isearch-function (b wrap)
1117 (let (a)
1118 (or b (setq b (current-buffer)))
1119 (cond (wrap
1120 (if isearch-forward
1121 (setq a (car prj-files))
1122 (setq a (car (last prj-files)))
1123 ))
1124 ((setq a (rassoc b prj-files))
1125 (if isearch-forward
1126 (setq a (prj-next-file prj-files a))
1127 (setq a (prj-prev-file prj-files a))
1128 )
1129 ))
1130 (car (prj-find-file a))
1131 ;; (print `(prj-isearch (wrap . ,wrap) ,b ,d) (get-buffer "*Messages*"))
1132 ))
1134 (defun prj-isearch-setup ()
1135 (cond ((and prj-set-multi-isearch prj-current)
1136 (setq multi-isearch-next-buffer-function 'prj-isearch-function)
1137 (setq multi-isearch-pause 'initial)
1138 (add-hook 'isearch-mode-hook 'multi-isearch-setup)
1139 )
1140 (t
1141 (remove-hook 'isearch-mode-hook 'multi-isearch-setup)
1142 )))
1144 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1145 ;; Initialize
1147 (defun prj-startup-delayed ()
1148 ;; load UI support
1149 (load (eproject-addon "eproject-config") nil t)
1151 ;; When no projects are specified yet, load the eproject project itself.
1152 (unless prj-list
1153 (load (eproject-addon prj-default-cfg))
1154 )
1156 ;; no project so far
1157 (prj-reset)
1158 (prj-setup-all)
1159 (add-hook 'kill-emacs-hook 'prj-on-kill)
1161 ;; inhibit open last project when a file was on the commandline
1162 (unless (buffer-file-name (window-buffer))
1163 (when prj-last-open
1165 ;; open last project
1166 (eproject-open prj-last-open)
1168 ;; restore frame position
1169 (when (and prj-set-framepos prj-frame-pos prj-initial-frame)
1170 (modify-frame-parameters prj-initial-frame prj-frame-pos)
1171 ;; emacs bug: when it's too busy it doesn't set frames correctly.
1172 (sit-for 0.2)
1173 ))))
1175 (defun prj-command-line-switch (option)
1176 (setq prj-last-open (pop argv))
1177 (setq inhibit-startup-screen t)
1178 )
1180 (defun eproject-startup ()
1181 ;; where is this file
1182 (if load-file-name
1183 (setq eproject-directory (file-name-directory load-file-name)))
1184 (if (boundp 'prj-list)
1185 (progn
1186 (load (eproject-addon "eproject-config"))
1187 (prj-setup-all))
1188 (progn
1189 (prj-loadlist)
1190 (when prj-last-open (setq inhibit-startup-screen t))
1191 (when (display-graphic-p) (setq prj-initial-frame (selected-frame)))
1192 (push '("project" . prj-command-line-switch) command-switch-alist)
1193 (run-with-idle-timer 0.1 nil 'prj-startup-delayed)
1194 )))
1196 ;;;###autoload(require 'eproject)
1197 (provide 'eproject)
1198 (eproject-startup)
1200 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1201 ;; eproject.el ends here