eproject-config.el

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; eproject-config.el --- project workspaces for emacs --- UI part
   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 ;; 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-config-parse ()
 220   (when (and (prj-config-active) prj-edit-mode)
 221     (with-current-buffer prj-buffer
 222       (save-excursion
 223         (let ((s (p-get (prj-active-group . :scan))) l r e)
 224           (prj-goto-line prj-group-top)
 225           (if (eq 'u (car prj-active-group))
 226               (setq l (read (concat
 227                              "(("
 228                              (buffer-substring-no-properties (point) (point-max))
 229                              "))")))
 230               (progn
 231                 (while (< (point) (point-max))
 232                   (setq e (line-end-position))
 233                   (setq r
 234                     (if (and s (posix-search-forward (car s) e t))
 235                         (apply (cdr s) nil)
 236                         (and (re-search-forward "^ *\\(.*[^ :]\\)[ :]*$" e t)
 237                              (list (match-string-no-properties 1))
 238                              )))
 239                   (if r (setq l (cons r l)))
 240                   (forward-line 1)
 241                   )
 242                 (setq l (nreverse l))
 243                 ))
 244           (p-call (prj-active-group . :parse) l)
 245           )))))
 246
 247 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 248 ;; The project config window
 249
 250 ;; (makunbound 'prj-groups) (makunbound 'prj-links)
 251
 252 (defvar prj-groups `(
 253
 254    (p nil
 255       :title "Projects"
 256       :comment "All projects on a list"
 257       :pos (1 0)
 258       :list prj-list
 259       :exec eproject-open
 260       :print ,(lambda (a p)
 261                (prj-link (car a) nil a)
 262                (prj-link-2 nil p (cadr a))
 263                (and (caddr a) (prj-link-2 nil p (caddr a)))
 264                )
 265       :scan ("^ *\\([^ :]+\\) *: *\\([^ ]+\\) *\\( +: *\\([^ ]+\\)\\)? *$" .
 266               ,(lambda ()
 267                (let ((a (match-string-no-properties 1))
 268                      (b (match-string-no-properties 2))
 269                      (c (match-string-no-properties 4))
 270                      )
 271                 (cons a (cons b (and c (list c))))
 272                 )))
 273       :parse ,(lambda (s)
 274                (dolist (a s)
 275                  (unless (cadr a)
 276                    (error "Error: Project directory empty: %s" (car a))
 277                    )
 278                  (when prj-current
 279                    (when (string-equal (cadr a) (cadr prj-current))
 280                      (setq prj-current a)
 281                      (prj-setconfig "project-name" (car a))
 282                      )))
 283                (setq prj-list s)
 284                )
 285       :menu (add remove open close)
 286       )
 287
 288    (f nil
 289       :title "Files"
 290       :comment "The files that belong to the project"
 291       :pos (1 0)
 292       :list prj-files
 293       :exec eproject-visitfile
 294       :print ,(lambda (a p)
 295                (prj-link (car a) nil a)
 296                )
 297       :scan nil
 298       :parse ,(lambda (s)
 299                 (let (b)
 300                   (dolist (l s)
 301                     (setcdr l (cdr (assoc (car l) prj-files)))
 302                     )
 303                   (dolist (a prj-files)
 304                     (if (setq b (assoc (car a) s))
 305                         (if (eq a prj-curfile) (setq prj-curfile b))
 306                         (prj-remove-file a)
 307                         ))
 308                   (setq prj-files s)
 309                   ))
 310       :menu (add-file remove-file visit-file)
 311       )
 312
 313    (t nil
 314       :title "Tools"
 315       :comment "Configurable tools and keyboard shortcuts"
 316       :pos (1 0)
 317       :list prj-tools
 318       :exec prj-run-tool
 319       :print ,(lambda (a p)
 320                (prj-link (car a) nil a)
 321                (when (caddr a)
 322                  (unless prj-edit-mode
 323                    (insert-char 32 (- (- prj-group-tab 12) (- (point) p)))
 324                    )
 325                  (insert " (" (caddr a) ")")
 326                  )
 327                (prj-link-2 nil p (cadr a))
 328                )
 329       :scan ("^ *\\([^(:]*[^(: ]\\) *\\(([^ ):]+)\\)?\\( *: *\\(.*[^ ]\\)?\\)? *$" .
 330               ,(lambda ()
 331                  (let ((a (match-string-no-properties 1))
 332                        (b (match-string-no-properties 2))
 333                        (c (match-string-no-properties 4))
 334                        )
 335                    (list a c (and b (substring b 1 -1)))
 336                    )))
 337       :parse ,(lambda (s)
 338                (setq prj-tools s)
 339                )
 340       :menu ()
 341       )
 342
 343    (s nil
 344       :title "Settings"
 345       :comment "Project options"
 346       :pos (1 0)
 347       :list prj-config
 348       :exec eproject-edit
 349       :print ,(lambda (a p)
 350                (prj-link-2 (car a) p (cdr a))
 351                )
 352       :scan ("^ *\\([^ :]+\\) *: *\\(.*[^ ]\\)? *$" .
 353               ,(lambda ()
 354                  (list (match-string-no-properties 1)
 355                        (match-string-no-properties 2)
 356                        )))
 357       :parse ,(lambda (s)
 358                (dolist (l s) (setcdr l (cadr l)))
 359                (let ((prj-config s) n)
 360                  (setq n (prj-getconfig "project-name"))
 361                  (unless (> (length n) 0)
 362                    (error "Error: Project name empty.")
 363                    )
 364                  (when prj-current
 365                    (setcar prj-current n)
 366                    ))
 367                (setq prj-config s)
 368                (prj-update-config)
 369                )
 370       :menu ()
 371       )
 372
 373 ;;;    (u nil
 374 ;;;       :title "Functions"
 375 ;;;       :comment "ELisP Utitlities"
 376 ;;;       :pos (1 0)
 377 ;;;       :list prj-functions
 378 ;;;       :exec eproject-edit
 379 ;;;       :print ,(lambda (a p)
 380 ;;;                (pp a (current-buffer))
 381 ;;;                )
 382 ;;;       :parse ,(lambda (s)
 383 ;;;                 (prj-set-functions s)
 384 ;;;                )
 385 ;;;       :menu ()
 386 ;;;       )
 387    ))
 388
 389
 390 (defvar prj-links '(
 391
 392    ;; projects
 393    (add "Add" "Add new or existing project to the list"
 394          eproject-add
 395          )
 396    (remove "Remove" "Remove a project from the the list"
 397          eproject-remove
 398          )
 399    (open "Open" "Open a Project"
 400          eproject-open
 401          )
 402    (close "Close" "Close the current project"
 403          eproject-close
 404          )
 405
 406    ;; files
 407    (add-file "Add" "Add a file to the project"
 408          eproject-addfile
 409          )
 410    (remove-file "Remove" "Remove file from project"
 411          eproject-removefile
 412          )
 413    (dired "Dired" "Browse project directory - Use 'a' in dired to add file(s) to the project"
 414          eproject-dired
 415          )
 416    (visit-file "Visit" "Visit this file"
 417          eproject-visitfile
 418          )
 419
 420    ;; edit mode
 421    (edit "Edit" "Edit this list (spacebar)"
 422          eproject-edit
 423          )
 424    (quit-edit "Quit" "Quit edit mode (escape)"
 425          eproject-edit-quit
 426          )
 427    (revert "Revert" "Revert all configuration to last saved state"
 428          eproject-revert
 429          )
 430    (save "Save" "Save the configuration now"
 431          eproject-save
 432          )
 433
 434    ;; other
 435    (help "Help" "View the 'eproject' documentation."
 436          eproject-help
 437          )
 438    (quit "Quit" "Quit configuration area"
 439       eproject-setup-quit
 440       )
 441    ))
 442
 443 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 444 ;; Print the config
 445
 446 (defun prj-config-print ()
 447   (when (prj-config-active)
 448     (let (x f a n title l p (inhibit-read-only t) active)
 449
 450       (setq buffer-read-only nil)
 451       (buffer-disable-undo)
 452       (erase-buffer)
 453
 454       (setq prj-group-left (if prj-edit-mode 0 1))
 455       (setq prj-group-tab (+ 26 prj-group-left))
 456       (setq active
 457             (or prj-active-group
 458                 (setq prj-active-group (car prj-groups))
 459                 ))
 460       (insert "\n")
 461       (setq n 1)
 462       (dolist (s prj-groups)
 463         (setq f (eq s active))
 464         (when (or f (and prj-current (null prj-edit-mode)))
 465           (setq title (p-get (s . :title)))
 466           (insert-char 32 n)
 467           (cond (f
 468                  (setq p (point))
 469                  (insert title)
 470                  (prj-make-hilite-bar 'prj-hilight-bar-2 p (point))
 471                  )
 472                 (t
 473                  (prj-link title (p-get (s . :comment)) s t)
 474                  ))
 475           (setq n 2)
 476           ))
 477
 478       (dolist (s prj-links)
 479         (prj-define-shortcut nil (cadr s) 'ignore)
 480         )
 481       (dolist (s prj-groups)
 482         (prj-define-shortcut nil (symbol-name (car s)) 'prj-key-set-group)
 483         )
 484       (insert "  -")
 485       (dolist (id (if prj-edit-mode '(revert save quit-edit) '(edit help quit)))
 486          (insert "  ")
 487          (prj-link-3 id nil)
 488          )
 489       (insert "\n\n  -")
 490       (when prj-current
 491         (insert " " (car prj-current) " ")
 492         )
 493       (insert "-")
 494       (unless prj-edit-mode
 495         (dolist (id (p-get (active . :menu)))
 496           (insert "  ")
 497           (prj-link-3 id nil)
 498           )
 499         )
 500       (insert "\n\n")
 501
 502       (when prj-edit-mode
 503         (add-text-properties (point-min) (point)
 504            '(read-only t intangible t front-sticky t rear-nonsticky t))
 505         )
 506
 507       (setq prj-group-top (line-number-at-pos))
 508
 509       (prj-print-items
 510         (p-get (active . :print))
 511         (eval (p-get (active . :list)))
 512         prj-group-left
 513        )
 514
 515       (setq p (p-get (active . :pos)))
 516       (set-window-start (get-buffer-window prj-buffer) (car p))
 517       (prj-goto-line (+ prj-group-top (cadr p)))
 518       (unless (eobp)
 519         (forward-char prj-group-left)
 520         )
 521       (unless (pos-visible-in-window-p)
 522         (recenter (/ (window-height) 5))
 523         )
 524       (set-buffer-modified-p nil)
 525       (cond (prj-edit-mode
 526              (buffer-enable-undo)
 527              (setq cursor-type 'box)
 528              )
 529             (t
 530              (prj-set-hilite-bar)
 531              (setq buffer-read-only t)
 532              (setq cursor-type nil)
 533              ))
 534       t
 535       )))
 536
 537 (defun prj-print-items (fn items tab)
 538   (dolist (a items)
 539     (when (stringp (car a))
 540       (unless (and (string-match "^ *#" (car a)) (null prj-edit-mode))
 541         (insert-char 32 tab)
 542         ))
 543     (funcall fn a (- (point) tab))
 544     (insert "\n")
 545     ))
 546
 547 (defun prj-link (text help &optional fn top)
 548   (if (and prj-edit-mode (null help))
 549       (insert text)
 550       (let ((p (point)) (f (if top 'link)))
 551         (insert-text-button
 552          text
 553          'help-echo help
 554          'action 'prj-action
 555          'class (or fn 'link)
 556          'follow-link t
 557          'face f
 558          'mouse-face 'link
 559          )
 560         (when (or f help)
 561           (add-text-properties p (1+ p) '(face (:foreground "blue" :underline t)))
 562           )
 563         )))
 564
 565 (defun prj-link-2 (a p b)
 566   (if a (insert a))
 567   (insert-char 32 (- prj-group-tab 1 (- (point) p)))
 568   (if b (insert " : " b) (insert " :"))
 569   )
 570
 571 (defun prj-link-3 (id f)
 572   (let ((a (assq id prj-links)))
 573     (when a
 574       (prj-link (cadr a) (caddr a) a f)
 575       (prj-define-shortcut nil (cadr a) (nth 3 a))
 576     )))
 577
 578 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 579 ;; Project selection and configuration
 580
 581 (defun prj-action (b)
 582   (let ((a (button-get b 'class)))
 583     (cond ((memq a prj-links)
 584            (command-execute (nth 3 a))
 585            )
 586           ((memq a prj-groups)
 587            (setq prj-active-group a)
 588            (prj-config-print)
 589            )
 590           (t
 591            (p-call (prj-active-group . :exec) a)
 592            ))))
 593
 594 (defun prj-key-set-group ()
 595   (interactive)
 596   (let ((c (intern (char-to-string (logand last-input-event 255)))) s)
 597       (when (setq s (assoc c prj-groups))
 598         (setq prj-active-group s)
 599         (prj-config-print)
 600         )))
 601
 602 (defun prj-define-shortcut (map s fn)
 603   (let ((c (logior (aref s 0) 32)))
 604     (define-key
 605       (or map (current-local-map))
 606       (read (format "\"\\M-%c\"" c))
 607       fn
 608       )))
 609
 610 (defun prj-config-get-result (id)
 611   (and (prj-config-active)
 612        (eq id (car prj-active-group))
 613        (nth (cadr (p-get (prj-active-group . :pos)))
 614             (eval (p-get (prj-active-group . :list)))
 615             )))
 616
 617 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 618 ;; Tab between buttons and move files up/down
 619
 620 (defun prj-next-button ()
 621   (interactive)
 622   (if prj-qs-pos
 623       (prj-qs-next 1)
 624     ))
 625
 626 (defun prj-prev-button ()
 627   (interactive)
 628   (if prj-qs-pos
 629       (prj-qs-next -1)
 630   ))
 631
 632 (defun prj-move-left ()
 633   (interactive)
 634   (prj-move-to -1)
 635   )
 636
 637 (defun prj-move-right ()
 638   (interactive)
 639   (prj-move-to 1)
 640   )
 641
 642 (defun prj-move-to (d &optional cycle)
 643   (let ((n 0) (x 0))
 644     (dolist (s prj-groups)
 645       (if (eq s prj-active-group)
 646           (setq x n))
 647       (setq n (1+ n))
 648       )
 649     (setq x (+ x d))
 650     (unless prj-current (setq n 1))
 651     (if cycle
 652         (if (< x 0) (setq x (1- n)) (if (>= x n) (setq x 0)))
 653         (setq x (max 0 (min (1- n) x)))
 654         )
 655     (setq prj-active-group (nth x prj-groups))
 656     (prj-config-print)
 657     ))
 658
 659 (defun prj-enter ()
 660   (interactive)
 661   (let (a b)
 662     (and (setq b (button-at (point)))
 663          (setq a (button-get b 'action))
 664          (funcall a b)
 665          )))
 666
 667 (defun prj-mouse ()
 668   (interactive)
 669   ;;(message "LC: %s" (prin1-to-string last-input-event))
 670   (let ((i last-input-event) p b a x y tp)
 671     (when (consp i)
 672       (select-window (car (cadr i)))
 673       (setq p (nth 5 (cadr i)))
 674       (setq tp (nth 6 (cadr i)))
 675       (setq y (+ (cdr tp) (line-number-at-pos (window-start))))
 676       (setq x (+ (car tp) 1))
 677       (if (>= y prj-group-top)
 678           (prj-goto-line y)
 679         )
 680       (and (memq (car i) '(mouse-1 mouse-2))
 681            (setq b (button-at p))
 682            (setq a (button-get b 'action))
 683            (funcall a b)
 684            ))))
 685
 686 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 687 ;; A hook to maintain the selection bar
 688
 689 (defun prj-post-command-hook ()
 690   (and
 691    (prj-config-active)
 692    (prj-set-hilite-bar)
 693    ))
 694
 695 (defun prj-set-hilite-bar ()
 696   (unless prj-edit-mode
 697     ;;(message "LC: %s" (prin1-to-string (cons this-command last-input-event)))
 698     (let (n m a c e p)
 699       (setq m (length (eval (p-get (prj-active-group . :list)))))
 700       (setq p (line-number-at-pos))
 701       (setq n (max prj-group-top
 702                    (min (line-number-at-pos)
 703                         (1- (+ prj-group-top m))
 704                         )))
 705       (prj-goto-line n)
 706       (if (< p n)
 707           (set-window-start nil (point-min))
 708         )
 709       (unless (eobp)
 710         (setq a (point))
 711         (forward-char prj-group-left)
 712         (setq e (line-end-position))
 713         (when (< (setq c (+ a prj-group-tab)) e)
 714           (save-excursion
 715             (if (re-search-forward " *:" e t)
 716                 (setq e (1- (match-end 0)))
 717               )))
 718         (while (= (char-after) 32)
 719           (forward-char 1)
 720           )
 721         (prj-make-hilite-bar 'prj-hilight-bar (point) e)
 722         (prj-save-window-pos)
 723         ))))
 724
 725 (defun prj-make-hilite-bar (s a e)
 726   (let (b)
 727     (if (and (boundp s) (setq b (eval s)))
 728         (move-overlay b a e)
 729         (overlay-put
 730            (set s (make-overlay a e))
 731            'face '(:background "grey90" :foreground "blue")
 732            ))
 733     ))
 734
 735 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 736 ;; Quick Search
 737
 738 (defun prj-qsearch ()
 739   (interactive)
 740   (setq prj-qs-str
 741         (cond ((member last-command-event '(backspace 127))
 742                (substring prj-qs-str 0 (max 0 (1- (length prj-qs-str))))
 743                )
 744               ((eq last-command-event 'delete)
 745                ""
 746                )
 747               (t
 748                (concat prj-qs-str (char-to-string last-command-event))
 749                )))
 750   (prj-qs-next 0)
 751   )
 752
 753 (defun prj-qs-clear ()
 754   (when prj-qs-face
 755     (delete-overlay prj-qs-face)
 756     )
 757   (setq prj-qs-face nil)
 758   (setq prj-qs-pos nil)
 759   (setq prj-qs-str "")
 760   (setq prj-qs-len 0)
 761   )
 762
 763 (defun prj-qs-find (s f p)
 764   (save-excursion
 765     (let (r fn beg end start limit)
 766       (setq s (concat
 767                "^[[:space:]]*\\([^[:space:]]*[/\\]\\)?\\("
 768                (regexp-quote s)
 769                "\\)[^/\\[:space:]]*\\([[:space:]]\\|$\\)"
 770                ))
 771
 772       (prj-goto-line prj-group-top)
 773       (setq beg (point))
 774       (setq end (point-max))
 775       (goto-char (max p beg))
 776
 777       (if (>= f 0)
 778           (setq fn 're-search-forward
 779                 start beg
 780                 limit end
 781                 )
 782           (setq fn 're-search-backward
 783                 start end
 784                 limit beg
 785                 ))
 786
 787       (catch 'loop
 788         (while t
 789           (beginning-of-line (max 1 (1+ f)))
 790           (cond ((funcall fn s limit t)
 791                  (throw 'loop (match-beginning 2))
 792                  )
 793                 (r
 794                  (throw 'loop nil)
 795                  )
 796                 ((setq r t)
 797                  (goto-char start)
 798                  )))))))
 799
 800 (defun prj-qs-next (f)
 801   (let (k l p a e n s)
 802     (setq p prj-qs-pos)
 803     (setq l prj-qs-len)
 804     (setq s prj-qs-str)
 805     (prj-qs-clear)
 806
 807     (setq k (length s))
 808     (if (= k 0)
 809         (setq l k)
 810         (progn
 811           (if (setq n (prj-qs-find s f (or p (point))))
 812               (setq p n l k)
 813               (setq s (substring s 0 l))
 814               )
 815           (message "Quick search: %s" s)
 816           ))
 817
 818     (when p
 819       (goto-char (+ p l))
 820       (prj-set-hilite-bar)
 821       (when (> l 0)
 822         (setq prj-qs-face (make-overlay p (+ p l)))
 823         (overlay-put prj-qs-face 'face '(:background "white" :box "black"))
 824
 825         (setq prj-qs-pos p)
 826         (setq prj-qs-len l)
 827         (setq prj-qs-str s)
 828
 829         (when (setq e (read-key-sequence nil))
 830           (setq e (listify-key-sequence e))
 831           (setq  unread-command-events (nconc e unread-command-events))
 832           (unless (lookup-key prj-browse-map (vconcat e) t)
 833             (prj-qs-clear)
 834             ))))
 835     ))
 836
 837 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 838 ;; eproject-config.el ends here