eproject.el

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