| blob | 8643376669f7a76018507b7334d03c5b5da39bd2 |
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-set-default-directory nil
50 "*Should eproject set the project directory as default-directory
51 for all project files (nil/t).")
53 (defvar prj-set-framepos nil
54 "*Should eproject restore the last frame position/size (nil/t).")
56 (defvar prj-set-compilation-frame nil
57 "*Should eproject show compilation output in the other frame (nil/t).")
59 (defvar prj-set-multi-isearch nil
60 "*Should eproject setup multi-isearch in the project files (nil/t).")
62 ;; End of user-configurable items
63 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
65 ;; There is a global file (~/.emacs.d/eproject.lst)
66 (defun prj-globalfile ()
67 (expand-file-name "eproject.lst"
68 (if (boundp 'user-emacs-directory)
69 user-emacs-directory
70 "~/.emacs.d/"
71 )))
73 ;; with the list of all projects
74 (defvar prj-list)
76 ;; and the project that was open in the last session (if any)
77 (defvar prj-last-open nil)
79 ;; and the frame coords from last session
80 (defvar prj-frame-pos nil)
82 ;; eproject version that created the config file
83 (defvar prj-version nil)
85 ;; Here is a function to reset these
86 (defun prj-init ()
87 (setq prj-version nil)
88 (setq prj-list nil)
89 (setq prj-last-open nil)
90 (setq prj-frame-pos nil)
91 )
93 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
94 ;; Each project has a directory
96 (defvar prj-directory)
98 ;; with a configuration files in it
99 (defvar prj-default-cfg "eproject.cfg")
101 ;; This file defines:
103 ;; the list of files
104 (defvar prj-files)
106 ;; the current file
107 (defvar prj-curfile)
109 ;; an alist of settings
110 (defvar prj-config)
112 ;; a list of tools
113 (defvar prj-tools)
115 ;; a list of utility functions (feature incomplete)
116 (defvar prj-functions nil)
118 ;; directory to run commands, default to prj-directory
119 (defvar prj-exec-directory)
121 ;; The current project
122 (defvar prj-current)
124 ;; A list with generated functions for each tool
125 (defvar prj-tools-fns)
127 ;; A list with files removed from the project
128 (defvar prj-removed-files)
130 ;; Here is a function to reset/close the project
131 (defun prj-reset ()
132 (setq prj-version nil)
133 (setq prj-current nil)
134 (setq prj-directory nil)
135 (setq prj-exec-directory nil)
136 (setq prj-files nil)
137 (setq prj-removed-files nil)
138 (setq prj-curfile nil)
139 (setq prj-config nil)
140 (setq prj-tools-fns nil)
141 (setq prj-tools (copy-tree prj-default-config))
142 (prj-reset-functions)
143 )
145 (defun prj-reset-functions ()
146 (dolist (l prj-functions)
147 (if (eq (car l) 'setq)
148 (makunbound (cadr l))
149 (fmakunbound (cadr l))
150 ))
151 (setq prj-functions nil)
152 )
154 (defun prj-set-functions (s)
155 (prj-reset-functions)
156 (setq prj-functions s)
157 (dolist (l s) (eval l))
158 )
160 ;; Some more variables:
162 ;; the frame that exists on startup
163 (defvar prj-initial-frame nil)
165 ;; this is put into minor-mode-alist
166 (defvar eproject-mode t)
168 ;; where this file is in
169 (defvar eproject-directory)
171 ;; eproject version that created the files
172 (defvar eproject-version "0.4")
174 ;; Configuration UI
175 (eval-and-compile
176 (defun eproject-setup-toggle () (interactive))
177 (defun eproject-setup-quit () (interactive))
178 (defun prj-config-get-result (s))
179 (defun prj-config-reset ())
180 (defun prj-config-print ())
181 (defun prj-config-parse ())
182 )
184 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
185 ;; Small functions
187 (defun caddr (l) (car (cddr l)))
189 (defun prj-del-list (l e)
190 (let ((a (assoc (car e) l)))
191 (if a
192 (delq a l)
193 l)))
195 (defun prj-add-list (l e)
196 (nconc (prj-del-list l e) (list e))
197 )
199 (defun prj-next-file (l e)
200 (and (setq e (assoc (car e) l))
201 (cadr (memq e l))
202 ))
204 (defun prj-prev-file (l e)
205 (prj-next-file (reverse l) e)
206 )
208 ; replace a closed file, either by the previous or the next.
209 (defun prj-otherfile (l f)
210 (or (prj-prev-file l f)
211 (prj-next-file l f)
212 ))
214 ;; make relative path, but only up to the second level of ..
215 (defun prj-relative-path (f)
216 (let ((r (file-relative-name f prj-directory)))
218 f
219 r
220 )))
222 ;; friendly truncate filename
223 (defun prj-shortname (s)
224 (let ((l (length s)) (x 30) n)
225 (cond ((>= x l) s)
226 ((progn
227 (setq x (- x 3))
228 (setq n (length (file-name-nondirectory s)))
229 (if (< n l) (setq n (1+ n)))
230 (>= x n)
231 )
232 (concat (substring s 0 (- x n)) "..." (substring s (- n)))
233 )
234 ((= n l)
235 (concat (substring s 0 x) "...")
236 )
237 (t
238 (concat "..." (substring s (- n) (- (- x 3) n)) "...")
239 ))))
241 (defun prj-settitle ()
242 (modify-frame-parameters
243 nil
244 (list (cons 'title
245 (and prj-current
246 (format "emacs - %s" (car prj-current))
247 )))))
249 (defun eproject-addon (f)
250 (concat eproject-directory f)
251 )
253 (defun prj-goto-line (n)
254 (goto-char 1)
255 (beginning-of-line n)
256 )
258 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
259 ;; Write configuration to file
261 (defun prj-print-list (s fp)
262 (let ((v (eval s)))
263 (setq v (list 'setq s
264 (if (and (atom v) (null (and (symbolp v) v)))
265 v
266 (list 'quote v)
267 )))
268 ;;(print v fp)
270 ))
272 (defun prj-create-file (filename)
273 (let ((fp (generate-new-buffer filename)))
275 fp))
277 (defun prj-close-file (fp)
278 (with-current-buffer fp
279 (condition-case nil
280 (and t (write-region nil nil (buffer-name fp) nil 0))
281 (error nil)
282 ))
283 (kill-buffer fp)
284 )
286 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
287 ;; Load/Save global project list and initial frame sizes
289 (defun prj-loadlist ()
290 (prj-init)
291 (load (prj-globalfile) t t)
292 (setq prj-version eproject-version)
293 )
295 (defun prj-get-frame-pos (f)
296 (mapcar
297 (lambda (parm) (cons parm (frame-parameter f parm)))
298 '(top left width height)
299 ))
301 (defun prj-savelist ()
302 (let ((g (prj-globalfile)) fp)
303 (unless (file-exists-p g)
304 (make-directory (file-name-directory g) t)
305 )
306 (setq prj-last-open (car prj-current))
307 (when (frame-live-p prj-initial-frame)
308 (setq prj-frame-pos (prj-get-frame-pos prj-initial-frame))
309 )
310 (setq fp (prj-create-file g))
311 (when fp
312 (prj-print-list 'prj-version fp)
313 (prj-print-list 'prj-list fp)
314 (prj-print-list 'prj-last-open fp)
315 (prj-print-list 'prj-frame-pos fp)
316 (prj-close-file fp)
317 )))
319 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
320 ;; Load/Save local per-project configuration file
322 (defun prj-update-config ()
323 (let ((d (prj-get-directory prj-current))
324 (e (prj-getconfig "exec-root"))
325 )
326 (if e (setq d (expand-file-name e d)))
327 (setq prj-exec-directory (file-name-as-directory d))
328 ))
330 (defun prj-get-directory (a)
331 (file-name-as-directory (expand-file-name (cadr a)))
332 )
334 (defun prj-get-cfg ()
335 (expand-file-name (or (caddr prj-current) prj-default-cfg) prj-directory)
336 )
338 (defun prj-loadconfig (a)
339 (let (lf e)
340 (prj-reset)
341 (setq prj-current a)
342 (setq prj-directory (prj-get-directory a))
343 (when (file-regular-p (setq lf (prj-get-cfg)))
344 (load lf nil t)
345 (setq prj-curfile
346 (or (assoc prj-curfile prj-files)
347 (car prj-files)
348 ))
349 )
350 (if (setq e (prj-getconfig "project-name"))
351 (setcar a e)
352 (prj-setconfig "project-name" (car a))
353 )
354 (prj-update-config)
355 (prj-set-functions prj-functions)
356 (setq prj-version eproject-version)
357 ))
359 (defun prj-saveconfig ()
360 (when prj-current
361 (let (w c b files)
362 (prj-removehooks)
363 (setq w (selected-window))
364 (setq c (window-buffer w))
365 (dolist (f prj-files)
366 (cond ((setq b (get-buffer (car f)))
367 (set-window-buffer w b t)
368 (with-current-buffer b
369 (let ((s (line-number-at-pos (window-start w)))
370 (p (line-number-at-pos (window-point w)))
371 )
372 (push (list (car f) s p) files)
373 )))
374 (t ;;(consp (cdr f))
375 (push f files)
376 )))
377 (set-window-buffer w c t)
378 (prj-addhooks)
379 (let ((fp (prj-create-file (prj-get-cfg)))
380 (prj-curfile (car prj-curfile))
381 (prj-files (nreverse files))
382 )
383 (when fp
384 (prj-print-list 'prj-version fp)
385 (prj-print-list 'prj-config fp)
386 (prj-print-list 'prj-tools fp)
387 (prj-print-list 'prj-files fp)
388 (prj-print-list 'prj-curfile fp)
389 (prj-print-list 'prj-functions fp)
390 (prj-close-file fp)
391 ))
392 )))
394 (defun prj-saveall ()
395 (prj-saveconfig)
396 (prj-savelist)
397 )
399 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
400 ;; The core functions: Open / Close / Add / Remove Project
402 (defun eproject-open (a)
403 "Open another project."
404 (interactive
405 (list
406 (or (prj-config-get-result 'p)
407 (completing-read "Open Project: " (mapcar 'car prj-list))
408 )))
409 (unless (consp a)
410 (let ((b (assoc a prj-list)))
411 (unless b
412 (error "No such project: %s" a)
413 )
414 (setq a b)
415 ))
416 (setq a (or (car (member a prj-list)) a))
417 (unless (eq a prj-current)
418 (unless (file-directory-p (prj-get-directory a))
419 (error "No such directory: %s" (cadr a))
420 )
421 (setq prj-list (cons a (delq a prj-list)))
422 (eproject-close)
423 (prj-loadconfig a)
424 )
425 (prj-addhooks)
426 (prj-setup-all)
427 (prj-isearch-setup)
428 (unless (prj-edit-file prj-curfile)
429 (eproject-dired)
430 ))
432 (defun eproject-close ()
433 "Close the current project."
434 (interactive)
435 (when prj-current
436 (prj-saveconfig)
437 (prj-removehooks)
438 (let (f)
439 (unwind-protect
440 (progn
441 (save-some-buffers nil)
442 (eproject-killbuffers t)
443 (setq f t)
444 )
445 (or f (prj-addhooks))
446 ))
447 (prj-reset)
448 (prj-config-reset)
449 (prj-setup-all)
450 (prj-isearch-setup)
451 ))
453 (defun eproject-killbuffers (&optional from-project)
454 "If called interactively kills all buffers that
455 do not belong to project files"
456 (interactive)
457 (let (a b)
458 (dolist (f prj-files)
459 (setq b (get-buffer (car f)))
460 (if b
461 (setq a (cons (list b) a))
462 ))
463 (dolist (b (buffer-list))
464 (when (eq (consp (assoc b a)) from-project)
465 (kill-buffer b)
466 ))))
468 (defun eproject-add (dir &optional name cfg)
469 "Add a new or existing project to the list."
470 (interactive
471 (let (d n f)
472 (setq d (read-directory-name "Add project in directory: " prj-directory nil t))
473 (setq n (file-name-nondirectory (directory-file-name d)))
474 (setq n (read-string "Project name: " n))
475 (setq f (read-string "Project file: " prj-default-cfg))
476 (list d n f)
477 ))
478 (when dir
479 (setq dir (directory-file-name dir))
480 (unless name
481 (setq name (file-name-nondirectory dir))
482 )
483 (when (and cfg (string-equal cfg prj-default-cfg))
484 (setq cfg nil)
485 )
486 (let ((a (if cfg (list name dir cfg) (list name dir))))
487 (push a prj-list)
488 (eproject-open a)
489 )))
491 (defun eproject-remove (a)
492 "Remove a project from the list."
493 (interactive
494 (list
495 (or (prj-config-get-result 'p)
496 (completing-read "Remove project: " (mapcar 'car prj-list))
497 )))
498 (unless (consp a)
499 (let ((b (assoc a prj-list)))
500 (unless b
501 (error "No such project: %s" a)
502 )
503 (setq a b)
504 ))
505 (when (progn
506 (beep)
508 (message "")
509 ))
510 (setq prj-list (prj-del-list prj-list a))
511 (prj-setup-all)
512 ))
514 (defun eproject-save ()
515 "Save the project configuration to file."
516 (interactive)
517 (prj-config-parse)
518 (prj-config-print)
519 (prj-saveall)
520 )
522 (defun eproject-revert ()
523 "Reload the project configuration from file."
524 (interactive)
525 (prj-loadlist)
526 (if prj-current
527 (prj-loadconfig prj-current)
528 )
529 (prj-setup-all)
530 )
532 (defun eproject-addfile (f)
533 "Add a file to the current project."
534 (interactive
535 (and prj-current
536 (list
537 (read-file-name "Add file to project: " nil nil t nil)
538 )))
539 (unless prj-current (error "No project open"))
540 (let ((a (prj-insert-file f (prj-config-get-result 'f))))
541 (unless (cdr a)
542 (message "Added to project: %s" (car a))
543 ))
544 (prj-config-print)
545 (prj-setmenu)
546 )
548 (defun eproject-removefile (a)
549 "Remove a file from the current project."
550 (interactive (prj-get-existing-file-1 "Remove file from project: "))
551 (setq a (prj-get-existing-file-2 a))
552 (prj-remove-file a)
553 )
555 (defun eproject-visitfile (a)
556 "Visit a file from the current project."
557 (interactive (prj-get-existing-file-1 "Visit file: "))
558 (setq a (prj-get-existing-file-2 a))
559 (prj-edit-file a)
560 )
562 (defun prj-get-existing-file-1 (msg)
563 (and prj-current
564 (list
565 (or (prj-config-get-result 'f)
566 (completing-read msg (mapcar 'car prj-files))
567 ))))
569 (defun prj-get-existing-file-2 (a)
570 (unless prj-current (error "No project open"))
571 (if (consp a)
572 a
573 (let ((b (assoc (prj-relative-path a) prj-files)))
574 (unless b (error "No such file in project: %s" a))
575 b
576 )))
578 (defun eproject-help ()
579 "Show the eproject README."
580 (interactive)
581 (view-file (eproject-addon "eproject.txt"))
582 )
584 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
585 ;; Hook functions to track opening/closing files from emacs
587 (defun prj-addhooks ()
588 (add-hook 'kill-buffer-hook 'prj-kill-buffer-hook)
589 (add-hook 'find-file-hook 'prj-find-file-hook)
590 (add-hook 'window-configuration-change-hook 'prj-wcc-hook)
591 )
593 (defun prj-removehooks ()
594 (remove-hook 'window-configuration-change-hook 'prj-wcc-hook)
595 (remove-hook 'find-file-hook 'prj-find-file-hook)
596 (remove-hook 'kill-buffer-hook 'prj-kill-buffer-hook)
597 )
599 (defun prj-wcc-hook ()
600 (dolist (w (window-list))
601 (prj-register-buffer (window-buffer w))
602 ))
604 (defun prj-find-file-hook ()
605 (run-with-idle-timer 0.2 nil 'prj-wcc-hook)
606 )
608 (defun prj-kill-buffer-hook ()
609 (let ((b (current-buffer)) a)
610 (if (setq a (rassq b prj-files))
611 (prj-remove-file a t)
612 (if (setq a (rassq b prj-removed-files))
613 (setq prj-removed-files (delq a prj-removed-files))
614 ))))
616 (defun prj-register-buffer (b)
617 (let (f a)
618 (setq f (buffer-file-name b))
620 (setq a (rassq b prj-files))
621 (unless a
622 (setq a (prj-insert-file f nil t))
623 (when a
624 (unless (cdr a)
625 (message "Added to project: %s" (car a))
626 )
627 (prj-init-buffer a b)
628 ))
629 (when (and a (null (eq a prj-curfile)))
630 (setq prj-curfile a)
631 (prj-setmenu)
632 ))
633 a))
635 (defun prj-insert-file (f &optional after on-the-fly)
636 (let ((r (prj-relative-path f)) a m)
637 (setq a (assoc r prj-files))
638 (unless (or a (and on-the-fly (assoc r prj-removed-files)))
639 (setq a (list r))
640 (setq m (memq (or after prj-curfile) prj-files))
641 (if m
642 (setcdr m (cons a (cdr m)))
643 (setq prj-files (prj-add-list prj-files a))
644 )
645 (setq prj-removed-files (prj-del-list prj-removed-files a))
646 )
647 a))
649 (defun prj-remove-file (a &optional on-the-fly)
650 (let ((n (prj-otherfile prj-files a)) b)
651 (setq prj-files (prj-del-list prj-files a))
652 (when (eq prj-curfile a)
653 (setq prj-curfile n)
654 )
655 (unless on-the-fly
656 (setq prj-removed-files (prj-add-list prj-removed-files a))
657 )
658 (unless (prj-config-print)
659 (prj-edit-file prj-curfile)
660 )
661 (prj-setmenu)
662 (message "Removed from project: %s" (car a))
663 ))
665 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
666 ;; Edit another file
668 (defun prj-init-buffer (a b)
669 (with-current-buffer b
670 (rename-buffer (car a) t)
671 (when prj-set-default-directory
672 (cd prj-directory)
673 ))
674 (setcdr a b)
675 )
677 (defun prj-find-file (a)
678 (when a
679 (let (f b pos)
680 (setq b (cdr a))
681 (setq f (expand-file-name (car a) prj-directory))
682 (setq b (get-file-buffer f))
683 (unless b
684 (prj-removehooks)
685 (setq b (find-file-noselect f))
686 (prj-addhooks)
687 (when (and b (consp (cdr a)))
688 (setq pos (cdr a))
689 ))
690 (when b
691 (prj-init-buffer a b)
692 (cons b pos)
693 ))))
695 (defun prj-edit-file (a)
696 (let ((f (prj-find-file a)))
697 (when f
698 (eproject-setup-quit)
699 (switch-to-buffer (car f))
700 (prj-restore-edit-pos (cdr f) (selected-window))
701 (prj-setmenu)
702 ;;(message "dir: %s" default-directory)
703 )
704 (setq prj-curfile a)
705 ))
707 (defun prj-restore-edit-pos (pos w)
708 (let ((top (car pos)) (line (cadr pos)))
709 (when (and (numberp top) (numberp line))
710 (prj-goto-line top)
711 (set-window-start w (point))
712 (prj-goto-line line)
713 )))
715 (defun prj-select-window (w)
716 (let (focus-follows-mouse)
717 (select-window w)
718 (select-frame-set-input-focus (window-frame w))
719 ))
721 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
722 ;; choose next/previous file
724 (defun eproject-nextfile ()
725 "Switch to the next file that belongs to the current project."
726 (interactive)
727 (prj-switch-file 'prj-next-file 'next-buffer)
728 )
730 (defun eproject-prevfile ()
731 "Switch to the previous file that belongs to the current project."
732 (interactive)
733 (prj-switch-file 'prj-prev-file 'previous-buffer)
734 )
736 (defun prj-switch-file (fn1 fn2)
737 (let ((a (rassoc (current-buffer) prj-files)))
738 (cond (a
739 (prj-edit-file (or (funcall fn1 prj-files a) a))
740 )
741 (prj-curfile
742 (prj-edit-file prj-curfile)
743 )
744 (t
745 (funcall fn2)
746 ))))
748 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
749 ;; Set key shortcuts
751 (defun prj-setkeys ()
752 (let ((f (consp prj-current))
753 (a (assoc 'eproject-mode minor-mode-map-alist))
754 (map (make-sparse-keymap))
755 )
756 (if a
757 (setcdr a map)
758 (push (cons 'eproject-mode map) minor-mode-map-alist)
759 )
760 (dolist (k prj-keybindings)
761 (when (or f (eq (caddr k) 'always))
762 (define-key map (car k) (cadr k))
763 ))
765 (when f
766 (let ((n 0) fn s)
767 (dolist (a prj-tools)
768 (unless (setq fn (nth n prj-tools-fns))
769 (setq fn (list 'lambda))
770 (setq prj-tools-fns (nconc prj-tools-fns (list fn)))
771 )
772 (setcdr fn `(() (interactive) (prj-run-tool ',a)))
773 (setq n (1+ n))
774 (when (setq s (caddr a))
775 (define-key map (prj-parse-key s) (and f fn))
776 ))))))
778 (defun prj-parse-key (s)
779 (read
780 (if (string-match "[a-z][a-z0-9]+$" s)
781 (concat "[" s "]")
784 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
785 ;; Set menus
787 (defun prj-list-sorted ()
788 (sort (append prj-list nil)
789 '(lambda (a b) (string-lessp (car a) (car b)))
790 ))
792 (defun prj-setmenu ()
793 (let ((f (consp prj-current)) m1 m2 m3)
795 (setq m1
796 `(("Open" open ,@(prj-menulist-maker prj-list prj-current 'prj-menu-open))
797 ("Add/Remove" other
798 ("Add ..." "Add new or existing project to the list" . eproject-add)
799 ("Remove ..." "Remove project from the list" . eproject-remove)
800 ,@(and f '(("Close" "Close current project" . eproject-close)))
801 ("--")
802 ("Setup" "Enter the project setup area." . eproject-setup-toggle)
803 ("Help" "View eproject.txt" . eproject-help)
804 )
805 ))
806 (when f
807 (nconc m1 (cons '("--") (prj-menulist-maker prj-tools nil prj-tools-fns)))
808 (setq m2
809 `(("Dired" "Browse project directory in Dired - Use 'a' to add file(s) to the project" . eproject-dired)
810 ("--")
811 ,@(prj-menulist-maker prj-files prj-curfile 'prj-menu-edit)
812 )))
814 (prj-menu-maker
815 global-map
816 `((buffer "Project" project ,@m1)
817 (file "List" list ,@m2)
818 )
819 '(menu-bar)
820 )))
822 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
824 (defun prj-menu-edit ()
825 (interactive)
826 (let ((a (nth last-command-event prj-files)))
827 (if a (prj-edit-file a))
828 ))
830 (defun prj-menu-open ()
831 (interactive)
832 (let ((a (nth last-command-event prj-list)))
833 (if a (eproject-open (car a)))
834 ))
836 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
838 (defun prj-menu-maker (map l v)
839 (let ((e (list nil)))
840 (setq v (append v e))
841 (dolist (k (reverse l))
842 (let (s a)
843 (when (symbolp (car k))
844 (setq a (pop k))
845 )
846 (cond
847 ((numberp (car k))
848 (setcar e (pop k))
849 )
850 ((and (consp (cdr k)) (symbolp (cadr k)))
851 (setcar e (cadr k))
852 (setq s (cddr k))
853 (setq k (and s (cons (car k) (make-sparse-keymap (car k)))))
854 )
855 (t
856 (setcar e (intern (downcase (car k))))
857 ))
858 (if a
859 (define-key-after map (vconcat v) k a)
860 (define-key map (vconcat v) k)
861 )
862 (if s (prj-menu-maker map s v))
863 ))))
865 (defun prj-copy-head (l n)
866 (let (r)
867 (while (and l (> n 0))
868 (push (pop l) r)
869 (setq n (1- n))
870 )
871 (nreverse r)
872 ))
874 (defun prj-split-list (l n)
875 (let (r)
876 (while l
877 (push (prj-copy-head l n) r)
878 (setq l (nthcdr n l))
879 )
880 (nreverse r)
881 ))
883 (defun prj-menulist-maker (l act fns)
884 (let (r (w 30) s (m 0) (n 0) k)
885 (cond
886 ((< (length l) w)
887 (prj-menulist-maker-1 (list l fns n) act)
888 )
889 (t
890 ;; menu too long; split into submenus
891 (setq s (prj-split-list l w))
892 (setq k (prj-menulist-maker-1 (list (append (pop s) '(("--"))) fns n) act))
893 (setq r (nreverse k))
894 (dolist (l s)
895 (when (consp fns)
896 (setq fns (nthcdr w fns))
897 )
898 (setq n (+ n w))
899 (setq k (prj-menulist-maker-1 (list l fns n) act))
900 (push (cons (concat (prj-shortname (caar l)) " ...")
901 (cons (intern (format "m_%d" (setq m (1+ m))))
902 k)) r)
903 )
904 (nreverse r)
905 ))))
907 (defun prj-menulist-maker-1 (l act)
908 (let (r e f s i n a)
909 (while (car l)
910 (setq a (caar l))
911 (setcar l (cdar l))
912 (setq n (caddr l))
913 (setcar (cddr l) (1+ n))
914 (setq f (if (consp (cadr l))
915 (prog1 (car (cadr l)) (setcar (cdr l) (cdr (cadr l))))
916 (cadr l)))
918 (setq i (car a))
919 (unless (string-match "^ *#" i)
920 (setq s (if (and (consp (cdr a)) (stringp (cadr a))) (cadr a) i))
921 (cond ((equal ">" i)
922 (setq e (cons s (cons (intern s) (prj-menulist-maker-1 l act))))
923 (setq r (cons e r))
924 )
925 ((equal "<" i)
926 (setq l nil)
927 )
928 (t
929 (setq i (prj-shortname i))
930 (setq e (cons n (if (eq a act)
931 `(menu-item ,i ,f :button (:toggle . t) :help ,s)
932 (cons i (cons s f)))))
933 (setq r (cons e r))
934 )))
935 )
936 (nreverse r)
937 ))
939 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
940 ;; Run make and other commands
942 (defun prj-compilation-in-frame (cmd)
943 (let ((bn "*compilation*") w h b c f)
944 (unless (get-buffer-window bn t)
945 (setq b (get-buffer-create bn))
946 (setq f (frame-list))
947 (cond ((cdr f)
948 (setq w (frame-first-window (car f)))
949 (delete-other-windows w)
950 )
951 (t
952 (setq h (/ (* 70 (frame-height)) 100))
953 (delete-other-windows w)
954 (setq w (split-window w h))
955 ))
956 (set-window-buffer w b)
957 ))
958 (let ((display-buffer-reuse-frames t) (f (selected-frame)))
959 (compile cmd)
960 (select-frame-set-input-focus f)
961 ))
963 (defun prj-run (cmd)
964 (cond ((string-match "^-e +" cmd)
965 (setq cmd (read (substring cmd (match-end 0))))
966 (unless (commandp cmd)
967 (setq cmd `(lambda () (interactive) ,cmd))
968 )
969 (command-execute cmd)
970 )
971 ((let ((b (current-buffer))
972 (old-dir default-directory)
973 (new-dir ".")
974 )
976 (setq new-dir (match-string-no-properties 1 cmd))
977 (setq cmd (substring cmd (match-end 0)))
978 )
979 (when prj-exec-directory
980 (setq new-dir (expand-file-name new-dir prj-exec-directory))
981 )
982 (cd new-dir)
984 (start-process-shell-command
985 "eproject-async" nil (match-string 1 cmd))
986 (message (match-string 1 cmd))
987 )
988 (prj-set-compilation-frame
989 (prj-compilation-in-frame cmd)
990 )
991 (t
992 (compile cmd)
993 ))
994 (with-current-buffer b (cd old-dir))
995 ))))
997 (defun prj-run-tool (a)
998 (unless (string-match "^--+$" (car a))
999 (prj-run (or (cadr a) (car a)))
1000 ))
1002 (defun eproject-killtool ()
1003 (interactive)
1004 (let ((bn "*compilation*") w0 w1)
1005 (when (setq w1 (get-buffer-window bn t))
1006 (when (fboundp 'kill-compilation)
1007 (setq w0 (selected-window))
1008 (select-window w1)
1009 (kill-compilation)
1010 (select-window w0)
1011 ))))
1013 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1014 ;; run grep on project files
1016 (defun eproject-grep (command-args)
1017 "Run the grep command on all the project files."
1018 (interactive
1019 (progn
1020 (require 'grep)
1021 (grep-compute-defaults)
1022 (let ((default (grep-default-command)))
1023 (list (read-from-minibuffer
1024 "Run grep on project files: "
1025 (if current-prefix-arg default grep-command)
1026 nil
1027 nil
1028 'grep-history
1029 (if current-prefix-arg nil default)
1030 )))))
1031 (let ((b (current-buffer)) (old-dir default-directory))
1032 (dolist (f (mapcar 'car prj-files))
1033 (setq command-args (concat command-args " " f))
1034 )
1035 (when prj-directory (cd prj-directory))
1036 (grep command-args)
1037 (with-current-buffer b (cd old-dir))
1038 ))
1040 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1041 ;; add files to the project with dired
1043 (require 'dired)
1045 (defun prj-dired-addfiles ()
1046 (interactive)
1047 (when prj-current
1048 (let ((n 0) a)
1049 (dolist (f (dired-get-marked-files))
1050 (setq a (prj-insert-file f))
1051 (unless (cdr a)
1052 (setq n (1+ n))
1053 (setq prj-curfile a)
1054 ))
1055 (message "Added to project: %d file(s)" n)
1056 (prj-setmenu)
1057 )))
1059 (defun eproject-dired ()
1060 "Start a dired window with the project directory."
1061 (interactive)
1062 (when prj-directory
1063 (eproject-setup-quit)
1064 ;;(message "Use 'a' to add marked or single files to the project.")
1065 (dired prj-directory)
1066 (let ((map dired-mode-map))
1067 (define-key map "a" 'prj-dired-addfiles)
1068 (define-key map [menu-bar operate command] '("Add to Project"
1069 "Add current or marked file(s) to project" . prj-dired-addfiles))
1070 )))
1072 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1074 (defun prj-setup-all ()
1075 (prj-setkeys)
1076 (prj-setmenu)
1077 (prj-settitle)
1078 (prj-config-print)
1079 )
1081 (defun prj-getconfig (n)
1082 (let ((a (cdr (assoc n prj-config))))
1083 (and (stringp a) a)
1084 ))
1086 (defun prj-setconfig (n v)
1087 (let ((a (assoc n prj-config)))
1088 (unless a
1089 (setq a (list n))
1090 (setq prj-config (nconc prj-config (list a)))
1091 )
1092 (setcdr a v)
1093 ))
1095 (defun prj-on-kill ()
1096 (prj-saveall)
1097 )
1099 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1100 ;; isearch in all project files
1102 (defun prj-isearch-function (b wrap)
1103 (let (a d)
1104 (or b (setq b (current-buffer)))
1105 (cond (wrap
1106 (if isearch-forward
1107 (setq a (car prj-files))
1108 (setq a (car (last prj-files)))
1109 ))
1110 ((setq a (rassoc b prj-files))
1111 (if isearch-forward
1112 (setq a (prj-next-file prj-files a))
1113 (setq a (prj-prev-file prj-files a))
1114 )
1115 ))
1116 (when a
1117 (if (buffer-live-p (cdr a))
1118 (setq d (cdr a))
1119 (setq d (car (prj-find-file a)))
1120 ))
1121 ;; (print `(prj-isearch (wrap . ,wrap) ,b ,d) (get-buffer "*Messages*"))
1122 d
1123 ))
1125 (defun prj-isearch-setup ()
1126 (cond ((and prj-set-multi-isearch prj-current)
1127 (setq multi-isearch-next-buffer-function 'prj-isearch-function)
1128 (setq multi-isearch-pause 'initial)
1129 (add-hook 'isearch-mode-hook 'multi-isearch-setup)
1130 )
1131 (t
1132 (remove-hook 'isearch-mode-hook 'multi-isearch-setup)
1133 )))
1135 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1136 ;; Initialize
1138 (defun prj-startup-delayed ()
1139 ;; load UI support
1140 (load (eproject-addon "eproject-config") nil t)
1142 ;; When no projects are specified yet, load the eproject project itself.
1143 (unless prj-list
1144 (load (eproject-addon prj-default-cfg))
1145 )
1147 ;; no project so far
1148 (prj-reset)
1149 (prj-setup-all)
1150 (add-hook 'kill-emacs-hook 'prj-on-kill)
1152 ;; inhibit open last project when a file was on the commandline
1153 (unless (buffer-file-name (window-buffer))
1154 (when prj-last-open
1156 ;; open last project
1157 (eproject-open prj-last-open)
1159 ;; restore frame position
1160 (when (and prj-set-framepos prj-frame-pos prj-initial-frame)
1161 (modify-frame-parameters prj-initial-frame prj-frame-pos)
1162 ;; emacs bug: when it's too busy it doesn't set frames correctly.
1163 (sit-for 0.2)
1164 ))))
1166 (defun prj-command-line-switch (option)
1167 (setq prj-last-open (pop argv))
1168 (setq inhibit-startup-screen t)
1169 )
1171 (defun eproject-startup ()
1172 ;; where is this file
1173 (if load-file-name
1174 (setq eproject-directory (file-name-directory load-file-name)))
1175 (if (boundp 'prj-list)
1176 (progn
1177 (load (eproject-addon "eproject-config"))
1178 (prj-setup-all))
1179 (progn
1180 (prj-loadlist)
1181 (when prj-last-open (setq inhibit-startup-screen t))
1182 (when (display-graphic-p) (setq prj-initial-frame (selected-frame)))
1183 (push '("project" . prj-command-line-switch) command-switch-alist)
1184 (run-with-idle-timer 0.1 nil 'prj-startup-delayed)
1185 )))
1187 ;;;###autoload(require 'eproject)
1188 (provide 'eproject)
1189 (eproject-startup)
1191 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1192 ;; eproject.el ends here