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