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 ;;;###autoload
  79 (defun eproject-setup ()
  80   "Show the configuration buffer."
  81   (interactive)
  82   (let ((map (make-keymap)))
  83
  84     (substitute-key-definition
  85       'self-insert-command
  86       'prj-qsearch
  87       map
  88       global-map
  89       )
  90
  91     (dolist (k '(
  92         ("\t" . prj-next-button)
  93         ([tab] . prj-next-button)
  94         ("\e\t" . prj-prev-button)
  95         ([S-tab] . prj-prev-button)
  96         ([backtab] . prj-prev-button)
  97
  98         ([left] . prj-move-left)
  99         ([right] . prj-move-right)
 100         ([backspace] . prj-qsearch)
 101         ([delete] . prj-qsearch)
 102         ([127] . prj-qsearch)
 103         ([return] . prj-enter)
 104
 105         ([32] . eproject-edit)
 106         ([escape] . eproject-setup-quit)
 107
 108         ([down-mouse-1] . prj-mouse)
 109         ([down-mouse-2] . prj-mouse)
 110         ([mouse-1] . prj-mouse)
 111         ([mouse-2] . prj-mouse)
 112         ([mouse-3] . ignore)
 113         ([drag-mouse-1] . ignore)
 114         ))
 115       (define-key map (car k) (cdr k))
 116       )
 117
 118     (cond ((buffer-live-p prj-buffer)
 119            (switch-to-buffer prj-buffer)
 120            )
 121           (t
 122            (unless prj-buffer
 123              (add-hook 'post-command-hook 'prj-post-command-hook)
 124              )
 125            (prj-config-init)
 126            (setq prj-buffer (get-buffer-create "*eproject*"))
 127            (switch-to-buffer prj-buffer)
 128            ))
 129
 130     (setq prj-browse-map map)
 131     (prj-qs-clear)
 132     (unless prj-edit-mode
 133       (use-local-map map)
 134       (prj-config-print)
 135       )
 136     ))
 137
 138 (defun eproject-setup-quit ()
 139   "Kill the configuration buffer."
 140   (interactive)
 141   (let ((alive (buffer-live-p prj-buffer)))
 142     (cond ((and alive prj-edit-mode)
 143            (bury-buffer prj-buffer)
 144            )
 145           (t
 146            (when alive
 147              (kill-buffer prj-buffer)
 148              )
 149            (remove-hook 'post-command-hook 'prj-post-command-hook)
 150            (setq prj-buffer nil)
 151            ))))
 152
 153 (defun eproject-setup-toggle ()
 154   "Show/hide the project configuration browser."
 155   (interactive)
 156   (if (prj-config-active)
 157       (eproject-setup-quit)
 158     (eproject-setup)
 159     ))
 160
 161 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 162 ;; Edit mode
 163
 164 (defun eproject-edit ()
 165   (interactive)
 166   (if (eq 'u (car prj-active-group)) (emacs-lisp-mode))
 167   (let ((map (make-sparse-keymap)))
 168     (define-key map [escape] 'eproject-edit-quit)
 169     (setq prj-edit-mode t)
 170     (prj-qs-clear)
 171     (use-local-map map)
 172     (prj-config-print)
 173     ))
 174
 175 (defun eproject-edit-quit ()
 176   (interactive)
 177   (if (eq 'u (car prj-active-group)) (fundamental-mode))
 178   (prj-config-parse)
 179   (use-local-map prj-browse-map)
 180   (setq prj-edit-mode nil)
 181   (setq cursor-type nil)
 182   (prj-set-hilite-bar)
 183   (prj-setup-all)
 184   )
 185
 186 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 187
 188 (defun prj-config-active ()
 189   (eq (current-buffer) prj-buffer)
 190   )
 191
 192 (defun prj-save-window-pos ()
 193   (p-set (prj-active-group . :pos)
 194      (list
 195       (window-start)
 196       (- (line-number-at-pos) prj-group-top)
 197       )))
 198
 199 (defun prj-config-reset ()
 200   (dolist (s prj-groups)
 201     (p-set (s . :pos) (list 1 0))
 202     )
 203   (setq prj-active-group (car prj-groups))
 204   )
 205
 206 (defun prj-config-init ()
 207   (dolist (v '(
 208       prj-buffer
 209       prj-browse-map
 210       prj-hilight-bar
 211       prj-hilight-bar-2
 212       prj-edit-mode
 213       ))
 214     (set v nil)
 215     ))
 216
 217 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 218 ;; Read back the configuration after edits
 219
 220 (defun prj-config-parse ()
 221   (when (and (prj-config-active) prj-edit-mode)
 222     (with-current-buffer prj-buffer
 223       (save-excursion
 224         (let ((s (p-get (prj-active-group . :scan))) l r e)
 225           (prj-goto-line prj-group-top)
 226           (if (eq 'u (car prj-active-group))
 227               (setq l (read (concat
 228                              "(("
 229                              (buffer-substring-no-properties (point) (point-max))
 230                              "))")))
 231               (progn
 232                 (while (< (point) (point-max))
 233                   (setq e (line-end-position))
 234                   (setq r
 235                     (if (and s (posix-search-forward (car s) e t))
 236                         (apply (cdr s) nil)
 237                         (and (re-search-forward "^ *\\(.*[^ :]\\)[ :]*$" e t)
 238                              (list (match-string-no-properties 1))
 239                              )))
 240                   (if r (setq l (cons r l)))
 241                   (forward-line 1)
 242                   )
 243                 (setq l (nreverse l))
 244                 ))
 245           (p-call (prj-active-group . :parse) l)
 246           )))))
 247
 248 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 249 ;; The project config window
 250
 251 ;; (makunbound 'prj-groups) (makunbound 'prj-links)
 252
 253 (defvar prj-groups `(
 254
 255    (p nil
 256       :title "Projects"
 257       :comment "All projects on a list"
 258       :pos (1 0)
 259       :list prj-list
 260       :exec eproject-open
 261       :print ,(lambda (a p)
 262                (prj-link (car a) nil a)
 263                (prj-link-2 nil p (cadr a))
 264                (and (caddr a) (prj-link-2 nil p (caddr a)))
 265                )
 266       :scan ("^ *\\([^ :]+\\) *: *\\([^ ]+\\) *\\( +: *\\([^ ]+\\)\\)? *$" .
 267               ,(lambda ()
 268                (let ((a (match-string-no-properties 1))
 269                      (b (match-string-no-properties 2))
 270                      (c (match-string-no-properties 4))
 271                      )
 272                 (cons a (cons b (and c (list c))))
 273                 )))
 274       :parse ,(lambda (s)
 275                (dolist (a s)
 276                  (unless (cadr a)
 277                    (error "Error: Project directory empty: %s" (car a))
 278                    )
 279                  (when prj-current
 280                    (when (string-equal (cadr a) (cadr prj-current))
 281                      (setq prj-current a)
 282                      (prj-setconfig "project-name" (car a))
 283                      )))
 284                (setq prj-list s)
 285                )
 286       :menu (add remove open close)
 287       )
 288
 289    (f nil
 290       :title "Files"
 291       :comment "The files that belong to the project"
 292       :pos (1 0)
 293       :list prj-files
 294       :exec eproject-visitfile
 295       :print ,(lambda (a p)
 296                (prj-link (car a) nil a)
 297                )
 298       :scan nil
 299       :parse ,(lambda (s)
 300                 (let (b)
 301                   (dolist (l s)
 302                     (setcdr l (cdr (assoc (car l) prj-files)))
 303                     )
 304                   (dolist (a prj-files)
 305                     (if (setq b (assoc (car a) s))
 306                         (if (eq a prj-curfile) (setq prj-curfile b))
 307                         (prj-remove-file a)
 308                         ))
 309                   (setq prj-files s)
 310                   ))
 311       :menu (add-file remove-file visit-file)
 312       )
 313
 314    (t nil
 315       :title "Tools"
 316       :comment "Configurable tools and keyboard shortcuts"
 317       :pos (1 0)
 318       :list prj-tools
 319       :exec prj-run-tool
 320       :print ,(lambda (a p)
 321                (prj-link (car a) nil a)
 322                (when (caddr a)
 323                  (unless prj-edit-mode
 324                    (insert-char 32 (- (- prj-group-tab 12) (- (point) p)))
 325                    )
 326                  (insert " (" (caddr a) ")")
 327                  )
 328                (prj-link-2 nil p (cadr a))
 329                )
 330       :scan ("^ *\\([^(:]*[^(: ]\\) *\\(([^ ):]+)\\)?\\( *: *\\(.*[^ ]\\)?\\)? *$" .
 331               ,(lambda ()
 332                  (let ((a (match-string-no-properties 1))
 333                        (b (match-string-no-properties 2))
 334                        (c (match-string-no-properties 4))
 335                        )
 336                    (list a c (and b (substring b 1 -1)))
 337                    )))
 338       :parse ,(lambda (s)
 339                (setq prj-tools s)
 340                )
 341       :menu ()
 342       )
 343
 344    (s nil
 345       :title "Settings"
 346       :comment "Project options"
 347       :pos (1 0)
 348       :list prj-config
 349       :exec eproject-edit
 350       :print ,(lambda (a p)
 351                (prj-link-2 (car a) p (cdr a))
 352                )
 353       :scan ("^ *\\([^ :]+\\) *: *\\(.*[^ ]\\)? *$" .
 354               ,(lambda ()
 355                  (list (match-string-no-properties 1)
 356                        (match-string-no-properties 2)
 357                        )))
 358       :parse ,(lambda (s)
 359                (dolist (l s) (setcdr l (cadr l)))
 360                (let ((prj-config s) n)
 361                  (setq n (prj-getconfig "project-name"))
 362                  (unless (> (length n) 0)
 363                    (error "Error: Project name empty.")
 364                    )
 365                  (when prj-current
 366                    (setcar prj-current n)
 367                    ))
 368                (setq prj-config s)
 369                (prj-update-config)
 370                )
 371       :menu ()
 372       )
 373
 374 ;;;    (u nil
 375 ;;;       :title "Functions"
 376 ;;;       :comment "ELisP Utitlities"
 377 ;;;       :pos (1 0)
 378 ;;;       :list prj-functions
 379 ;;;       :exec eproject-edit
 380 ;;;       :print ,(lambda (a p)
 381 ;;;                (pp a (current-buffer))
 382 ;;;                )
 383 ;;;       :parse ,(lambda (s)
 384 ;;;                 (prj-set-functions s)
 385 ;;;                )
 386 ;;;       :menu ()
 387 ;;;       )
 388    ))
 389
 390
 391 (defvar prj-links '(
 392
 393    ;; projects
 394    (add "Add" "Add new or existing project to the list"
 395          eproject-add
 396          )
 397    (remove "Remove" "Remove a project from the the list"
 398          eproject-remove
 399          )
 400    (open "Open" "Open a Project"
 401          eproject-open
 402          )
 403    (close "Close" "Close the current project"
 404          eproject-close
 405          )
 406
 407    ;; files
 408    (add-file "Add" "Add a file to the project"
 409          eproject-addfile
 410          )
 411    (remove-file "Remove" "Remove file from project"
 412          eproject-removefile
 413          )
 414    (dired "Dired" "Browse project directory - Use 'a' in dired to add file(s) to the project"
 415          eproject-dired
 416          )
 417    (visit-file "Visit" "Visit this file"
 418          eproject-visitfile
 419          )
 420
 421    ;; edit mode
 422    (edit "Edit" "Edit this list (spacebar)"
 423          eproject-edit
 424          )
 425    (quit-edit "Quit" "Quit edit mode (escape)"
 426          eproject-edit-quit
 427          )
 428    (revert "Revert" "Revert all configuration to last saved state"
 429          eproject-revert
 430          )
 431    (save "Save" "Save the configuration now"
 432          eproject-save
 433          )
 434
 435    ;; other
 436    (help "Help" "View the 'eproject' documentation."
 437          eproject-help
 438          )
 439    (quit "Quit" "Quit configuration area"
 440       eproject-setup-quit
 441       )
 442    ))
 443
 444 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 445 ;; Print the config
 446
 447 (defun prj-config-print ()
 448   (when (prj-config-active)
 449     (let (x f a n title l p (inhibit-read-only t) active)
 450
 451       (setq buffer-read-only nil)
 452       (buffer-disable-undo)
 453       (erase-buffer)
 454
 455       (setq prj-group-left (if prj-edit-mode 0 1))
 456       (setq prj-group-tab (+ 26 prj-group-left))
 457       (setq active
 458             (or prj-active-group
 459                 (setq prj-active-group (car prj-groups))
 460                 ))
 461       (insert "\n")
 462       (setq n 1)
 463       (dolist (s prj-groups)
 464         (setq f (eq s active))
 465         (when (or f (and prj-current (null prj-edit-mode)))
 466           (setq title (p-get (s . :title)))
 467           (insert-char 32 n)
 468           (cond (f
 469                  (setq p (point))
 470                  (insert title)
 471                  (prj-make-hilite-bar 'prj-hilight-bar-2 p (point))
 472                  )
 473                 (t
 474                  (prj-link title (p-get (s . :comment)) s t)
 475                  ))
 476           (setq n 2)
 477           ))
 478
 479       (dolist (s prj-links)
 480         (prj-define-shortcut nil (cadr s) 'ignore)
 481         )
 482       (dolist (s prj-groups)
 483         (prj-define-shortcut nil (symbol-name (car s)) 'prj-key-set-group)
 484         )
 485       (insert "  -")
 486       (dolist (id (if prj-edit-mode '(revert save quit-edit) '(edit help quit)))
 487          (insert "  ")
 488          (prj-link-3 id nil)
 489          )
 490       (insert "\n\n  -")
 491       (when prj-current
 492         (insert " " (car prj-current) " ")
 493         )
 494       (insert "-")
 495       (unless prj-edit-mode
 496         (dolist (id (p-get (active . :menu)))
 497           (insert "  ")
 498           (prj-link-3 id nil)
 499           )
 500         )
 501       (insert "\n\n")
 502
 503       (when prj-edit-mode
 504         (add-text-properties (point-min) (point)
 505            '(read-only t intangible t front-sticky t rear-nonsticky t))
 506         )
 507
 508       (setq prj-group-top (line-number-at-pos))
 509
 510       (prj-print-items
 511         (p-get (active . :print))
 512         (eval (p-get (active . :list)))
 513         prj-group-left
 514        )
 515
 516       (setq p (p-get (active . :pos)))
 517       (set-window-start (get-buffer-window prj-buffer) (car p))
 518       (prj-goto-line (+ prj-group-top (cadr p)))
 519       (unless (eobp)
 520         (forward-char prj-group-left)
 521         )
 522       (unless (pos-visible-in-window-p)
 523         (recenter (/ (window-height) 5))
 524         )
 525       (set-buffer-modified-p nil)
 526       (cond (prj-edit-mode
 527              (buffer-enable-undo)
 528              (setq cursor-type 'box)
 529              )
 530             (t
 531              (prj-set-hilite-bar)
 532              (setq buffer-read-only t)
 533              (setq cursor-type nil)
 534              ))
 535       t
 536       )))
 537
 538 (defun prj-print-items (fn items tab)
 539   (dolist (a items)
 540     (when (stringp (car a))
 541       (unless (and (string-match "^ *#" (car a)) (null prj-edit-mode))
 542         (insert-char 32 tab)
 543         ))
 544     (funcall fn a (- (point) tab))
 545     (insert "\n")
 546     ))
 547
 548 (defun prj-link (text help &optional fn top)
 549   (if (and prj-edit-mode (null help))
 550       (insert text)
 551       (let ((p (point)) (f (if top 'link)))
 552         (insert-text-button
 553          text
 554          'help-echo help
 555          'action 'prj-action
 556          'class (or fn 'link)
 557          'follow-link t
 558          'face f
 559          'mouse-face 'link
 560          )
 561         (when (or f help)
 562           (add-text-properties p (1+ p) '(face (:foreground "blue" :underline t)))
 563           )
 564         )))
 565
 566 (defun prj-link-2 (a p b)
 567   (if a (insert a))
 568   (insert-char 32 (- prj-group-tab 1 (- (point) p)))
 569   (if b (insert " : " b) (insert " :"))
 570   )
 571
 572 (defun prj-link-3 (id f)
 573   (let ((a (assq id prj-links)))
 574     (when a
 575       (prj-link (cadr a) (caddr a) a f)
 576       (prj-define-shortcut nil (cadr a) (nth 3 a))
 577     )))
 578
 579 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 580 ;; Project selection and configuration
 581
 582 (defun prj-action (b)
 583   (let ((a (button-get b 'class)))
 584     (cond ((memq a prj-links)
 585            (command-execute (nth 3 a))
 586            )
 587           ((memq a prj-groups)
 588            (setq prj-active-group a)
 589            (prj-config-print)
 590            )
 591           (t
 592            (p-call (prj-active-group . :exec) a)
 593            ))))
 594
 595 (defun prj-key-set-group ()
 596   (interactive)
 597   (let ((c (intern (char-to-string (logand last-input-event 255)))) s)
 598       (when (setq s (assoc c prj-groups))
 599         (setq prj-active-group s)
 600         (prj-config-print)
 601         )))
 602
 603 (defun prj-define-shortcut (map s fn)
 604   (let ((c (logior (aref s 0) 32)))
 605     (define-key
 606       (or map (current-local-map))
 607       (read (format "\"\\M-%c\"" c))
 608       fn
 609       )))
 610
 611 (defun prj-config-get-result (id)
 612   (and (prj-config-active)
 613        (eq id (car prj-active-group))
 614        (nth (cadr (p-get (prj-active-group . :pos)))
 615             (eval (p-get (prj-active-group . :list)))
 616             )))
 617
 618 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 619 ;; Tab between buttons and move files up/down
 620
 621 (defun prj-next-button ()
 622   (interactive)
 623   (if prj-qs-pos
 624       (prj-qs-next 1)
 625     ))
 626
 627 (defun prj-prev-button ()
 628   (interactive)
 629   (if prj-qs-pos
 630       (prj-qs-next -1)
 631   ))
 632
 633 (defun prj-move-left ()
 634   (interactive)
 635   (prj-move-to -1)
 636   )
 637
 638 (defun prj-move-right ()
 639   (interactive)
 640   (prj-move-to 1)
 641   )
 642
 643 (defun prj-move-to (d &optional cycle)
 644   (let ((n 0) (x 0))
 645     (dolist (s prj-groups)
 646       (if (eq s prj-active-group)
 647           (setq x n))
 648       (setq n (1+ n))
 649       )
 650     (setq x (+ x d))
 651     (unless prj-current (setq n 1))
 652     (if cycle
 653         (if (< x 0) (setq x (1- n)) (if (>= x n) (setq x 0)))
 654         (setq x (max 0 (min (1- n) x)))
 655         )
 656     (setq prj-active-group (nth x prj-groups))
 657     (prj-config-print)
 658     ))
 659
 660 (defun prj-enter ()
 661   (interactive)
 662   (let (a b)
 663     (and (setq b (button-at (point)))
 664          (setq a (button-get b 'action))
 665          (funcall a b)
 666          )))
 667
 668 (defun prj-mouse ()
 669   (interactive)
 670   ;;(message "LC: %s" (prin1-to-string last-input-event))
 671   (let ((i last-input-event) p b a x y tp)
 672     (when (consp i)
 673       (select-window (car (cadr i)))
 674       (setq p (nth 5 (cadr i)))
 675       (setq tp (nth 6 (cadr i)))
 676       (setq y (+ (cdr tp) (line-number-at-pos (window-start))))
 677       (setq x (+ (car tp) 1))
 678       (if (>= y prj-group-top)
 679           (prj-goto-line y)
 680         )
 681       (and (memq (car i) '(mouse-1 mouse-2))
 682            (setq b (button-at p))
 683            (setq a (button-get b 'action))
 684            (funcall a b)
 685            ))))
 686
 687 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 688 ;; A hook to maintain the selection bar
 689
 690 (defun prj-post-command-hook ()
 691   (and
 692    (prj-config-active)
 693    (prj-set-hilite-bar)
 694    ))
 695
 696 (defun prj-set-hilite-bar ()
 697   (unless prj-edit-mode
 698     ;;(message "LC: %s" (prin1-to-string (cons this-command last-input-event)))
 699     (let (n m a c e p)
 700       (setq m (length (eval (p-get (prj-active-group . :list)))))
 701       (setq p (line-number-at-pos))
 702       (setq n (max prj-group-top
 703                    (min (line-number-at-pos)
 704                         (1- (+ prj-group-top m))
 705                         )))
 706       (prj-goto-line n)
 707       (if (< p n)
 708           (set-window-start nil (point-min))
 709         )
 710       (unless (eobp)
 711         (setq a (point))
 712         (forward-char prj-group-left)
 713         (setq e (line-end-position))
 714         (when (< (setq c (+ a prj-group-tab)) e)
 715           (save-excursion
 716             (if (re-search-forward " *:" e t)
 717                 (setq e (1- (match-end 0)))
 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-event '(backspace 127))
 743                (substring prj-qs-str 0 (max 0 (1- (length prj-qs-str))))
 744                )
 745               ((eq last-command-event 'delete)
 746                ""
 747                )
 748               (t
 749                (concat prj-qs-str (char-to-string last-command-event))
 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 fn 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