eproject-config.el

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; eproject-config.el --- project workspaces for emacs --- UI part
   4 ;;
   5 ;; Copyright (C) 2008 grischka
   6 ;;
   7 ;; Author: grischka -- grischka@users.sourceforge.net
   8 ;; Created: 24 Jan 2008
   9 ;; Version: 0.2
  10 ;;
  11 ;; This program is free software, released under the GNU General
  12 ;; Public License (GPL, version 2). For details see:
  13 ;;
  14 ;;     http://www.fsf.org/licenses/gpl.html
  15 ;;
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  19 ;; General Public License for more details.
  20 ;;
  21 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22
  23 ;; buffer
  24 (defvar prj-buffer nil)
  25 ;; keymap
  26 (defvar prj-browse-map nil)
  27 ;; overlays
  28 (defvar prj-hilight-bar nil)
  29 (defvar prj-hilight-bar-2 nil)
  30 ;; flag
  31 (defvar prj-edit-mode nil)
  32
  33 ;; tabs
  34 (defvar prj-groups)
  35 (defvar prj-active-group nil)
  36 (defvar prj-group-top nil)
  37 (defvar prj-group-left nil)
  38 (defvar prj-group-tab nil)
  39
  40 ;; tab menus
  41 (defvar prj-links)
  42
  43 ;; quick search
  44 (defvar prj-qs-face nil)
  45 (defvar prj-qs-str nil)
  46 (defvar prj-qs-len nil)
  47 (defvar prj-qs-pos nil)
  48
  49 ;; from eproject.el
  50 (defvar prj-list)
  51 (defvar prj-current)
  52 (defvar prj-files)
  53 (defvar prj-curfile)
  54 (defvar prj-config)
  55 (defvar prj-tools)
  56 ;; also
  57 (declare-function prj-setconfig "eproject")
  58 (declare-function prj-getconfig "eproject")
  59 (declare-function prj-setup-all "eproject")
  60 (declare-function prj-remove-file "eproject")
  61 (declare-function caddr "eproject")
  62
  63 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  64
  65 (defmacro p-get (e)
  66   `(plist-get ,(car e) ',(cdr e))
  67   )
  68 (defmacro p-set (e v)
  69   `(plist-put ,(car e) ',(cdr e) ,v)
  70   )
  71 (defmacro p-call (e &rest args)
  72   `(funcall (plist-get ,(car e) ',(cdr e)) ,@args)
  73   )
  74
  75 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  76 ;; Show/Hide the *eproject* buffer
  77
  78 (defun eproject-setup ()
  79   "Show the configuration buffer."
  80   (interactive)
  81   (let ((map (make-keymap)))
  82
  83     (substitute-key-definition
  84       'self-insert-command
  85       'prj-qsearch
  86       map
  87       global-map
  88       )
  89
  90     (dolist (k '(
  91         ("\t" . prj-next-button)
  92         ([tab] . prj-next-button)
  93         ("\e\t" . prj-prev-button)
  94         ([S-tab] . prj-prev-button)
  95         ([backtab] . prj-prev-button)
  96
  97         ([left] . prj-move-left)
  98         ([right] . prj-move-right)
  99         ([backspace] . prj-qsearch)
 100         ([delete] . prj-qsearch)
 101         ([127] . prj-qsearch)
 102         ([return] . prj-enter)
 103
 104         ([32] . eproject-edit)
 105         ([escape] . eproject-setup-quit)
 106
 107         ([down-mouse-1] . prj-mouse)
 108         ([down-mouse-2] . prj-mouse)
 109         ([mouse-1] . prj-mouse)
 110         ([mouse-2] . prj-mouse)
 111         ([mouse-3] . ignore)
 112         ([drag-mouse-1] . ignore)
 113         ))
 114       (define-key map (car k) (cdr k))
 115       )
 116
 117     (cond ((buffer-live-p prj-buffer)
 118            (switch-to-buffer prj-buffer)
 119            )
 120           (t
 121            (unless prj-buffer
 122              (add-hook 'post-command-hook 'prj-post-command-hook)
 123              )
 124            (prj-config-init)
 125            (setq prj-buffer (get-buffer-create "*eproject*"))
 126            (switch-to-buffer prj-buffer)
 127            ))
 128
 129     (setq prj-browse-map map)
 130     (prj-qs-clear)
 131     (unless prj-edit-mode
 132       (use-local-map map)
 133       (prj-config-print)
 134       )
 135     ))
 136
 137 (defun eproject-setup-quit ()
 138   "Kill the configuration buffer."
 139   (interactive)
 140   (let ((alive (buffer-live-p prj-buffer)))
 141     (cond ((and alive prj-edit-mode)
 142            (bury-buffer prj-buffer)
 143            )
 144           (t
 145            (when alive
 146              (kill-buffer prj-buffer)
 147              )
 148            (remove-hook 'post-command-hook 'prj-post-command-hook)
 149            (setq prj-buffer nil)
 150            ))))
 151
 152 (defun eproject-setup-toggle ()
 153   "Show/hide the project configuration browser."
 154   (interactive)
 155   (if (prj-config-active)
 156       (eproject-setup-quit)
 157     (eproject-setup)
 158     ))
 159
 160 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 161 ;; Edit mode
 162
 163 (defun eproject-edit ()
 164   (interactive)
 165   (if (eq 'u (car prj-active-group)) (emacs-lisp-mode))
 166   (let ((map (make-sparse-keymap)))
 167     (define-key map [escape] 'eproject-edit-quit)
 168     (setq prj-edit-mode t)
 169     (prj-qs-clear)
 170     (use-local-map map)
 171     (prj-config-print)
 172     ))
 173
 174 (defun eproject-edit-quit ()
 175   (interactive)
 176   (if (eq 'u (car prj-active-group)) (fundamental-mode))
 177   (prj-config-parse)
 178   (use-local-map prj-browse-map)
 179   (setq prj-edit-mode nil)
 180   (setq cursor-type nil)
 181   (prj-set-hilite-bar)
 182   (prj-setup-all)
 183   )
 184
 185 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 186
 187 (defun prj-config-active ()
 188   (eq (current-buffer) prj-buffer)
 189   )
 190
 191 (defun prj-save-window-pos ()
 192   (p-set (prj-active-group . :pos)
 193      (list
 194       (window-start)
 195       (- (line-number-at-pos) prj-group-top)
 196       )))
 197
 198 (defun prj-config-reset ()
 199   (dolist (s prj-groups)
 200     (p-set (s . :pos) (list 1 0))
 201     )
 202   (setq prj-active-group (car prj-groups))
 203   )
 204
 205 (defun prj-config-init ()
 206   (dolist (v '(
 207       prj-buffer
 208       prj-browse-map
 209       prj-hilight-bar
 210       prj-hilight-bar-2
 211       prj-edit-mode
 212       ))
 213     (set v nil)
 214     ))
 215
 216 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 217 ;; Read back the configuration after edits
 218
 219 (defun prj-scan-group ()
 220   (when (and (prj-config-active) prj-edit-mode)
 221     (with-current-buffer prj-buffer
 222       (save-excursion
 223         (let (l r e s)
 224           (prj-goto-line prj-group-top)
 225
 226           (if (eq 'u (car prj-active-group))
 227               (read (concat "(("
 228                             (buffer-substring-no-properties (point) (point-max))
 229                             "))"))
 230
 231             (while (< (point) (point-max))
 232               (setq e (line-end-position))
 233               (setq r
 234
 235   (cond ((re-search-forward
 236           "^ *\\[[-+]\\] +\\([^ ]\\(.+[^ ]\\)?\\) *$"
 237           e t)
 238          (list ">" (match-string-no-properties 1))
 239          )
 240         ((re-search-forward
 241           "^ *==+ *$"
 242           e t)
 243          (list "<")
 244          )
 245         ((re-search-forward
 246           "^ *\\([^ ()]\\([^()]*[^ ()]\\)?\\) *\\((.+)\\)? *:\\( +\\(.*[^ ]\\)\\)? *$"
 247           e t)
 248          (setq s (match-string-no-properties 3))
 249          (cons (match-string-no-properties 1)
 250                (cons (or (match-string-no-properties 5) "")
 251                      (and s (list (substring s 1 -1)))
 252                      )))
 253         ((re-search-forward
 254           "^ *\\([^ ]\\(.*[^ ]\\)?\\) *$"
 255           e t)
 256          (list (match-string-no-properties 1))
 257          )))
 258
 259               (when r
 260                 (setq l (cons r l))
 261                 )
 262               (forward-line 1)
 263               )
 264             (list (nreverse l))
 265             ))))))
 266
 267 (defun prj-config-parse ()
 268     (let ((s (prj-scan-group)))
 269       (if s (p-call (prj-active-group . :parse) (car s)))
 270       ))
 271
 272 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 273 ;; The project config window
 274
 275 ;; (makunbound 'prj-groups) (makunbound 'prj-links)
 276
 277 (defvar prj-groups `(
 278
 279    (p nil
 280       :title "Projects"
 281       :comment "All projects on a list"
 282       :pos (1 0)
 283       :list prj-list
 284       :exec eproject-open
 285       :print ,(lambda (a p)
 286                (prj-link (car a) nil a)
 287                (prj-link-2 nil p (cadr a))
 288                )
 289       :parse ,(lambda (s)
 290                (dolist (a s)
 291                  (unless (cadr a)
 292                    (error "Error: Project directory empty.")
 293                    ))
 294                (setq prj-list s)
 295                (let ((a (rassoc (cdr prj-current) s)))
 296                  (when a
 297                    (setq prj-current a)
 298                    (prj-setconfig "project-name" (car a))
 299                    )))
 300       :menu (add remove open close)
 301       )
 302
 303    (f nil
 304       :title "Files"
 305       :comment "The files that belong to the project"
 306       :pos (1 0)
 307       :list prj-files
 308       :exec eproject-visitfile
 309       :print ,(lambda (a p)
 310                (prj-link (car a) nil a)
 311                )
 312       :parse ,(lambda (s)
 313                 (let (b)
 314                   (dolist (l s)
 315                     (setcdr l (cdr (assoc (car l) prj-files)))
 316                     )
 317                   (dolist (a prj-files)
 318                     (if (setq b (assoc (car a) s))
 319                         (if (eq a prj-curfile) (setq prj-curfile b))
 320                         (prj-remove-file a)
 321                         ))
 322                   (setq prj-files s)
 323                   ))
 324       :menu (add-file remove-file visit-file)
 325       )
 326
 327    (t nil
 328       :title "Tools"
 329       :comment "Configurable tools and keyboard shortcuts"
 330       :pos (1 0)
 331       :list prj-tools
 332       :exec prj-run-tool
 333       :print ,(lambda (a p)
 334                (prj-link (car a) nil a)
 335                (when (caddr a)
 336                  (unless prj-edit-mode
 337                    (insert-char 32 (- (- prj-group-tab 10) (- (point) p)))
 338                    )
 339                  (insert " (" (caddr a) ")")
 340                  )
 341                (when (cadr a)
 342                  (prj-link-2 nil p (cadr a))
 343                  ))
 344       :parse ,(lambda (s)
 345                (setq prj-tools s)
 346                )
 347       :menu ()
 348       )
 349
 350    (s nil
 351       :title "Settings"
 352       :comment "Project options"
 353       :pos (1 0)
 354       :list prj-config
 355       :exec eproject-edit
 356       :print ,(lambda (a p)
 357                (prj-link-2 (car a) p (or (cdr a) ""))
 358                )
 359       :parse ,(lambda (s)
 360                (dolist (l s) (setcdr l (cadr l)))
 361                (let ((prj-config s) n)
 362                  (setq n (prj-getconfig "project-name"))
 363                  (unless (> (length n) 0)
 364                    (error "Error: Project name empty.")
 365                    )
 366                  (when prj-current
 367                    (setcar prj-current n)
 368                    ))
 369                (setq prj-config s)
 370                (prj-update-config)
 371                )
 372       :menu ()
 373       )
 374
 375 ;;;    (u nil
 376 ;;;       :title "Functions"
 377 ;;;       :comment "ELisP Utitlities"
 378 ;;;       :pos (1 0)
 379 ;;;       :list prj-functions
 380 ;;;       :exec eproject-edit
 381 ;;;       :print ,(lambda (a p)
 382 ;;;                (pp a (current-buffer))
 383 ;;;                )
 384 ;;;       :parse ,(lambda (s)
 385 ;;;                 (prj-set-functions s)
 386 ;;;                )
 387 ;;;       :menu ()
 388 ;;;       )
 389    ))
 390
 391
 392 (defvar prj-links '(
 393
 394    ;; projects
 395    (add "Add" "Add new or existing project to the list"
 396          eproject-add
 397          )
 398    (remove "Remove" "Remove a project from the the list"
 399          eproject-remove
 400          )
 401    (open "Open" "Open a Project"
 402          eproject-open
 403          )
 404    (close "Close" "Close the current project"
 405          eproject-close
 406          )
 407
 408    ;; files
 409    (add-file "Add" "Add a file to the project"
 410          eproject-addfile
 411          )
 412    (remove-file "Remove" "Remove file from project"
 413          eproject-removefile
 414          )
 415    (dired "Dired" "Browse project directory - Use 'a' in dired to add file(s) to the project"
 416          eproject-dired
 417          )
 418    (visit-file "Visit" "Visit this file"
 419          eproject-visitfile
 420          )
 421
 422    ;; edit mode
 423    (edit "Edit" "Edit this list (spacebar)"
 424          eproject-edit
 425          )
 426    (quit-edit "Quit" "Quit edit mode (escape)"
 427          eproject-edit-quit
 428          )
 429    (revert "Revert" "Revert all configuration to last saved state"
 430          eproject-revert
 431          )
 432    (save "Save" "Save the configuration now"
 433          eproject-save
 434          )
 435
 436    ;; other
 437    (help "Help" "View the 'eproject' documentation."
 438          eproject-help
 439          )
 440    (quit "Quit" "Quit configuration area"
 441       eproject-setup-quit
 442       )
 443    ))
 444
 445 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 446 ;; Print the config
 447
 448 (defun prj-config-print ()
 449   (when (prj-config-active)
 450     (let (x f a n title l p (inhibit-read-only t) active)
 451
 452       (setq buffer-read-only nil)
 453       (buffer-disable-undo)
 454       (erase-buffer)
 455
 456       (setq prj-group-left (if prj-edit-mode 0 1))
 457       (setq prj-group-tab (+ 24 prj-group-left))
 458       (setq active
 459             (or prj-active-group
 460                 (setq prj-active-group (car prj-groups))
 461                 ))
 462       (insert "\n")
 463       (setq n 1)
 464       (dolist (s prj-groups)
 465         (setq f (eq s active))
 466         (when (or f (and prj-current (null prj-edit-mode)))
 467           (setq title (p-get (s . :title)))
 468           (insert-char 32 n)
 469           (cond (f
 470                  (setq p (point))
 471                  (insert title)
 472                  (prj-make-hilite-bar 'prj-hilight-bar-2 p (point))
 473                  )
 474                 (t
 475                  (prj-link title (p-get (s . :comment)) s t)
 476                  ))
 477           (setq n 2)
 478           ))
 479
 480       (dolist (s prj-links)
 481         (prj-define-shortcut nil (cadr s) 'ignore)
 482         )
 483       (dolist (s prj-groups)
 484         (prj-define-shortcut nil (symbol-name (car s)) 'prj-key-set-group)
 485         )
 486       (insert "  -")
 487       (dolist (id (if prj-edit-mode '(revert save quit-edit) '(edit help quit)))
 488          (insert "  ")
 489          (prj-link-3 id nil)
 490          )
 491       (insert "\n\n  -")
 492       (when prj-current
 493         (insert " " (car prj-current) " ")
 494         )
 495       (insert "-")
 496       (unless prj-edit-mode
 497         (dolist (id (p-get (active . :menu)))
 498           (insert "  ")
 499           (prj-link-3 id nil)
 500           )
 501         )
 502       (insert "\n\n")
 503
 504       (when prj-edit-mode
 505         (add-text-properties (point-min) (point)
 506            '(read-only t intangible t front-sticky t rear-nonsticky t))
 507         )
 508
 509       (setq prj-group-top (line-number-at-pos))
 510
 511       (prj-print-items
 512         (p-get (active . :print))
 513         (eval (p-get (active . :list)))
 514         prj-group-left
 515        )
 516
 517       (setq p (p-get (active . :pos)))
 518       (set-window-start (get-buffer-window prj-buffer) (car p))
 519       (prj-goto-line (+ prj-group-top (cadr p)))
 520       (unless (eobp)
 521         (forward-char prj-group-left)
 522         )
 523       (unless (pos-visible-in-window-p)
 524         (recenter (/ (window-height) 5))
 525         )
 526       (set-buffer-modified-p nil)
 527       (cond (prj-edit-mode
 528              (buffer-enable-undo)
 529              (setq cursor-type 'box)
 530              )
 531             (t
 532              (prj-set-hilite-bar)
 533              (setq buffer-read-only t)
 534              (setq cursor-type nil)
 535              ))
 536       t
 537       )))
 538
 539 (defun prj-print-items (fn items tab)
 540   (dolist (a items)
 541     (when (stringp (car a))
 542       (unless (and (string-match "^ *#" (car a)) (null prj-edit-mode))
 543         (insert-char 32 tab)
 544         ))
 545     (funcall fn a (- (point) tab))
 546     (insert "\n")
 547     ))
 548
 549 (defun prj-link (text help &optional fn top)
 550   (if (and prj-edit-mode (null help))
 551       (insert text)
 552       (let ((p (point)) (f (if top 'link)))
 553         (insert-text-button
 554          text
 555          'help-echo help
 556          'action 'prj-action
 557          'class (or fn 'link)
 558          'follow-link t
 559          'face f
 560          'mouse-face 'link
 561          )
 562         (when (or f help)
 563           (add-text-properties p (1+ p) '(face (:foreground "blue" :underline t)))
 564           )
 565         )))
 566
 567 (defun prj-link-2 (a p b)
 568   (if a (insert a))
 569   (insert-char 32 (- prj-group-tab 1 (- (point) p)))
 570   (insert " : " b)
 571   )
 572
 573 (defun prj-link-3 (id f)
 574   (let ((a (assq id prj-links)))
 575     (when a
 576       (prj-link (cadr a) (caddr a) a f)
 577       (prj-define-shortcut nil (cadr a) (nth 3 a))
 578     )))
 579
 580 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 581 ;; Project selection and configuration
 582
 583 (defun prj-action (b)
 584   (let ((a (button-get b 'class)))
 585     (cond ((memq a prj-links)
 586            (command-execute (nth 3 a))
 587            )
 588           ((memq a prj-groups)
 589            (setq prj-active-group a)
 590            (prj-config-print)
 591            )
 592           (t
 593            (p-call (prj-active-group . :exec) a)
 594            ))))
 595
 596 (defun prj-key-set-group ()
 597   (interactive)
 598   (let ((c (intern (char-to-string (logand last-input-event 255)))) s)
 599       (when (setq s (assoc c prj-groups))
 600         (setq prj-active-group s)
 601         (prj-config-print)
 602         )))
 603
 604 (defun prj-define-shortcut (map s fn)
 605   (let ((c (logior (aref s 0) 32)))
 606     (define-key
 607       (or map (current-local-map))
 608       (read (format "\"\\M-%c\"" c))
 609       fn
 610       )))
 611
 612 (defun prj-config-get-result (id)
 613   (and (prj-config-active)
 614        (eq id (car prj-active-group))
 615        (nth (cadr (p-get (prj-active-group . :pos)))
 616             (eval (p-get (prj-active-group . :list)))
 617             )))
 618
 619 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 620 ;; Tab between buttons and move files up/down
 621
 622 (defun prj-next-button ()
 623   (interactive)
 624   (if prj-qs-pos
 625       (prj-qs-next 1)
 626     ))
 627
 628 (defun prj-prev-button ()
 629   (interactive)
 630   (if prj-qs-pos
 631       (prj-qs-next -1)
 632   ))
 633
 634 (defun prj-move-left ()
 635   (interactive)
 636   (prj-move-to -1)
 637   )
 638
 639 (defun prj-move-right ()
 640   (interactive)
 641   (prj-move-to 1)
 642   )
 643
 644 (defun prj-move-to (d &optional cycle)
 645   (let ((n 0) (x 0))
 646     (dolist (s prj-groups)
 647       (if (eq s prj-active-group)
 648           (setq x n))
 649       (setq n (1+ n))
 650       )
 651     (setq x (+ x d))
 652     (unless prj-current (setq n 1))
 653     (if cycle
 654         (if (< x 0) (setq x (1- n)) (if (>= x n) (setq x 0)))
 655         (setq x (max 0 (min (1- n) x)))
 656         )
 657     (setq prj-active-group (nth x prj-groups))
 658     (prj-config-print)
 659     ))
 660
 661 (defun prj-enter ()
 662   (interactive)
 663   (let (a b)
 664     (and (setq b (button-at (point)))
 665          (setq a (button-get b 'action))
 666          (funcall a b)
 667          )))
 668
 669 (defun prj-mouse ()
 670   (interactive)
 671   ;;(message "LC: %s" (prin1-to-string last-input-event))
 672   (let ((i last-input-event) p b a x y tp)
 673     (when (consp i)
 674       (select-window (car (cadr i)))
 675       (setq p (nth 5 (cadr i)))
 676       (setq tp (nth 6 (cadr i)))
 677       (setq y (+ (cdr tp) (line-number-at-pos (window-start))))
 678       (setq x (+ (car tp) 1))
 679       (if (>= y prj-group-top)
 680           (prj-goto-line y)
 681         )
 682       (and (memq (car i) '(mouse-1 mouse-2))
 683            (setq b (button-at p))
 684            (setq a (button-get b 'action))
 685            (funcall a b)
 686            ))))
 687
 688 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 689 ;; A hook to maintain the selection bar
 690
 691 (defun prj-post-command-hook ()
 692   (and
 693    (prj-config-active)
 694    (prj-set-hilite-bar)
 695    ))
 696
 697 (defun prj-set-hilite-bar ()
 698   (unless prj-edit-mode
 699     ;;(message "LC: %s" (prin1-to-string (cons this-command last-input-event)))
 700     (let (n m a c e p)
 701       (setq m (length (eval (p-get (prj-active-group . :list)))))
 702       (setq p (line-number-at-pos))
 703       (setq n (max prj-group-top
 704                    (min (line-number-at-pos)
 705                         (1- (+ prj-group-top m))
 706                         )))
 707       (prj-goto-line n)
 708       (if (< p n)
 709           (set-window-start nil (point-min))
 710         )
 711       (unless (eobp)
 712         (setq a (point))
 713         (forward-char prj-group-left)
 714         (setq e (line-end-position))
 715         (and (< (setq c (+ a prj-group-tab)) e)
 716              (= (char-after c) ?:)
 717              (setq e c)
 718              )
 719         (while (= (char-after) 32)
 720           (forward-char 1)
 721           )
 722         (prj-make-hilite-bar 'prj-hilight-bar (point) e)
 723         (prj-save-window-pos)
 724         ))))
 725
 726 (defun prj-make-hilite-bar (s a e)
 727   (let (b)
 728     (if (and (boundp s) (setq b (eval s)))
 729         (move-overlay b a e)
 730         (overlay-put
 731            (set s (make-overlay a e))
 732            'face '(:background "grey90" :foreground "blue")
 733            ))
 734     ))
 735
 736 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 737 ;; Quick Search
 738
 739 (defun prj-qsearch ()
 740   (interactive)
 741   (setq prj-qs-str
 742         (cond ((member last-command-char '(backspace 127))
 743                (substring prj-qs-str 0 (max 0 (1- (length prj-qs-str))))
 744                )
 745               ((eq last-command-char 'delete)
 746                ""
 747                )
 748               (t
 749                (concat prj-qs-str (char-to-string last-command-char))
 750                )))
 751   (prj-qs-next 0)
 752   )
 753
 754 (defun prj-qs-clear ()
 755   (when prj-qs-face
 756     (delete-overlay prj-qs-face)
 757     )
 758   (setq prj-qs-face nil)
 759   (setq prj-qs-pos nil)
 760   (setq prj-qs-str "")
 761   (setq prj-qs-len 0)
 762   )
 763
 764 (defun prj-qs-find (s f p)
 765   (save-excursion
 766     (let (r beg end start limit)
 767       (setq s (concat
 768                "^[[:space:]]*\\([^[:space:]]*[/\\]\\)?\\("
 769                (regexp-quote s)
 770                "\\)[^/\\[:space:]]*\\([[:space:]]\\|$\\)"
 771                ))
 772
 773       (prj-goto-line prj-group-top)
 774       (setq beg (point))
 775       (setq end (point-max))
 776       (goto-char (max p beg))
 777
 778       (if (>= f 0)
 779           (setq fn 're-search-forward
 780                 start beg
 781                 limit end
 782                 )
 783           (setq fn 're-search-backward
 784                 start end
 785                 limit beg
 786                 ))
 787
 788       (catch 'loop
 789         (while t
 790           (beginning-of-line (max 1 (1+ f)))
 791           (cond ((funcall fn s limit t)
 792                  (throw 'loop (match-beginning 2))
 793                  )
 794                 (r
 795                  (throw 'loop nil)
 796                  )
 797                 ((setq r t)
 798                  (goto-char start)
 799                  )))))))
 800
 801 (defun prj-qs-next (f)
 802   (let (k l p a e n s)
 803     (setq p prj-qs-pos)
 804     (setq l prj-qs-len)
 805     (setq s prj-qs-str)
 806     (prj-qs-clear)
 807
 808     (setq k (length s))
 809     (if (= k 0)
 810         (setq l k)
 811         (progn
 812           (if (setq n (prj-qs-find s f (or p (point))))
 813               (setq p n l k)
 814               (setq s (substring s 0 l))
 815               )
 816           (message "Quick search: %s" s)
 817           ))
 818
 819     (when p
 820       (goto-char (+ p l))
 821       (prj-set-hilite-bar)
 822       (when (> l 0)
 823         (setq prj-qs-face (make-overlay p (+ p l)))
 824         (overlay-put prj-qs-face 'face '(:background "white" :box "black"))
 825
 826         (setq prj-qs-pos p)
 827         (setq prj-qs-len l)
 828         (setq prj-qs-str s)
 829
 830         (when (setq e (read-key-sequence nil))
 831           (setq e (listify-key-sequence e))
 832           (setq  unread-command-events (nconc e unread-command-events))
 833           (unless (lookup-key prj-browse-map (vconcat e) t)
 834             (prj-qs-clear)
 835             ))))
 836     ))
 837
 838 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 839 ;; eproject-config.el ends here