Initial Commit
[temp.git] / site-lisp / cedet-1.0pre4 / ecb-2.32 / ecb-common-browser.el
blob1ba6040e7333cd9d479e7f6b9020d50251398d6f
1 ;;; ecb-common-browser.el --- common browsing stuff for Emacs
3 ;; Copyright (C) 2000 - 2005 Jesper Nordenberg,
4 ;; Klaus Berndl,
5 ;; Kevin A. Burton,
6 ;; Free Software Foundation, Inc.
8 ;; Author: Jesper Nordenberg <mayhem@home.se>
9 ;; Klaus Berndl <klaus.berndl@sdm.de>
10 ;; Kevin A. Burton <burton@openprivacy.org>
11 ;; Maintainer: Klaus Berndl <klaus.berndl@sdm.de>
12 ;; Keywords: browser, code, programming, tools
13 ;; Created: 2004
15 ;; This program is free software; you can redistribute it and/or modify it under
16 ;; the terms of the GNU General Public License as published by the Free Software
17 ;; Foundation; either version 2, or (at your option) any later version.
19 ;; This program is distributed in the hope that it will be useful, but WITHOUT
20 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
21 ;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
22 ;; details.
24 ;; You should have received a copy of the GNU General Public License along with
25 ;; GNU Emacs; see the file COPYING. If not, write to the Free Software
26 ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
28 ;; $Id: ecb-common-browser.el,v 1.21 2005/06/27 17:03:06 berndl Exp $
31 ;;; History
33 ;; For the ChangeLog of this file see the CVS-repository. For a complete
34 ;; history of the ECB-package see the file NEWS.
36 ;;; Code:
38 (eval-when-compile
39 (require 'silentcomp))
42 (require 'ecb-util)
44 (require 'tree-buffer)
45 ;; (require 'ecb-layout) ;; causes cyclic dependencies!
46 (require 'ecb-mode-line)
48 ;; various loads
49 (require 'assoc)
51 (eval-when-compile
52 ;; to avoid compiler grips
53 (require 'cl))
55 (silentcomp-defvar modeline-map)
57 (defgroup ecb-tree-buffer nil
58 "General settings related to the tree-buffers of ECB."
59 :group 'ecb
60 :prefix "ecb-")
62 (defcustom ecb-bucket-node-display '("" "" ecb-bucket-node-face)
63 "*How ECB displays bucket-nodes in a ECB tree-buffer.
64 Bucket-nodes have only one job: Nodes with similar properties will be dropped
65 into one bucket for such a common property and all these nodes will be added
66 as children to the bucket-node. Besides being expandable and collapsable a
67 bucket-node has no senseful action assigned. Examples for bucket-nodes are
68 \"[+] Variables\", \"[+] Dependencies\" etc. in the Methods-buffer or buckets
69 which combine filenames with same extension under a bucket-node with name this
70 extension.
72 This option defines how bucket-node should be displayed. The name of the
73 bucket-node is computed by ECB but you can define a prefix, a suffix and a
74 special face for the bucket-node
76 The default are empty prefix/suffix-strings and 'ecb-bucket-node-face'. But
77 an alternative can be for example '\(\"[\" \"]\" nil) which means no special
78 face and a display like \"[+] [<bucket-name>]\"."
79 :group 'ecb-general
80 :set (function (lambda (symbol value)
81 (set symbol value)
82 (ecb-clear-tag-tree-cache)))
83 :type '(list (string :tag "Bucket-prefix" :value "[")
84 (string :tag "Bucket-suffix" :value "]")
85 (choice :tag "Bucket-face" :menu-tag "Bucket-face"
86 (const :tag "No special face" :value nil)
87 (face :tag "Face" :value ecb-bucket-node-face)))
88 :initialize 'custom-initialize-default)
90 (defcustom ecb-use-speedbar-instead-native-tree-buffer nil
91 "*If true then uses speedbar for directories, sources or methods.
92 This means that speedbar is integrated in the ECB-frame and is displayed in
93 that window normally displaying the standard ECB-directories-buffer,
94 ECB-sources-buffer or ECB-methods-buffer.
96 This option takes effect in all layouts which contain either a directory
97 window, a sources window or a method window.
99 This option can have four valid values:
100 - nil: Do not use speedbar \(default)
101 - dir: Use speedbar instead of the standard directories-buffer
102 - source: Use speedbar instead of the standard sources-buffer
103 - method: Use speedbar instead of the standard methods-buffer
105 Note: For directories and sources a similar effect and usability is available
106 by setting this option to nil \(or 'method) and setting
107 `ecb-show-sources-in-directories-buffer' to not nil, because this combination
108 displays also directories and sources in one window.
110 `ecb-use-speedbar-instead-native-tree-buffer' is for people who like the
111 speedbar way handling directories and source-files or methods and want it in
112 conjunction with ECB."
113 :group 'ecb-general
114 :group 'ecb-directories
115 :group 'ecb-sources
116 :group 'ecb-methods
117 :type '(radio (const :tag "Do not use speedbar" :value nil)
118 (const :tag "For directories" :value dir)
119 (const :tag "For sources" :value source)
120 (const :tag "For methods" :value method))
121 :initialize 'custom-initialize-default
122 :set (function (lambda (sym val)
123 (set sym val)
124 (if (and (boundp 'ecb-minor-mode) ecb-minor-mode)
125 (ecb-redraw-layout-full)))))
127 (defvar ecb-tree-do-not-leave-window-after-select--internal nil
128 "Only set by customizing `ecb-tree-do-not-leave-window-after-select' or
129 calling `ecb-toggle-do-not-leave-window-after-select'! Do not set this
130 variable directly, it is only for internal uses!")
132 (defcustom ecb-tree-do-not-leave-window-after-select nil
133 "*Tree-buffers which stay selected after a key- or mouse-selection.
134 If a buffer \(either its name or the variable-symbol which holds the name) is
135 contained in this list then selecting a tree-node either by RET or by a
136 mouse-click doesn't leave that tree-buffer after the node-selection but
137 performes only the appropriate action \(opening a new source, selecting a
138 method etc.) but point stays in the tree-buffer. In tree-buffers not contained
139 in this option normaly a node-selection selects as \"last\" action the right
140 edit-window or maximizes the next senseful tree-buffer in case of a currently
141 maximized tree-buffer \(see `ecb-maximize-next-after-maximized-select').
143 The buffer-name can either be defined as plain string or with a symbol which
144 contains the buffer-name as value. The latter one is recommended for the
145 builtin ECB-tree-buffers because then simply the related option-symbol can be
146 used.
148 A special remark for the `ecb-directories-buffer-name': Of course here the
149 value of this option is only relevant if the name of the current layout is
150 contained in `ecb-show-sources-in-directories-buffer' or if the value of
151 `ecb-show-sources-in-directories-buffer' is 'always and the clicked ot hitted
152 node represents a sourcefile \(otherwise this would not make any sense)!
154 The setting in this option is only the default for each tree-buffer. With the
155 command `ecb-toggle-do-not-leave-window-after-select' the behavior of a
156 node-selection can be changed fast and easy in a tree-buffer without
157 customizing this option, but of course not for future Emacs sessions!"
158 :group 'ecb-tree-buffer
159 :set (function (lambda (sym val)
160 (set sym val)
161 (setq ecb-tree-do-not-leave-window-after-select--internal
162 (ecb-copy-list val))))
163 :type '(repeat (choice :menu-tag "Buffer-name"
164 (string :tag "Buffer-name as string")
165 (symbol :tag "Symbol holding buffer-name"))))
168 (defcustom ecb-tree-indent 4
169 "*Indent size for tree buffer.
170 If you change this during ECB is activated you must deactivate and activate
171 ECB again to take effect."
172 :group 'ecb-tree-buffer
173 :group 'ecb-most-important
174 :type 'integer)
176 (defcustom ecb-tree-expand-symbol-before t
177 "*Show the expand symbol before the items in a tree.
178 When the expand-symbol is located before the items then the tree looks like:
180 \[-] ECB
181 \[+] code-save
182 \[-] ecb-images
183 \[-] directories
185 When located after then the tree looks like:
187 ECB \[-]
188 code-save \[+]
189 ecb-images \[-]
190 directories \[-]
192 The after-example above use a value of 2 for `ecb-tree-indent' whereas the
193 before-example uses a value of 4.
195 It is recommended to display the expand-symbol before because otherwise it
196 could be that with a deep nested item-structure with and/or with long
197 item-names \(e.g. a deep directory-structure with some long
198 subdirectory-names) the expand-symbol is not visible in the tree-buffer and
199 the tree-buffer has to be horizontal scrolled to expand an item."
200 :group 'ecb-tree-buffer
201 :group 'ecb-most-important
202 :type 'boolean)
205 (defcustom ecb-tree-buffer-style (if ecb-images-can-be-used
206 'image
207 'ascii-guides)
208 "*The style of the tree-buffers.
209 There are three different styles available:
211 Image-style \(value 'image):
212 Very nice and modern - just try it. For this style the options
213 `ecb-tree-indent' and `ecb-tree-expand-symbol-before' have no effect!
214 Note: GNU Emacs <= 21.3.X for Windows does not support image-display so ECB
215 uses always 'ascii-guides even when here 'image is set!
217 Ascii-style with guide-lines \(value 'ascii-guides):
218 \[-] ECB
219 | \[+] code-save
220 `- \[-] ecb-images
221 | \[-] directories
222 | | \[-] height-15
223 | | | * close.xpm
224 | | | * empty.xpm
225 | | | * leaf.xpm
226 | | `- * open.xpm
227 | | \[+] height-17
228 | | \[+] height-19
229 | `- \[+] height-21
230 | \[x] history
231 | \[x] methods
232 `- \[x] sources
234 Ascii-style without guide-lines \(value 'ascii-no-guides) - this is the style
235 used by ECB <= 1.96:
236 \[-] ECB
237 \[+] code-save
238 \[-] ecb-images
239 \[-] directories
240 \[-] height-15
241 * close.xpm
242 * empty.xpm
243 * leaf.xpm
244 * open.xpm
245 \[+] height-17
246 \[+] height-19
247 \[+] height-21
248 \[x] history
249 \[x] methods
250 \[x] sources
252 With both ascii-styles the tree-layout can be affected with the options
253 `ecb-tree-indent' and `ecb-tree-expand-symbol-before'."
254 :group 'ecb-tree-buffer
255 :group 'ecb-most-important
256 :type '(radio (const :tag "Images-style" :value image)
257 (const :tag "Ascii-style with guide-lines" :value ascii-guides)
258 (const :tag "Ascii-style w/o guide-lines" :value ascii-no-guides)))
260 ;; TODO: Klaus Berndl <klaus.berndl@sdm.de>: add here the analyse buffer if
261 ;; additonal images are necessary - but currently i don't think we need
262 ;; special images for this analyse-stuff.
263 (defcustom ecb-tree-image-icons-directories
264 (let ((base (concat (if ecb-regular-xemacs-package-p
265 (format "%s" (locate-data-directory "ecb"))
266 ecb-ecb-dir)
267 "ecb-images/")))
268 (cons (concat base "default/height-17")
269 (mapcar (function (lambda (i)
270 (cons (car i) (concat base (cdr i)))))
271 '((ecb-directories-buffer-name . "directories/height-17")
272 (ecb-sources-buffer-name . "sources/height-14_to_21")
273 (ecb-methods-buffer-name . "methods/height-14_to_21")))))
274 "*Directories where the images for the tree-buffer can be found.
275 This is a cons cell where:
277 car: Default directory where the default images for the tree-buffer can be
278 found. It should contain an image for every name of
279 `tree-buffer-tree-image-names'. The name of an image-file must be:
280 \"ecb-<NAME of TREE-BUFFER-TREE-IMAGE-NAMES>.<ALLOWED EXTENSIONS>\".
282 cdr: This is a list where each element is a cons again with: car is the buffer
283 name of the tree-buffer for which a special image-path should be used. The
284 buffer-name can either be defined as plain string or with a symbol which
285 contains the buffer-name as value. The latter one is recommended for the
286 builtin ECB-tree-buffers because then simply the related option-symbol can be
287 used \(e.g. the symbol `ecb-directories-buffer-name'). The cdr is the the
288 full-path of an additional image-directorie which is searched first for images
289 needed for the related tree-buffer. If the image can not be found in this
290 directory then the default-directory \(see above) is searched. If the
291 image can't even be found there the related ascii-symbol is used - which is
292 defined in `tree-buffer-tree-image-names'. If a tree-buffer is not contained
293 in this list then there is no additional special image-directory for it.
295 ECB comes with predefined images in several different heights - so for the
296 most senseful font-heights of a tree-buffer a fitting image-size should be
297 available. The images reside either in the subdirectory \"ecb-images\" of the
298 ECB-installation or - if ECB is installed as regular XEmacs-package - in the
299 ECB-etc data-directory \(the directory returned by \(locate-data-directory
300 \"ecb\")."
301 :group 'ecb-tree-buffer
302 :type '(cons (directory :tag "Full default image-path")
303 (repeat (cons (choice :menu-tag "Buffer-name"
304 (string :tag "Buffer-name as string")
305 (symbol :tag "Symbol holding
306 buffer-name"))
307 (directory :tag "Full image-path for this tree-buffer")))))
309 (defcustom ecb-tree-truncate-lines '(ecb-directories-buffer-name
310 ecb-sources-buffer-name
311 ecb-methods-buffer-name
312 ecb-history-buffer-name
313 ecb-analyse-buffer-name)
314 "*Truncate lines in ECB buffers.
315 If a buffer \(either its name or the variable-symbol which holds the name) is
316 contained in this list then line-truncation is switched on for this buffer
317 otherwise it is off.
319 The buffer-name can either be defined as plain string or with a symbol which
320 contains the buffer-name as value. The latter one is recommended to switch on
321 line-truncation for one of the builtin ECB-tree-buffers because then simply
322 the related option-symbol can be used. To truncate lines in the builtin
323 directories tree-buffer just add the symbol `ecb-directories-buffer-name' to
324 this option.
326 If you change this during ECB is activated you must deactivate and activate
327 ECB again to take effect."
328 :group 'ecb-tree-buffer
329 :group 'ecb-most-important
330 :type '(repeat (choice :menu-tag "Buffer-name"
331 (string :tag "Buffer-name as string")
332 (symbol :tag "Symbol holding buffer-name"))))
334 (defcustom ecb-tree-easy-hor-scroll 5
335 "*Scroll step for easy hor. scrolling via mouse-click in tree-buffers.
336 XEmacs has horizontal scroll-bars so invisible parts beyond the right
337 window-border of a tree-buffer can always made visible very easy.
339 GNU Emacs does not have hor. scroll-bars so especially with the mouse it is
340 quite impossible to scroll smoothly right and left. The functions
341 `scroll-left' and `scroll-right' can be annoying and are also not bound to
342 mouse-buttons.
344 If this option is a positive integer S then in all ECB-tree-buffers the keys
345 \[M-mouse-1] and \[M-mouse-3] are bound to scrolling left rsp. right with
346 scroll-step S - clicking with mouse-1 or mouse-2 onto the edge of the modeline
347 has the same effect, i.e. if you click with mouse-1 onto the left \(rsp.
348 right) edge of the modeline you will scroll left \(rsp. right). Additionally
349 \[C-M-mouse-1] and \[C-M-mouse-3] are bound to scrolling left rsp. right with
350 scroll-step `window-width' - 2. Default is a scroll-step of 5. If the value is
351 nil then no keys for horizontal scrolling are bound."
352 :group 'ecb-tree-buffer
353 :type '(radio :value 5
354 (const :tag "No hor. mouse scrolling" :value nil)
355 (integer :tag "Scroll step")))
357 ;; TODO: Klaus Berndl <klaus.berndl@sdm.de>: maybe we should change this to a
358 ;; type analogous to ecb-tree-truncate-lines
359 (defcustom ecb-truncate-long-names t
360 "*Truncate long names that don't fit in the width of the ECB windows.
361 If you change this during ECB is activated you must deactivate and activate
362 ECB again to take effect."
363 :group 'ecb-tree-buffer
364 :group 'ecb-most-important
365 :type 'boolean)
367 (defcustom ecb-tree-incremental-search 'prefix
368 "*Enable incremental search in the ECB-tree-buffers.
369 For a detailed explanation see the online help section \"Working with the
370 keyboard in the ECB buffers\". If you change this during ECB is activated you
371 must deactivate and activate ECB again to take effect."
372 :group 'ecb-tree-buffer
373 :type '(radio (const :tag "Match only prefix"
374 :value prefix)
375 (const :tag "Match every substring"
376 :value substring)
377 (const :tag "No incremental search"
378 :value nil)))
380 (defcustom ecb-tree-navigation-by-arrow t
381 "*Enable smart navigation in the tree-windows by horizontal arrow-keys.
382 If not nil then the left- and right-arrow keys work in the ECB tree-window in
383 the following smart way if onto an expandable node:
384 + Left-arrow: If node is expanded then it will be collapsed otherwise point
385 jumps to the next \"higher\" node in the hierarchical tree \(higher means
386 the next higher tree-level or - if no higher level available - the next
387 higher node on the same level).
388 + Right-arrow: If node is not expanded then it will be expanded.
389 Onto a not expandable node the horizontal arrow-keys go one character in the
390 senseful correct direction.
392 If this option is changed the new value takes first effect after deactivating
393 ECB and then activating it again!"
394 :group 'ecb-tree-buffer
395 :type 'boolean)
397 (defun ecb-show-any-node-info-by-mouse-moving-p ()
398 "Return not nil if for at least one tree-buffer showing node info only by
399 moving the mouse over a node is activated. See
400 `ecb-directories-show-node-info' etc...."
401 (let ((when-list (mapcar (function (lambda (elem)
402 (car (symbol-value elem))))
403 '(ecb-directories-show-node-info
404 ecb-sources-show-node-info
405 ecb-methods-show-node-info
406 ecb-history-show-node-info
407 ecb-analyse-show-node-info
408 ))))
409 (or (member 'if-too-long when-list)
410 (member 'always when-list))))
412 (defcustom ecb-primary-secondary-mouse-buttons 'mouse-2--C-mouse-2
413 "*Primary- and secondary mouse button for using the ECB-buffers.
414 A click with the primary button causes the main effect in each ECB-buffer:
415 - ECB Directories: Expanding/collapsing nodes and displaying files in the ECB
416 Sources buffer.
417 - ECB sources/history: Opening the file in that edit-window specified by the
418 option `ecb-mouse-click-destination'.
419 - ECB Methods: Jumping to the method in that edit-window specified by the
420 option `ecb-mouse-click-destination'.
422 A click with the primary mouse-button while the SHIFT-key is pressed called
423 the POWER-click and does the following \(depending on the ECB-buffer where the
424 POWER-click occurs):
425 + Directory-buffer: Refreshing the directory-contents-cache \(see
426 `ecb-cache-directory-contents').
427 + Sources- and History-buffer: Only displaying the source-contents in the
428 method-buffer but not displaying the source-file in the edit-window.
429 + Methods-buffer: Narrowing to the clicked method/variable/ect... \(see
430 `ecb-tag-visit-post-actions'). This works only for sources supported by
431 semantic!
433 In addition always the whole node-name is displayed in the minibuffer after a
434 POWER-click \(for this see `ecb-directories-show-node-info' etc...).
436 The secondary mouse-button is for opening \(jumping to) the file in another
437 edit-window \(see the documentation `ecb-mouse-click-destination').
439 The following combinations are possible:
440 - primary: mouse-2, secondary: C-mouse-2 \(means mouse-2 while CTRL-key is
441 pressed). This is the default setting.
442 - primary: mouse-1, secondary: C-mouse-1
443 - primary: mouse-1, secondary: mouse-2
445 Note: If the tree-buffers are used with the keyboard instead with the mouse
446 then [RET] is interpreted as primary mouse-button and [C-RET] as secondary
447 mouse-button!
449 If you change this during ECB is activated you must deactivate and activate
450 ECB again to take effect!"
451 :group 'ecb-tree-buffer
452 :group 'ecb-most-important
453 :type '(radio (const :tag "Primary: mouse-2, secondary: Ctrl-mouse-2"
454 :value mouse-2--C-mouse-2)
455 (const :tag "Primary: mouse-1, secondary: Ctrl-mouse-1"
456 :value mouse-1--C-mouse-1)
457 (const :tag "Primary: mouse-1, secondary: mouse-2"
458 :value mouse-1--mouse-2)))
460 (defcustom ecb-tree-mouse-action-trigger 'button-release
461 "*When the tree-buffer mouse-action should be triggered.
462 This option determines the moment a mouse-action in a tree-buffer is
463 triggered. This can be either direct after pressing a mouse-button \(value
464 'button-press) or not until releasing the mouse-button \(value:
465 'button-release).
467 If you change this during ECB is activated you must deactivate and activate
468 ECB again to take effect!"
469 :group 'ecb-tree-buffer
470 :type '(radio (const :tag "After button release" :value button-release)
471 (const :tag "After button press" :value button-press)))
473 (defcustom ecb-mouse-click-destination 'last-point
474 "*Destination of a mouse-button click.
475 Defines in which edit-window \(if splitted) ECB does the \"right\" action
476 \(opening a source, jumping to a method/variable etc.) after clicking with a
477 mouse-button \(see `ecb-primary-secondary-mouse-buttons') onto a node. There
478 are two possible choices:
479 - left-top: Does the \"right\" action always in the left/topmost edit-window.
480 - last-point: Does the \"right\" action always in that edit-window which had
481 the point before.
482 This is if the user has clicked either with the primary mouse-button or
483 has activated a popup-menu in the tree-buffer.
485 A click with the secondary mouse-button \(see again
486 `ecb-primary-secondary-mouse-buttons') does the \"right\" action always in
487 another edit-window related to the setting in this option: If there are two
488 edit-windows then the \"other\" edit-window is used and for more than 2
489 edit-windows the \"next\" edit-window is used \(whereas the next edit-window
490 of the last edit-window is the first edit-window).
492 If the edit-window is not splitted this setting has no effect.
494 Note: If the tree-buffers are used with the keyboard instead with the mouse
495 then this option takes effect too because [RET] is interpreted as primary
496 mouse-button and [C-RET] as secondary mouse-button!"
497 :group 'ecb-general
498 :group 'ecb-most-important
499 :type '(radio (const :tag "Left/topmost edit-window"
500 :value left-top)
501 (const :tag "Last edit-window with point"
502 :value last-point)))
505 (defcustom ecb-common-tree-buffer-after-create-hook nil
506 "*Local hook running at the end of each tree-buffer creation.
507 Every function of this hook is called once without arguments direct after
508 creating a tree-buffer of ECB and it's local key-map. So for example a function
509 could be added which performs calls of `local-set-key' to define new
510 key-bindings for EVERY tree-buffer.
512 The following keys must not be rebind in all tree-buffers:
513 - <RET> and all combinations with <Shift> and <Ctrl>
514 - <TAB>
515 - `C-t'"
516 :group 'ecb-tree-buffer
517 :type 'hook)
519 ;;====================================================
520 ;; Internals
521 ;;====================================================
523 ;; all defined tree-buffer creators
525 (defvar ecb-tree-buffer-creators nil
526 "The tree-buffer creators of ECB.
527 An alist where each element is a cons where the car is a symbol which contains
528 the name of a tree-buffer \(e.g. `ecb-sources-buffer-name') and the cdr is the
529 associated function-symbol which creates the tree-buffer with that name.")
531 (defun ecb-tree-buffer-creators-init ()
532 "Initialize `ecb-tree-buffer-creators'.
533 Removes all creators and set it to nil."
534 (setq ecb-tree-buffer-creators nil))
536 (defun ecb-tree-buffer-creators-register (name-symbol fn)
537 "Register the creator-function FN for the tree-buffer NAME-SYMBOL."
538 (add-to-list 'ecb-tree-buffer-creators (cons name-symbol fn)))
540 (defun ecb-tree-buffer-creators-run ()
541 "Run all currently registered creator-functions."
542 (dolist (creator-elem ecb-tree-buffer-creators)
543 ;; create all the tree-buffers if they don't already exist
544 (funcall (cdr creator-elem))))
547 (defmacro defecb-tree-buffer-creator (creator
548 tree-buffer-name-symbol
549 docstring &rest body)
550 "Define a creator-function CREATOR for a tree-buffer which name is hold in
551 the symbol TREE-BUFFER-NAME-SYMBOL. Do not quote CREATOR and
552 TREE-BUFFER-NAME-SYMBOL. DOCSTRING is the docstring for CREATOR. BODY is all
553 the program-code of CREATOR \(must contain a call to `tree-buffer-create'). It
554 makes sense that BODY returns the created tree-buffer.
556 When creating a tree-buffer with this macro then this tree-buffer will be
557 automatically created \(i.e. its creator-function defined with this macro will
558 be called) when activating ECB and the tree-buffer will automatically
559 registered at ECB. This means that some features of ECB will work
560 automatically out of the box with this tree-buffer.
562 When creating a tree-buffer for ECB then it MUST be created with this macro
563 and not with `tree-buffer-create'!"
564 `(eval-and-compile
565 (ecb-tree-buffer-creators-register (quote ,tree-buffer-name-symbol)
566 (quote ,creator))
567 (defun ,creator ()
568 ,docstring
569 (unless (ecb-tree-buffers-get-symbol ,tree-buffer-name-symbol)
570 (ecb-tree-buffers-add ,tree-buffer-name-symbol
571 (quote ,tree-buffer-name-symbol))
572 ,@body))))
574 (put 'defecb-tree-buffer-creator 'lisp-indent-function 2)
576 ;; all created tree-buffers
578 (defvar ecb-tree-buffers nil
579 "The tree-buffers of ECB.
580 An alist with a cons for each created \(do not confuse created with visible!)
581 tree-buffer where the car is the name of the tree-buffer and the cdr is the
582 associated symbol which contains this name.")
584 (defsubst ecb-tree-buffers-init ()
585 (setq ecb-tree-buffers nil))
587 (defsubst ecb-tree-buffers-add (name name-symbol)
588 (unless (ecb-find-assoc name ecb-tree-buffers)
589 (setq ecb-tree-buffers
590 (ecb-add-assoc (cons name name-symbol) ecb-tree-buffers))))
592 (defsubst ecb-tree-buffers-name-list ()
593 (mapcar (function (lambda (e) (car e))) ecb-tree-buffers))
595 (defsubst ecb-tree-buffers-symbol-list ()
596 (mapcar (function (lambda (e) (cdr e))) ecb-tree-buffers))
598 (defsubst ecb-tree-buffers-buffer-list ()
599 (mapcar (function (lambda (e) (get-buffer (car e)))) ecb-tree-buffers))
601 (defsubst ecb-tree-buffers-get-symbol (name)
602 (ecb-find-assoc-value name ecb-tree-buffers))
606 ;; the filename/path cache
608 (defecb-multicache ecb-filename-cache 500 nil '(FILES-AND-SUBDIRS
609 EMPTY-DIR-P
610 SOURCES
612 FIXED-FILENAMES
613 REMOTE-PATH
614 HOST-ACCESSIBLE)
615 "Cache used for the filebrowser to cache all necessary informations
616 associated to file- or directory-names.
618 Currently there are three subcaches managed within this cache:
620 FILES-AND-SUBDIRS:
622 Cache for every directory all subdirs and files. This is a cache with
623 key: <directory>
624 value: \(<file-list> . <subdirs-list>)
626 EMPTY-DIR-P:
628 Cache for every directory if it is empty or not. This is a cache with
629 key: <directory>
630 value: \(\[nil|t] . <checked-with-show-sources>)
632 SOURCES:
634 Cache for the contents of the buffer `ecb-sources-buffer-name'. This is a
635 cache with
636 key: <directory>
637 value: \(<full-content> . <filtered-content>)
638 whereas <full-content> is a 3-elem list \(tree-buffer-root <copy of
639 tree-buffer-displayed-nodes> buffer-string) for a full \(i.e. all files)
640 cache and <filtered-content> is a 4-elem list \(tree-buffer-root <copy of
641 tree-buffer-displayed-nodes> sources-buffer-string <filter>) for a filtered
642 cache where <filter> is a cons-cell \(<filter-regexp> . <filter-display>).
646 Cache necessary informations for the version-control-support. This is a
647 cache for filenames and directories. In case of a file with
648 key: <filename> of a sourcefile
649 value: \(<state> <check-timestamp> <checked-buffers>)
650 whereas <state> is the that VC-state the file had at time <check-timestamp>.
651 <checked-buffers> is a list of tree-buffer-names for which <state> was
652 checked.
653 In case of a directory with
654 key: <dirname> of a directory
655 value: <vc-state-fcn> or 'NO-VC
656 <vc-state-fcn> is the function used to get the VC-state if <check-timestamp>
657 is older than the most recent modification-timestamp of <filename>.
659 FIXED-FILENAMES:
661 Cache for fixed filenames which can speedup handling-remote-paths \(like
662 tramp-paths)
663 key: The concatenation of the args PATH and FILENAME of `ecb-fix-filename'.
664 value: The result of `ecb-fix-filename' for these args.
666 REMOTE-PATH:
668 Cache if a path is a remote path and store its components if yes.
669 key: a path
670 value: 'NOT-REMOTE if not a remote path otherwise the result of
671 `ecb-remote-path'.
673 HOST-ACCESSIBLE:
675 Cache if a host is accessible or not.
676 key: a host \(e.g. ecb.sourceforge.net)
677 value: \(<timestamp> . <value>) whereas <timestamp> is the cache time of
678 <value> and <value> is either 'NOT-ACCESSIBLE if host is not accessible
679 or t if accessible.
682 (defun ecb-filename-cache-init ()
683 "Initialize the whole cache for file- and directory-names"
684 (if (ecb-multicache-p 'ecb-filename-cache)
685 (ecb-multicache-clear 'ecb-filename-cache)))
687 ;; directory separator
689 (defconst ecb-directory-sep-char
690 (if ecb-running-xemacs directory-sep-char ?/))
692 (defsubst ecb-directory-sep-char (&optional refdir)
693 (if (or (null refdir)
694 (not (ecb-remote-path refdir)))
695 ecb-directory-sep-char
696 ?/))
698 (defsubst ecb-directory-sep-string (&optional refdir)
699 (char-to-string (ecb-directory-sep-char refdir)))
702 ;;; ----- Wrappers for file- and directory-operations ------
704 (dolist (f '(file-name-nondirectory
705 file-exists-p
706 file-name-directory
707 file-readable-p
708 file-attributes
709 file-name-extension
710 file-directory-p
711 file-accessible-directory-p
712 file-name-sans-extension
713 file-writable-p
714 file-name-as-directory
715 directory-files))
716 (fset (intern (format "ecb-%s" f))
717 `(lambda (file-or-dir-name &rest args)
718 ,(format "Delegate all args to `%s' but call first `ecb-fix-path' for FILE-OR-DIR-NAME." f)
719 (apply (quote ,f) (ecb-fix-path file-or-dir-name) args))))
721 (defun ecb-expand-file-name (name &optional default-dir)
722 "Delegate all args to `expand-file-name' but call first `ecb-fix-path'
723 for both args."
724 (expand-file-name (ecb-fix-path name) (ecb-fix-path default-dir)))
726 ;;; ----- Canonical filenames ------------------------------
728 (defun ecb-fix-path (path)
729 "Fixes an annoying behavior of the native windows-version of XEmacs:
730 When PATH contains only a drive-letter and a : then `expand-file-name' does
731 not interpret this PATH as root of that drive. So we add a trailing
732 `directory-sep-char' and return this new path because then `expand-file-name'
733 treats this as root-dir of that drive. For all \(X)Emacs-version besides the
734 native-windows-XEmacs PATH is returned."
735 (if (and ecb-running-xemacs
736 (equal system-type 'windows-nt))
737 (if (and (= (length path) 2)
738 (equal (aref path 1) ?:))
739 (concat path (ecb-directory-sep-string))
740 path)
741 path))
743 ;; accessors for the FIXED-FILENAMES-cache
745 (defsubst ecb-fixed-filename-cache-put (path filename fixed-filename)
746 "Add FIXED-FILENAME for PATH and FILENAME to the FIXED-FILENAMES-cache
747 of `ecb-filename-cache'."
748 (ecb-multicache-put-value 'ecb-filename-cache
749 (concat path filename)
750 'FIXED-FILENAMES
751 fixed-filename))
753 (defsubst ecb-fixed-filename-cache-get (path filename)
754 "Get the cached value for PATH and FILENAME from the FIXED-FILENAMES-cache
755 in `ecb-filename-cache'. If no vaue is cached for PATH and FILENAME then nil
756 is returned."
757 (ecb-multicache-get-value 'ecb-filename-cache
758 (concat path filename)
759 'FIXED-FILENAMES))
761 (defun ecb-fixed-filename-cache-dump (&optional no-nil-value)
762 "Dump the whole FIXED-FILENAMES-cache. If NO-NIL-VALUE is not nil then these
763 cache-entries are not dumped. This command is not intended for end-users of ECB."
764 (interactive "P")
765 (ecb-multicache-print-subcache 'ecb-filename-cache
766 'FIXED-FILENAMES
767 no-nil-value))
769 ;; TODO: Klaus Berndl <klaus.berndl@sdm.de>: What about the new cygwin-version
770 ;; of GNU Emacs 21? We have to test if this function and all locations where
771 ;; `ecb-fix-path' is used work correctly with the cygwin-port of GNU Emacs.
772 (silentcomp-defun mswindows-cygwin-to-win32-path)
773 (defun ecb-fix-filename (path &optional filename substitute-env-vars)
774 "Normalizes path- and filenames for ECB. If FILENAME is not nil its pure
775 filename \(i.e. without directory part) will be concatenated to PATH. The
776 result will never end with the directory-separator! If SUBSTITUTE-ENV-VARS is
777 not nil then in both PATH and FILENAME env-var substitution is done. If the
778 `system-type' is 'cygwin32 then the path is converted to win32-path-style!"
779 (when (stringp path)
780 (or (ecb-fixed-filename-cache-get path filename)
781 (let ((remote-path (ecb-remote-path path))
782 (norm-path nil)
783 (result nil))
784 (if (or (not remote-path)
785 (ecb-host-accessible-p (nth 1 remote-path)))
786 (progn
787 (setq norm-path (if ecb-running-xemacs
788 (case system-type
789 (cygwin32
790 (mswindows-cygwin-to-win32-path
791 (expand-file-name path)))
792 (windows-nt
793 (expand-file-name (ecb-fix-path path)))
794 (otherwise
795 (expand-file-name path)))
796 (expand-file-name path)))
797 ;; substitute environment-variables
798 (setq norm-path (expand-file-name (if substitute-env-vars
799 (substitute-in-file-name norm-path)
800 norm-path))))
801 (setq norm-path path))
802 ;; For windows systems we normalize drive-letters to downcase
803 (setq norm-path (if (and (member system-type '(windows-nt cygwin32))
804 (> (length norm-path) 1)
805 (equal (aref norm-path 1) ?:))
806 (concat (downcase (substring norm-path 0 2))
807 (substring norm-path 2))
808 norm-path))
809 ;; delete a trailing directory-separator if there is any
810 (setq norm-path (if (and (> (length norm-path) 1)
811 (= (aref norm-path (1- (length norm-path)))
812 (ecb-directory-sep-char path)))
813 (substring norm-path 0 (1- (length norm-path)))
814 norm-path))
815 (setq result
816 (concat norm-path
817 (if (stringp filename)
818 (concat (when (> (length norm-path) 1)
819 ;; currently all protocols like tramp,
820 ;; ange-ftp or efs support only not
821 ;; windows-remote-hosts ==> we must not
822 ;; add a backslash here (would be done
823 ;; in case of a native Windows-XEmacs)
824 (ecb-directory-sep-string path))
825 (file-name-nondirectory (if substitute-env-vars
826 (substitute-in-file-name filename)
827 filename))))))
828 (ecb-fixed-filename-cache-put path filename result)
829 result))))
831 ;; -- end of canonical filenames
834 (defun ecb-format-bucket-name (name)
835 "Format NAME as a bucket-name according to `ecb-bucket-node-display'."
836 (let ((formatted-name (concat (nth 0 ecb-bucket-node-display)
837 name
838 (nth 1 ecb-bucket-node-display))))
839 (ecb-merge-face-into-text formatted-name (nth 2 ecb-bucket-node-display))
840 formatted-name))
842 (defun ecb-toggle-do-not-leave-window-after-select ()
843 "Toggles if a node-selection in a tree-buffer leaves the tree-window.
844 See also the option `ecb-tree-do-not-leave-window-after-select'."
845 (interactive)
846 (let ((tree-buffer (ecb-point-in-ecb-tree-buffer)))
847 (if tree-buffer
848 (let ((tree-buf-name (buffer-name tree-buffer)))
849 (if (ecb-member-of-symbol/value-list
850 tree-buf-name
851 ecb-tree-do-not-leave-window-after-select--internal)
852 (progn
853 (setq ecb-tree-do-not-leave-window-after-select--internal
854 ;; we must try both - the symbol of the tree-buffer-name
855 ;; and the tree-buffer-name because we do not know what
856 ;; the user has specified in
857 ;; `ecb-tree-do-not-leave-window-after-select'!
858 (delete (ecb-tree-buffers-get-symbol tree-buf-name)
859 (delete tree-buf-name
860 ecb-tree-do-not-leave-window-after-select--internal)))
861 (message "Selections leave the tree-window of %s" tree-buf-name))
862 (setq ecb-tree-do-not-leave-window-after-select--internal
863 (append ecb-tree-do-not-leave-window-after-select--internal
864 (list (ecb-tree-buffers-get-symbol tree-buf-name))))
865 (message "Selections don't leave the tree-window of %s." tree-buf-name)))
866 (message "Point must stay in an ECB tree-buffer!"))))
868 (defun ecb-common-tree-buffer-modeline-menu-creator (buf-name)
869 "Return a menu for the modeline of all ECB-tree-buffers."
870 '((delete-other-windows "Maximize Window Above")
871 (ecb-redraw-layout-preserving-compwin-state "Display All ECB-windows")))
873 (defun ecb-common-after-tree-buffer-create-actions ()
874 "Things which should be performed after creating a tree-buffer.
875 The tree-buffer is the current buffer."
876 (local-set-key (kbd "C-t") 'ecb-toggle-do-not-leave-window-after-select)
877 (if ecb-running-xemacs
878 ;; TODO: Klaus Berndl <klaus.berndl@sdm.de>: Is it necessary to make
879 ;; modeline-map buffer-local for current buffer first?!
880 (define-key modeline-map
881 '(button2up)
882 'ecb-toggle-maximize-ecb-window-with-mouse)
883 (local-set-key [mode-line mouse-2]
884 'ecb-toggle-maximize-ecb-window-with-mouse)))
887 (defun ecb-combine-ecb-button/edit-win-nr (ecb-button edit-window-nr)
888 "Depending on ECB-BUTTON and EDIT-WINDOW-NR return one value:
889 - nil if ECB-BUTTON is 1.
890 - t if ECB-BUTTON is 2 and the edit-area of ECB is splitted.
891 - EDIT-WINDOW-NR if ECB-BUTTON is 3."
892 (case ecb-button
893 (1 nil)
894 (2 (ecb-edit-window-splitted))
895 (3 edit-window-nr)))
897 (defun ecb-get-edit-window (other-edit-window)
898 "Get the correct edit-window. Which one is the correct one depends on the
899 value of OTHER-EDIT-WINDOW \(which is a value returned by
900 `ecb-combine-ecb-button/edit-win-nr') and `ecb-mouse-click-destination'.
901 - OTHER-EDIT-WINDOW is nil: Get the edit-window according to the option
902 `ecb-mouse-click-destination'.
903 - OTHER-EDIT-WINDOW is t: Get the next edit-window in the cyclic list of
904 current edit-windows starting either from the left-top-most one or from the
905 last edit-window with point (depends on
906 `ecb-mouse-click-destination').
907 - OTHER-EDIT-WINDOW is an integer: Get exactly the edit-window with that
908 number > 0."
909 (let ((edit-win-list (ecb-canonical-edit-windows-list)))
910 (typecase other-edit-window
911 (null
912 (if (eq ecb-mouse-click-destination 'left-top)
913 (car edit-win-list)
914 ecb-last-edit-window-with-point))
915 (integer
916 (ecb-get-edit-window-by-number other-edit-window edit-win-list))
917 (otherwise
918 (ecb-next-listelem edit-win-list
919 (if (eq ecb-mouse-click-destination 'left-top)
920 (car edit-win-list)
921 ecb-last-edit-window-with-point))))))
923 ;;====================================================
924 ;; Mouse callbacks
925 ;;====================================================
927 (defun ecb-tree-buffer-node-select-callback (node
928 mouse-button
929 shift-pressed
930 control-pressed
931 meta-pressed
932 tree-buffer-name)
933 "This is the callback-function ecb.el gives to every tree-buffer to call
934 when a node has been selected. This function does nothing if the click
935 combination is invalid \(see `ecb-interpret-mouse-click'."
936 (let* ((ecb-button-list (ecb-interpret-mouse-click mouse-button
937 shift-pressed
938 control-pressed
939 meta-pressed
940 tree-buffer-name))
941 (ecb-button (nth 0 ecb-button-list))
942 (shift-mode (nth 1 ecb-button-list))
943 (meta-mode (nth 2 ecb-button-list))
944 (keyboard-p (equal (nth 3 ecb-button-list) 'keyboard))
945 (maximized-p (ecb-buffer-is-maximized-p tree-buffer-name)))
946 ;; we need maybe later that something has clicked in a tree-buffer, e.g.
947 ;; in `ecb-handle-major-mode-visibilty'.
948 (setq ecb-item-in-tree-buffer-selected t)
949 (if (not keyboard-p)
950 (setq ecb-layout-prevent-handle-ecb-window-selection t))
951 ;; first we dispatch to the right action
952 (when ecb-button-list
953 (cond ((ecb-string= tree-buffer-name ecb-directories-buffer-name)
954 (ecb-directory-clicked node ecb-button nil shift-mode meta-mode))
955 ((ecb-string= tree-buffer-name ecb-sources-buffer-name)
956 (ecb-source-clicked node ecb-button nil shift-mode meta-mode))
957 ((ecb-string= tree-buffer-name ecb-history-buffer-name)
958 (ecb-history-clicked node ecb-button nil shift-mode meta-mode))
959 ((ecb-string= tree-buffer-name ecb-methods-buffer-name)
960 (ecb-method-clicked node ecb-button nil shift-mode meta-mode))
961 ((ecb-string= tree-buffer-name ecb-analyse-buffer-name)
962 (ecb-analyse-node-clicked node ecb-button nil shift-mode meta-mode))
963 (t nil)))
965 ;; now we go back to the tree-buffer but only if all of the following
966 ;; conditions are true:
967 ;; 1. The ecb-windows are now not hidden
968 ;; 2. The tree-buffer-name is contained in
969 ;; ecb-tree-do-not-leave-window-after-select--internal
970 ;; 3. Either it is not the ecb-directories-buffer-name or
971 ;; at least `ecb-show-sources-in-directories-buffer-p' is true and the
972 ;; hitted node is a sourcefile
973 (when (and (not ecb-windows-hidden)
974 (ecb-member-of-symbol/value-list
975 tree-buffer-name
976 ecb-tree-do-not-leave-window-after-select--internal)
977 (or (not (ecb-string= tree-buffer-name ecb-directories-buffer-name))
978 (and (ecb-show-sources-in-directories-buffer-p)
979 (= ecb-directories-nodetype-sourcefile
980 (tree-node->type node)))))
981 ;; If there is currently no maximized window then we can savely call
982 ;; `ecb-goto-ecb-window'. If we have now a maximized window then there
983 ;; are two possibilities:
984 ;; - if it is not equal to the maximzed tree-buffer before the selection
985 ;; then we must maximi
986 (if (and maximized-p
987 (not (ecb-buffer-is-maximized-p tree-buffer-name)))
988 (ecb-maximize-ecb-buffer tree-buffer-name t)
989 (ecb-goto-ecb-window tree-buffer-name))
990 (tree-buffer-remove-highlight))))
992 (defun ecb-tree-buffer-node-collapsed-callback (node
993 mouse-button
994 shift-pressed
995 control-pressed
996 meta-pressed
997 tree-buffer-name)
998 "This is the callback-function ecb.el gives to every tree-buffer to call
999 when a node has been collapsed."
1000 (let* ((ecb-button-list (ecb-interpret-mouse-click mouse-button
1001 shift-pressed
1002 control-pressed
1003 meta-pressed
1004 tree-buffer-name))
1005 (keyboard-p (equal (nth 3 ecb-button-list) 'keyboard)))
1006 (if (not keyboard-p)
1007 (setq ecb-layout-prevent-handle-ecb-window-selection t))))
1009 (defun ecb-tree-buffer-node-expand-callback (node
1010 mouse-button
1011 shift-pressed
1012 control-pressed
1013 meta-pressed
1014 tree-buffer-name)
1015 "This is the callback-function ecb.el gives to every tree-buffer to call
1016 when a node should be expanded. This function does nothing if the click
1017 combination is invalid \(see `ecb-interpret-mouse-click')."
1018 (let* ((ecb-button-list (ecb-interpret-mouse-click mouse-button
1019 shift-pressed
1020 control-pressed
1021 meta-pressed
1022 tree-buffer-name))
1023 (ecb-button (nth 0 ecb-button-list))
1024 (shift-mode (nth 1 ecb-button-list))
1025 (meta-mode (nth 2 ecb-button-list))
1026 (keyboard-p (equal (nth 3 ecb-button-list) 'keyboard)))
1027 (if (not keyboard-p)
1028 (setq ecb-layout-prevent-handle-ecb-window-selection t))
1029 (when ecb-button-list
1030 (cond ((ecb-string= tree-buffer-name ecb-directories-buffer-name)
1031 (ecb-update-directory-node node))
1032 ((ecb-string= tree-buffer-name ecb-sources-buffer-name)
1033 (ecb-source-clicked node ecb-button nil shift-mode meta-mode))
1034 ((ecb-string= tree-buffer-name ecb-history-buffer-name)
1035 (ecb-history-clicked node ecb-button nil shift-mode meta-mode))
1036 ((ecb-string= tree-buffer-name ecb-methods-buffer-name)
1037 nil)
1038 (t nil)))))
1040 (defun ecb-interpret-mouse-click (mouse-button
1041 shift-pressed
1042 control-pressed
1043 meta-pressed
1044 tree-buffer-name)
1045 "Converts the physically pressed MOUSE-BUTTON \(1 = mouse-1, 2 = mouse-2, 0 =
1046 no mouse-button but the keys RET or TAB) to ECB-mouse-buttons: either primary
1047 or secondary mouse-button depending on the value of CONTROL-PRESSED and the
1048 setting in `ecb-primary-secondary-mouse-buttons'. Returns a list
1049 '\(<ECB-button> <shift-mode> <meta-mode> <device>) where <ECB-button> is
1050 either 1 \(= primary) or 2 \(= secondary) and <shift-mode> and <meta-mode> are
1051 non nil if SHIFT-PRESSED rsp. META-PRESSED is non nil. <device> is either
1052 'mouse or 'keyboard dependent if the uses has used the mouse rsp. the keyboard
1053 in the tree-buffer. For an invalid and not accepted click combination nil is
1054 returned.
1056 Note: If MOUSE-BUTTON is 0 \(means no mouse-button but a key like RET or TAB
1057 was hitted) then CONTROL-PRESSED is interpreted as ECB-button 2.
1059 Currently the fourth argument TREE-BUFFER-NAME is not used here."
1060 (if (eq mouse-button 0)
1061 (list (if control-pressed 2 1) shift-pressed meta-pressed 'keyboard)
1062 (if (and (not (eq mouse-button 1)) (not (eq mouse-button 2)))
1064 (case ecb-primary-secondary-mouse-buttons
1065 (mouse-1--mouse-2
1066 (if control-pressed
1068 (list mouse-button shift-pressed meta-pressed 'mouse)))
1069 (mouse-1--C-mouse-1
1070 (if (not (eq mouse-button 1))
1072 (list (if control-pressed 2 1) shift-pressed meta-pressed 'mouse)))
1073 (mouse-2--C-mouse-2
1074 (if (not (eq mouse-button 2))
1076 (list (if control-pressed 2 1) shift-pressed meta-pressed 'mouse)))
1077 (otherwise nil)))))
1079 (defun ecb-show-minibuffer-info (node window when-spec)
1080 "Checks if any info about the current node in the ECB-window WINDOW should
1081 be displayed. WHEN-SPEC must have the same format as the car of
1082 `ecb-directories-show-node-info'."
1083 (or (eq when-spec 'always)
1084 (and (eq when-spec 'if-too-long)
1085 window
1086 (>= (tree-node-linelength node)
1087 (window-width window)))))
1090 (tree-buffer-defpopup-command ecb-maximize-ecb-window-menu-wrapper
1091 "Expand the current ECB-window from popup-menu."
1092 (ecb-maximize-ecb-buffer (buffer-name (current-buffer)) t))
1094 ;; stealthy mechanism
1096 (defvar ecb-stealthy-function-list nil
1097 "List of functions which ECB runs stealthy. Do not modify this variable!
1098 This variable is autom. set by the macro `defecb-stealthy'!")
1100 (defvar ecb-stealthy-function-state-alist nil
1101 "Alist which stores the state of each function of
1102 `ecb-stealthy-function-list'. Do not add new items to this variable because
1103 this is autom. done by the macro `defecb-stealthy'!")
1105 (defun ecb-stealthy-function-list-add (fcn)
1106 (add-to-list 'ecb-stealthy-function-list fcn))
1108 (defun ecb-stealthy-function-state-alist-add (fcn)
1109 (add-to-list 'ecb-stealthy-function-state-alist
1110 (cons fcn 'done)))
1112 (defun ecb-stealthy-function-state-get (fcn)
1113 "Getter for `ecb-stealthy-function-state-alist'. Return state for the
1114 stealthy function FCN."
1115 (cdr (assoc fcn ecb-stealthy-function-state-alist)))
1117 (defun ecb-stealthy-function-state-set (fcn state)
1118 "Setter for `ecb-stealthy-function-state-alist'. Set STATE for the
1119 stealthy function FCN. Return STATE."
1120 (setcdr (assoc fcn ecb-stealthy-function-state-alist) state))
1122 (defun ecb-stealthy-function-p (fcn)
1123 "Return not nil if FCN is a stealthy function defined with
1124 `defecb-stealthy'."
1125 (member fcn ecb-stealthy-function-list))
1127 (defun ecb-stealthy-function-state-init (&optional fcn state)
1128 "Reset the state of stealthy functions. If first optional arg FCN is a
1129 stealthy function then only the state of this function is reset - otherwise
1130 all stealthy functions of `ecb-stealthy-function-list' are reset. If second
1131 optional arg STATE is nil then the state will be reset to the special state
1132 'restart - otherwise to the value STATE."
1133 (if (and fcn (ecb-stealthy-function-p fcn))
1134 (ecb-stealthy-function-state-set fcn (or state 'restart))
1135 (dolist (f ecb-stealthy-function-list)
1136 (ecb-stealthy-function-state-set f (or state 'restart)))))
1138 (defmacro defecb-stealthy (name docstring &rest body)
1139 "Define a so called stealthy function with NAME. This function will be
1140 registered by this macro in `ecb-stealthy-function-list' and
1141 `ecb-stealthy-function-state-alist'. During the evaluation of BODY the
1142 variable `state' will be bound and initialized with the stealthy state. BODY
1143 can use and modify `state'. After evaluating BODY `state' will be
1144 automatically saved so its available at the runtime of this stealthy function.
1145 BODY will only be evaluated if `state' is not 'done. BODY should be designed
1146 to be interruptable by the user \(e.g. with `input-pending-p'). If BODY
1147 completes then BODY has to set `state' to the special value 'done! If BODY has
1148 been interrupted then `state' can have an arbitrary value which will be autom.
1149 stored and at next runtime of the stealthy function NAME `state' will be
1150 initialized with this stored value. If `state' is initialized with the special
1151 value 'restart then this means the stealthy function should start from scratch
1152 because an eventually stored state is not longer valid. If the stealthy
1153 function sets `state' to 'done then this function will first being called
1154 after the state for this function has been reset to something else than 'done
1155 \(mostly to 'restart)\; such a reset of the state for a stealthy function can
1156 be done by any code and must be done via `ecb-stealthy-function-state-init'!"
1157 `(progn
1158 (unless (fboundp (quote ,name))
1159 (ecb-stealthy-function-list-add (quote ,name))
1160 (ecb-stealthy-function-state-alist-add (quote ,name)))
1161 (eval-and-compile
1162 (unless (fboundp (quote ,name))
1163 (defun ,name nil
1164 ,docstring
1165 (let ((state (ecb-stealthy-function-state-get (quote ,name))))
1166 (unless (equal state 'done)
1167 ,@body)
1168 (ecb-stealthy-function-state-set (quote ,name) state)))))))
1170 (put 'defecb-stealthy 'lisp-indent-function 1)
1172 (defvar ecb-stealthy-update-running nil
1173 "Recursion avoidance variable for stealthy performance.")
1175 (defun ecb-stealthy-updates ()
1176 "Run all functions in the stealthy function list.
1177 Each function returns 'done if it completes successfully, or something else if
1178 interrupted by the user \(i.e. the function has been interrupted by the
1179 user). If a function is interrupted then `ecb-stealthy-function-list' is
1180 rotated so the interrupted function is the first element so the nect stealthy
1181 run starts with this interrupted function."
1182 (ecb-debug-autocontrol-fcn-error 'ecb-stealthy-updates
1183 "Begin: Cur-buf: %s" (current-buffer))
1184 (unless ecb-stealthy-update-running
1185 (let ((l ecb-stealthy-function-list)
1186 (ecb-stealthy-update-running t))
1187 (while (and l (equal 'done (funcall (car l))))
1188 (setq l (cdr l)))
1189 ;; if l is nil this means all functions have successfully completed -
1190 ;; otherwise we ensure that next time we start with the interrupted
1191 ;; function.
1192 (when l
1193 (setq ecb-stealthy-function-list
1194 (ecb-rotate ecb-stealthy-function-list (car l))))))
1195 (ecb-debug-autocontrol-fcn-error 'ecb-stealthy-updates
1196 "End: Cur-buf: %s" (current-buffer)))
1199 ;; generation of nodes rsp. of attributes of nodes
1201 (defun ecb-generate-node-name (text-name first-chars icon-name name-of-buffer)
1202 "Generate a new name from TEXT-NAME by adding an appropriate image according
1203 to ICON-NAME to the first FIRST-CHARS of TEXT-NAME. If FIRST-CHARS is < 0 then
1204 a string with length abs\(FIRST-CHARS) is created, the image is applied to
1205 this new string and this \"image\"-string is added to the front of TEXT-NAME.
1206 If no image can be found for ICON-NAME then the original TEXT-NAME is
1207 returned. NAME-OF-BUFFER is the name of the tree-buffer where the resulting
1208 node-name will be displayed.
1210 If an image is added then two text-properties are added to the FIRST-CHARS of
1211 the returned string: 'tree-buffer-image-start which holds 0 as value and
1212 'tree-buffer-image-length which holds the absolute value of FIRST-CHARS
1213 value."
1214 (let ((image nil))
1215 (save-excursion
1216 (set-buffer name-of-buffer)
1217 (setq image (and icon-name (tree-buffer-find-image icon-name)))
1218 (if image
1219 (if (> first-chars 0)
1220 (tree-buffer-add-image-icon-maybe
1221 0 first-chars text-name image)
1222 (concat (tree-buffer-add-image-icon-maybe
1223 0 (- first-chars)
1224 (make-string (- first-chars) ? ) image)
1225 text-name))
1226 text-name))))
1229 (silentcomp-provide 'ecb-common-browser)
1231 ;;; ecb-common-browser.el ends here