| blob | c6026a86b486cce4af0e40d98d5a40504263d501 |
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:
31 ([M-right] eproject-nextfile)
32 ([M-left] eproject-prevfile)
33 ([C-f5] eproject-dired)
34 )
35 "Key bindings in eproject"
36 :type
37 '(repeat
38 (list
39 (restricted-sexp
40 :tag "Key sequence"
41 :match-alternatives (vectorp stringp))
42 function
43 (choice :format "%[Always provide%] %v"
44 (const :tag "yes" always)
45 (const :tag "no" nil))))
46 :group 'prj-group)
49 (defcustom prj-default-config
50 '(
51 ("Make" "make" "f9")
52 ("Clean" "make clean" "C-f9")
53 ("Run" "echo run what" "f8")
54 ("Stop" "-e eproject-killtool" "C-f8")
55 ("---")
56 ("Configure" "./configure")
57 ("---")
58 ("Explore Project" "nautilus --browser `pwd` &")
59 ("XTerm In Project" "xterm &"))
60 "*The default tools menu for new projects in eproject."
61 :type
62 '(repeat
63 (choice :format "%v"
64 (const :tag "--- Item separator ---" ("---"))
66 (string :tag "name")
67 (string :tag "shell command")
68 (choice :format "%[Toggle%] %v"
69 (restricted-sexp
70 :tag "Key sequence"
71 :match-alternatives (vectorp stringp))
72 (const :inline t :tag "No key sequence" nil)))))
73 :group 'prj-group)
76 (defcustom prj-autotracking t
77 "*Should eproject automatically add/remove files to/from the project (nil/t)"
78 :type 'boolean
79 :group 'prj-group)
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)"
84 :type 'boolean
85 :group 'prj-group)
87 (defcustom prj-set-default-directory nil
88 "*Should eproject set the project directory as default-directory
89 for all project files (nil/t)."
90 :type 'boolean
91 :group 'prj-group)
93 (defcustom prj-set-framepos nil
94 "*Should eproject restore the last frame position/size (nil/t)."
95 :type 'boolean
96 :group 'prj-group)
98 (defcustom prj-set-compilation-frame nil
99 "*Should eproject show compilation output in the other frame (nil/t)."
100 :type 'boolean
101 :group 'prj-group)
103 (defcustom prj-set-multi-isearch nil
104 "*Should eproject setup multi-isearch in the project files (nil/t)."
105 :type 'boolean
106 :group 'prj-group)
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)
115 user-emacs-directory
116 "~/.emacs.d/"
117 )))
119 ;; with the list of all projects
120 (defvar prj-list)
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
132 (defun prj-init ()
133 (setq prj-version nil)
134 (setq prj-list nil)
135 (setq prj-last-open nil)
136 (setq prj-frame-pos nil)
137 )
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:
149 ;; the list of files
150 (defvar prj-files)
152 ;; the current file
153 (defvar prj-curfile)
155 ;; an alist of settings
156 (defvar prj-config)
158 ;; a list of tools
159 (defvar prj-tools)
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
168 (defvar prj-current)
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
177 (defun prj-reset ()
178 (setq prj-version nil)
179 (setq prj-current nil)
180 (setq prj-directory nil)
181 (setq prj-exec-directory nil)
182 (setq prj-files 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)
189 )
191 (defun prj-reset-functions ()
192 (dolist (l prj-functions)
193 (if (eq (car l) 'setq)
194 (makunbound (cadr l))
195 (fmakunbound (cadr l))
196 ))
197 (setq prj-functions nil)
198 )
200 (defun prj-set-functions (s)
201 (prj-reset-functions)
202 (setq prj-functions s)
203 (dolist (l s) (eval l))
204 )
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")
220 ;; Configuration UI
221 (eval-and-compile
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 ())
228 )
230 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
231 ;; Small functions
233 (defun caddr (l) (car (cddr l)))
235 (defun prj-del-list (l e)
236 (let ((a (assoc (car e) l)))
237 (if a
238 (delq a l)
239 l)))
241 (defun prj-add-list (l e)
242 (nconc (prj-del-list l e) (list e))
243 )
245 (defun prj-next-file (l e)
246 (and (setq e (assoc (car e) l))
247 (cadr (memq e l))
248 ))
250 (defun prj-prev-file (l e)
251 (prj-next-file (reverse l) e)
252 )
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)
257 (prj-next-file l f)
258 ))
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)))
264 f
265 r
266 )))
268 ;; friendly truncate filename
269 (defun prj-shortname (s)
270 (let ((l (length s)) (x 30) n)
271 (cond ((>= x l) s)
272 ((progn
273 (setq x (- x 3))
274 (setq n (length (file-name-nondirectory s)))
275 (if (< n l) (setq n (1+ n)))
276 (>= x n)
277 )
278 (concat (substring s 0 (- x n)) "..." (substring s (- n)))
279 )
280 ((= n l)
281 (concat (substring s 0 x) "...")
282 )
283 (t
284 (concat "..." (substring s (- n) (- (- x 3) n)) "...")
285 ))))
287 (defun prj-settitle ()
288 (modify-frame-parameters
289 nil
290 (list (cons 'title
291 (and prj-current
292 (format "emacs - %s" (car prj-current))
293 )))))
295 (defun eproject-addon (f)
296 (concat eproject-directory f)
297 )
299 (defun prj-goto-line (n)
300 (goto-char 1)
301 (beginning-of-line n)
302 )
304 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
305 ;; Write configuration to file
307 (defun prj-print-list (s fp)
308 (let ((v (eval s)))
309 (setq v (list 'setq s
310 (if (and (atom v) (null (and (symbolp v) v)))
311 v
312 (list 'quote v)
313 )))
314 ;;(print v fp)
316 ))
318 (defun prj-create-file (filename)
319 (let ((fp (generate-new-buffer filename)))
321 fp))
323 (defun prj-close-file (fp)
324 (with-current-buffer fp
325 (condition-case nil
326 (and t (write-region nil nil (buffer-name fp) nil 0))
327 (error nil)
328 ))
329 (kill-buffer fp)
330 )
332 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
333 ;; Load/Save global project list and initial frame sizes
335 (defun prj-loadlist ()
336 (prj-init)
337 (load (prj-globalfile) t t)
338 (setq prj-version eproject-version)
339 )
341 (defun prj-get-frame-pos (f)
342 (mapcar
343 (lambda (parm) (cons parm (frame-parameter f parm)))
344 '(top left width height)
345 ))
347 (defun prj-savelist ()
348 (let ((g (prj-globalfile)) fp)
349 (unless (file-exists-p g)
350 (make-directory (file-name-directory g) t)
351 )
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))
355 )
356 (setq fp (prj-create-file g))
357 (when fp
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)
362 (prj-close-file fp)
363 )))
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"))
371 )
372 (if e (setq d (expand-file-name e d)))
373 (setq prj-exec-directory (file-name-as-directory d))
374 ))
376 (defun prj-get-directory (a)
377 (file-name-as-directory (expand-file-name (cadr a)))
378 )
380 (defun prj-get-cfg ()
381 (expand-file-name (or (caddr prj-current) prj-default-cfg) prj-directory)
382 )
384 (defun prj-get-buffer (a)
385 (cond ((buffer-live-p (cdr a))
386 (cdr a)
387 )
388 (prj-directory
389 (get-file-buffer (expand-file-name (car a) prj-directory))
390 )))
392 (defun prj-loadconfig (a)
393 (let (lf e)
394 (prj-reset)
395 (setq prj-current a)
396 (setq prj-directory (prj-get-directory a))
397 (when (file-regular-p (setq lf (prj-get-cfg)))
398 (load lf nil t)
399 (setq prj-curfile
400 (or (assoc prj-curfile prj-files)
401 (car prj-files)
402 ))
403 )
404 (if (setq e (prj-getconfig "project-name"))
405 (setcar a e)
406 (prj-setconfig "project-name" (car a))
407 )
408 (prj-update-config)
409 (prj-set-functions prj-functions)
410 (setq prj-version eproject-version)
411 ))
413 (defun prj-saveconfig ()
414 (when prj-current
415 (let (w c b files)
416 (prj-removehooks)
417 (setq w (selected-window))
418 (setq c (window-buffer w))
419 (dolist (a prj-files)
420 (setq b (prj-get-buffer a))
421 (cond (b
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)))
426 )
427 (push (list (car a) s p) files)
428 )))
429 ((consp (cdr a))
430 (push a files)
431 )
432 (t
433 (push (list (car a)) files)
434 )))
435 (set-window-buffer w c t)
436 (prj-addhooks)
437 (let ((fp (prj-create-file (prj-get-cfg)))
438 (prj-curfile (car prj-curfile))
439 (prj-files (nreverse files))
440 )
441 (when fp
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)
448 (prj-close-file fp)
449 ))
450 )))
452 (defun prj-saveall ()
453 (prj-saveconfig)
454 (prj-savelist)
455 )
457 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
458 ;; The core functions: Open / Close / Add / Remove Project
460 (defun eproject-open (a)
461 "Open another project."
462 (interactive
463 (list
464 (or (prj-config-get-result 'p)
465 (completing-read "Open Project: " (mapcar 'car prj-list))
466 )))
467 (unless (consp a)
468 (let ((b (assoc a prj-list)))
469 (unless b
470 (error "No such project: %s" a)
471 )
472 (setq a b)
473 ))
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))
478 )
479 (setq prj-list (cons a (delq a prj-list)))
480 (eproject-close)
481 (prj-loadconfig a)
482 )
483 (prj-addhooks)
484 (prj-setup-all)
485 (prj-isearch-setup)
486 (unless (prj-edit-file prj-curfile)
487 (eproject-dired)
488 ))
490 (defun eproject-close ()
491 "Close the current project."
492 (interactive)
493 (when prj-current
494 (prj-saveconfig)
495 (prj-removehooks)
496 (let (f)
497 (unwind-protect
498 (progn
499 (save-some-buffers nil)
500 (eproject-killbuffers t)
501 (setq f t)
502 )
503 (or f (prj-addhooks))
504 ))
505 (prj-reset)
506 (prj-config-reset)
507 (prj-setup-all)
508 (prj-isearch-setup)
509 ))
511 (defun eproject-killbuffers (&optional from-project)
512 "If called interactively kills all buffers that do not belong to project files"
513 (interactive)
514 (let (l b)
515 (dolist (a prj-files)
516 (setq b (prj-get-buffer a))
517 (if b (setq l (cons (list b) l)))
518 )
519 (dolist (b (buffer-list))
520 (when (eq (consp (assoc b l)) from-project)
521 (kill-buffer b)
522 ))))
524 (defun eproject-add (dir &optional name cfg)
525 "Add a new or existing project to the list."
526 (interactive
527 (let (d n f)
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))
532 (list d n f)
533 ))
534 (when dir
535 (setq dir (directory-file-name dir))
536 (unless name
537 (setq name (file-name-nondirectory dir))
538 )
539 (when (and cfg (string-equal cfg prj-default-cfg))
540 (setq cfg nil)
541 )
542 (let ((a (if cfg (list name dir cfg) (list name dir))))
543 (push a prj-list)
544 (eproject-open a)
545 )))
547 (defun eproject-remove (a)
548 "Remove a project from the list."
549 (interactive
550 (list
551 (or (prj-config-get-result 'p)
552 (completing-read "Remove project: " (mapcar 'car prj-list))
553 )))
554 (unless (consp a)
555 (let ((b (assoc a prj-list)))
556 (unless b
557 (error "No such project: %s" a)
558 )
559 (setq a b)
560 ))
561 (when (progn
562 (beep)
564 (message "")
565 ))
566 (setq prj-list (prj-del-list prj-list a))
567 (prj-setup-all)
568 ))
570 (defun eproject-save ()
571 "Save the project configuration to file."
572 (interactive)
573 (prj-config-parse)
574 (prj-config-print)
575 (prj-saveall)
576 )
578 (defun eproject-revert ()
579 "Reload the project configuration from file."
580 (interactive)
581 (prj-loadlist)
582 (if prj-current
583 (prj-loadconfig prj-current)
584 )
585 (prj-setup-all)
586 )
588 (defun eproject-addfile (f)
589 "Add a file to the current project."
590 (interactive
591 (and prj-current
592 (list
593 (read-file-name "Add file to project: " nil nil t nil)
594 )))
595 (unless prj-current (error "No project open"))
596 (prj-insert-file f (prj-config-get-result 'f))
597 (prj-config-print)
598 (prj-setmenu)
599 )
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))
605 (prj-remove-file a)
606 )
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))
612 (prj-edit-file a)
613 )
615 (defun prj-get-existing-file-1 (msg)
616 (and prj-current
617 (list
618 (or (prj-config-get-result 'f)
619 (completing-read msg (mapcar 'car prj-files))
620 ))))
622 (defun prj-get-existing-file-2 (a)
623 (unless prj-current (error "No project open"))
624 (if (consp a)
625 a
626 (let ((b (assoc (prj-relative-path a) prj-files)))
627 (unless b (error "No such file in project: %s" a))
628 b
629 )))
631 (defun eproject-help ()
632 "Show the eproject README."
633 (interactive)
634 (view-file (eproject-addon "eproject.txt"))
635 )
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)
645 ))
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)
651 )
653 (defun prj-wcc-hook ()
654 (dolist (w (window-list))
655 (prj-register-buffer (window-buffer w))
656 ))
658 (defun prj-find-file-hook ()
659 (run-with-idle-timer 0.2 nil 'prj-wcc-hook)
660 )
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))
668 ))))
670 (defun prj-register-buffer (b)
671 (let (f a)
672 (setq f (buffer-file-name b))
674 (setq a (rassq b prj-files))
675 (unless a
676 (setq a (prj-insert-file f nil t))
677 (when a
678 (prj-init-buffer a b)
679 ))
680 (when (and a (null (eq a prj-curfile)))
681 (setq prj-curfile a)
682 (prj-setmenu)
683 ))
684 a))
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)))
690 (setq a (list r))
691 (setq m (memq (or after prj-curfile) prj-files))
692 (if m
693 (setcdr m (cons a (cdr m)))
694 (setq prj-files (prj-add-list prj-files a))
695 )
696 (setq prj-removed-files (prj-del-list prj-removed-files a))
697 (message "Added to project: %s" r)
698 )
699 a))
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)
705 (setq prj-curfile n)
706 )
707 (unless on-the-fly
708 (setq prj-removed-files (prj-add-list prj-removed-files a))
709 )
710 (unless (prj-config-print)
711 (prj-edit-file prj-curfile)
712 )
713 (prj-setmenu)
714 (message "Removed from project: %s" (car a))
715 ))
717 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
718 ;; Edit another file
720 (defun prj-init-buffer (a b)
721 (with-current-buffer b
722 (when prj-rename-buffers
723 (rename-buffer (car a) t)
724 )
725 (when prj-set-default-directory
726 (cd prj-directory)
727 ))
728 (setcdr a b)
729 )
731 (defun prj-find-file (a)
732 (when a
733 (let (b pos f)
734 (setq b (prj-get-buffer a))
735 (unless b
736 (prj-removehooks)
737 (setq f (expand-file-name (car a) prj-directory))
738 (setq b (find-file-noselect f))
739 (prj-addhooks)
740 (when (and b (consp (cdr a)))
741 (setq pos (cdr a))
742 ))
743 (when b
744 (prj-init-buffer a b)
745 (cons b pos)
746 ))))
748 (defun prj-edit-file (a)
749 (let ((f (prj-find-file a)))
750 (when f
751 (eproject-setup-quit)
752 (switch-to-buffer (car f))
753 (prj-restore-edit-pos (cdr f) (selected-window))
754 (prj-setmenu)
755 ;;(message "dir: %s" default-directory)
756 )
757 (setq prj-curfile a)
758 ))
760 (defun prj-restore-edit-pos (pos w)
761 (let ((top (car pos)) (line (cadr pos)))
762 (when (and (numberp top) (numberp line))
763 (prj-goto-line top)
764 (set-window-start w (point))
765 (prj-goto-line line)
766 )))
768 (defun prj-select-window (w)
769 (let (focus-follows-mouse)
770 (select-window w)
771 (select-frame-set-input-focus (window-frame w))
772 ))
774 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
775 ;; choose next/previous file
777 (defun eproject-nextfile ()
778 "Switch to the next file that belongs to the current project."
779 (interactive)
780 (prj-switch-file 'prj-next-file 'next-buffer)
781 )
783 (defun eproject-prevfile ()
784 "Switch to the previous file that belongs to the current project."
785 (interactive)
786 (prj-switch-file 'prj-prev-file 'previous-buffer)
787 )
789 (defun prj-switch-file (fn1 fn2)
790 (let ((a (rassoc (current-buffer) prj-files)))
791 (cond (a
792 (prj-edit-file (or (funcall fn1 prj-files a) a))
793 )
794 (prj-curfile
795 (prj-edit-file prj-curfile)
796 )
797 (t
798 (funcall fn2)
799 ))))
801 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
802 ;; Set key shortcuts
804 (defun prj-setkeys ()
805 (let ((f (consp prj-current))
806 (a (assoc 'eproject-mode minor-mode-map-alist))
807 (map (make-sparse-keymap))
808 )
809 (if a
810 (setcdr a map)
811 (push (cons 'eproject-mode map) minor-mode-map-alist)
812 )
813 (dolist (k prj-keybindings)
814 (when (or f (eq (caddr k) 'always))
815 (define-key map (car k) (cadr k))
816 ))
818 (when f
819 (let ((n 0) fn s)
820 (dolist (a prj-tools)
821 (unless (setq fn (nth n prj-tools-fns))
822 (setq fn (list 'lambda))
823 (setq prj-tools-fns (nconc prj-tools-fns (list fn)))
824 )
825 (setcdr fn `(() (interactive) (prj-run-tool ',a)))
826 (setq n (1+ n))
827 (when (setq s (caddr a))
828 (define-key map (prj-parse-key s) (and f fn))
829 ))))))
831 (defun prj-parse-key (s)
832 (read
833 (if (string-match "[a-z][a-z0-9]+$" s)
834 (concat "[" s "]")
837 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
838 ;; Set menus
840 (defun prj-list-sorted ()
841 (sort (append prj-list nil)
842 '(lambda (a b) (string-lessp (car a) (car b)))
843 ))
845 (defun prj-setmenu ()
846 (let ((f (consp prj-current)) m1 m2 m3)
848 (setq m1
849 `(("Open" open ,@(prj-menulist-maker prj-list prj-current 'prj-menu-open))
850 ("Add/Remove" other
851 ("Add ..." "Add new or existing project to the list" . eproject-add)
852 ("Remove ..." "Remove project from the list" . eproject-remove)
853 ,@(and f '(("Close" "Close current project" . eproject-close)))
854 ("--")
855 ("Setup" "Enter the project setup area." . eproject-setup-toggle)
856 ("Help" "View eproject.txt" . eproject-help)
857 )
858 ))
859 (when f
860 (nconc m1 (cons '("--") (prj-menulist-maker prj-tools nil prj-tools-fns)))
861 (setq m2
862 `(("Dired" "Browse project directory in Dired - Use 'a' to add file(s) to the project" . eproject-dired)
863 ("--")
864 ,@(prj-menulist-maker prj-files prj-curfile 'prj-menu-edit)
865 )))
867 (prj-menu-maker
868 global-map
869 `((buffer "Project" project ,@m1)
870 (file "List" list ,@m2)
871 )
872 '(menu-bar)
873 )))
875 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
877 (defun prj-menu-edit ()
878 (interactive)
879 (let ((a (nth last-command-event prj-files)))
880 (if a (prj-edit-file a))
881 ))
883 (defun prj-menu-open ()
884 (interactive)
885 (let ((a (nth last-command-event prj-list)))
886 (if a (eproject-open (car a)))
887 ))
889 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
891 (defun prj-menu-maker (map l v)
892 (let ((e (list nil)))
893 (setq v (append v e))
894 (dolist (k (reverse l))
895 (let (s a)
896 (when (symbolp (car k))
897 (setq a (pop k))
898 )
899 (cond
900 ((numberp (car k))
901 (setcar e (pop k))
902 )
903 ((and (consp (cdr k)) (symbolp (cadr k)))
904 (setcar e (cadr k))
905 (setq s (cddr k))
906 (setq k (and s (cons (car k) (make-sparse-keymap (car k)))))
907 )
908 (t
909 (setcar e (intern (downcase (car k))))
910 ))
911 (if a
912 (define-key-after map (vconcat v) k a)
913 (define-key map (vconcat v) k)
914 )
915 (if s (prj-menu-maker map s v))
916 ))))
918 (defun prj-copy-head (l n)
919 (let (r)
920 (while (and l (> n 0))
921 (push (pop l) r)
922 (setq n (1- n))
923 )
924 (nreverse r)
925 ))
927 (defun prj-split-list (l n)
928 (let (r)
929 (while l
930 (push (prj-copy-head l n) r)
931 (setq l (nthcdr n l))
932 )
933 (nreverse r)
934 ))
936 (defun prj-menulist-maker (l act fns)
937 (let (r (w 30) s (m 0) (n 0) k)
938 (cond
939 ((< (length l) w)
940 (prj-menulist-maker-1 (list l fns n) act)
941 )
942 (t
943 ;; menu too long; split into submenus
944 (setq s (prj-split-list l w))
945 (setq k (prj-menulist-maker-1 (list (append (pop s) '(("--"))) fns n) act))
946 (setq r (nreverse k))
947 (dolist (l s)
948 (when (consp fns)
949 (setq fns (nthcdr w fns))
950 )
951 (setq n (+ n w))
952 (setq k (prj-menulist-maker-1 (list l fns n) act))
953 (push (cons (concat (prj-shortname (caar l)) " ...")
954 (cons (intern (format "m_%d" (setq m (1+ m))))
955 k)) r)
956 )
957 (nreverse r)
958 ))))
960 (defun prj-menulist-maker-1 (l act)
961 (let (r e f s i n a)
962 (while (car l)
963 (setq a (caar l))
964 (setcar l (cdar l))
965 (setq n (caddr l))
966 (setcar (cddr l) (1+ n))
967 (setq f (if (consp (cadr l))
968 (prog1 (car (cadr l)) (setcar (cdr l) (cdr (cadr l))))
969 (cadr l)))
971 (setq i (car a))
972 (unless (string-match "^ *#" i)
973 (setq s (if (and (consp (cdr a)) (stringp (cadr a))) (cadr a) i))
974 (cond ((equal ">" i)
975 (setq e (cons s (cons (intern s) (prj-menulist-maker-1 l act))))
976 (setq r (cons e r))
977 )
978 ((equal "<" i)
979 (setq l nil)
980 )
981 (t
982 (setq i (prj-shortname i))
983 (setq e (cons n (if (eq a act)
984 `(menu-item ,i ,f :button (:toggle . t) :help ,s)
985 (cons i (cons s f)))))
986 (setq r (cons e r))
987 )))
988 )
989 (nreverse r)
990 ))
992 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
993 ;; Run make and other commands
995 (defun prj-compilation-in-frame (cmd)
996 (let ((bn "*compilation*") w h b c f)
997 (unless (get-buffer-window bn t)
998 (setq b (get-buffer-create bn))
999 (setq f (frame-list))
1000 (cond ((cdr f)
1001 (setq w (frame-first-window (car f)))
1002 (delete-other-windows w)
1003 )
1004 (t
1005 (setq h (/ (* 70 (frame-height)) 100))
1006 (delete-other-windows w)
1007 (setq w (split-window w h))
1008 ))
1009 (set-window-buffer w b)
1010 ))
1011 (let ((display-buffer-reuse-frames t) (f (selected-frame)))
1012 (compile cmd)
1013 (select-frame-set-input-focus f)
1014 ))
1016 (defun prj-run (cmd)
1017 (cond ((string-match "^-e +" cmd)
1018 (setq cmd (read (substring cmd (match-end 0))))
1019 (unless (commandp cmd)
1020 (setq cmd `(lambda () (interactive) ,cmd))
1021 )
1022 (command-execute cmd)
1023 )
1024 ((let ((b (current-buffer))
1025 (old-dir default-directory)
1026 (new-dir ".")
1027 )
1029 (setq new-dir (match-string-no-properties 1 cmd))
1030 (setq cmd (substring cmd (match-end 0)))
1031 )
1032 (when prj-exec-directory
1033 (setq new-dir (expand-file-name new-dir prj-exec-directory))
1034 )
1035 (cd new-dir)
1037 (start-process-shell-command
1038 "eproject-async" nil (match-string 1 cmd))
1039 (message (match-string 1 cmd))
1040 )
1041 (prj-set-compilation-frame
1042 (prj-compilation-in-frame cmd)
1043 )
1044 (t
1045 (compile cmd)
1046 ))
1047 (with-current-buffer b (cd old-dir))
1048 ))))
1050 (defun prj-run-tool (a)
1051 (unless (string-match "^--+$" (car a))
1052 (prj-run (or (cadr a) (car a)))
1053 ))
1055 (defun eproject-killtool ()
1056 (interactive)
1057 (let ((bn "*compilation*") w0 w1)
1058 (when (setq w1 (get-buffer-window bn t))
1059 (when (fboundp 'kill-compilation)
1060 (setq w0 (selected-window))
1061 (select-window w1)
1062 (kill-compilation)
1063 (select-window w0)
1064 ))))
1066 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1067 ;; run grep on project files
1069 (defun eproject-grep (command-args)
1070 "Run the grep command on all the project files."
1071 (interactive
1072 (progn
1073 (require 'grep)
1074 (grep-compute-defaults)
1075 (let ((default (grep-default-command)))
1076 (list (read-from-minibuffer
1077 "Run grep on project files: "
1078 (if current-prefix-arg default grep-command)
1079 nil
1080 nil
1081 'grep-history
1082 (if current-prefix-arg nil default)
1083 )))))
1084 (let ((b (current-buffer)) (old-dir default-directory))
1085 (dolist (f (mapcar 'car prj-files))
1086 (setq command-args (concat command-args " " f))
1087 )
1088 (when prj-directory (cd prj-directory))
1089 (grep command-args)
1090 (with-current-buffer b (cd old-dir))
1091 ))
1093 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1094 ;; add files to the project with dired
1096 (require 'dired)
1098 (defun prj-dired-addfiles ()
1099 (interactive)
1100 (when prj-current
1101 (let ((n 0) a)
1102 (dolist (f (dired-get-marked-files))
1103 (setq a (prj-insert-file f))
1104 (unless (cdr a)
1105 (setq n (1+ n))
1106 (setq prj-curfile a)
1107 ))
1108 (if (> n 1) (message "Added to project: %d file(s)" n))
1109 (prj-setmenu)
1110 )))
1112 (defun eproject-dired ()
1113 "Start a dired window with the project directory."
1114 (interactive)
1115 (when prj-directory
1116 (eproject-setup-quit)
1117 ;;(message "Use 'a' to add marked or single files to the project.")
1118 (dired prj-directory)
1119 (let ((map dired-mode-map))
1120 (define-key map "a" 'prj-dired-addfiles)
1121 (define-key map [menu-bar operate command] '("Add to Project"
1122 "Add current or marked file(s) to project" . prj-dired-addfiles))
1123 )))
1125 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1127 (defun prj-setup-all ()
1128 (prj-setkeys)
1129 (prj-setmenu)
1130 (prj-settitle)
1131 (prj-config-print)
1132 )
1134 (defun prj-getconfig (n)
1135 (let ((a (cdr (assoc n prj-config))))
1136 (and (stringp a) a)
1137 ))
1139 (defun prj-setconfig (n v)
1140 (let ((a (assoc n prj-config)))
1141 (unless a
1142 (setq a (list n))
1143 (setq prj-config (nconc prj-config (list a)))
1144 )
1145 (setcdr a v)
1146 ))
1148 (defun prj-on-kill ()
1149 (prj-saveall)
1150 )
1152 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1153 ;; isearch in all project files
1155 (defun prj-isearch-function (b wrap)
1156 (let (a)
1157 (or b (setq b (current-buffer)))
1158 (cond (wrap
1159 (if isearch-forward
1160 (setq a (car prj-files))
1161 (setq a (car (last prj-files)))
1162 ))
1163 ((setq a (rassoc b prj-files))
1164 (if isearch-forward
1165 (setq a (prj-next-file prj-files a))
1166 (setq a (prj-prev-file prj-files a))
1167 )
1168 ))
1169 (car (prj-find-file a))
1170 ;; (print `(prj-isearch (wrap . ,wrap) ,b ,d) (get-buffer "*Messages*"))
1171 ))
1173 (defun prj-isearch-setup ()
1174 (cond ((and prj-set-multi-isearch prj-current)
1175 (setq multi-isearch-next-buffer-function 'prj-isearch-function)
1176 (setq multi-isearch-pause 'initial)
1177 (add-hook 'isearch-mode-hook 'multi-isearch-setup)
1178 )
1179 (t
1180 (remove-hook 'isearch-mode-hook 'multi-isearch-setup)
1181 )))
1183 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1184 ;; Initialize
1186 (defun prj-startup-delayed ()
1187 ;; load UI support
1188 (load (eproject-addon "eproject-config") nil t)
1190 ;; When no projects are specified yet, load the eproject project itself.
1191 (unless prj-list
1192 (load (eproject-addon prj-default-cfg))
1193 )
1195 ;; no project so far
1196 (prj-reset)
1197 (prj-setup-all)
1198 (add-hook 'kill-emacs-hook 'prj-on-kill)
1200 ;; inhibit open last project when a file was on the commandline
1201 (unless (buffer-file-name (window-buffer))
1202 (when prj-last-open
1204 ;; open last project
1205 (eproject-open prj-last-open)
1207 ;; emacs bug: deferred jit-lock is dropped if run from idle timer
1208 (and jit-lock-mode jit-lock-defer-time (jit-lock-function (point)))
1210 ;; restore frame position
1211 (when (and prj-set-framepos prj-frame-pos prj-initial-frame)
1212 (modify-frame-parameters prj-initial-frame prj-frame-pos)
1213 ;; emacs bug: when it's too busy it doesn't set frames correctly.
1214 (sit-for 0.2)
1215 ))))
1217 (defun prj-command-line-switch (option)
1218 (setq prj-last-open (pop argv))
1219 (setq inhibit-startup-screen t)
1220 )
1222 (defun eproject-startup ()
1223 ;; where is this file
1224 (if load-file-name
1225 (setq eproject-directory (file-name-directory load-file-name)))
1226 (if (boundp 'prj-list)
1227 (progn
1228 (load (eproject-addon "eproject-config"))
1229 (prj-setup-all))
1230 (progn
1231 (prj-loadlist)
1232 (when prj-last-open (setq inhibit-startup-screen t))
1233 (when (display-graphic-p) (setq prj-initial-frame (selected-frame)))
1234 (push '("project" . prj-command-line-switch) command-switch-alist)
1235 (run-with-idle-timer 0.1 nil 'prj-startup-delayed)
1236 )))
1238 ;;;###autoload(require 'eproject)
1239 (provide 'eproject)
1240 (eproject-startup)
1242 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1243 ;; eproject.el ends here