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