eproject.el

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