[C] ECB - sync with upstream 2.30.1

Here is the patch between new upstream-sync and latest xemacs-version ? ecb-autoloads.el Index: .cvsignore =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/.cvsignore,v retrieving revision 1.4 diff -u -r1.4 .cvsignore --- .cvsignore 18 Sep 2003 10:22:52 -0000 1.4 +++ .cvsignore 1 Dec 2004 15:59:46 -0000 ＠＠ -1,4 +1,5 ＠＠ test-install +test-start ecb*.html patches create-patch Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ChangeLog,v retrieving revision 1.48 diff -u -r1.48 ChangeLog --- ChangeLog 6 Sep 2004 11:32:49 -0000 1.48 +++ ChangeLog 1 Dec 2004 15:59:46 -0000 ＠＠ -1,3 +1,7 ＠＠ +2004-12-01 Klaus Berndl <klaus.berndl(a)sdm.de&gt; + + * Sync with current upstream 2.30.1 + 2004-09-06 Norbert Koch <viteno(a)xemacs.org&gt; * Makefile (VERSION): XEmacs package 1.19 released. Index: Makefile =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/Makefile,v retrieving revision 1.39 diff -u -r1.39 Makefile --- Makefile 6 Sep 2004 11:32:49 -0000 1.39 +++ Makefile 1 Dec 2004 15:59:46 -0000 ＠＠ -18,7 +18,7 ＠＠ # Boston, MA 02111-1307, USA. VERSION = 1.19 -AUTHOR_VERSION = 2.27 +AUTHOR_VERSION = 2.30.1 MAINTAINER = Klaus Berndl <klaus.berndl(a)sdm.de&gt; PACKAGE = ecb PKG_TYPE = regular ＠＠ -32,7 +32,8 ＠＠ ecb-upgrade.elc ecb-layout-defs.elc ecb-tod.elc silentcomp.elc \ ecb-create-layout.elc ecb-examples.elc ecb-autogen.elc ecb-jde.elc \ ecb-winman-support.elc ecb-file-browser.elc ecb-method-browser.elc \ - ecb-semantic-wrapper.elc ecb-compatibility.elc + ecb-semantic-wrapper.elc ecb-compatibility.elc \ + ecb-common-browser.elc EXTRA_SOURCES = NEWS README RELEASE_NOTES ＠＠ -84,6 +85,9 ＠＠ DATA_18_DEST = $(PACKAGE)/ecb-images/default/height-14 DATA_19_FILES = $(wildcard ecb-images/directories/height-14/*.xpm) DATA_19_DEST = $(PACKAGE)/ecb-images/directories/height-14 + +DATA_20_FILES = $(wildcard ecb-images/sources/height-14_to_21/*.xpm) +DATA_20_DEST = $(PACKAGE)/ecb-images/sources/height-14_to_21 PRELOADS = -l compile -l ecb-util -l ecb-eshell \ Index: Makefile.upstream =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/Makefile.upstream,v retrieving revision 1.14 diff -u -r1.14 Makefile.upstream --- Makefile.upstream 31 Aug 2004 16:00:51 -0000 1.14 +++ Makefile.upstream 1 Dec 2004 15:59:46 -0000 ＠＠ -26,7 +26,7 ＠＠ # GNU Emacs; see the file COPYING. If not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -# $Id: Makefile.upstream,v 1.14 2004/08/31 16:00:51 berndl Exp $ +# $Id: Makefile,v 1.100 2004/11/30 18:42:07 berndl Exp $ # ======================================================================== ＠＠ -53,7 +53,7 ＠＠ #CEDET= CEDET=c:/Programme/emacs-21/site-lisp/package-development/cedet -#CEDET=c:/Programme/emacs-21/site-lisp/multi-file-packages/cedet-1.0beta3b +#CEDET=c:/Programme/emacs-21/site-lisp/multi-file-packages/cedet-1.0beta2b # -------- Compiling ECB with the semantic < 2.0 ------------------------- ＠＠ -144,11 +144,11 ＠＠ # Do not change anything below! -# $Id: Makefile.upstream,v 1.14 2004/08/31 16:00:51 berndl Exp $ +# $Id: Makefile,v 1.100 2004/11/30 18:42:07 berndl Exp $ # For the ECB-maintainers: Change the version-number here and not # elsewhere! -ecb_VERSION=2.27 +ecb_VERSION=2.30.1 include ecb-makedef.mk Index: NEWS =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/NEWS,v retrieving revision 1.12 diff -u -r1.12 NEWS --- NEWS 31 Aug 2004 16:00:51 -0000 1.12 +++ NEWS 1 Dec 2004 15:59:47 -0000 ＠＠ -1,3 +1,150 ＠＠ +* Changes for ECB version 2.30.1 + +** Enhancement to the automatic option-upgrading mechanism + ECB now automatically makes a backup-file of that file which will be + modified by storing the upgraded rsp. renamed ECB-options. This backup file + gets a unique name by adding a suffix ".before_ecb_<version>" to the name + of the modified file. If such a file already exists ECB adds a unique number + to the end of the filename to make the filename unique. + This is a safety mechanism if something fails during storing the upgraded + options, so you never lose the contents of your customization-file! + +** Enhancement to the VC-support + +*** Better recomputing of the VC-state of a file when state changed outside + With the new check-state-function `ecb-vc-state' the heuristic state is + always computed right which is especially useful if the state for a file + has been changed outside Emacs (e.g. by checking in from command line or + Windows Explorer). This function is now added to the default-value of + `ecb-vc-supported-backends' for GNU Emacs. + +*** Added out-of-the-box support for VC-system Subversion + For this the latest version of the VC-package incl. the library vc-syn.el + is needed. Latest CVS Emacs contains this VC-version. The new function + `ecb-vc-dir-managed-by-SVN' is now added to the default-value of + `ecb-vc-supported-backends'. Thanks for first implementation to Ekkehard + Görlach <ekkehard.goerlach(a)pharma.novartis.com&gt;. + +** Fixed bugs + +*** Fixed errors occured at load-time of ECB 2.30 + + + +* Changes for ECB version 2.30 + +** Enhancements to the file-browser + +*** Much better performance of the file-browser display because all + time-consuming tasks (like the check if the displayed directories are + empty of not) are now performed "stealthy" - means when Emacs is idle. + Each stealthy task is interruptable by the user just by hitting any key or + clicking the mouse so Emacs/ECB will not be blocked by such tasks; next + time Emacs is idle again the interrupted task automatically proceeds from + the state it has been interrupted. There is a new macro `defecb-stealthy' + which can be used by a user to program own stealthy tasks. + + Currently ECB performs three stealthy tasks: + + Prescann directories for emptyness: Prescann directories and display + them as empty or not-empty in the directories-buffer. See the + documentation of the option `ecb-prescan-directories-for-emptyness' for + a description. + + File is read only: Check if sourcefile-items of the directories- or + sources-buffer are read-only or not. See documentation of the option + `ecb-sources-perform-read-only-check'. + + Version-control-state: Checks the version-control-state of files in + directories which are managed by a VC-backend. See the option + `ecb-vc-enable-support'. + + There is also a new option `ecb-stealthy-tasks-delay'. + + There are three options which allow excluding certain directories from + these stealthy tasks: `ecb-prescan-directories-exclude-regexps', + `ecb-read-only-check-exclude-regexps' and last but not least + `ecb-vc-directory-exclude-regexps'. + +*** ECB is now capable of handling remote paths. + "Remote" means file- or directory-paths in the sense of TRAMP, ANGE-FTP or + EFS. Such paths can now being added to the option `ecb-source-path' with + no limitation compared to "local" paths. Just work with remote-paths in + the same manner as with local paths. See also the additional choices of + the options `ecb-prescan-directories-for-emptyness', + `ecb-sources-perform-read-only-check' and `ecb-vc-enable-support' (new). + This new support is tested with the combinations GNU Emacs+TRAMP and + XEmacs+EFS but it should (hopefully) also work with all other + combinations. Thanks a lot to Tomas Orti for beta-testing! + +*** ECB displays the Version-control-state of a file in the tree-buffers. + There are four new options `ecb-vc-enable-support', + `ecb-vc-supported-backends', `ecb-vc-directory-exclude-regexps' and + `ecb-vc-state-mapping' which define if and how ECB should check the state + of a sourcefile in a directory managed by a version-control system. By + default ECB supports the same VC-backends as the builtin VC-support of + Emacs: CVS, RCS and SCCS. But the option `ecb-vc-supported-backends' + allows to add support for arbitrary VC-backends (e.g. Clearcase). New + image-icons are also included for a cute display of the VC-state in the + directories, sources and history-buffer. Thanks to Markus Gritsch + <gritsch(a)iue.tuwien.ac.at&gt; for contributing the icons. + + It's recommended to read the section "Version-control support" in the + chapter "Tips and Trick" of the ECB-info-manual! + +*** New hook which runs directly after the selected directory has changed. + See documentation of `ecb-after-directory-change-hook'. + +** The popup-menu of the methods-browser allows precisely expanding of the + current node. This means you can precisely expand a certain node to an + exact indentation level relative to the node. This means all subnodes <= + this level will be expanded (full recursive expanding is therefore of + course also possible) and all subnodes indented deeper than this level will + be collapsed - this is very different from using the expand/collapse symbol + of a node. For forther details and examples the the manual and the section + "Expanding" and here the subsection "Explicit expanding of the current node + to a certain level". + +** Automatically upgraded ecb-option-settings are now not saved by default. + This means that ECB has now the new policy "Never touching the + customization-files of a user without asking". The result is a completely + redesigned upgraded-options-buffer: Now at the bottom of this buffer + (displayed by `ecb-display-upgraded-options') two clickable buttons [Save] + and [Cancel] are displayed which give the user the choice between saving + the upgraded options for future Emacs-sessions ot just to cancel this + buffer. In the latter case ECB has also upgraded the not compatible or + renamed options (as listed in the displayed upgraded-options-buffer) but + they will be not saved, i.e. no customization-file is touched and the + changed and upgraded values will be lost after quiting Emacs. + +** With XEmacs ECB temporary sets `progress-feedback-use-echo-area' to t + This is necessary because otherwise the progress-display with native + widgets modifies the window-sizes of ECB and does not exactly restore the + window-sizes as before that progress-display. Deactivating ECB + automatically restores the old value of this option. + +** Fixed bugs + +*** Fixed resizing of the ecb-windows after opening a file + Sometimes (X)Emacs (the behavior has only been reported for XEmacs) + resizes the ecb-windows after opening a file by clicking onto a sourcefile + or calling `find-file' (or similar functions). This is not a bug of ECB + but nevertheless it is annoying for the ECB-users. Therefore ECB has now a + workaround which prevents the ecb-windows from resizing. The work around + is done via two simple advices of `find-file' and `find-file-other-window'. + +*** Fixed a bug in the upgrading feature (command `ecb-download-ecb') which has + occured when the user has set a different LOKALE (e.g. "de_DE＠euro"). + +*** Fixed a bug in restoring sizes of the ecb-windows. + Now a check will be performed if there are ecb-windows visible. If not + nothing will be done (versions < 2.30 have failed in such a case). + This bug has prevented ediff from working together with ECB when a + compile-window was visible and the user has stored window-sizes for the + current layout. + + + * Changes for ECB version 2.27 ** The option `ecb-auto-expand-tag-tree-collapse-other' now has three possible Index: README =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/README,v retrieving revision 1.14 diff -u -r1.14 README --- README 31 Aug 2004 16:00:50 -0000 1.14 +++ README 1 Dec 2004 15:59:47 -0000 ＠＠ -1,4 +1,4 ＠＠ -README for the Emacs Code Browser (ECB) version 2.27 +README for the Emacs Code Browser (ECB) version 2.30.1 About Index: RELEASE_NOTES =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/RELEASE_NOTES,v retrieving revision 1.13 diff -u -r1.13 RELEASE_NOTES --- RELEASE_NOTES 31 Aug 2004 16:00:50 -0000 1.13 +++ RELEASE_NOTES 1 Dec 2004 15:59:47 -0000 ＠＠ -1,4 +1,4 ＠＠ -This file contains some important release-notes for ECB version 2.27 +This file contains some important release-notes for ECB version 2.30.1 General: -------- Index: ecb-autogen.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb-autogen.el,v retrieving revision 1.12 diff -u -r1.12 ecb-autogen.el --- ecb-autogen.el 31 Aug 2004 16:00:49 -0000 1.12 +++ ecb-autogen.el 1 Dec 2004 15:59:47 -0000 ＠＠ -26,7 +26,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: ecb-autogen.el,v 1.12 2004/08/31 16:00:49 berndl Exp $ +;; $Id: ecb-autogen.el,v 1.12 2004/05/06 09:02:08 berndl Exp $ ;;; Commentary: ;; Index: ecb-compatibility.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb-compatibility.el,v retrieving revision 1.5 diff -u -r1.5 ecb-compatibility.el --- ecb-compatibility.el 31 Aug 2004 16:00:49 -0000 1.5 +++ ecb-compatibility.el 1 Dec 2004 15:59:47 -0000 ＠＠ -24,7 +24,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: ecb-compatibility.el,v 1.5 2004/08/31 16:00:49 berndl Exp $ +;; $Id: ecb-compatibility.el,v 1.4 2004/02/17 16:50:10 berndl Exp $ ;;; Commentary: ;; Index: ecb-create-layout.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb-create-layout.el,v retrieving revision 1.13 diff -u -r1.13 ecb-create-layout.el --- ecb-create-layout.el 31 Aug 2004 16:00:49 -0000 1.13 +++ ecb-create-layout.el 1 Dec 2004 15:59:47 -0000 ＠＠ -26,7 +26,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: ecb-create-layout.el,v 1.13 2004/08/31 16:00:49 berndl Exp $ +;; $Id: ecb-create-layout.el,v 1.29 2004/05/06 09:02:08 berndl Exp $ ;;; Commentary: ;; Index: ecb-eshell.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb-eshell.el,v retrieving revision 1.5 diff -u -r1.5 ecb-eshell.el --- ecb-eshell.el 31 Aug 2004 16:00:49 -0000 1.5 +++ ecb-eshell.el 1 Dec 2004 15:59:47 -0000 ＠＠ -26,7 +26,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: ecb-eshell.el,v 1.73 2004/05/06 09:02:08 berndl Exp $ +;; $Id: ecb-eshell.el,v 1.74 2004/11/17 17:28:39 berndl Exp $ ;;; Commentary: ＠＠ -80,6 +80,7 ＠＠ (require 'ecb-util) (require 'ecb-compilation) +(require 'ecb-common-browser) (silentcomp-defvar eshell-buffer-name) (silentcomp-defun eshell) Index: ecb-examples.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb-examples.el,v retrieving revision 1.13 diff -u -r1.13 ecb-examples.el --- ecb-examples.el 31 Aug 2004 16:00:48 -0000 1.13 +++ ecb-examples.el 1 Dec 2004 15:59:47 -0000 ＠＠ -26,7 +26,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: ecb-examples.el,v 1.13 2004/08/31 16:00:48 berndl Exp $ +;; $Id: ecb-examples.el,v 1.14 2004/11/17 17:28:39 berndl Exp $ ;;; Commentary: ;; ＠＠ -64,6 +64,7 ＠＠ (require 'ecb-util) (require 'ecb-layout) +(require 'ecb-common-browser) ;; --------------------------------------------------------------------------- Index: ecb-face.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb-face.el,v retrieving revision 1.14 diff -u -r1.14 ecb-face.el --- ecb-face.el 31 Aug 2004 16:00:48 -0000 1.14 +++ ecb-face.el 1 Dec 2004 15:59:47 -0000 ＠＠ -26,7 +26,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: ecb-face.el,v 1.14 2004/08/31 16:00:48 berndl Exp $ +;; $Id: ecb-face.el,v 1.21 2004/08/31 15:33:04 berndl Exp $ ;;; Commentary: Index: ecb-file-browser.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb-file-browser.el,v retrieving revision 1.6 diff -u -r1.6 ecb-file-browser.el --- ecb-file-browser.el 31 Aug 2004 16:00:47 -0000 1.6 +++ ecb-file-browser.el 1 Dec 2004 15:59:47 -0000 ＠＠ -23,7 +23,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: ecb-file-browser.el,v 1.6 2004/08/31 16:00:47 berndl Exp $ +;; $Id: ecb-file-browser.el,v 1.47 2004/12/01 14:19:54 berndl Exp $ ;;; Commentary: ＠＠ -36,6 +36,7 ＠＠ (require 'ecb-face) (require 'ecb-speedbar) (require 'ecb-layout) +(require 'ecb-common-browser) ;; various loads (require 'assoc) ＠＠ -48,17 +49,8 ＠＠ (require 'silentcomp)) (silentcomp-defun ecb-speedbar-update-contents) +(silentcomp-defvar vc-cvs-stay-local) -(defvar ecb-path-selected-directory nil - "Path to currently selected directory.") - -(defvar ecb-path-selected-source nil - "Path to currently selected source.") - -(defun ecb-file-browser-initialize () - (setq ecb-path-selected-directory nil - ecb-path-selected-source nil)) - ;;==================================================== ;; Customization ;;==================================================== ＠＠ -79,16 +71,30 ＠＠ :group 'ecb :prefix "ecb-") +(defgroup ecb-version-control nil + "Settings for the version-control support in the ECB." +:group 'ecb +:prefix "ecb-") + (defcustom ecb-source-path nil "*Paths where to find code sources. Each path can have an optional alias that is used as it's display name. If no -alias is set, the path is used as display name." +alias is set, the path is used as display name. + +Lisp-type of this option: The value must be a list L whereas each element of L +is either +- a simple string which has to be the full path of a directory \(this string + is displayed in the directory-browser of ECB) or +- a 2-element list whereas the first element is the full path of a directory + \(string) and the second element is an arbitrary alias \(string) for this + directory which is then displayed instead of the underlying directory." :group 'ecb-directories :group 'ecb-most-important :initialize 'custom-initialize-default :set (function (lambda (symbol value) - (set symbol value) - (if (and ecb-minor-mode + (set symbol value) + (if (and (boundp 'ecb-minor-mode) + ecb-minor-mode (functionp 'ecb-update-directories-buffer)) (ecb-update-directories-buffer)))) :type '(repeat (choice :tag "Display type" ＠＠ -98,7 +104,6 ＠＠ (directory :tag "Path") (string :tag "Alias"))))) - (defcustom ecb-add-path-for-not-matching-files '(t . nil) "*Add path of a file to `ecb-source-path' if not already contained. This is done during the auto. windows synchronization which happens if a file ＠＠ -107,7 +112,11 ＠＠ for the current Emacs session. This option defines two things: 1. Should only the root-part \(which means for Unix-like systems always '/' and for windows-like systems the drive) of the new file be added as - source-path to `ecb-source-path' or the whole directory-part? + source-path to `ecb-source-path' or the whole directory-part? For + remote-files \(e.g. tramp, ange-ftp- or efs-files) the root-part is the + complete host-part + the root-dir at that host \(example: + /berndl＠ecb.sourceforge.net:/ would be the root-part of + /berndl＠ecb.sourceforge.net:/tmp/test.txt). 2. Should this path be added for future sessions too? The value of this option is a cons-cell where the car is a boolean for 1. and ＠＠ -211,6 +220,8 ＠＠ (defun ecb-show-sources-in-directories-buffer-p () + "Return not nil if in current layout sources are shown in the +directories-buffer." (cond ((equal ecb-show-sources-in-directories-buffer 'never) nil) ((equal ecb-show-sources-in-directories-buffer 'always) ＠＠ -220,15 +231,17 ＠＠ (member ecb-layout-name ecb-show-sources-in-directories-buffer))))) -(defcustom ecb-cache-directory-contents '((".*" . 50)) +(defcustom ecb-cache-directory-contents '(("^/\\([^:/]*＠\\)?\\([^＠:/]*\\):.*" . 0) + (".*" . 50)) "*Cache contents of certain directories. This can be useful if `ecb-source-path' contains directories with many files and subdirs, especially if these directories are mounted net-drives \(\"many\" means here something > 1000, dependent of the speed of the net-connection and -the machine). For these directories actualizing the sources- and/or directories- -buffer of ECB \(if displayed in current layout!) can slow down dramatically so -a caching increases speed a lot. - +the machine). Or if it contains remote-source-paths which means paths in the +sense of tramp, ange-ftp or efs. For these directories actualizing the +sources- and/or directories- buffer of ECB \(if displayed in current layout!) +can slow down dramatically so a caching increases speed a lot. + The value of this option is a list where the each element is a cons-cell and looks like: \(<dir-regexp> . <filenumber threshold>) ＠＠ -244,17 +257,21 ＠＠ by using the POWER-click \(see `ecb-primary-secondary-mouse-buttons') in the directories-buffer of ECB. +Default-value: ECB caches the contents of all remote directories regardless of +the size and all other directories if more than 50 entries are contained. + Examples: -A value of \(\(\"/usr/home/john_smith/bigdir*\" . 1000)) means the contents of +An entry \(\"/usr/home/john_smith/bigdir*\" . 1000) means the contents of every subdirectory of the home-directory of John Smith will be cached if the directory contains more than 1000 entries and its name begins with \"bigdir\". -A value of \(\(\".*\" . 1000)) caches every directory which has more than 1000 +An entry \(\".*\" . 1000) caches every directory which has more than 1000 entries. -A value of \(\(\".*\" . 0)) caches every directory regardless of the number of -entries. +An entry \(\"^/\\\\\(\[^:/]*＠\\\\)?\\\\\(\[^＠:/]*\\\\):.*\" . 0) caches every +remote \(in the sense of tramp, ange-ftp or efs) directory regardless of the +number of entries. Please note: If you want your home-dir being cached then you MUST NOT use \"~\" because ECB tries always to match full path-names!" ＠＠ -287,19 +304,157 ＠＠ :group 'ecb-directories :type `(repeat (regexp :tag "Directory-regexp"))) -(defcustom ecb-prescan-directories-for-emptyness t +(defcustom ecb-ping-program "ping" + "Program to send network test packets to a host. +See also `ecb-ping-options'." +:group 'ecb-directories +:type 'string) + +(defcustom ecb-ping-options + (if (eq system-type 'windows-nt) + (list "-n" "1") + (list "-c" "1")) + "List of options for the ping program. +These options can be used to limit how many ICMP packets are emitted. Ping is +used to test if a remote host of a remote path \(e.g. a tramp-, ange-ftp- or +efs-path) is accessible. See also `ecb-ping-program'." +:group 'ecb-directories +:type '(repeat string)) + +(defcustom ecb-host-accessible-check-valid-time nil + "Time in seconds a cached accessible-state of a remote host is valid. +This option is a list where each element specifies how long for a certain +remote host the cached ping-state \(i.e. if the host is accessible or not) +should be valid. During this time-intervall ECB pings such a remote host only +once, all other checks use the cached value of that real check. But it the +cached value is older than the value of this option ECB will ping again. + +Per default ECB discards after 1 minute the cached ping-state of each remote +host. But if you are sure that a certain remote host is always accessible +\(i.e. means in consequence that you are always online when working with ECB +and remote-paths) then add an entry to this option with a high valid-interval. + +Examples: An entry \(\".*sourceforge.*\" . 3600) ensures that all remote hosts +machting the string \"sourceforge\" will only once pinged during one hour. Or +\(\".*\" . 300) would ensure that every remote host would be pinged only once +during 5 minutes." +:group 'ecb-directories +:type '(repeat (cons (regexp :tag "Remote host regexp") + (integer :tag "Valid interval")))) + +(defcustom ecb-prescan-directories-for-emptyness 'unless-remote "*Prescan directories for emptyness. ECB does this so directories are displayed as empty in the directories-buffer even without user-interaction \(i.e. in previous ECB-versions the emptyness of a directory has been first checked when the user has clicked onto a directory). ECB optimizes this check as best as possible but if a directory contains a lot of subdirectories which contain in turn a lot of entries, then -expanding such a directory or selecting it takes of course more time as +expanding such a directory or selecting it would take of course more time as without this check - at least at the first time \(all following selects of a directory uses the cached information if its subdirectories are empty or not). -Therefore this feature can be switched of via this option." +Therefore ECB performs this check stealthy \(see `ecb-stealthy-tasks-delay') +so normally there should no performance-decrease or additional waiting-time +for the user. There is one exception: For remote directories \(in the sense of +tramp, ange-ftp, or efs) this check can descrease performance even if +performed stealthy and interruptable. Therefore this option offers three +possible settings: + + t: Switch on this feature + + 'unless-remote: Switch on this feature but not for remote directories. The + term \"remote\" means here directories which are used via tramp, ange-ftp or + efs. So mounted directories are counted not as remote directories here even + if such a directory is maybe hosted on a remote machine. But normally only + directories in a LAN are mounted so there should be no performance-problems + with such mounted directories. + + nil: Switch off this feature completely. + +The option `ecb-prescan-directories-exclude-regexps' offers are more fine +granularity to exclude certain directories from this prescan." :group 'ecb-directories -:type 'boolean) +:type '(radio (const :tag "Switch on" :value t) + (const :tag "Switch off for remote directories" :value unless-remote) + (const :tag "Switch off completely" :value nil))) + +(defcustom ecb-prescan-directories-exclude-regexps nil + "*Which directories should be excluded from the empty-prescan. +If a directory matches any of the regexps of this option it will not be +prescanned for emptyness - This option takes only effect if +`ecb-prescan-directories-for-emptyness' is not nil." +:group 'ecb-directories +:type '(repeat (regexp :tag "Directory-regexp"))) + +(defsubst ecb-directory-should-prescanned-p (dir) + "Return not nil if DIR should be prescanned for emptyness. +The check is performed according to the settings in the options +`ecb-prescan-directories-for-emptyness' and +`ecb-prescan-directories-exclude-regexps'." + (and (or (equal t ecb-prescan-directories-for-emptyness) + (and (equal 'unless-remote ecb-prescan-directories-for-emptyness) + (not (ecb-remote-path dir)))) + (not (ecb-match-regexp-list dir ecb-prescan-directories-exclude-regexps)))) + +(defcustom ecb-after-directory-change-hook nil + "*Hook which run directly after the selected directory has changed. +This means not onyl after a click onto a directory in the directory-window of +ECB but it means this hook runs always when the current directory changes +regardless of the trigger of this change. So for example it runs also when you +just switches from one buffer to another via `switch-to-buffer' or +`switch-to-buffer-other-window' and the directory of these filebuffers is +different but only when auto-synchronizing of the ECB-windows is on (see +`ecb-window-sync'). It runs not when switching between buffers and the +associated files reside in the same directory. + +Each function added to this hook will be called with two arguments: The +directory which was current _before_ the directory-change-trigger and the +directory which was now the current \(i.e. after the trigger). + +Example: If you switch from a filebuffer \"~/.emacs\" to a filebuffer +\"/tmp/test.txt\" then the functions of this hook will be called with the +two arguments \"~\" and \"/tmp\"." +:group 'ecb-directories +:type 'hook) + +(defcustom ecb-sources-perform-read-only-check 'unless-remote + "*Check if source-items in the tree-buffers are read-only. +If a sourcefile is read-only then it will be displayed with that face set in +the option `ecb-source-read-only-face'. + +Because this check can be take some time if files are used via a mounted +net-drive ECB performs this check stealthy \(see `ecb-stealthy-tasks-delay') +so normally there should no performance-decrease or additional waiting-time +for the user. But to get sure this option offers three choices: t, +'unless-remote and nil. See `ecb-prescan-directories-for-emptyness' for an +explanation for these three choices. + +The option `ecb-read-only-check-exclude-regexps' offers are more fine +granularity to exclude the sources of certain directories from the read-only +state-check." +:group 'ecb-sources +:group 'ecb-directories +:type '(radio (const :tag "Switch on" :value t) + (const :tag "Switch off for remote directories" :value unless-remote) + (const :tag "Switch off completely" :value nil))) + +(defcustom ecb-read-only-check-exclude-regexps nil + "*Which directories should be excluded from the sources-read-only-check. +If a directory matches any of the regexps of this option their sources will +not be checked if they are writable - This option takes only effect if +`ecb-sources-perform-read-only-check' is not nil." +:group 'ecb-sources +:group 'ecb-directories +:type '(repeat (regexp :tag "Directory-regexp"))) + +(defsubst ecb-sources-read-only-check-p (dir) + "Return not nil if the sources of DIR should be checked for read-only-state. +The check is performed according to the settings in the options +`ecb-sources-perform-read-only-check' and +`ecb-read-only-check-exclude-regexps'." + (and (or (equal t ecb-sources-perform-read-only-check) + (and (equal 'unless-remote ecb-sources-perform-read-only-check) + (not (ecb-remote-path dir)))) + (not (ecb-match-regexp-list dir ecb-read-only-check-exclude-regexps)))) (defcustom ecb-directories-buffer-name " *ECB Directories*" "*Name of the ECB directory buffer. ＠＠ -481,7 +636,7 ＠＠ - nil: No sorting, means the most recently used buffers are on the top of the history and the seldom used buffers at the bottom. See also `ecb-history-sort-ignore-case'." -:group 'ecb-sources +:group 'ecb-history :type '(radio (const :tag "By name" :value name) (const :tag "By extension" ＠＠ -583,7 +738,10 ＠＠ (ecb-file-popup-vc-next-action "Check In/Out") (ecb-file-popup-vc-log "Revision history") (ecb-file-popup-vc-annotate "Annotate") - (ecb-file-popup-vc-diff "Diff against last version"))) + (ecb-file-popup-vc-diff "Diff against last version") + ("---") + (ecb-file-popup-vc-refresh-file "Recompute state for file") + (ecb-file-popup-vc-refresh-dir "Recompute state for whole dir"))) "*Static user extensions for the popup-menu of the sources buffer. For further explanations see `ecb-directories-menu-user-extension'. ＠＠ -615,8 +773,11 ＠＠ (ecb-file-popup-vc-next-action "Check In/Out") (ecb-file-popup-vc-log "Revision history") (ecb-file-popup-vc-annotate "Annotate") - (ecb-file-popup-vc-diff "Diff against last version"))) - "*Static user extensions for the popup-menu of the history buffer. + (ecb-file-popup-vc-diff "Diff against last version") + ("---") + (ecb-file-popup-vc-refresh-file "Recompute state for file") + (ecb-file-popup-vc-refresh-all-files "Recompute state for whole history"))) + "*Static user extensions for the popup-menu of the history buffer. For further explanations see `ecb-directories-menu-user-extension'. The node-argument of a menu-function contains as data the filename of the ＠＠ -722,32 +883,556 ＠＠ :group 'ecb-history :type 'hook) +(defcustom ecb-vc-enable-support 'unless-remote + "*Enable support for version-control \(VC) systems. +If on then in the directories-buffer \(if the value of the option +`ecb-show-sources-in-directories-buffer' is on for current layout), the +sources-buffer and the history-buffer all file-items are displayed with an +appropriate icon in front of the item-name to indicate the VC-state of this +item. If off then no version-control-state checking is done. + +Because this check can be take some time if files are managed by a not local +Version-control-server ECB performs this check stealthy \(see +`ecb-stealthy-tasks-delay') so normally there should no performance-decrease +or additional waiting-time for the user. But to get sure this option offers +three choices: t, 'unless-remote and nil. See the option +`ecb-prescan-directories-for-emptyness' for an explanation for these three +choices. + +The option `ecb-vc-directory-exclude-regexps' offers are more fine granularity +to exclude the sources of certain directories from the VC-state-check. + +See `ecb-vc-supported-backends' how to customize the VC-support itself." +:group 'ecb-version-control +:group 'ecb-sources +:type '(radio (const :tag "Switch on" :value t) + (const :tag "Switch off for remote directories" :value unless-remote) + (const :tag "Switch off completely" :value nil))) + +(defcustom ecb-vc-directory-exclude-regexps nil + "*Which directories should be excluded from VC-state-check. +If a directory matches any of the regexps of this option the VC-state of its +sources will not be checked - This option takes only effect if +`ecb-vc-enable-support' is not nil." +:group 'ecb-version-control +:group 'ecb-sources +:type '(repeat (regexp :tag "Directory-regexp"))) + +(defsubst ecb-vc-directory-should-be-checked-p (dir) + "Return not nil if the sources of DIR should be checked for VC-state. +The check is performed according to the settings in the options +`ecb-vc-enable-support' and `ecb-vc-directory-should-be-checked-p'." + (and (or (equal t ecb-vc-enable-support) + (and (equal 'unless-remote ecb-vc-enable-support) + (not (ecb-remote-path dir)))) + (not (ecb-match-regexp-list dir ecb-vc-directory-exclude-regexps)))) + +(defcustom ecb-vc-state-mapping '((up-to-date . up-to-date) + (edited . edited) + (locally-modified . edited) + (needs-patch . needs-patch) + (needs-checkout . needs-patch) + (needs-merge . needs-merge) + (unlocked-changes . unlocked-changes) + (added . added) + (locally-added . added) + (ignored . ignored) + (unknown . unknown)) + "*Mapping from VC-state-values of the backends to VC-state-values of ECB. +ECB understands the following state-values: + + 'up-to-date The working file is unmodified with respect to the + latest version on the current branch, and not locked. + + 'edited The working file has been locally edited by the user. If + locking is used for the file, this state means that + the current version is locked by the calling user. + + 'needs-patch The file has not been edited by the user, but there is + a more recent version on the current branch stored + in the master file. + + 'needs-merge The file has been edited by the user, and there is also + a more recent version on the current branch stored in + the master file. This state can only occur if locking + is not used for the file. + + 'unlocked-changes The current version of the working file is not locked, + but the working file has been changed with respect + to that version. This state can only occur for files + with locking\; it represents an erroneous condition that + should be resolved by the user. + + 'added The working file has already been added/registered to the + VC-system but not yet commited. + + 'ignored The version-control-system ignores this file \(e.g. + because included in a .cvsignore-file in case of CVS). + + 'unknown The state of the file can not be retrieved\; probably the + file is not under a version-control-system. + +All state-values a check-vc-state-function of `ecb-vc-supported-backends' can +return must have a mapping to one of the ECB-state-values listed above. If for +a certain backend-VC-state no mapping can be found then per default 'edited is +assumed! + +The default value of this option maps already the possible returned +state-values of `ecb-vc-state', `vc-state' and `vc-recompute-state' \(both GNU +Emacs) and `vc-cvs-status' \(Xemacs) to the ECB-VC-state-values." +:group 'ecb-version-control +:group 'ecb-sources +:initialize 'custom-initialize-default +:set (function (lambda (sym val) + (set sym val) + (ecb-vc-cache-clear))) +:type '(repeat (cons (choice :tag "Backend VC-state" +:menu-tag "Backend VC-state" + (const :tag "up-to-date" :value up-to-date) + (const :tag "edited" :value edited) + (const :tag "locally-modified" :value locally-modified) + (const :tag "needs-patch" :value needs-patch) + (const :tag "needs-checkout" :value needs-checkout) + (const :tag "needs-merge" :value needs-merge) + (const :tag "unlocked-changes" :value unlocked-changes) + (const :tag "added" :value added) + (const :tag "locally-added" :value locally-added) + (const :tag "ignored" :value ignored) + (const :tag "unknown" :value unknown) + (symbol :tag "Other...")) + (choice :tag "ECB VC-state" +:menu-tag "ECB VC-state" + (const :tag "up-to-date" :value up-to-date) + (const :tag "edited" :value edited) + (const :tag "needs-patch" :value needs-patch) + (const :tag "needs-merge" :value needs-merge) + (const :tag "unlocked-changes" :value unlocked-changes) + (const :tag "added" :value added) + (const :tag "ignored" :value ignored) + (const :tag "unknown" :value unknown))))) + +(defcustom ecb-vc-supported-backends + (if ecb-running-xemacs + '((ecb-vc-dir-managed-by-CVS . vc-cvs-status)) + '((ecb-vc-dir-managed-by-CVS . ecb-vc-state) + (ecb-vc-dir-managed-by-RCS . ecb-vc-state) + (ecb-vc-dir-managed-by-SCCS . ecb-vc-state) + (ecb-vc-dir-managed-by-SVN . ecb-vc-state))) + "*Define how to to identify the VC-backend and how to check the state. +The value of this option is a list containing cons-cells where the car is a +function which is called to identify the VC-backend for a DIRECTORY and the +cdr is a function which is called to check the VC-state of the FILEs contained +in DIRECTORY. + +Identify-backend-function: It gets a full directory-name as argument - always +without ending slash \(rsp. backslash for native Windows-XEmacs) - and has to +return a unique symbol for the VC-backend which manages that directory \(e.g. +'CVS for the CVS-system or 'RCS for the RCS-system) or nil if the file is not +managed by a version-control-system. + +Check-vc-state-function: It gets a full filename \(ie. incl. the complete +directory-part) and has to return a symbol which indicates the VC-state of +that file. The possible returned values of such a check-vc-state-function have +to be mapped with `ecb-vc-state-mapping' to the allowed ECB-VC-state values. + +ECB runs for a certain DIRECTORY all identify-backend-functions in that order +they are listed in this option. For the first which returns a value unequal +nil the associated check-state-function is used to retrieve the VC-state of +all sourcefiles in that DIRECTORY. + +There is no need for the identify-backend-function or the +check-vc-state-function to cache any state because ECB automatically caches +internally all necessary informations for directories and files for best +possible performance. + +To prepend ECB from checking the VC-state for any file set +`ecb-vc-enable-support' to nil. + +Default value for GNU Emacs: Support for CVS, RCS, SCCS and Subversion \(for +the later one the most recent version of the VC-package incl. the vc-svn +library is needed) is added per default. To identify the VC-backend the +functions `ecb-vc-managed-by-CVS', `ecb-vc-managed-by-RCS' rsp. +`ecb-vc-managed-by-SCCS' rsp. `ecb-vc-managed-by-SVN' are used. For all three +backends the function `ecb-vc-state' of the VC-package is used. + +Default value for XEmacs: XEmacs contains only a quite outdated VC-package, +especially there is no backend-independent check-vc-state-function available +\(like `vc-state' for GNU Emacs). Only for CVS a check-vc-state-function is +available: `vc-cvs-status'. Therefore ECB adds per default only support for +CVS and uses `ecb-vc-managed-by-CVS' rsp. `vc-cvs-status'. + +Example for GNU Emacs: If `vc-recompute-state' \(to get real state-values not +only heuristic ones) should be used to check the state for CVS-managed files +and `vc-state' for all other backends then an element +\(ecb-vc-dir-managed-by-CVS . vc-recompute-state) should be added at the +beginning of this option." +:group 'ecb-version-control +:group 'ecb-sources +:initialize 'custom-initialize-default +:set (function (lambda (sym val) + (set sym val) + (ecb-vc-cache-clear))) +:type '(repeat (cons (symbol :tag "Identify-backend-function") + (symbol :tag "Check-state-function")))) + +;; Klaus Berndl <klaus.berndl(a)sdm.de&gt;: For XEmacs a function like the +;; following could be used to get always fresh state-values: + +;; (defun ecb-vc-recompute-state (file) +;; ;; Return the cvs status of FILE +;; ;; (Status field in output of "cvs status") +;; (vc-fetch-master-properties file) +;; (vc-file-getprop file 'vc-cvs-status)) ;;==================================================== ;; Internals ;;==================================================== +;; constants for the node-types +(defconst ecb-directories-nodetype-directory 0) +(defconst ecb-directories-nodetype-sourcefile 1) +(defconst ecb-directories-nodetype-sourcepath 2) +(defconst ecb-sources-nodetype-sourcefile 0) +(defconst ecb-history-nodetype-sourcefile 0) + + +(defvar ecb-path-selected-directory nil + "Path to currently selected directory.") + +(defvar ecb-path-selected-source nil + "Path to currently selected source.") + +;; accessors for the FILES-AND-SUBDIRS-cache + +(defun ecb-files-and-subdirs-cache-add (dir cached-value) + "Add the files and subdirs of DIR to the cache." + (ecb-multicache-put-value 'ecb-filename-cache dir 'FILES-AND-SUBDIRS + cached-value)) + +(defun ecb-files-and-subdirs-cache-get (dir) + "Get the files and subdirs of DIR from the cache. Nil if not cached." + (ecb-multicache-get-value 'ecb-filename-cache dir 'FILES-AND-SUBDIRS)) + +(defun ecb-files-and-subdirs-cache-remove (dir) + "Remove DIR from the cache." + (ecb-multicache-clear-value 'ecb-filename-cache dir 'FILES-AND-SUBDIRS)) + +(defun ecb-files-and-subdirs-cache-clear () + "Clear the whole FILES-AND-SUBDIRS-cache." + (ecb-multicache-clear-subcache 'ecb-filename-cache 'FILES-AND-SUBDIRS)) + +(defun ecb-files-and-subdirs-cache-dump (&optional no-nil-value) + "Dump the whole FILES-AND-SUBDIRS-cache in another window. If NO-NIL-VALUE +is not nil then these cache-entries are not dumped. This command is not +intended for end-users of ECB." + (interactive "P") + (ecb-multicache-print-subcache 'ecb-filename-cache + 'FILES-AND-SUBDIRS + no-nil-value)) + +;; accessors for the EMPTY-DIR-P-cache + +(defun ecb-directory-empty-cache-add (dir cached-value) + "Add information if DIR is empty or not to the cache." + (ecb-multicache-put-value 'ecb-filename-cache dir 'EMPTY-DIR-P + cached-value)) + +(defun ecb-directory-empty-cache-get (dir) + "get information if DIR is empty or not from the cache." + (ecb-multicache-get-value 'ecb-filename-cache dir 'EMPTY-DIR-P)) + +(defun ecb-directory-empty-cache-remove (dir) + "Remove DIR from the EMPTY-DIR-P-cache." + (ecb-multicache-clear-value 'ecb-filename-cache dir 'EMPTY-DIR-P)) + +(defun ecb-directory-empty-cache-remove-all (dir) + "Remove DIR and all its suddirs from the EMPTY-DIR-P-cache." + (ecb-directory-empty-cache-remove dir) + ;; now we remove the subdirs + (save-match-data + (ecb-multicache-mapsubcache + 'ecb-filename-cache 'EMPTY-DIR-P + (function (lambda (key old-value) + (if (string-match (concat "^" + (regexp-quote dir) + ".+") + key) + ;; the directory-key matches DIR so its a cache + ;; subdirectory of DIR so we return nil ==> in fact we + ;; remove this subdir from the empty-dir-p-cache + nil + ;; the directory-key doesn't match DIR so we just return + ;; the old-value, which means in fact that nothing changes + old-value)))))) + +(defun ecb-directory-empty-cache-clear () + "Clear the whole EMPTY-DIR-P-cache." + (ecb-multicache-clear-subcache 'ecb-filename-cache 'EMPTY-DIR-P)) + +(defun ecb-directory-empty-cache-dump (&optional no-nil-value) + "Dump the whole EMPTY-DIR-P-cache. If NO-NIL-VALUE is not nil then these +cache-entries are not dumped. This command is not intended for end-users of +ECB." + (interactive "P") + (ecb-multicache-print-subcache 'ecb-filename-cache + 'EMPTY-DIR-P no-nil-value)) + + +;; accessors for the SOURCES-cache + +(defun ecb-sources-cache-remove (dir) + "Remove the cache-entry for DIR from the cache." + (ecb-multicache-clear-value 'ecb-filename-cache dir 'SOURCES)) + +(defun ecb-sources-cache-add-full (dir cache-elem-full) + "Add the full sources-cache CACHE-ELEM-FULL for DIR to the cache. If there +is already a full cache-entry then replace it. CACHE-ELEM-FULL has to be a +list as returned by `ecb-sources-cache-get-full'." + (ecb-multicache-apply-to-value + 'ecb-filename-cache dir 'SOURCES + (function (lambda (old-cached-value) + (if (consp old-cached-value) + (progn + (setcar old-cached-value cache-elem-full) + old-cached-value) + (cons cache-elem-full nil)))))) + +(defun ecb-sources-cache-add-filtered (dir cache-elem-filtered) + "Add the filtered sources-cache CACHE-ELEM-FILTERED for DIR to the cache. If +there is already a filtered cache-entry then replace it. CACHE-ELEM-FILTERED +has to be a list as returned by `ecb-sources-cache-get-filtered'." + (ecb-multicache-apply-to-value + 'ecb-filename-cache dir 'SOURCES + (function (lambda (old-cached-value) + (if (consp old-cached-value) + (progn + (setcdr old-cached-value cache-elem-filtered) + old-cached-value) + (cons nil cache-elem-filtered)))))) + +(defun ecb-sources-cache-get-full (dir) + "Return the full value of a cached-directory DIR, means the 3-element-list +\(tree-buffer-root, tree-buffer-nodes, sources-buffer-string). If no +cache-entry for DIR is available then nil is returned." + (car (ecb-multicache-get-value 'ecb-filename-cache dir 'SOURCES))) + +(defun ecb-sources-cache-get-filtered (dir) + "Return the filtered value of a cached-directory DIR, means the +4-element-list \(tree-buffer-root, tree-buffer-nodes, sources-buffer-string, +filter-regexp). If no cache-entry for DIR is available then nil is returned." + (cdr (ecb-multicache-get-value 'ecb-filename-cache dir 'SOURCES))) + +(defun ecb-sources-cache-clear () + "Clear the whole SOURCES-cache." + (ecb-multicache-clear-subcache 'ecb-filename-cache 'SOURCES)) + +(defun ecb-sources-cache-dump (&optional no-nil-value) + "Dump the whole SOURCES-cache. If NO-NIL-VALUE is not nil then these +cache-entries are not dumped. This command is not intended for end-users of +ECB." + (interactive "P") + (ecb-multicache-print-subcache 'ecb-filename-cache 'SOURCES no-nil-value)) + +;; accessors for the VC-cache + +(defun ecb-vc-cache-add-file (file state checked-buffer-names) + (ecb-multicache-put-value 'ecb-filename-cache file 'VC + (list state + (ecb-subseq (current-time) 0 2) + checked-buffer-names)) + state) + +(defun ecb-vc-cache-add-dir (dir backend) + (ecb-multicache-put-value 'ecb-filename-cache dir 'VC backend) + backend) + +(defun ecb-vc-cache-get (file) + (ecb-multicache-get-value 'ecb-filename-cache file 'VC)) + +(defun ecb-vc-cache-remove (file) + "Remove FILE from the VC-cache." + (ecb-multicache-clear-value 'ecb-filename-cache file 'VC)) + +(defun ecb-vc-cache-remove-files-of-dir (dir) + "Remove all files contained in DIR from the VC-cache." + (let* ((dir-sep-string (ecb-directory-sep-string dir)) + (regexp (concat "^" + (regexp-quote dir) + (regexp-quote dir-sep-string) + "[^" + dir-sep-string + "]+$"))) + (save-match-data + (ecb-multicache-mapsubcache + 'ecb-filename-cache 'VC + (function (lambda (key old-value) + (if (and old-value + (string-match regexp key)) + ;; the filename-key has a VC-cache value and matches the + ;; regexp above so its a cached file of DIR so we return + ;; nil ==> in fact we remove this file from the VC-cache + nil + ;; the filename-key doesn't match the regexp above so we + ;; just return the old-value, which means in fact that + ;; nothing changes + old-value))))))) + + +(defun ecb-vc-cache-clear () + "Clear the whole VC-cache." + (ecb-multicache-clear-subcache 'ecb-filename-cache 'VC)) + +(defun ecb-vc-cache-dump (&optional no-nil-value) + "Dump the whole VC-cache. If NO-NIL-VALUE is not nil then these +cache-entries are not dumped. This command is not intended for end-users of +ECB." + (interactive "P") + (ecb-multicache-print-subcache 'ecb-filename-cache 'VC no-nil-value)) + +;; accessors for the REMOTE-PATH cache + +(defun ecb-remote-path-cache-add (path remote-path) + "Add the value of REMOTE-PATH for PATH to the REMOTE-PATH-cache." + (ecb-multicache-put-value 'ecb-filename-cache path 'REMOTE-PATH + remote-path)) + +(defun ecb-remote-path-cache-get (path) + "Return the cached value for PATH from the REMOTE-PATH-cache." + (ecb-multicache-get-value 'ecb-filename-cache path 'REMOTE-PATH)) + +(defun ecb-remote-path-cache-dump (&optional no-nil-value) + "Dump the whole REMOTE-PATH-cache. If NO-NIL-VALUE is not nil then these +cache-entries are not dumped. This command is not intended for end-users of +ECB." + (interactive "P") + (ecb-multicache-print-subcache 'ecb-filename-cache 'REMOTE-PATH no-nil-value)) + +;; accessors for the HOST-ACCESSIBLE cache + +(defun ecb-host-accessible-cache-add (host accessible-p) + "Add the value of ACCESSIBLE-P to the HOST-ACCESSIBLE-cache with key HOST." + (ecb-multicache-put-value 'ecb-filename-cache host 'HOST-ACCESSIBLE + (cons (current-time) accessible-p))) + +(defun ecb-host-accessible-cache-get (host valid-time) + "Get the accessible-p value from the HOST-ACCESSIBLE-cache. If the cache +entry is older then VALID-TIME \(in seconds) then it is discarded." + (let ((value (ecb-multicache-get-value 'ecb-filename-cache host + 'HOST-ACCESSIBLE))) + (if (or (null value) + (> (ecb-time-diff (current-time) (car value) t) valid-time)) + ;; either not yet cached or outdated + nil + ;; return the valid cache-value + (cdr value)))) + +(defun ecb-host-accessible-cache-dump (&optional no-nil-value) + "Dump the whole HOST-ACCESSIBLE-cache. If NO-NIL-VALUE is not nil then these +cache-entries are not dumped. This command is not intended for end-users of +ECB." + (interactive "P") + (ecb-multicache-print-subcache 'ecb-filename-cache 'HOST-ACCESSIBLE no-nil-value)) + + +;; ---- end of filename-cache implementation ----------------------- + +(defun ecb-file-browser-initialize-caches () + "Initialize the caches of the file-browser of ECB." + (ecb-reset-history-filter) + (ecb-filename-cache-init)) + +(defun ecb-file-browser-initialize (&optional no-caches) + "Initialize the file-browser of ECB. If optional arg NO-CACHES is not nil +then the caches used by the file-browser will not be initialized." + (setq ecb-path-selected-directory nil + ecb-path-selected-source nil) + (unless no-caches + (ecb-file-browser-initialize-caches))) + (defmacro ecb-exec-in-directories-window (&rest body) + "Evaluates BODY in the directories-window of ECB. If that window is not +visible then return the symbol 'window-not-visible. Otherwise the return +value of BODY is returned." `(unwind-protect - (when (ecb-window-select ecb-directories-buffer-name) + (if (not (ecb-window-select ecb-directories-buffer-name)) + 'window-not-visible ,＠body) )) (defmacro ecb-exec-in-sources-window (&rest body) + "Evaluates BODY in the sources-window of ECB. If that window is not +visible then return the symbol 'window-not-visible. Otherwise the return +value of BODY is returned." `(unwind-protect - (when (ecb-window-select ecb-sources-buffer-name) + (if (not (ecb-window-select ecb-sources-buffer-name)) + 'window-not-visible ,＠body) )) (defmacro ecb-exec-in-history-window (&rest body) + "Evaluates BODY in the history-window of ECB. If that window is not +visible then return the symbol 'window-not-visible. Otherwise the return +value of BODY is returned." `(unwind-protect - (when (ecb-window-select ecb-history-buffer-name) + (if (not (ecb-window-select ecb-history-buffer-name)) + 'window-not-visible ,＠body) )) +(defun ecb-goto-window-directories () + "Make the ECB-directories window the current window. +If `ecb-use-speedbar-instead-native-tree-buffer' is 'dir then goto to the +speedbar-window." + (interactive) + (or (ecb-goto-ecb-window ecb-directories-buffer-name) + (and (equal ecb-use-speedbar-instead-native-tree-buffer 'dir) + (ecb-goto-window-speedbar)))) + +(defun ecb-goto-window-sources () + "Make the ECB-sources window the current window. +If `ecb-use-speedbar-instead-native-tree-buffer' is 'source then goto to the +speedbar-window." + (interactive) + (or (ecb-goto-ecb-window ecb-sources-buffer-name) + (and (equal ecb-use-speedbar-instead-native-tree-buffer 'source) + (ecb-goto-window-speedbar)))) + +(defun ecb-goto-window-history () + "Make the ECB-history window the current window." + (interactive) + (ecb-goto-ecb-window ecb-history-buffer-name)) + +(defun ecb-maximize-window-directories () + "Maximize the ECB-directories-window. +I.e. delete all other ECB-windows, so only one ECB-window and the +edit-window\(s) are visible \(and maybe a compile-window). Works also if the +ECB-directories-window is not visible in current layout." + (interactive) + (if (equal ecb-use-speedbar-instead-native-tree-buffer 'dir) + (ecb-maximize-window-speedbar) + (ecb-display-one-ecb-buffer ecb-directories-buffer-name))) + +(defun ecb-maximize-window-sources () + "Maximize the ECB-sources-window. +I.e. delete all other ECB-windows, so only one ECB-window and the +edit-window\(s) are visible \(and maybe a compile-window). Works also if the +ECB-sources-window is not visible in current layout." + (interactive) + (if (equal ecb-use-speedbar-instead-native-tree-buffer 'source) + (ecb-maximize-window-speedbar) + (ecb-display-one-ecb-buffer ecb-sources-buffer-name))) + +(defun ecb-maximize-window-history () + "Maximize the ECB-history-window. +I.e. delete all other ECB-windows, so only one ECB-window and the +edit-window\(s) are visible \(and maybe a compile-window). Works also if the +ECB-history-window is not visible in current layout." + (interactive) + (ecb-display-one-ecb-buffer ecb-history-buffer-name)) + (defun ecb-expand-directory-tree (path node) "Expands the directory part so the node representing PATH is visible. ＠＠ -761,7 +1446,8 ＠＠ (when (and (>= (length path) (length data)) (ecb-string= (substring path 0 (length data)) data) (or (= (length path) (length data)) - (eq (elt path (length data)) ecb-directory-sep-char))) + (eq (elt path (length data)) + (ecb-directory-sep-char path)))) (let ((was-expanded (or (not (tree-node-is-expandable child)) (tree-node-is-expanded child)))) (tree-node-set-expanded child t) ＠＠ -772,33 +1458,6 ＠＠ (not was-expanded))))))))) -(defvar ecb-files-and-subdirs-cache nil - "Cache for every directory all subdirs and files. This is an alist where an -element looks like: - \(<directory> . \(<file-list> . <subdirs-list>))") - - -(defun ecb-files-and-subdirs-cache-add (cache-elem) - (if (not (ecb-files-and-subdirs-cache-get (car cache-elem))) - (setq ecb-files-and-subdirs-cache - (cons cache-elem ecb-files-and-subdirs-cache)))) - - -(defun ecb-files-and-subdirs-cache-get (dir) - (cdr (assoc dir ecb-files-and-subdirs-cache))) - - -(defun ecb-files-and-subdirs-cache-remove (dir) - (let ((elem (assoc dir ecb-files-and-subdirs-cache))) - (if elem - (setq ecb-files-and-subdirs-cache - (delete elem ecb-files-and-subdirs-cache))))) - - -(defun ecb-clear-files-and-subdirs-cache () - (setq ecb-files-and-subdirs-cache nil)) - - (defun ecb-check-directory-for-caching (dir number-of-contents) "Return not nil if DIR matches not any regexp of the option `ecb-cache-directory-contents-not' but matches at least one regexp in ＠＠ -833,7 +1492,7 ＠＠ file in current directory." (let* ((fixed-path (ecb-fix-path dir)) (cvsignore-content (ecb-file-content-as-string - (expand-file-name ".cvsignore" fixed-path))) + (expand-file-name ".cvsignore" fixed-path))) (files nil)) (when cvsignore-content (dolist (f (split-string cvsignore-content)) ＠＠ -877,7 +1536,7 ＠＠ '(("") ("")))) (cvsignore-files (if (ecb-check-directory-for-cvsignore-exclude dir) (ecb-files-from-cvsignore dir))) - sorted-files source-files subdirs cache-elem) + sorted-files source-files subdirs cached-value) ;; if necessary sort FILES (setq sorted-files (if ecb-sources-sort-method ＠＠ -890,81 +1549,21 ＠＠ (dolist (file sorted-files) (if (file-directory-p (ecb-fix-filename dir file)) (when (not (ecb-check-dir-exclude file)) - (when (ecb-string= file "C:/System Volume Information" t) ;; (not (file-accessible-directory-p file)) - (ecb-merge-face-into-text file - ecb-directory-not-accessible-face)) +;; (when (not (file-accessible-directory-p file)) +;; (ecb-merge-face-into-text file +;; ecb-directory-not-accessible-face)) (setq subdirs (append subdirs (list file)))) (when (and (not (member file cvsignore-files)) (or (ecb-match-regexp-list file (cadr source-regexps)) (not (ecb-match-regexp-list file (car source-regexps))))) - (when (not (file-writable-p file)) - (ecb-merge-face-into-text file ecb-source-read-only-face)) (setq source-files (append source-files (list file)))))) - (setq cache-elem (cons dir (cons source-files subdirs))) + (setq cached-value (cons source-files subdirs)) ;; check if this directory must be cached (if (ecb-check-directory-for-caching dir (length sorted-files)) - (ecb-files-and-subdirs-cache-add cache-elem)) + (ecb-files-and-subdirs-cache-add dir cached-value)) ;; return the result - (cdr cache-elem)))) - - -(defvar ecb-sources-cache nil - "Cache for the contents of the buffer `ecb-sources-buffer-name'. This is an -alist where every element is a cons cell which looks like: - \(<directory> . <cache-entry>) whereas <cache-entry> is a cons-cell too which -contains as car a 3-elem list \(tree-buffer-root <copy of tree-buffer-nodes> -buffer-string) for a full \(i.e. all files) cache and as cdr a 4-elem list -\(tree-buffer-root, tree-buffer-nodes, sources-buffer-string, <filter>) for a -filtered cache where <filter> is another cons-cell \(<filter-regexp> . -<filter-display>).") - - -(defun ecb-sources-cache-remove (dir) - "Remove the cache-entry for DIR in `ecb-sources-cache'." - (let ((cache-elem (assoc dir ecb-sources-cache))) - (if cache-elem - (setq ecb-sources-cache (delq cache-elem ecb-sources-cache))))) - - -(defun ecb-sources-cache-add-full (dir cache-elem-full) - "Add the full sources-cache CACHE-ELEM-FULL for DIR to -`ecb-sources-cache'. If there is already a full cache-entry then replace it." - (let ((elem (assoc dir ecb-sources-cache))) - (if (not elem) - (setq ecb-sources-cache - (cons (cons dir (cons cache-elem-full nil)) - ecb-sources-cache)) - (setcdr elem (cons cache-elem-full - (cdr (cdr elem))))))) - -(defun ecb-sources-cache-add-filtered (dir cache-elem-filtered) - "Add the filtered sources-cache CACHE-ELEM-FILTERED for DIR to -`ecb-sources-cache'. If there is already a filtered cache-entry then replace -it." - (let ((elem (assoc dir ecb-sources-cache))) - (if (not elem) - (setq ecb-sources-cache - (cons (cons dir (cons nil cache-elem-filtered)) - ecb-sources-cache)) - (setcdr elem (cons (car (cdr elem)) - cache-elem-filtered))))) - -(defun ecb-sources-cache-get-full (dir) - "Return the full value of a cached-directory DIR, means the 3-element-list -\(tree-buffer-root, tree-buffer-nodes, sources-buffer-string). If no -cache-entry for DIR is available then nil is returned." - (car (cdr (assoc dir ecb-sources-cache)))) - -(defun ecb-sources-cache-get-filtered (dir) - "Return the filtered value of a cached-directory DIR, means the -4-element-list \(tree-buffer-root, tree-buffer-nodes, sources-buffer-string, -filter-regexp). If no cache-entry for DIR is available then nil is returned." - (cdr (cdr (assoc dir ecb-sources-cache)))) - -(defun ecb-sources-cache-clear () - "Clear the whole cache of `ecb-sources-cache'." - (setq ecb-sources-cache nil)) + cached-value))) (defun ecb-update-sources-buffer (dir-before-update) ＠＠ -1001,7 +1600,8 ＠＠ new-tree ecb-path-selected-directory (car (ecb-get-files-and-subdirs ecb-path-selected-directory)) - 0 ecb-show-source-file-extension old-children t) + ecb-sources-nodetype-sourcefile + ecb-show-source-file-extension old-children t) ;; updating the buffer itself (tree-buffer-set-root new-tree) ＠＠ -1116,7 +1716,8 ＠＠ new-tree ecb-path-selected-directory (nreverse filtered-files) - 0 ecb-show-source-file-extension old-children t) + ecb-sources-nodetype-sourcefile + ecb-show-source-file-extension old-children t) ;; updating the buffer itself (tree-buffer-set-root new-tree) ＠＠ -1129,7 +1730,8 ＠＠ (ecb-sources-cache-add-filtered ecb-path-selected-directory (list (tree-buffer-get-root) (ecb-copy-list tree-buffer-nodes) - (buffer-string) + (buffer-substring (point-min) + (point-max)) (cons filter-regexp (or filter-display filter-regexp))))))))) ＠＠ -1163,9 +1765,9 ＠＠ (lambda (lhs rhs) (> (length lhs) (length rhs))))))) -(defun ecb-get-best-matching-source-path () - "Return the best-matching source-path for the current selected source." - (car (ecb-matching-source-paths ecb-path-selected-source t))) +(defun ecb-get-best-matching-source-path (path) + "Return the best-matching source-path for PATH." + (car (ecb-matching-source-paths path t))) (defun ecb-set-selected-directory (path &optional force) "Set the contents of the ECB-directories and -sources buffer correct for the ＠＠ -1191,8 +1793,8 ＠＠ ;; otherwise the node of the best matching ;; source-path (let ((best-source-path - (car (ecb-matching-source-paths - ecb-path-selected-directory t)))) + (ecb-get-best-matching-source-path + ecb-path-selected-directory))) (if best-source-path (tree-buffer-find-node-data (ecb-fix-filename best-source-path)))) ＠＠ -1214,7 +1816,11 ＠＠ (tree-buffer-get-root))) (not was-expanded)) (tree-buffer-update) - (tree-buffer-recenter start (selected-window)))) + (tree-buffer-recenter start (selected-window)) + ;; sometimes we do not need a full tree-buffer-update, even + ;; when FORCE is not nil. But we have to restart the + ;; directories-buffer stealthy-state. + (and force (ecb-stealth-tasks-after-directories-update)))) ;; (ecb-expand-directory-tree ecb-path-selected-directory ;; (or start ;; (tree-buffer-get-root))) ＠＠ -1223,7 +1829,11 ＠＠ (tree-buffer-highlight-node-data ecb-path-selected-directory start))))) ;; now we update the sources buffer for `ecb-path-selected-directory' - (ecb-update-sources-buffer last-dir)))) + (ecb-update-sources-buffer last-dir) + ;; now we run the hooks + (run-hook-with-args 'ecb-after-directory-change-hook + last-dir ecb-path-selected-directory) + ))) ;; set the default-directory of each tree-buffer to current selected ;; directory so we can open files via find-file from each tree-buffer. ＠＠ -1236,8 +1846,8 ＠＠ (concat ecb-path-selected-directory (and (not (= (aref ecb-path-selected-directory (1- (length ecb-path-selected-directory))) - ecb-directory-sep-char)) - ecb-directory-sep-string))))) + (ecb-directory-sep-char ecb-path-selected-directory))) + (ecb-directory-sep-string ecb-path-selected-directory)))))) ;; set the modelines of all visible tree-buffers new (ecb-mode-line-format)) ＠＠ -1343,13 +1953,20 ＠＠ (tree-node-add-child-first (tree-buffer-get-root) (tree-node-new - (if (eq ecb-history-item-name 'buffer-name) - (let ((b (get-file-buffer filename))) - (if b - (buffer-name b) - (ecb-get-source-name filename))) - (ecb-get-source-name filename)) - 0 + (let ((file-1 (if (eq ecb-history-item-name 'buffer-name) + (let ((b (get-file-buffer filename))) + (if b + (buffer-name b) + (ecb-get-source-name filename))) + (ecb-get-source-name filename))) + (dir (file-name-directory filename))) + (if (and (ecb-vc-directory-should-be-checked-p dir) + (ecb-vc-managed-dir-p dir)) + (ecb-vc-generate-node-name file-1 + (nth 0 (ecb-vc-cache-get filename))) + (ecb-generate-node-name file-1 -1 "leaf" + ecb-sources-buffer-name))) + ecb-history-nodetype-sourcefile filename t))))) ＠＠ -1362,20 +1979,36 ＠＠ (tree-buffer-get-root) (cond ((equal ecb-history-sort-method 'name) (function (lambda (l r) - (ecb-string< (tree-node-get-name l) - (tree-node-get-name r) - ecb-history-sort-ignore-case)))) + (let* ((l0 (tree-node-get-name l)) + (r0 (tree-node-get-name r)) + (l1 (save-match-data + (if (string-match "^(.) \\(.+\\)$" l0) + (match-string 1 l0) + l0))) + (r1 (save-match-data + (if (string-match "^(.) \\(.+\\)$" r0) + (match-string 1 r0) + r0)))) + (ecb-string< l1 r1 ecb-history-sort-ignore-case))))) ((equal ecb-history-sort-method 'extension) (function (lambda (l r) - (let* ((a (tree-node-get-name l)) - (b (tree-node-get-name r)) - (ext-a (file-name-extension a t)) - (ext-b (file-name-extension b t))) - (if (ecb-string= ext-a ext-b ecb-history-sort-ignore-case) - (ecb-string< a b ecb-history-sort-ignore-case) - (ecb-string< ext-a ext-b ecb-history-sort-ignore-case)))))) - (t (function (lambda (a b) + (let* ((l0 (tree-node-get-name l)) + (r0 (tree-node-get-name r)) + (l1 (save-match-data + (if (string-match "^(.) \\(.+\\)$" l0) + (match-string 1 l0) + l0))) + (r1 (save-match-data + (if (string-match "^(.) \\(.+\\)$" r0) + (match-string 1 r0) + r0))) + (ext-l (file-name-extension l1 t)) + (ext-r (file-name-extension r1 t))) + (if (ecb-string= ext-l ext-r ecb-history-sort-ignore-case) + (ecb-string< l1 r1 ecb-history-sort-ignore-case) + (ecb-string< ext-l ext-r ecb-history-sort-ignore-case)))))) + (t (function (lambda (l r) nil)))))))) ＠＠ -1428,27 +2061,6 ＠＠ (tree-buffer-highlight-node-data ecb-path-selected-source))))) - (defun ecb-tree-node-add-files - (node path files type include-extension old-children - &optional not-expandable) - "For every file in FILES add a child-node to NODE." - (dolist (file files) - (let* ((filename (ecb-fix-filename path file)) - (file-1 (if include-extension - file - (file-name-sans-extension file))) - (displayed-file file-1)) - (tree-node-add-child - node - (ecb-new-child - old-children - displayed-file - type filename - (or not-expandable - (= type 1) - (ecb-check-emptyness-of-dir filename)) - (if ecb-truncate-long-names 'end)))))) - (defun ecb-update-directory-node (node) "Updates the directory node NODE and add all subnodes if any." ＠＠ -1458,9 +2070,11 ＠＠ (if (file-accessible-directory-p path) (let ((files-and-dirs (ecb-get-files-and-subdirs path))) (ecb-tree-node-add-files node path (cdr files-and-dirs) - 0 t old-children) + ecb-directories-nodetype-directory + t old-children) (if (ecb-show-sources-in-directories-buffer-p) - (ecb-tree-node-add-files node path (car files-and-dirs) 1 + (ecb-tree-node-add-files node path (car files-and-dirs) + ecb-directories-nodetype-sourcefile ecb-show-source-file-extension old-children t)) (tree-node-set-expandable node (or (tree-node-get-children node))) ＠＠ -1491,8 +2105,6 ＠＠ (not (equal (selected-frame) ecb-frame))) (save-selected-window (ecb-exec-in-directories-window - ;; (setq tree-buffer-type-faces - ;; (list (cons 1 ecb-source-in-directories-buffer-face))) (let* ((node (tree-buffer-get-root)) (old-children (tree-node-get-children node)) (paths (append (ecb-get-source-paths-from-functions) ＠＠ -1500,79 +2112,849 ＠＠ (tree-node-set-children node nil) (dolist (dir paths) (let* ((path (if (listp dir) (car dir) dir)) - (norm-dir (ecb-fix-filename path nil t)) - (name (if (listp dir) (cadr dir) norm-dir))) - (if (file-accessible-directory-p norm-dir) - (tree-node-add-child - node - (ecb-new-child old-children name 2 norm-dir - (ecb-check-emptyness-of-dir norm-dir) - (if ecb-truncate-long-names 'beginning))) + (remote-path (ecb-remote-path path)) + (norm-dir nil) + (name nil) + (not-accessible nil)) + (if (or (not remote-path) + (ecb-host-accessible-p (nth 1 remote-path))) + (progn + (setq norm-dir (ecb-fix-filename path nil t)) + (setq name (if (listp dir) (cadr dir) norm-dir)) + (if (file-accessible-directory-p norm-dir) + (tree-node-add-child + node + (ecb-new-child old-children name + ecb-directories-nodetype-sourcepath + norm-dir + nil + (if ecb-truncate-long-names + 'beginning))) + (setq not-accessible t))) + (setq not-accessible t)) + (when not-accessible (if (listp dir) (ecb-warning "Source-path %s with alias %s is not accessible - ignored!" - norm-dir (cadr dir)) - (ecb-warning "Source-path %s is not accessible - ignored!" norm-dir))))) - (tree-buffer-update)))))) - - -(defvar ecb-directory-empty-cache nil - "Cache for every directory if it is empty or not. This is an alist where an -element looks like: - \(<directory> . \(\[nil|t] . <checked-with-show-sources>") - + (car dir) (cadr dir)) + (ecb-warning "Source-path %s is not accessible - ignored!" dir))))) + (tree-buffer-update)))) + )) -(defun ecb-directory-empty-cache-add (cache-elem) - (if (not (ecb-directory-empty-cache-get (car cache-elem))) - (setq ecb-directory-empty-cache - (cons cache-elem ecb-directory-empty-cache)))) +;; remote-path stuff +(defsubst ecb-host-accessible-valid-time (host) + "Get the valid-cache-time of a remote HOST concering its ping-state. If host +doesn't match any regexp of `ecb-host-accessible-check-valid-time' then return +60 seconds." + (or (ecb-match-regexp-list host ecb-host-accessible-check-valid-time + 'car 'cdr) + 60)) + +;; (ecb-host-accessible-valid-time "ecb.sourceforge.net") + +(defun ecb-host-accessible-p (host) + "Return not nil if HOST is accessible." + (let ((value (ecb-host-accessible-cache-get + host (ecb-host-accessible-valid-time host)))) + (cond ((equal value 'NOT-ACCESSIBLE) + nil) + (value value) + (t (let* ((options (append ecb-ping-options (list host))) + (result (equal 0 (apply 'call-process + ecb-ping-program + nil nil nil + options)))) + (ecb-host-accessible-cache-add host (or result 'NOT-ACCESSIBLE)) + result))))) + +;; (ecb-host-accessible-p "ecb.sourceforge.net") + +(silentcomp-defun ange-ftp-ftp-name) +(silentcomp-defun efs-ftp-path) +(silentcomp-defun tramp-tramp-file-p) +(silentcomp-defun tramp-file-name-path) +(silentcomp-defun tramp-file-name-localname) +(silentcomp-defun tramp-file-name-host) +(silentcomp-defun tramp-dissect-file-name) +(defun ecb-remote-path (path) + "Test if PATH is a remote path and dissect it into components if yes. +Returns a list (FULL-HOST-USER-PART HOST REAL-PATH), or nil if PATH is not a +remote path. FULL-HOST-USER-PART is that component from beginning of PATH to +the:-separator which separates user- and host-parts from the real path, i.e. +it always ends with a colon! HOST is the remote HOST and REAL-PATH is that +component after that :-separator. Supports tramp, ange-ftp and efs." + (let ((value (ecb-remote-path-cache-get path))) + (cond ((equal value 'NOT-REMOTE) + nil) + (value value) + (t + (let* ((dissection (or (and (featurep 'tramp) ;; tramp-support + (tramp-tramp-file-p path) + (tramp-dissect-file-name path)) + (and (featurep 'ange-ftp) ;; ange-ftp-support + (ange-ftp-ftp-name path)) + (and (featurep 'efs) ;; efs support + (efs-ftp-path path)))) + (host/real-path + (if dissection + (or (and (featurep 'tramp) ;; tramp-support + (cons (tramp-file-name-host dissection) + (if (fboundp 'tramp-file-name-localname) + (tramp-file-name-localname dissection) + (tramp-file-name-path dissection)))) + (and (featurep 'ange-ftp) ;; ange-ftp-support + (cons (nth 0 dissection) + (nth 2 dissection))) + (and (featurep 'efs) ;; efs support + (cons (nth 0 dissection) + (nth 2 dissection)))) + (cons nil path))) + (full-host-user-part + (substring path 0 (- (length path) + (length (cdr host/real-path))))) + (result nil)) + (setq result + (and dissection + (list full-host-user-part + (car host/real-path) + (cdr host/real-path)))) + (ecb-remote-path-cache-add path (or result 'NOT-REMOTE)) + result))))) -(defun ecb-directory-empty-cache-get (dir) - (cdr (assoc dir ecb-directory-empty-cache))) +;; (ecb-remote-path "/berndl＠ecb.sourceforge.net:~") +;; (ecb-remote-path "~") -(defun ecb-directory-empty-cache-remove (dir) - (let ((elem (assoc dir ecb-directory-empty-cache))) - (if elem - (setq ecb-directory-empty-cache - (delete elem ecb-directory-empty-cache))))) +;; empty dirs +(defun ecb-check-emptyness-of-dir (dir) + "Checks if DIR is an empty directory. If empty return not nil otherwise nil." + (let ((cache-value (ecb-directory-empty-cache-get dir)) + (show-sources (ecb-show-sources-in-directories-buffer-p))) + (if (and cache-value + (equal (cdr cache-value) show-sources)) + (car cache-value) + (ecb-directory-empty-cache-remove dir) + (let ((entries (and (file-accessible-directory-p dir) + (directory-files dir nil nil t))) + (just-files-means-empty (not show-sources)) + (full-file-name nil) + (empty-p nil)) + (setq empty-p + (catch 'found + (dolist (e entries) + (when (not (member e '("." ".." "CVS"))) + (setq full-file-name (ecb-fix-filename dir e)) + (if (file-directory-p full-file-name) + (throw 'found 'nil) + (if (not just-files-means-empty) + (throw 'found 'nil))))) + t)) + ;; now we add this value to the cache + (ecb-directory-empty-cache-add (ecb-fix-filename dir) + (cons empty-p show-sources)) + empty-p)))) + + +(defecb-stealthy ecb-stealthy-empty-dir-check + "Check for each current visible nodes in the directories buffer if the +underlying directory is empty or not and update the node if the current node +state and display is different from the empty-state of the associated +directory. This function is only for use by `ecb-stealthy-updates'!" + (save-selected-window + (when (equal 'window-not-visible + (ecb-exec-in-directories-window + (if (equal state 'restart) + (setq state 1)) + ;; Here the state is an integer because a stealthy functions runs only + ;; when state != 'done + (let ((lines-of-buffer (count-lines (point-min) (point-max))) + (curr-node nil) + (dir-empty-p nil)) + (save-excursion + (while (and (not (input-pending-p)) + (<= state lines-of-buffer)) + (goto-line state) + (setq curr-node (tree-buffer-get-node-at-point)) + (when (ecb-directory-should-prescanned-p + (tree-node-get-data curr-node)) + (setq dir-empty-p + (ecb-check-emptyness-of-dir (tree-node-get-data curr-node))) + ;; we update the node only if we have an empty dir and the node is + ;; still expandable + (when (or (and dir-empty-p + (tree-node-is-expandable curr-node)) + (and (not dir-empty-p) + (not (tree-node-is-expandable curr-node)))) + (tree-buffer-update-node nil + 'use-old-value + 'use-old-value + 'use-old-value + 'use-old-value + (not dir-empty-p) + t))) + (setq state (1+ state)))) + (if (> state lines-of-buffer) + (setq state 'done))))) + (setq state 'done)))) + +;; read-only-files? + +(defun ecb-stealthy-read-only-check--internal (state) + "Check for all sourcefile-nodes either in the directories- or the +sources-buffer if the associated file is writable or not. This function does +the real job and is is only for use by a stealthy function defined with +`defecb-stealthy'! STATE is the initial state-value the stealthy-function has +when called. Return the new state-value." + (if (or (not ecb-sources-perform-read-only-check) + (not (or (string= (buffer-name (current-buffer)) + ecb-sources-buffer-name) + (and (string= (buffer-name (current-buffer)) + ecb-directories-buffer-name) + (ecb-show-sources-in-directories-buffer-p))))) + 'done + ;; Now we are either in the sources-buffer or in the directories-buffer + ;; when sources are displayed in the directories-buffer + (if (equal state 'restart) + (setq state 1)) + ;; Here the state is an integer because a stealthy functions runs only + ;; when state != 'done + (let ((lines-of-buffer (count-lines (point-min) (point-max))) + (curr-node nil) + (new-name nil) + (read-only-p nil) + (node-type-to-check (if (string= (buffer-name (current-buffer)) + ecb-sources-buffer-name) + ecb-sources-nodetype-sourcefile + ecb-directories-nodetype-sourcefile))) + (save-excursion + (while (and (not (input-pending-p)) + (<= state lines-of-buffer)) + (goto-line state) + (setq curr-node (tree-buffer-get-node-at-point)) + (when (and (= (tree-node-get-type curr-node) node-type-to-check) + (ecb-sources-read-only-check-p + (file-name-directory (tree-node-get-data curr-node)))) + (setq new-name (tree-node-get-name curr-node)) + (setq read-only-p + (not (file-writable-p (tree-node-get-data curr-node)))) + (if read-only-p + (ecb-merge-face-into-text new-name + ecb-source-read-only-face)) + ;; we update the node only if we have an empty dir and the node is + ;; still expandable + (when read-only-p + (tree-buffer-update-node + nil + new-name + 'use-old-value + 'use-old-value + 'use-old-value + 'use-old-value + t))) + (setq state (1+ state)))) + (if (> state lines-of-buffer) + (setq state 'done))) + state)) + + +(defecb-stealthy ecb-stealthy-ro-check-in-directories-buf + "Check for all sourcefile-nodes in the directories-buffer if the associated +file is writable or not." + (if (ecb-show-sources-in-directories-buffer-p) + (save-selected-window + (when (equal 'window-not-visible + (ecb-exec-in-directories-window + (setq state + (ecb-stealthy-read-only-check--internal state)))) + (setq state 'done))) + (setq state 'done))) + +(defecb-stealthy ecb-stealthy-ro-check-in-sources-buf + "Check for all sourcefile-nodes in the sources-buffer if the associated file +is writable or not." + (save-selected-window + (when (equal 'window-not-visible + (ecb-exec-in-sources-window + (setq state + (ecb-stealthy-read-only-check--internal state)))) + (setq state 'done)))) + +;; version control support + +;; We use a cache which stores for +;; + a directory: either the function used to check the VC-state of its files +;; (if the directory is managed by a VC-backend) or the symbol 'NO-VC (if +;; the dir is not managed by a VC-backend). +;; + a file: the most recent VC-state plus the check-timestamp for this state. +;; +;; So we have to call only once the identify-backend-function (see above) for +;; a directory. The check-state-function must only be called if the file has +;; been modified since the stored check-state-timestamp. With this caching +;; even using real-VC-checks (as vc-recompute-state) which never uses +;; heuristics is possible without loosing to much informations (only if a file +;; is modified by another user can not be detected with this cache - but for +;; this we have the power-click which always throws away any cache-state) + +(defconst ecb-vc-state-icon-alist '((up-to-date . ("vc-up-to-date" "(u)")) + (edited . ("vc-edited" "(e)")) + (added . ("vc-added" "(a)")) + (needs-patch . ("vc-needs-patch" "(p)")) + (needs-merge . ("vc-needs-merge" "(m)")) + (ignored . ("vc-ignored" "(x)")) + (unknown . ("vc-unknown" "(?)")) + (nil . ("vc-unknown" "(?)"))) + "Associate an image-name and a textual icon to the allowed VC-states - see +`ecb-vc-supported-backends'. Each element is a cons-cell where the car is the +symbol of a supported VC-state and the cdr a 2-element list where the first +element is the name of the needed image-icon and the second element the +ascii-string which should be dislayed if Emacs doesn't support image-display.") + +(defsubst ecb-vc-get-image-name-for-vc-state (state) + "Return the associated image-name for the vc-state STATE." + (or (nth 0 (cdr (assq state ecb-vc-state-icon-alist))) + "vc-unknown")) + +(defsubst ecb-vc-get-ascii-icon-for-vc-state (state) + "Return the associated texual icon for the vc-state STATE." + (or (nth 1 (cdr (assq state ecb-vc-state-icon-alist))) + "(?)")) + + +(defconst ecb-vc-incr-searchpattern-node-prefix + '("\\(\\(([uempx?])\\)? \\)?" . 2) + "Prefix-pattern which ignores all not interesting vc-icon-stuff of a +node-name at incr. search. This ignores the \"(<vc-state-char>)\" whereas +<vc-state-char> is one of u, e, m, p or ?. +Format: cons with car is the pattern and cdr is the number of subexpr in this +pattern.") + + +(defun ecb-vc-check-state (file tree-buffer-name vc-state-fcn) + "Check if the VC-state for FILE must be rechecked, i.e. if it is out of +date. If it is still valid and also already checked for TREE-BUFFER-NAME then +return the symbol 'unchanged \(if still valid but only not checked for +TREE-BUFFER-NAME then return the state and store the fact that it has been +check now also for this buffer). Otherwise check the new state for FILE with +VC-STATE-FCN, store it in the cache only for TREE-BUFFER-NAME and return the +new state." + (let* ((cached-state (ecb-vc-cache-get file)) + (last-state (nth 0 cached-state)) + (last-check-time (nth 1 cached-state)) + (checked-tree-buffer-names (nth 2 cached-state)) + (no-need-for-state-check-p + (and last-check-time + (or (null last-state) ;; FILE has been checked but is not in VC + (not (ecb-time-less-p last-check-time + (ecb-subseq (nth 5 (file-attributes file)) + 0 2)))))) + (result nil)) + (if no-need-for-state-check-p + ;; FILE was not modified since our last vc-state-check + (if (member tree-buffer-name checked-tree-buffer-names) + ;; TREE-BUFFER-NAMES is in the list of buffer-names for which the + ;; state of FILE has already been cached ==> there is no need to + ;; update the cache we can just return 'unchanged to signalize + ;; that nothing has to be updated + (setq result 'unchanged) + ;; now we add TREE-BUFFER-NAME to that list - this new list will be + ;; added to the cache below. As result we will return the last-state + ;; because the state itself is still valid - the only thing we now + ;; have to store in the cache is that the last-state is now valid + ;; for TREE-BUFFER-NAME too! + (setq result last-state) + (setq checked-tree-buffer-names + (cons tree-buffer-name checked-tree-buffer-names))) + + ;; FILE was modified since our last vc-state-check, so we have to check + ;; the state again + + ;; set the list of the buffer-names for which the check will be performed + ;; and then cached to TREE-BUFFER-NAME ==> Only for this buffer-name the + ;; cache is valid. + (setq checked-tree-buffer-names (list tree-buffer-name)) + ;; get the new vc-state + (setq result (and vc-state-fcn + (fboundp vc-state-fcn) + ;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: + ;; vc-cvs-state seems to change the window-config + ;; (opens a new small window) if it fails...so maybe + ;; we have to save the window-config before this call + ;; and restore it when the call fails - later... ;-) + + ;; we must ignore errors here because it could be that + ;; a user has a certain VC-system not installed onto + ;; his machine but opens directories which have a + ;; CVS-subdir for example - then for such a directory + ;; ECB would eventually call this backend - but this + ;; would fail because the needed program is not + ;; installed - so we ignore this an handle this as + ;; unknown-state. + (ignore-errors (funcall vc-state-fcn file)))) + ;; now we map the backend-state to one of the ECB-VC-state-values + (setq result (or (cdr (assoc result ecb-vc-state-mapping)) 'unknown))) + (if (not (equal result 'unchanged)) + ;; add the new state to the cache because either the list of checked + ;; buffers and/or the state has been modified. + (ecb-vc-cache-add-file file + result + checked-tree-buffer-names)) + ;; return the result - either 'unchanged or the new VC-state + result)) + +(defun ecb-vc-update-sources-cache (dir) + "Update the SOURCES cache for DIR with the current-content of the +sources-buffer if DIR has currently either a filtered or full cache entry in +the SOURCES-cache." + (let* ((full-sources-cache (ecb-sources-cache-get-full dir)) + (filtered-sources-cache (and full-sources-cache + (ecb-sources-cache-get-filtered dir)))) + (if filtered-sources-cache + ;; we have currently a filtered sources-buffer so we must update the + ;; filtered sources-cache. + (ecb-sources-cache-add-filtered dir + (list (tree-buffer-get-root) + (ecb-copy-list tree-buffer-nodes) + (buffer-substring (point-min) + (point-max)) + ;; add the old-filter-spec + ;; because it must be the same + (nth 3 filtered-sources-cache))) + (if full-sources-cache + ;; we have currently a cached sources-buffer without an applied + ;; filter so we must update the full sources-cache. + (ecb-sources-cache-add-full dir + (list (tree-buffer-get-root) + (ecb-copy-list tree-buffer-nodes) + (buffer-substring (point-min) + (point-max)))))))) + + +(defun ecb-vc-dir-managed-by-CVS (directory) + "Return 'CVS if DIRECTORY is managed by CVS. nil if not. + +This function tries to be as smart as possible: First it checks if DIRECTORY +is managed by CVS by checking if there is a subdir CVS. If no then nil is +returned. If yes then for GNU Emacs it takes into account the value of +`vc-cvs-stay-local': If t then just return 'CVS. Otherwise ECB checks the root +repository if it is a remote repository. If not just 'CVS is returned. If a +remote repository it checks if the value of `vc-cvs-stay-local' is a string +and matches the host of that repository. If yes then just 'CVS is returned. If +not then ECB checks if that host is currently accessible by performing a ping. +If accessible 'CVS is returned otherwise nil. This has the advantage that ECB +will not be blocked by trying to get the state from a remote repository while +the host is not accessible \(e.g. because the user works offline). + +Special remark for XEmacs: XEmacs has a quite outdated VC-package which has no +option `vc-cvs-stay-local' so the user can not work with remote +CVS-repositories if working offline for example. So if there is no option +`vc-cvs-stay-local' then ECB performs always the repository check mentioned +above." + (and (file-exists-p (concat directory "/CVS/")) + (or (ignore-errors (progn + (require 'vc) + (require 'vc-cvs))) + t) + (if (or (not (boundp 'vc-cvs-stay-local)) ;; XEmacs doesn't have this + (not (eq vc-cvs-stay-local t))) + ;; XEmacs has a quite outdated VC-package which has no option + ;; `vc-cvs-stay-local' so the user can not work with remote + ;; directories if working offline for example. so we use a + ;; workaround by checking the root of the CVS-repsoitory (we can + ;; get it from the file /CVS/Root) if it is a remote root and if + ;; yes we ping the host of that root. If accessible ... + (let* ((Root-content (ecb-file-content-as-string (concat directory + "/CVS/Root"))) + (host (and Root-content + ;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: This + ;; regexp will fail when the user＠ is not + ;; contained in the Root - it can be omitted if + ;; the user on the local and remote machines is + ;; the same! But for now it should be enough... + (string-match "＠\\(.+\\):" Root-content) + (match-string 1 Root-content)))) + (when (or (null host) ;; local repository + ;; vc-cvs-stay-local says VC should stay local for this + ;; host + (and (boundp 'vc-cvs-stay-local) + (stringp vc-cvs-stay-local) + (string-match vc-cvs-stay-local host)) + ;; the host is at least accessible + (ecb-host-accessible-p host)) + 'CVS)) + ;; VC always will stay local so we are satisfied ;-) + 'CVS))) + + +(defun ecb-vc-dir-managed-by-RCS (directory) + "Return 'RCS if DIRECTORY is managed by RCS. nil if not." + (and (file-exists-p (concat directory "/RCS/")) + 'RCS)) + +(defun ecb-vc-dir-managed-by-SVN (directory) + "Return 'SVN if DIRECTORY is managed by SVN. nil if not." + (and (file-exists-p (concat directory "/.svn/")) + (locate-library "vc-svn") + 'SVN)) + +(defun ecb-vc-dir-managed-by-SCCS (directory) + "Return 'SCCS if DIRECTORY is managed by SCCS. nil if not." + (or (and (file-exists-p (concat directory "/SCCS/")) 'SCCS) + ;; Remote SCCS project + (let ((proj-dir (getenv "PROJECTDIR"))) + (if proj-dir + (and (file-exists-p (concat proj-dir "/SCCS")) 'SCCS) + nil)))) + +(defun ecb-vc-state (file) + "Same as `vc-state' but it clears the internal caches of the VC-package for +FILE before calling `vc-state'. Finally calls `vc-state' and returns that value." + (and (fboundp 'vc-file-clearprops) (vc-file-clearprops file)) + (vc-state file)) + +(defun ecb-vc-get-state-fcn-for-dir (directory) + "Get that function which should be used for checking the VC-state for files +contained in DIRECTORY. Get it either from the VC-cache or call the car of +each element of `ecb-vc-supported-backends' and return the cdr of the first +elem where the car returns not nil. If Directory is not managed by a +version-control system then return nil. Store the result in the VC-cache for +speeding up things next time. Ange-ftp- or efs-directories will never be +checked for VC-states!" + (let* ((norm-dir (ecb-fix-filename directory)) + (cache-val (ecb-vc-cache-get norm-dir))) + (cond ((equal cache-val 'NO-VC) + nil) + (cache-val cache-val) + (t + (let ((vc-backend-fcn + (catch 'found + (dolist (elem ecb-vc-supported-backends) + (when (and (fboundp (car elem)) + (funcall (car elem) norm-dir)) + (throw 'found (cdr elem)))) + nil))) + ;; Add it to the vc-cache: Either NO-VC if nil otherwise the + ;; check-state-function + (ecb-vc-cache-add-dir norm-dir (or vc-backend-fcn 'NO-VC)) + vc-backend-fcn))))) + +(defalias 'ecb-vc-managed-dir-p 'ecb-vc-get-state-fcn-for-dir) + +(defun ecb-vc-generate-node-name (name state) + "Generate a node-name with an appropriate icon in the front of NAME +depending on STATE. If Emacs supports image-display then an image-icon wll be +used otherwise an ascii-icon." + (let* ((ascii-icon (ecb-vc-get-ascii-icon-for-vc-state state)) + (node-name (concat ascii-icon " " + (save-match-data + (if (string-match "^(.) \\(.+\\)$" name) + (match-string 1 name) + name))))) + (ecb-generate-node-name node-name 4 + (ecb-vc-get-image-name-for-vc-state state) + ;; even in the history- or the directories-buffers + ;; we use the icons of the sources-buffer because + ;; they are the same! + ecb-sources-buffer-name))) + +;; (insert (ecb-vc-generate-node-name "test-name" 'needs-merge)) + + (defun ecb-stealthy-vc-check--dir/history (state) + "Check for all sourcefile-nodes either in the directories- or the +history-buffer the VC-state. This function does the real job and is is only +for use by a stealthy function defined with `defecb-stealthy'! STATE is the +initial state-value the stealthy-function has when called. Return the new +state-value." + (if (not ecb-vc-enable-support) + 'done + (if (not (or (string= (buffer-name (current-buffer)) + ecb-history-buffer-name) + (and (string= (buffer-name (current-buffer)) + ecb-directories-buffer-name) + (ecb-show-sources-in-directories-buffer-p)))) + 'done + ;; Now we are either in the history-buffer or in the directories-buffer + ;; when sources are displayed in the directories-buffer + (if (equal state 'restart) + (setq state 1)) + ;; Here the state is an integer because a stealthy functions runs only + ;; when state != 'done + (let ((lines-of-buffer (count-lines (point-min) (point-max))) + (curr-node nil) + (curr-dir nil) + (new-name nil) + (vc-state-fcn nil) + (new-state nil) + (node-type-to-check (if (string= (buffer-name (current-buffer)) + ecb-history-buffer-name) + ecb-history-nodetype-sourcefile + ecb-directories-nodetype-sourcefile))) + (save-excursion + (while (and (not (input-pending-p)) + (<= state lines-of-buffer)) + (goto-line state) + (setq curr-node (tree-buffer-get-node-at-point)) + (setq curr-dir (file-name-directory (tree-node-get-data curr-node))) + (when (and (= (tree-node-get-type curr-node) node-type-to-check) + (ecb-vc-directory-should-be-checked-p curr-dir)) + (setq vc-state-fcn (ecb-vc-get-state-fcn-for-dir curr-dir)) + (when vc-state-fcn ;; file is under VC-control + (setq new-name (tree-node-get-name curr-node)) + (setq new-state + (ecb-vc-check-state (tree-node-get-data curr-node) + (buffer-name (current-buffer)) + vc-state-fcn)) + ;; we update the node only if the state has changed + (when (not (equal 'unchanged new-state)) + (setq new-name (ecb-vc-generate-node-name new-name new-state)) + (tree-buffer-update-node + nil new-name + 'use-old-value 'use-old-value 'use-old-value 'use-old-value t)))) + (setq state (1+ state)))) + (if (> state lines-of-buffer) + (setq state 'done))) + state))) + +(defun ecb-stealthy-vc-check--sources (state) + "Check for all sourcefile-nodes in sources-buffer the VC-state. This +function does the real job and is is only for use by a stealthy function +defined with `defecb-stealthy'! STATE is the initial state-value the +stealthy-function has when called. Return the new state-value." + (if (not (ecb-vc-directory-should-be-checked-p ecb-path-selected-directory)) + 'done + (let ((vc-state-fcn (ecb-vc-get-state-fcn-for-dir ecb-path-selected-directory))) + (if (null vc-state-fcn) + ;; the sources-files are not under VC-control + 'done + ;; Now we are either in the sources-, or history-buffer or in the + ;; directories-buffer when sources are displayed in the + ;; directories-buffer + (if (equal state 'restart) + (setq state 1)) + ;; Here the state is an integer because a stealthy functions runs only + ;; when state != 'done + (let ((lines-of-buffer (count-lines (point-min) (point-max))) + (curr-node nil) + (new-name nil) + (new-state nil) + (update-performed-for-dir nil)) + (save-excursion + (while (and (not (input-pending-p)) + (<= state lines-of-buffer)) + (goto-line state) + (setq curr-node (tree-buffer-get-node-at-point)) + (setq new-name (tree-node-get-name curr-node)) + (setq new-state + (ecb-vc-check-state (tree-node-get-data curr-node) + (buffer-name (current-buffer)) + vc-state-fcn)) + ;; we update the node only if the state has changed + (when (not (equal 'unchanged new-state)) + (setq new-name (ecb-vc-generate-node-name new-name new-state)) + (or update-performed-for-dir + (setq update-performed-for-dir + (ecb-fix-filename + (file-name-directory (tree-node-get-data curr-node))))) + (tree-buffer-update-node + nil new-name + 'use-old-value 'use-old-value 'use-old-value 'use-old-value t)) + (setq state (1+ state)))) + ;; if we have performed at least one update then we must update the + ;; SOURCES-cache. + (when update-performed-for-dir + (ecb-vc-update-sources-cache update-performed-for-dir)) + (if (> state lines-of-buffer) + (setq state 'done))) + state)))) + +(defecb-stealthy ecb-stealthy-vc-check-in-history-buf + "Check for all entries in the history-buffer their VC-state and +display an appropriate icon in front of the item." + (save-selected-window + (when (equal 'window-not-visible + (ecb-exec-in-history-window + (setq state + (ecb-stealthy-vc-check--dir/history state)))) + (setq state 'done)))) -(defun ecb-clear-directory-empty-cache () - (setq ecb-directory-empty-cache nil)) +(defecb-stealthy ecb-stealthy-vc-check-in-sources-buf + "Check for all sourcefile-nodes in the sources-buffer their VC-state and +display an appropriate icon in front of the file." + (save-selected-window + (when (equal 'window-not-visible + (ecb-exec-in-sources-window + (setq state + (ecb-stealthy-vc-check--sources state)))) + (setq state 'done)))) + +(defecb-stealthy ecb-stealthy-vc-check-in-directories-buf + "Check for all sourcefile-nodes in the directories-buffer their VC-state and +display an appropriate icon in front of the file." + (if (ecb-show-sources-in-directories-buffer-p) + (save-selected-window + (when (equal 'window-not-visible + (ecb-exec-in-directories-window + (setq state + (ecb-stealthy-vc-check--dir/history state)))) + (setq state 'done))) + (setq state 'done))) + +(defun ecb-vc-reset-vc-stealthy-checks () + "Resets all stealthy VC-checks." + ;; we can call savely all these initialization because if one of the + ;; following tree-windows is not visible nothing will be done (and the + ;; directories-check will only run when sources are displayed in the + ;; directories buffer!). If visible the vc-check will be performed for all + ;; current visible file-nodes again in all visible tree-buffers of the + ;; file-browser but because we have only removed the cache-entry for + ;; exactly one file, the check will be very fast for all file-nodes + ;; besides this file! + + ;; I think the read-only check must be performed too - because for + ;; backends like Clearcase a changed VC-state can also result in a changed + ;; read-only-state! + (ecb-stealthy-function-state-init 'ecb-stealthy-ro-check-in-directories-buf) + (ecb-stealthy-function-state-init 'ecb-stealthy-ro-check-in-sources-buf) + (ecb-stealthy-function-state-init 'ecb-stealthy-vc-check-in-sources-buf) + (ecb-stealthy-function-state-init 'ecb-stealthy-vc-check-in-directories-buf) + (ecb-stealthy-function-state-init 'ecb-stealthy-vc-check-in-history-buf) + ;; This function is also used in write-file-hooks so we have to return nil + ;; because otherwise a file will never be written - see documentation of + ;; `write-file-hooks'! + nil) + +;; we have to add a smart piece of code to `vc-checkin-hook' which is able to +;; clear the cache entry for exactly that file checked-in with vc-checkin! +;; Problems to solve: +;; - unfortunatelly this hook is not called with the checked-in filename as +;; argument but it is a normal hook runned with `run-hooks' :-( But we can +;; not reset the stuff in the advice itself because this doesn't ensure that +;; the after-advice-stuff is called *after* the checkin - seems that the +;; after-advice runs already during the user inserts/edits the +;; checkin-comment. But the vc-checkin-hook is really called after the +;; checkin! ==> We use a combination of an after-advice and vc-checkin-hook! +;; - If a user uses PCL-CVS for CVS-operations this advice of vc-checkin will +;; not run because pcl-cvs doesn't delegate the checkin-task to +;; `vc-checkin'. Therefore also the `vc-checkin-hook' is not runned via +;; pcl-cvs. +;; - What about other backends not supported by VC, e.g. clearcase.el? Well, +;; with a good documentation what a user has to do.... ;-) + + +(defconst ecb-vc-advices '((vc-checkin . after)) + "All advices needed for the builtin VC-support of ECB. Same format as +`ecb-basic-adviced-functions'.") + +(defvar ecb-checkedin-file nil + "Stored the filename of the most recent checked-in file. Is only set by the +after-advice of `vc-checkin' and `ecb-vc-checkin-hook' \(resets it to nil). +Evaluated only by `ecb-vc-checkin-hook'. + +This is the communication-channel between `vc-checkin' and +`ecb-vc-checkin-hook' so this hook-function gets the filename of the +checked-in file.") + +(defadvice vc-checkin (after ecb) + "Simply stores the filename of the checked-in file in `ecb-checkedin-file' +so it is available in the `vc-checkin-hook'." + (setq ecb-checkedin-file (ecb-fix-filename (ad-get-arg 0)))) + +(defun ecb-vc-checkin-hook () + "Ensures that the ECB-cache is reset and the entry for the most recent +checkedin file is cleared. Uses `ecb-checkedin-file' as last checked-in file." + (when ecb-checkedin-file + (ecb-vc-cache-remove ecb-checkedin-file) + (ecb-vc-reset-vc-stealthy-checks) + (setq ecb-checkedin-file nil))) + +(defun ecb-vc-after-revert-hook () + "Ensures that the ECB-cache is reset and the entry for the currently +reverted file-buffer is cleared." + (let ((file (ignore-errors (ecb-fix-filename buffer-file-name)))) + (when (and file (file-exists-p file)) + (ecb-vc-cache-remove file) + (ecb-vc-reset-vc-stealthy-checks)))) + +(defun ecb-vc-enable-internals (arg) + "Enable or disable \(if ARG < 0) all settings needed by the VC-support." + (if (< arg 0) + (progn + (remove-hook 'after-revert-hook 'ecb-vc-after-revert-hook) + (remove-hook 'write-file-hooks 'ecb-vc-reset-vc-stealthy-checks) + (remove-hook 'vc-checkin-hook 'ecb-vc-checkin-hook) + (ecb-disable-advices ecb-vc-advices)) + (add-hook 'after-revert-hook 'ecb-vc-after-revert-hook) + (add-hook 'write-file-hooks 'ecb-vc-reset-vc-stealthy-checks) + (add-hook 'vc-checkin-hook 'ecb-vc-checkin-hook) + (ecb-enable-advices ecb-vc-advices))) + +;; -- end of vc-support --------------- + +;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: Maybe we should run directly +;; `ecb-stealthy-updates' from within this after-update-hooks?! + +(defun ecb-stealth-tasks-after-directories-update () + "After update hook for the directories-buffer. Runs directly after +performing a `tree-buffer-update' for this buffer." + (ecb-stealthy-function-state-init 'ecb-stealthy-empty-dir-check) + (ecb-stealthy-function-state-init 'ecb-stealthy-ro-check-in-directories-buf) + (ecb-stealthy-function-state-init 'ecb-stealthy-vc-check-in-directories-buf) + ) + +(defun ecb-stealth-tasks-after-sources-update () + "After update hook for the sources-buffer. Runs directly after +performing a `tree-buffer-update' for this buffer." + (ecb-stealthy-function-state-init 'ecb-stealthy-ro-check-in-sources-buf) + (ecb-stealthy-function-state-init 'ecb-stealthy-vc-check-in-sources-buf) + ) + +(defun ecb-stealth-tasks-after-history-update () + "After update hook for the history-buffer. Runs directly after +performing a `tree-buffer-update' for this buffer." + (ecb-stealthy-function-state-init 'ecb-stealthy-vc-check-in-history-buf) + ) -(defun ecb-check-emptyness-of-dir (dir) - (if (not ecb-prescan-directories-for-emptyness) - nil - (let ((cache-value (ecb-directory-empty-cache-get dir)) - (show-sources (ecb-show-sources-in-directories-buffer-p))) - (if (and cache-value - (equal (cdr cache-value) show-sources)) - (car cache-value) - (ecb-directory-empty-cache-remove dir) - (let ((entries (and (file-accessible-directory-p dir) - (directory-files dir nil nil t))) - (just-files-means-empty (not show-sources)) - (full-file-name nil) - (empty-p nil)) - (setq empty-p - (catch 'found - (dolist (e entries) - (when (not (member e '("." ".." "CVS"))) - (setq full-file-name (ecb-fix-filename dir e)) - (if (file-directory-p full-file-name) - (throw 'found 'nil) - (if (not just-files-means-empty) - (throw 'found 'nil))))) - t)) - ;; now we add this value to the cache - (ecb-directory-empty-cache-add (cons (ecb-fix-filename dir) - (cons empty-p show-sources))) - empty-p))))) +;; -- adding files --------------------- +(defun ecb-tree-node-add-files + (node path files type include-extension old-children &optional not-expandable) + "For every file in FILES add a child-node to NODE." + (let* ((no-vc-state-display + ;; no vc-state-display when the type of FILES means subdirs in + ;; the directories-buffer + (and (equal (buffer-name) ecb-directories-buffer-name) + (= type ecb-directories-nodetype-directory))) + (dir-managed-by-vc (if (or no-vc-state-display + (not (ecb-vc-directory-should-be-checked-p path))) + nil + (ecb-vc-managed-dir-p path)))) + (dolist (file files) + (let* ((filename (ecb-fix-filename path file)) + (file-1 (if include-extension + file + (file-name-sans-extension file)))) + (tree-node-add-child + node + (ecb-new-child + old-children + (if no-vc-state-display + file-1 + (if dir-managed-by-vc + (ecb-vc-generate-node-name file-1 + (nth 0 (ecb-vc-cache-get filename))) + (ecb-generate-node-name file-1 -1 "leaf" + ecb-sources-buffer-name))) + type filename + (or not-expandable + (= type ecb-directories-nodetype-sourcefile) + ;; The empty-dir-check is performed stealthy + nil ;;(ecb-check-emptyness-of-dir filename) + ) + (if ecb-truncate-long-names 'end))))))) -(defun ecb-new-child (old-children name type data &optional not-expandable shorten-name) +(defun ecb-new-child (old-children name type data + &optional not-expandable shorten-name) "Return a node with type = TYPE, data = DATA and name = NAME. Tries to find a node with matching TYPE and DATA in OLD-CHILDREN. If found no new node is created but only the fields of this node will be updated. Otherwise a new node ＠＠ -1600,7 +2982,7 ＠＠ (my-dir (ecb-fix-filename (or dir (file-name-directory (read-file-name "Add source path: "))) - t)) + nil t)) (my-alias (or alias (read-string (format "Alias for \"%s\" (empty = no alias): " my-dir))))) ＠＠ -1644,6 +3026,7 ＠＠ (defun ecb-remove-dir-from-caches (dir) + "Remove DIR from the caches SUBDIR, EMPTY-DIR and SOURCES." (ecb-files-and-subdirs-cache-remove dir) (ecb-directory-empty-cache-remove dir) (ecb-sources-cache-remove dir)) ＠＠ -1673,7 +3056,10 ＠＠ (ecb-update-directory-node node) (if shift-mode (ecb-mouse-over-directory-node node nil nil 'force)) - (if (or (= 0 (tree-node-get-type node)) (= 2 (tree-node-get-type node))) + (if (or (= ecb-directories-nodetype-directory + (tree-node-get-type node)) + (= ecb-directories-nodetype-sourcepath + (tree-node-get-type node))) (progn (if (= 2 ecb-button) (when (tree-node-is-expandable node) ＠＠ -1682,10 +3068,15 ＠＠ ;; Update the tree-buffer with optimized display of NODE (tree-buffer-update node))) - ;; Removing the element from the sources-cache and the - ;; files-and-subdirs-cache - (if shift-mode - (ecb-remove-dir-from-caches (tree-node-get-data node))) + ;; Removing the element from the sources-cache, the + ;; files-and-subdirs-cache and the empty-dirs-cache (incl. all + ;; subdirs) + (when shift-mode + (ecb-remove-dir-from-caches (tree-node-get-data node)) + (ecb-directory-empty-cache-remove-all (tree-node-get-data node)) + ;; a powerclick should remove all vc-caches of contained files + (ecb-vc-cache-remove-files-of-dir (tree-node-get-data node)) + ) (ecb-set-selected-directory (tree-node-get-data node) shift-mode) ;; if we have running an integrated speedbar we must update the ＠＠ -1758,7 +3149,7 ＠＠ `ecb-show-node-info-in-minibuffer'. NODE is the node for which help text should be displayed, WINDOW is the related window, NO-MESSAGE defines if the help-text should be printed here." - (if (= (tree-node-get-type node) 1) + (if (= (tree-node-get-type node) ecb-directories-nodetype-sourcefile) (ecb-mouse-over-source-node node window no-message click-force) (if (not (= (tree-node-get-type node) 3)) (let ((str (when (or click-force ＠＠ -1816,6 +3207,7 ＠＠ (unless no-message (tree-buffer-nolog-message str))))) +;; popups ;; needs methods (tree-buffer-defpopup-command ecb-create-source ＠＠ -1844,13 +3236,12 ＠＠ (defun ecb-grep-directory-internal (node find) (ecb-select-edit-window) - (let ((default-directory (concat (ecb-fix-filename - (if (file-directory-p - (tree-node-get-data node)) - (tree-node-get-data node) - (file-name-directory - (tree-node-get-data node)))) - ecb-directory-sep-string))) + (let* ((node-data (tree-node-get-data node)) + (default-directory (concat (ecb-fix-filename + (if (file-directory-p node-data) + node-data + (file-name-directory node-data))) + (ecb-directory-sep-string node-data)))) (call-interactively (if find (or (and (fboundp ecb-grep-find-function) ecb-grep-find-function) ＠＠ -1964,11 +3355,11 ＠＠ (function (lambda (node) (let ((node-type (tree-node-get-type node)) (node-data (tree-node-get-name node))) - (cond ((= node-type 0) ;; directory + (cond ((= node-type ecb-directories-nodetype-directory) (format "%s (Directory)" node-data)) - ((= node-type 1) ;; source-file + ((= node-type ecb-directories-nodetype-sourcefile) (format "%s (File)" node-data)) - ((= node-type 2) ;; source-path + ((= node-type ecb-directories-nodetype-sourcepath) (format "%s (Source-path)" node-data)))))) "The menu-title for the directories menu. Has to be either a string or a function which is called with current node and has to return a string.") ＠＠ -2024,23 +3415,27 ＠＠ (and (functionp ecb-directories-menu-user-extension-function) (funcall ecb-directories-menu-user-extension-function))) (dyn-builtin-extension (ecb-dir/source/hist-menu-editwin-entries))) - (list (cons 0 (funcall (or ecb-directories-menu-sorter - 'identity) - (append dyn-user-extension - ecb-directories-menu-user-extension - ecb-directories-menu))) - (cons 1 (funcall (or ecb-sources-menu-sorter - 'identity) - (append dyn-user-extension - ecb-sources-menu-user-extension - ecb-sources-menu - dyn-builtin-extension))) - (cons 2 (funcall (or ecb-directories-menu-sorter - 'identity) - (append dyn-user-extension - ecb-directories-menu-user-extension - ecb-source-path-menu)))))) + (list (cons ecb-directories-nodetype-directory + (funcall (or ecb-directories-menu-sorter + 'identity) + (append dyn-user-extension + ecb-directories-menu-user-extension + ecb-directories-menu))) + (cons ecb-directories-nodetype-sourcefile + (funcall (or ecb-sources-menu-sorter + 'identity) + (append dyn-user-extension + ecb-sources-menu-user-extension + ecb-sources-menu + dyn-builtin-extension))) + (cons ecb-directories-nodetype-sourcepath + (funcall (or ecb-directories-menu-sorter + 'identity) + (append dyn-user-extension + ecb-directories-menu-user-extension + ecb-source-path-menu)))))) +;; source-path tokens (defvar ecb-source-path-menu nil "Built-in menu for the directories-buffer for directories which are elements of ＠＠ -2091,18 +3486,27 ＠＠ (find-file file) (vc-annotate nil))) - (tree-buffer-defpopup-command ecb-file-popup-vc-diff "Diff file against last version in repository." (let ((file (tree-node-get-data node))) (find-file file) (vc-diff nil))) +(tree-buffer-defpopup-command ecb-file-popup-vc-refresh-file + "Recompute the VC-state for this file." + (let ((file (tree-node-get-data node))) + (ecb-vc-cache-remove file) + (ecb-vc-reset-vc-stealthy-checks))) + +(tree-buffer-defpopup-command ecb-file-popup-vc-refresh-dir + "Recompute the VC-state-values for the whole directory." + (let ((dir (ecb-fix-filename (file-name-directory (tree-node-get-data node))))) + (ecb-vc-cache-remove-files-of-dir dir) + (ecb-vc-reset-vc-stealthy-checks))) (defvar ecb-sources-menu nil "Built-in menu for the sources-buffer.") - (setq ecb-sources-menu '(("Grep" (ecb-grep-directory "Grep Directory") ＠＠ -2134,12 +3538,13 ＠＠ (and (functionp ecb-sources-menu-user-extension-function) (funcall ecb-sources-menu-user-extension-function))) (dyn-builtin-extension (ecb-dir/source/hist-menu-editwin-entries))) - (list (cons 0 (funcall (or ecb-sources-menu-sorter - 'identity) - (append dyn-user-extension - ecb-sources-menu-user-extension - ecb-sources-menu - dyn-builtin-extension)))))) + (list (cons ecb-sources-nodetype-sourcefile + (funcall (or ecb-sources-menu-sorter + 'identity) + (append dyn-user-extension + ecb-sources-menu-user-extension + ecb-sources-menu + dyn-builtin-extension)))))) ;; history popups ＠＠ -2191,6 +3596,15 ＠＠ "No history filter, i.e. add all existing file-buffers to the history." (ecb-add-all-buffers-to-history)) +(tree-buffer-defpopup-command ecb-file-popup-vc-refresh-all-files + "Recompute the VC-state for the whole history." + (when (equal (buffer-name) ecb-history-buffer-name) + (let ((files (mapcar (function (lambda (node) + (tree-node-get-data node))) + (tree-node-get-children (tree-buffer-get-root))))) + (dolist (file files) + (ecb-vc-cache-remove file)) + (ecb-vc-reset-vc-stealthy-checks)))) (defun ecb-history-filter () "Apply a filter to the history-buffer to reduce the number of entries. ＠＠ -2247,13 +3661,15 ＠＠ (and (functionp ecb-history-menu-user-extension-function) (funcall ecb-history-menu-user-extension-function))) (dyn-builtin-extension (ecb-dir/source/hist-menu-editwin-entries))) - (list (cons 0 (funcall (or ecb-history-menu-sorter - 'identity) - (append dyn-user-extension - ecb-history-menu-user-extension - ecb-history-menu - dyn-builtin-extension)))))) + (list (cons ecb-history-nodetype-sourcefile + (funcall (or ecb-history-menu-sorter + 'identity) + (append dyn-user-extension + ecb-history-menu-user-extension + ecb-history-menu + dyn-builtin-extension)))))) +;; create the tree-buffers (defun ecb-create-directories-tree-buffer () "Create the tree-buffer for directories" ＠＠ -2267,24 +3683,31 ＠＠ 'ecb-tree-buffer-node-collapsed-callback 'ecb-mouse-over-directory-node 'equal - (list 0) - (list 1) + (list ecb-directories-nodetype-directory) + ;; Now no longer tree-buffer decides if a node is displayed as leave but + ;; now the file-browser does it in the function `ecb-tree-node-add-files' - + ;; Reason: We have now to deal with the VC-support + nil ;;(list ecb-directories-nodetype-sourcefile) 'ecb-directories-menu-creator - (list (cons 0 ecb-directories-menu-title-creator) - (cons 1 ecb-directories-menu-title-creator) - (cons 2 ecb-directories-menu-title-creator)) + (list (cons ecb-directories-nodetype-directory + ecb-directories-menu-title-creator) + (cons ecb-directories-nodetype-sourcefile + ecb-directories-menu-title-creator) + (cons ecb-directories-nodetype-sourcepath + ecb-directories-menu-title-creator)) (nth 0 ecb-truncate-lines) t ecb-tree-indent ecb-tree-incremental-search - nil + ecb-vc-incr-searchpattern-node-prefix ecb-tree-navigation-by-arrow ecb-tree-easy-hor-scroll (nth 0 ecb-tree-image-icons-directories) (nth 1 ecb-tree-image-icons-directories) ecb-tree-buffer-style ecb-tree-guide-line-face - (list (cons 1 ecb-source-in-directories-buffer-face)) + (list (cons ecb-directories-nodetype-sourcefile + ecb-source-in-directories-buffer-face)) ecb-tree-expand-symbol-before ecb-directory-face ecb-directories-general-face ＠＠ -2302,6 +3725,7 ＠＠ 'ecb-toggle-maximize-ecb-window-with-mouse))))) ecb-common-tree-buffer-after-create-hook ecb-directories-buffer-after-create-hook) + 'ecb-stealth-tasks-after-directories-update )) (defun ecb-create-sources-tree-buffer () ＠＠ -2317,20 +3741,18 ＠＠ 'ecb-mouse-over-source-node 'equal nil - ;; set this list if you want leaf-symbols TODO: Klaus Berndl - ;; <klaus.berndl(a)sdm.de&gt;: If we want to display the VC-state in the - ;; sources-icon then we should set this argument to nil because then we - ;; must compute the needed icon in the file-browser and not in the - ;; tree-buffer-library (analogue to the methods-icons computet in the - ;; methods-browser). - nil ;; (list 0) + ;; If we want to display the VC-state in the sources-icon then we should + ;; set this argument to nil because then we must compute the needed icon in + ;; the file-browser and not in the tree-buffer-library (analogue to the + ;; methods-icons computet in the methods-browser). + nil ;; (list ecb-sources-nodetype-sourcefile) 'ecb-sources-menu-creator - (list (cons 0 ecb-sources-menu-title-creator)) + (list (cons ecb-sources-nodetype-sourcefile ecb-sources-menu-title-creator)) (nth 1 ecb-truncate-lines) t ecb-tree-indent ecb-tree-incremental-search - nil + ecb-vc-incr-searchpattern-node-prefix ecb-tree-navigation-by-arrow ecb-tree-easy-hor-scroll (nth 0 ecb-tree-image-icons-directories) ＠＠ -2350,7 +3772,8 ＠＠ [mode-line mouse-2] 'ecb-toggle-maximize-ecb-window-with-mouse))))) ecb-common-tree-buffer-after-create-hook - ecb-directories-buffer-after-create-hook))) + ecb-sources-buffer-after-create-hook) + 'ecb-stealth-tasks-after-sources-update)) (defun ecb-create-history-tree-buffer () "Create the tree-buffer for history" ＠＠ -2367,12 +3790,13 ＠＠ nil nil 'ecb-history-menu-creator - (list (cons 0 ecb-history-menu-title-creator)) + (list (cons ecb-history-nodetype-sourcefile + ecb-history-menu-title-creator)) (nth 3 ecb-truncate-lines) t ecb-tree-indent ecb-tree-incremental-search - nil + ecb-vc-incr-searchpattern-node-prefix ecb-tree-navigation-by-arrow ecb-tree-easy-hor-scroll (nth 0 ecb-tree-image-icons-directories) ＠＠ -2392,8 +3816,11 ＠＠ [mode-line mouse-2] 'ecb-toggle-maximize-ecb-window-with-mouse))))) ecb-common-tree-buffer-after-create-hook - ecb-directories-buffer-after-create-hook))) + ecb-history-buffer-after-create-hook) + 'ecb-stealth-tasks-after-history-update)) + (silentcomp-provide 'ecb-file-browser) ;;; ecb-file-browser.el ends here + Index: ecb-help.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb-help.el,v retrieving revision 1.10 diff -u -r1.10 ecb-help.el --- ecb-help.el 31 Aug 2004 16:00:47 -0000 1.10 +++ ecb-help.el 1 Dec 2004 15:59:47 -0000 ＠＠ -26,7 +26,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: ecb-help.el,v 1.108 2004/08/27 15:42:22 berndl Exp $ +;; $Id: ecb-help.el,v 1.109 2004/11/17 17:28:38 berndl Exp $ ;;; Commentary: ;; ＠＠ -199,7 +199,7 ＠＠ ecb-help-info-path)) (concat ecb-ecb-dir ecb-help-info-path) ecb-help-info-path))) - (html-path-abs (ecb-fix-filename + (html-path-abs (expand-file-name (if (or (string-match "^\\." ecb-help-html-path) (string-match (concat "^" (regexp-quote Index: ecb-jde.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb-jde.el,v retrieving revision 1.13 diff -u -r1.13 ecb-jde.el --- ecb-jde.el 31 Aug 2004 16:00:47 -0000 1.13 +++ ecb-jde.el 1 Dec 2004 15:59:47 -0000 ＠＠ -26,7 +26,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: ecb-jde.el,v 1.13 2004/08/31 16:00:47 berndl Exp $ +;; $Id: ecb-jde.el,v 1.11 2004/10/04 15:53:06 berndl Exp $ ;;; Commentary: ;; ＠＠ -180,7 +180,6 ＠＠ (add-hook 'efc-dialog-close-after-hook (function (lambda () (ecb-toggle-compile-window 1)))))) - (silentcomp-provide 'ecb-jde) Index: ecb-layout-defs.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb-layout-defs.el,v retrieving revision 1.13 diff -u -r1.13 ecb-layout-defs.el --- ecb-layout-defs.el 31 Aug 2004 16:00:47 -0000 1.13 +++ ecb-layout-defs.el 1 Dec 2004 15:59:47 -0000 ＠＠ -26,7 +26,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: ecb-layout-defs.el,v 1.13 2004/08/31 16:00:47 berndl Exp $ +;; $Id: ecb-layout-defs.el,v 1.16 2003/09/12 09:19:25 berndl Exp $ ;;; Commentary: ;; Index: ecb-layout.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb-layout.el,v retrieving revision 1.15 diff -u -r1.15 ecb-layout.el --- ecb-layout.el 31 Aug 2004 16:00:45 -0000 1.15 +++ ecb-layout.el 1 Dec 2004 15:59:48 -0000 ＠＠ -26,7 +26,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: ecb-layout.el,v 1.233 2004/08/31 15:33:52 berndl Exp $ +;; $Id: ecb-layout.el,v 1.243 2004/12/01 14:19:39 berndl Exp $ ;;; Commentary: ;; ＠＠ -996,7 +996,9 ＠＠ would walk through these windows." (let ((windows-list (or winlist (ecb-canonical-windows-list)))) (delete nil (mapcar (function (lambda (elem) - (if (window-dedicated-p elem) + (if (and (not (member elem + ecb-layout-temporary-dedicated-windows)) + (window-dedicated-p elem)) elem))) windows-list)))) ＠＠ -1008,7 +1010,9 ＠＠ (let ((comp-win-state (ecb-compile-window-state)) (windows-list (or winlist (ecb-canonical-windows-list)))) (delete nil (mapcar (function (lambda (elem) - (if (and (not (window-dedicated-p elem)) + (if (and (or (member elem + ecb-layout-temporary-dedicated-windows) + (not (window-dedicated-p elem))) (or (not (equal comp-win-state 'visible)) (not (equal elem ecb-compile-window)))) elem))) ＠＠ -1269,7 +1273,8 ＠＠ (defun ecb-layout-debug-error (&rest args) "Run ARGS through `format' and write it to the *Messages*-buffer." (when ecb-layout-debug-mode - (message (concat (format "ECB %s layout debug: " ecb-version) + (message (concat (format "ECB %s layout debug [%s] " ecb-version + (format-time-string "%H:%M:%S")) (apply 'format args))))) ＠＠ -1411,6 +1416,8 ＠＠ ;; that of GDB and watches expressions in the speedbar. It also uses features ;; of Emacs 21 such as the display margin for breakpoints, and the toolbar. ;; This is new in Emacs 21.4 so maybe we have to make it compatible with ECB! +;; But maybe this could be hard because AFAIK gdb-ui.el uses dedicated +;; windows! (defadvice scroll-all-mode (after ecb) ＠＠ -1447,9 +1454,10 ＠＠ This adviced version of `walk-windows' is not for direct usage therefore it is always disabled; use the macro `ecb-with-ecb-advice' instead if you need this adviced version of `walk-windows'!" - (if (or (equal (ad-get-arg 2) ecb-frame) - (and (null (ad-get-arg 2)) - (equal (selected-frame) ecb-frame))) + (if (and ecb-minor-mode + (or (equal (ad-get-arg 2) ecb-frame) + (and (null (ad-get-arg 2)) + (equal (selected-frame) ecb-frame)))) (progn (let ((ecb-walk-windows-advice-proc (ad-get-arg 0))) (ad-with-originals 'walk-windows ＠＠ -1472,11 +1480,42 ＠＠ not for direct usage therefore it is always disabled; use the macro `ecb-with-ecb-advice' instead if you need this adviced version of `one-window-p'!" - (if (equal (selected-frame) ecb-frame) + (if (and ecb-minor-mode + (equal (selected-frame) ecb-frame)) (setq ad-return-value (= (length (ecb-canonical-edit-windows-list)) 1)) ad-do-it)) +(defadvice find-file (around ecb) + "Workaround for the annoying \(X)Emacs-behavior to resize some of the +special ecb-windows after opening a file. This advices restores the sizes of +the ecb-windows exactly as before this command." + (if (and ecb-minor-mode + (equal (selected-frame) ecb-frame) + (not ecb-windows-hidden)) + (let ((ecb-sizes-before (ecb-get-ecb-window-sizes t))) + ad-do-it + ;; this seems to be necessary - otherwise the reszing seems not to + ;; take effect... + (sit-for 0) + (ignore-errors (ecb-set-ecb-window-sizes ecb-sizes-before))) + ad-do-it)) + +(defadvice find-file-other-window (around ecb) + "Workaround for the annoying \(X)Emacs-behavior to resize some of the +special ecb-windows after opening a file. This advices restores the sizes of +the ecb-windows exactly as before this command." + (if (and ecb-minor-mode + (equal (selected-frame) ecb-frame) + (not ecb-windows-hidden)) + (let ((ecb-sizes-before (ecb-get-ecb-window-sizes t))) + ad-do-it + ;; this seems to be necessary - otherwise the reszing seems not to + ;; take effect... + (sit-for 0) + (ignore-errors (ecb-set-ecb-window-sizes ecb-sizes-before))) + ad-do-it)) + (defun ecb-toggle-scroll-other-window-scrolls-compile (&optional arg) "Toggle the state of `ecb-scroll-other-window-scrolls-compile-window'. With prefix argument ARG, set it to t, otherwise to nil. For all details about ＠＠ -1518,358 +1557,357 ＠＠ arguments. Do never set this variable; it is only set by `show-temp-buffer-in-current-frame'!") -(if ecb-running-xemacs - (progn - ;; We advice this function to exactly that version of XEmacs 21.4.13. - ;; For that XEmacs-version (and higher) this would not be necessary but - ;; we need this advice for versions of XEmacs which do not have the - ;; 4-argument-version of `display-buffer'. With this advice we give - ;; older XEmacsen the newest display-buffer- and - ;; shrink-to-fit-mechanism. How this is done is described at beginning - ;; of `ecb-display-buffer-xemacs'. - (defadvice show-temp-buffer-in-current-frame (around ecb) - "Makes the function compatible with ECB." - (let ((pre-display-buffer-function nil)) ; turn it off, whatever it is - ;; Here we run our display-buffer-version which in turn calls - ;; `ecb-display-buffer-xemacs' which contains the shrink-to-fit - ;; mechanism. - (let ((window (ecb-with-adviced-functions - (condition-case oops - ;; For this call `ecb-temp-buffer-shrink-to-fit' - ;; is always nil - (display-buffer (ad-get-arg 0) nil nil - temp-buffer-shrink-to-fit) - (wrong-number-of-arguments - ;; we have a XEmacs which do not support the 4. - ;; arg SHRINK-TO-FIT of `display-buffer'. So we - ;; call it with only three args and simulate the - ;; 4. arg by setting - ;; `ecb-temp-buffer-shrink-to-fit' to the value of - ;; `temp-buffer-shrink-to-fit'. The adviced - ;; version of `display-buffer' calls - ;; `ecb-display-buffer-xemacs' for XEmacs which in - ;; turn evaluates `ecb-temp-buffer-shrink-to-fit'. - ;; For details see `ecb-display-buffer-xemacs'. - (let ((ecb-temp-buffer-shrink-to-fit temp-buffer-shrink-to-fit)) - (ecb-layout-debug-error "show-temp-buffer-in-current-frame for %s: we call a 3-arg display-buffer: %s" - (ad-get-arg 0) ecb-temp-buffer-shrink-to-fit) - (display-buffer (ad-get-arg 0) nil nil))) - (error (signal (car oops) (cdr oops))) - (quit (signal 'quit nil)))))) - (if (not (eq (last-nonminibuf-frame) (window-frame window))) - ;; only the pre-display-buffer-function should ever do this. - (error "display-buffer switched frames on its own!!")) - (setq minibuffer-scroll-window window) - (set-window-start window 1) ; obeys narrowing - (set-window-point window 1) - (ecb-layout-debug-error "show-temp-buffer-in-current-frame: buffer: %s, window: %s, shrink-to-fit: %s" - (ad-get-arg 0) window temp-buffer-shrink-to-fit) - nil))) +(when-ecb-running-xemacs + ;; We advice this function to exactly that version of XEmacs 21.4.13. + ;; For that XEmacs-version (and higher) this would not be necessary but + ;; we need this advice for versions of XEmacs which do not have the + ;; 4-argument-version of `display-buffer'. With this advice we give + ;; older XEmacsen the newest display-buffer- and + ;; shrink-to-fit-mechanism. How this is done is described at beginning + ;; of `ecb-display-buffer-xemacs'. + (defadvice show-temp-buffer-in-current-frame (around ecb) + "Makes the function compatible with ECB." + (let ((pre-display-buffer-function nil)) ; turn it off, whatever it is + ;; Here we run our display-buffer-version which in turn calls + ;; `ecb-display-buffer-xemacs' which contains the shrink-to-fit + ;; mechanism. + (let ((window (ecb-with-adviced-functions + (condition-case oops + ;; For this call `ecb-temp-buffer-shrink-to-fit' + ;; is always nil + (display-buffer (ad-get-arg 0) nil nil + temp-buffer-shrink-to-fit) + (wrong-number-of-arguments + ;; we have a XEmacs which do not support the 4. + ;; arg SHRINK-TO-FIT of `display-buffer'. So we + ;; call it with only three args and simulate the + ;; 4. arg by setting + ;; `ecb-temp-buffer-shrink-to-fit' to the value of + ;; `temp-buffer-shrink-to-fit'. The adviced + ;; version of `display-buffer' calls + ;; `ecb-display-buffer-xemacs' for XEmacs which in + ;; turn evaluates `ecb-temp-buffer-shrink-to-fit'. + ;; For details see `ecb-display-buffer-xemacs'. + (let ((ecb-temp-buffer-shrink-to-fit temp-buffer-shrink-to-fit)) + (ecb-layout-debug-error "show-temp-buffer-in-current-frame for %s: we call a 3-arg display-buffer: %s" + (ad-get-arg 0) ecb-temp-buffer-shrink-to-fit) + (display-buffer (ad-get-arg 0) nil nil))) + (error (signal (car oops) (cdr oops))) + (quit (signal 'quit nil)))))) + (if (not (eq (last-nonminibuf-frame) (window-frame window))) + ;; only the pre-display-buffer-function should ever do this. + (error "display-buffer switched frames on its own!!")) + (setq minibuffer-scroll-window window) + (set-window-start window 1) ; obeys narrowing + (set-window-point window 1) + (ecb-layout-debug-error "show-temp-buffer-in-current-frame: buffer: %s, window: %s, shrink-to-fit: %s" + (ad-get-arg 0) window temp-buffer-shrink-to-fit) + nil))) - ;; XEmacs-version - (defadvice shrink-window-if-larger-than-buffer (around ecb) - "Makes the function compatible with ECB." - (or (ad-get-arg 0) (ad-set-arg 0 (selected-window))) - (ecb-layout-debug-error "shrink-window-if-larger-than-buffer: window: %s" - (ad-get-arg 0)) - (if (or (not ecb-minor-mode) - (not (equal (window-frame (ad-get-arg 0)) ecb-frame)) - (member (ad-get-arg 0) (ecb-canonical-ecb-windows-list))) - (ecb-with-original-basic-functions - (ecb-with-original-functions - ad-do-it)) - - ;; we handle only the edit-windows and the compile-window of the - ;; ecb-frame in a special manner. - - ;; if called non-interactively (e.g. by `display-buffer's forth - ;; argument SHRINK-TO-FIT) and if called for the compile-window of - ;; ECB and if `ecb-compile-window-temporally-enlarge' is either - ;; after-selection or nil then we shrink to the - ;; ecb-compile-window-height! Otherwise we run the normal job! - (if (and (not (interactive-p)) - (equal (ad-get-arg 0) ecb-compile-window) - (member ecb-compile-window-temporally-enlarge - '(after-selection nil)) - ;; The *Completions*-buffer must always being enlarged! - (not (ecb-string= (buffer-name (window-buffer (ad-get-arg 0))) - "*Completions*"))) - (ecb-toggle-compile-window-height -1) - (save-excursion - (set-buffer (window-buffer (ad-get-arg 0))) - (ecb-layout-debug-error "shrink-window-if-larger-than-buffer: buffer to shrink: %s" - (current-buffer)) - ;; we prevent to shrink the compile-window below - ;; `ecb-compile-window-height' - (let ((window-min-height (if (and (equal (ad-get-arg 0) ecb-compile-window) - (and ecb-compile-window-prevent-shrink-below-height - (not (interactive-p))) - window-min-height - ecb-compile-window-height-lines - (< window-min-height - ecb-compile-window-height-lines)) + ;; XEmacs-version + (defadvice shrink-window-if-larger-than-buffer (around ecb) + "Makes the function compatible with ECB." + (or (ad-get-arg 0) (ad-set-arg 0 (selected-window))) + (ecb-layout-debug-error "shrink-window-if-larger-than-buffer: window: %s" + (ad-get-arg 0)) + (if (or (not ecb-minor-mode) + (not (equal (window-frame (ad-get-arg 0)) ecb-frame)) + (member (ad-get-arg 0) (ecb-canonical-ecb-windows-list))) + (ecb-with-original-basic-functions + (ecb-with-original-functions + ad-do-it)) + + ;; we handle only the edit-windows and the compile-window of the + ;; ecb-frame in a special manner. + + ;; if called non-interactively (e.g. by `display-buffer's forth + ;; argument SHRINK-TO-FIT) and if called for the compile-window of + ;; ECB and if `ecb-compile-window-temporally-enlarge' is either + ;; after-selection or nil then we shrink to the + ;; ecb-compile-window-height! Otherwise we run the normal job! + (if (and (not (interactive-p)) + (equal (ad-get-arg 0) ecb-compile-window) + (member ecb-compile-window-temporally-enlarge + '(after-selection nil)) + ;; The *Completions*-buffer must always being enlarged! + (not (ecb-string= (buffer-name (window-buffer (ad-get-arg 0))) + "*Completions*"))) + (ecb-toggle-compile-window-height -1) + (save-excursion + (set-buffer (window-buffer (ad-get-arg 0))) + (ecb-layout-debug-error "shrink-window-if-larger-than-buffer: buffer to shrink: %s" + (current-buffer)) + ;; we prevent to shrink the compile-window below + ;; `ecb-compile-window-height' + (let ((window-min-height (if (and (equal (ad-get-arg 0) ecb-compile-window) + (and ecb-compile-window-prevent-shrink-below-height + (not (interactive-p))) + window-min-height ecb-compile-window-height-lines - window-min-height)) - (n 0) - (test-pos - (- (point-max) - ;; If buffer ends with a newline, ignore it when counting - ;; height unless point is after it. - (if (and (not (eobp)) - (eq ?\n (char-after (1- (point-max))))) - 1 0))) - (mini (frame-property (window-frame (ad-get-arg 0)) 'minibuffer)) - (edges (window-pixel-edges (selected-window)))) - (if (and (< 1 (let ((frame (selected-frame))) - (select-frame (window-frame (ad-get-arg 0))) - (unwind-protect - (ecb-with-original-basic-functions - (count-windows)) - (select-frame frame)))) - (or (equal (ad-get-arg 0) ecb-compile-window) - (not (equal (ecb-edit-window-splitted) 'horizontal))) - (pos-visible-in-window-p (point-min) (ad-get-arg 0)) - (not (eq mini 'only)) - (or (not mini) (eq mini t) - (< (nth 3 edges) - (nth 1 (window-pixel-edges mini))) - (> (nth 1 edges) - 0))) - (progn - (save-window-excursion - (goto-char (point-min)) - (while (and (window-live-p (ad-get-arg 0)) - (pos-visible-in-window-p test-pos (ad-get-arg 0))) - (shrink-window 1 nil (ad-get-arg 0)) - (setq n (1+ n)))) - (ecb-layout-debug-error "shrink-window-if-larger-than-buffer: n: %d" n) - (if (> n 0) - (shrink-window (min (1- n) - (- (ecb-window-full-height (ad-get-arg 0)) - (1+ window-min-height))) - nil - (ad-get-arg 0)))))))))) + (< window-min-height + ecb-compile-window-height-lines)) + ecb-compile-window-height-lines + window-min-height)) + (n 0) + (test-pos + (- (point-max) + ;; If buffer ends with a newline, ignore it when counting + ;; height unless point is after it. + (if (and (not (eobp)) + (eq ?\n (char-after (1- (point-max))))) + 1 0))) + (mini (frame-property (window-frame (ad-get-arg 0)) 'minibuffer)) + (edges (window-pixel-edges (selected-window)))) + (if (and (< 1 (let ((frame (selected-frame))) + (select-frame (window-frame (ad-get-arg 0))) + (unwind-protect + (ecb-with-original-basic-functions + (count-windows)) + (select-frame frame)))) + (or (equal (ad-get-arg 0) ecb-compile-window) + (not (equal (ecb-edit-window-splitted) 'horizontal))) + (pos-visible-in-window-p (point-min) (ad-get-arg 0)) + (not (eq mini 'only)) + (or (not mini) (eq mini t) + (< (nth 3 edges) + (nth 1 (window-pixel-edges mini))) + (> (nth 1 edges) + 0))) + (progn + (save-window-excursion + (goto-char (point-min)) + (while (and (window-live-p (ad-get-arg 0)) + (pos-visible-in-window-p test-pos (ad-get-arg 0))) + (shrink-window 1 nil (ad-get-arg 0)) + (setq n (1+ n)))) + (ecb-layout-debug-error "shrink-window-if-larger-than-buffer: n: %d" n) + (if (> n 0) + (shrink-window (min (1- n) + (- (ecb-window-full-height (ad-get-arg 0)) + (1+ window-min-height))) + nil + (ad-get-arg 0)))))))))) - (defadvice pop-to-buffer (around ecb) - "Chooses the window with the ECB-adviced version of `display-buffer'." - (ecb-with-adviced-functions - ad-do-it) - (when (and (equal (selected-frame) ecb-frame) - (ecb-point-in-compile-window)) - ;; we set the height of the compile-window according to - ;; `ecb-enlarged-compilation-window-max-height' - (ecb-set-compile-window-height))) + (defadvice pop-to-buffer (around ecb) + "Chooses the window with the ECB-adviced version of `display-buffer'." + (ecb-with-adviced-functions + ad-do-it) + (when (and (equal (selected-frame) ecb-frame) + (ecb-point-in-compile-window)) + ;; we set the height of the compile-window according to + ;; `ecb-enlarged-compilation-window-max-height' + (ecb-set-compile-window-height))) - ) ;; end of progn + ) ;; end of if-ecb-running-xemacs - ;; only GNU Emacs basic advices - (defadvice mouse-drag-vertical-line (around ecb) - "Allows manually window-resizing even if `ecb-fix-window-size' is not nil +(when-ecb-running-emacs + ;; only GNU Emacs basic advices + (defadvice mouse-drag-vertical-line (around ecb) + "Allows manually window-resizing even if `ecb-fix-window-size' is not nil for current layout." - (if (and ecb-minor-mode - (equal (selected-frame) ecb-frame) - (not ecb-windows-hidden) - (ecb-get-window-fix-type ecb-layout-name)) - (ecb-do-with-unfixed-ecb-buffers ad-do-it) - ad-do-it)) + (if (and ecb-minor-mode + (equal (selected-frame) ecb-frame) + (not ecb-windows-hidden) + (ecb-get-window-fix-type ecb-layout-name)) + (ecb-do-with-unfixed-ecb-buffers ad-do-it) + ad-do-it)) - (defadvice mouse-drag-mode-line (around ecb) - "Allows manually window-resizing even if `ecb-fix-window-size' is not nil + (defadvice mouse-drag-mode-line (around ecb) + "Allows manually window-resizing even if `ecb-fix-window-size' is not nil for current layout." - (if (and ecb-minor-mode - (equal (selected-frame) ecb-frame) - (not ecb-windows-hidden) - (ecb-get-window-fix-type ecb-layout-name) - (member (car (car (cdr (ad-get-arg 0)))) ;; the window of the event - (ecb-canonical-ecb-windows-list))) - (ecb-do-with-unfixed-ecb-buffers ad-do-it) - ad-do-it)) + (if (and ecb-minor-mode + (equal (selected-frame) ecb-frame) + (not ecb-windows-hidden) + (ecb-get-window-fix-type ecb-layout-name) + (member (car (car (cdr (ad-get-arg 0)))) ;; the window of the event + (ecb-canonical-ecb-windows-list))) + (ecb-do-with-unfixed-ecb-buffers ad-do-it) + ad-do-it)) - (defadvice enlarge-window (around ecb) - "Allows manually window-resizing even if `ecb-fix-window-size' is not nil + (defadvice enlarge-window (around ecb) + "Allows manually window-resizing even if `ecb-fix-window-size' is not nil for current layout." - (if (and ecb-minor-mode - (equal (selected-frame) ecb-frame) - (not ecb-windows-hidden) - (ecb-get-window-fix-type ecb-layout-name) - (member (selected-window) (ecb-canonical-ecb-windows-list))) - (ecb-do-with-unfixed-ecb-buffers ad-do-it) - ad-do-it)) + (if (and ecb-minor-mode + (equal (selected-frame) ecb-frame) + (not ecb-windows-hidden) + (ecb-get-window-fix-type ecb-layout-name) + (member (selected-window) (ecb-canonical-ecb-windows-list))) + (ecb-do-with-unfixed-ecb-buffers ad-do-it) + ad-do-it)) - (defadvice shrink-window (around ecb) - "Allows manually window-resizing even if `ecb-fix-window-size' is not nil + (defadvice shrink-window (around ecb) + "Allows manually window-resizing even if `ecb-fix-window-size' is not nil for current layout." - (if (and ecb-minor-mode - (equal (selected-frame) ecb-frame) - (not ecb-windows-hidden) - ;; See comment of defadvice for mouse-drag-mode-line - (ecb-get-window-fix-type ecb-layout-name) - (member (selected-window) (ecb-canonical-ecb-windows-list))) - (ecb-do-with-unfixed-ecb-buffers ad-do-it) - ad-do-it)) - - ;; Klaus Berndl <klaus.berndl(a)sdm.de&gt;: We can not use our - ;; Electric-pop-up-window advice instaed of this advice because otherwise - ;; some commands of the popup-menus of the ecb-buffers would not work - this - ;; comes from the save-window-excursion in the the tmm. - (defadvice tmm-prompt (around ecb) - "Make it compatible with ECB." - (if (or (not ecb-minor-mode) - (not (equal (selected-frame) ecb-frame))) - (ecb-with-original-basic-functions - (ecb-with-original-functions - ad-do-it)) - ;; we set temporally `ecb-other-window-behavior' to a function which - ;; always selects the "next" window after the - ;; `ecb-last-edit-window-with-point' - (let ((ecb-other-window-behavior - (lambda (win-list edit-win-list ecb-win-list comp-win - mini-win point-loc nth-win) - (ecb-next-listelem edit-win-list - ecb-last-edit-window-with-point))) - ;; we must not handle the tmm-stuff as compilation-buffer - (ecb-compilation-buffer-names nil) - (ecb-compilation-major-modes nil) - (ecb-compilation-predicates nil)) - ad-do-it))) + (if (and ecb-minor-mode + (equal (selected-frame) ecb-frame) + (not ecb-windows-hidden) + ;; See comment of defadvice for mouse-drag-mode-line + (ecb-get-window-fix-type ecb-layout-name) + (member (selected-window) (ecb-canonical-ecb-windows-list))) + (ecb-do-with-unfixed-ecb-buffers ad-do-it) + ad-do-it)) + + ;; Klaus Berndl <klaus.berndl(a)sdm.de&gt;: We can not use our + ;; Electric-pop-up-window advice instaed of this advice because otherwise + ;; some commands of the popup-menus of the ecb-buffers would not work - this + ;; comes from the save-window-excursion in the the tmm. + (defadvice tmm-prompt (around ecb) + "Make it compatible with ECB." + (if (or (not ecb-minor-mode) + (not (equal (selected-frame) ecb-frame))) + (ecb-with-original-basic-functions + (ecb-with-original-functions + ad-do-it)) + ;; we set temporally `ecb-other-window-behavior' to a function which + ;; always selects the "next" window after the + ;; `ecb-last-edit-window-with-point' + (let ((ecb-other-window-behavior + (lambda (win-list edit-win-list ecb-win-list comp-win + mini-win point-loc nth-win) + (ecb-next-listelem edit-win-list + ecb-last-edit-window-with-point))) + ;; we must not handle the tmm-stuff as compilation-buffer + (ecb-compilation-buffer-names nil) + (ecb-compilation-major-modes nil) + (ecb-compilation-predicates nil)) + ad-do-it))) - (defadvice shrink-window-if-larger-than-buffer (around ecb) - "Makes the function compatible with ECB." - (or (ad-get-arg 0) (ad-set-arg 0 (selected-window))) - (ecb-layout-debug-error "shrink-window-if-larger-than-buffer: window: %s" - (ad-get-arg 0)) - (if (or (not ecb-minor-mode) - (not (equal (window-frame (ad-get-arg 0)) ecb-frame)) - (member (ad-get-arg 0) (ecb-canonical-ecb-windows-list))) - (ecb-with-original-basic-functions - (ecb-with-original-functions - ad-do-it)) - (save-selected-window - (select-window (ad-get-arg 0)) - (ecb-layout-debug-error "shrink-window-if-larger-than-buffer: buffer to shrink: %s" - (current-buffer)) - (let* ((params (frame-parameters)) - (mini (cdr (assq 'minibuffer params))) - (edges (ecb-window-edges)) - ;; we prevent to shrink the compile-window below - ;; `ecb-compile-window-height' - (window-min-height (if (and (equal (ad-get-arg 0) ecb-compile-window) - (and ecb-compile-window-prevent-shrink-below-height - (not (interactive-p))) - window-min-height - ecb-compile-window-height-lines - (< window-min-height - ecb-compile-window-height-lines)) - ecb-compile-window-height-lines - window-min-height))) - (if (and (< 1 (ecb-with-original-basic-functions - (count-windows))) - (or (equal (ad-get-arg 0) ecb-compile-window) - (not (equal (ecb-edit-window-splitted) 'horizontal))) - (pos-visible-in-window-p (point-min) (ad-get-arg 0)) - (not (eq mini 'only)) - (or (not mini) - (< (nth 3 edges) (nth 1 (ecb-window-edges mini))) - (> (nth 1 edges) (cdr (assq 'menu-bar-lines params))))) - (if ecb-running-emacs-21 - (fit-window-to-buffer (ad-get-arg 0) - (ecb-window-full-height (ad-get-arg 0))) - ;; code for GNU Emacs < 21.X - (let ((text-height (window-buffer-height (ad-get-arg 0))) - (window-height (ecb-window-full-height))) - ;; Don't try to redisplay with the cursor at the end - ;; on its own line--that would force a scroll and spoil things. - (when (and (eobp) (bolp)) - (forward-char -1)) - (when (> window-height (1+ text-height)) - (shrink-window - (- window-height (max (1+ text-height) window-min-height))))))))))) - - (defadvice resize-temp-buffer-window (around ecb) - "Makes the function compatible with ECB." - (ecb-layout-debug-error "resize-temp-buffer-window: buffer: %s, window: %s, frame: %s" - (current-buffer) (selected-window) (selected-frame)) - (if (or (not ecb-minor-mode) - (not (equal (selected-frame) ecb-frame)) - (equal (ecb-where-is-point) 'ecb)) - (ecb-with-original-basic-functions - (ecb-with-original-functions - ad-do-it)) - (if (and (equal (selected-window) ecb-compile-window) - (member ecb-compile-window-temporally-enlarge - '(after-selection nil)) - ;; The *Completions* buffer must always being enlarged!! - (not (ecb-string= (buffer-name (current-buffer)) "*Completions*"))) - (progn - (ecb-layout-debug-error "resize-temp-buffer-window: buffer: shrink to comp-win-height") - (ecb-toggle-compile-window-height -1)) - ;; we prevent to shrink the compile-window below - ;; `ecb-compile-window-height' - (let ((window-min-height (if (and window-min-height + (defadvice shrink-window-if-larger-than-buffer (around ecb) + "Makes the function compatible with ECB." + (or (ad-get-arg 0) (ad-set-arg 0 (selected-window))) + (ecb-layout-debug-error "shrink-window-if-larger-than-buffer: window: %s" + (ad-get-arg 0)) + (if (or (not ecb-minor-mode) + (not (equal (window-frame (ad-get-arg 0)) ecb-frame)) + (member (ad-get-arg 0) (ecb-canonical-ecb-windows-list))) + (ecb-with-original-basic-functions + (ecb-with-original-functions + ad-do-it)) + (save-selected-window + (select-window (ad-get-arg 0)) + (ecb-layout-debug-error "shrink-window-if-larger-than-buffer: buffer to shrink: %s" + (current-buffer)) + (let* ((params (frame-parameters)) + (mini (cdr (assq 'minibuffer params))) + (edges (ecb-window-edges)) + ;; we prevent to shrink the compile-window below + ;; `ecb-compile-window-height' + (window-min-height (if (and (equal (ad-get-arg 0) ecb-compile-window) + (and ecb-compile-window-prevent-shrink-below-height + (not (interactive-p))) + window-min-height ecb-compile-window-height-lines - ecb-compile-window-prevent-shrink-below-height (< window-min-height ecb-compile-window-height-lines)) ecb-compile-window-height-lines window-min-height))) - (unless (or (one-window-p 'nomini) - ;; Klaus Berndl <klaus.berndl(a)sdm.de&gt;: we do nothing if an unsplitted - ;; edit-window should be resized because this would fail (e.g. if - ;; `pop-up-windows' is nil) - (and (not (equal (selected-window) ecb-compile-window)) - (not (ecb-edit-window-splitted))) - (not (pos-visible-in-window-p (point-min)))) - (ecb-layout-debug-error "resize-temp-buffer-window: resize buffer: %s" - (current-buffer)) - (if ecb-running-emacs-21 - (fit-window-to-buffer - (selected-window) - (if (functionp temp-buffer-max-height) - (funcall temp-buffer-max-height (current-buffer)) - temp-buffer-max-height)) - (let* ((max-height (if (functionp temp-buffer-max-height) - (funcall temp-buffer-max-height (current-buffer)) - temp-buffer-max-height)) - (win-height (1- (ecb-window-full-height))) - (min-height (1- window-min-height)) - (text-height (window-buffer-height (selected-window))) - (new-height (max (min text-height max-height) min-height))) - (enlarge-window (- new-height win-height))))))))) - - (defadvice pop-to-buffer (around ecb) - "Chooses the window with the ECB-adviced version of `display-buffer'." - (if (or (not ecb-minor-mode) - (null (ad-get-arg 0))) - (ecb-with-original-basic-functions - (ecb-with-original-functions - ad-do-it)) - (condition-case nil - (progn - (ecb-layout-debug-error "pop-to-buffer: buffer: %s, %s" - (ad-get-arg 0) (ad-get-arg 1)) - (select-window (ecb-with-adviced-functions - (display-buffer (ad-get-arg 0) - (ad-get-arg 1)))) - (if (ad-get-arg 2) - ;; not the best solution but for now.... - (bury-buffer (ad-get-arg 0)))) - ;; This is if the call to the adviced `display-buffer' fails (seems - ;; to make problems with C-h i and the *info*-buffer). Then we run the - ;; orginal version. - (error - (ecb-layout-debug-error "pop-to-buffer: adviced version failed for buffer: %s, %s" - (ad-get-arg 0) (ad-get-arg 1)) - (if (ecb-buffer-is-dedicated-special-buffer-p (ad-get-arg 0)) - (ecb-error "Can not go to a invisible special ECB-buffer!") - ad-do-it))) - (when (ecb-point-in-compile-window) - ;; we set the height of the compile-window according to - ;; `ecb-enlarged-compilation-window-max-height' - (ecb-set-compile-window-height)))) + (if (and (< 1 (ecb-with-original-basic-functions + (count-windows))) + (or (equal (ad-get-arg 0) ecb-compile-window) + (not (equal (ecb-edit-window-splitted) 'horizontal))) + (pos-visible-in-window-p (point-min) (ad-get-arg 0)) + (not (eq mini 'only)) + (or (not mini) + (< (nth 3 edges) (nth 1 (ecb-window-edges mini))) + (> (nth 1 edges) (cdr (assq 'menu-bar-lines params))))) + (if ecb-running-emacs-21 + (fit-window-to-buffer (ad-get-arg 0) + (ecb-window-full-height (ad-get-arg 0))) + ;; code for GNU Emacs < 21.X + (let ((text-height (window-buffer-height (ad-get-arg 0))) + (window-height (ecb-window-full-height))) + ;; Don't try to redisplay with the cursor at the end + ;; on its own line--that would force a scroll and spoil things. + (when (and (eobp) (bolp)) + (forward-char -1)) + (when (> window-height (1+ text-height)) + (shrink-window + (- window-height (max (1+ text-height) window-min-height))))))))))) + + (defadvice resize-temp-buffer-window (around ecb) + "Makes the function compatible with ECB." + (ecb-layout-debug-error "resize-temp-buffer-window: buffer: %s, window: %s, frame: %s" + (current-buffer) (selected-window) (selected-frame)) + (if (or (not ecb-minor-mode) + (not (equal (selected-frame) ecb-frame)) + (equal (ecb-where-is-point) 'ecb)) + (ecb-with-original-basic-functions + (ecb-with-original-functions + ad-do-it)) + (if (and (equal (selected-window) ecb-compile-window) + (member ecb-compile-window-temporally-enlarge + '(after-selection nil)) + ;; The *Completions* buffer must always being enlarged!! + (not (ecb-string= (buffer-name (current-buffer)) "*Completions*"))) + (progn + (ecb-layout-debug-error "resize-temp-buffer-window: buffer: shrink to comp-win-height") + (ecb-toggle-compile-window-height -1)) + ;; we prevent to shrink the compile-window below + ;; `ecb-compile-window-height' + (let ((window-min-height (if (and window-min-height + ecb-compile-window-height-lines + ecb-compile-window-prevent-shrink-below-height + (< window-min-height + ecb-compile-window-height-lines)) + ecb-compile-window-height-lines + window-min-height))) + (unless (or (one-window-p 'nomini) + ;; Klaus Berndl <klaus.berndl(a)sdm.de&gt;: we do nothing if an unsplitted + ;; edit-window should be resized because this would fail (e.g. if + ;; `pop-up-windows' is nil) + (and (not (equal (selected-window) ecb-compile-window)) + (not (ecb-edit-window-splitted))) + (not (pos-visible-in-window-p (point-min)))) + (ecb-layout-debug-error "resize-temp-buffer-window: resize buffer: %s" + (current-buffer)) + (if ecb-running-emacs-21 + (fit-window-to-buffer + (selected-window) + (if (functionp temp-buffer-max-height) + (funcall temp-buffer-max-height (current-buffer)) + temp-buffer-max-height)) + (let* ((max-height (if (functionp temp-buffer-max-height) + (funcall temp-buffer-max-height (current-buffer)) + temp-buffer-max-height)) + (win-height (1- (ecb-window-full-height))) + (min-height (1- window-min-height)) + (text-height (window-buffer-height (selected-window))) + (new-height (max (min text-height max-height) min-height))) + (enlarge-window (- new-height win-height))))))))) + + (defadvice pop-to-buffer (around ecb) + "Chooses the window with the ECB-adviced version of `display-buffer'." + (if (or (not ecb-minor-mode) + (null (ad-get-arg 0))) + (ecb-with-original-basic-functions + (ecb-with-original-functions + ad-do-it)) + (condition-case nil + (progn + (ecb-layout-debug-error "pop-to-buffer: buffer: %s, %s" + (ad-get-arg 0) (ad-get-arg 1)) + (select-window (ecb-with-adviced-functions + (display-buffer (ad-get-arg 0) + (ad-get-arg 1)))) + (if (ad-get-arg 2) + ;; not the best solution but for now.... + (bury-buffer (ad-get-arg 0)))) + ;; This is if the call to the adviced `display-buffer' fails (seems + ;; to make problems with C-h i and the *info*-buffer). Then we run the + ;; orginal version. + (error + (ecb-layout-debug-error "pop-to-buffer: adviced version failed for buffer: %s, %s" + (ad-get-arg 0) (ad-get-arg 1)) + (if (ecb-buffer-is-dedicated-special-buffer-p (ad-get-arg 0)) + (ecb-error "Can not go to a invisible special ECB-buffer!") + ad-do-it))) + (when (ecb-point-in-compile-window) + ;; we set the height of the compile-window according to + ;; `ecb-enlarged-compilation-window-max-height' + (ecb-set-compile-window-height))))) - ) ;; end of (if ecb-running-xemacs...) ;; Klaus Berndl <klaus.berndl(a)sdm.de&gt;: Fixes a bug with ths ;; shrink-to-fit stuff: (set-window-buffer ...) has to be called BEFORE ＠＠ -2444,6 +2482,66 ＠＠ (member (selected-window) (ecb-canonical-ecb-windows-list))) (selected-window))) + +(defun ecb-goto-ecb-window (name) + "Select that special ecb-window with name NAME. Only names defined +for the current layout \(see `ecb-special-ecb-buffers-of-current-layout') or +the buffer-name of the integrated speedbar are accepted. If such a window can +not be selected then probably because another ecb-window of current layout is +currently maximized; therefore in such a case the layout has been redrawn and +then tried to select the window again. This function does nothing if NAME +fulfills not the described conditions or if the ecb-windows are hidden or ECB +is not active. If necessary the `ecb-frame' will be first raised." + (when (and ecb-minor-mode + (not ecb-windows-hidden) + (or (equal name ecb-speedbar-buffer-name) + (member name ecb-special-ecb-buffers-of-current-layout))) + (raise-frame ecb-frame) + (select-frame ecb-frame) + (or (ecb-window-select name) + ;; the window is not visible because another one is maximized; + ;; therefore we first redraw the layout + (progn + (ecb-redraw-layout-full nil nil nil nil) + ;; now we can go to the window + (ecb-window-select name))))) + +(defun ecb-goto-window-edit-last () + "Make the last selected edit-window window the current window. This is the +same as if `ecb-mouse-click-destination' is set to 'last-point." + (interactive) + (when ecb-minor-mode + (raise-frame ecb-frame) + (select-frame ecb-frame) + (let ((ecb-mouse-click-destination 'last-point)) + (ecb-select-edit-window)))) + +(defun ecb-goto-window-edit1 () + "Make the \(first) edit-window window the current window." + (interactive) + (when ecb-minor-mode + (raise-frame ecb-frame) + (select-frame ecb-frame) + (ecb-select-edit-window 1))) + +(defun ecb-goto-window-edit2 () + "Make the second edit-window \(if available) window the current window." + (interactive) + (when ecb-minor-mode + (raise-frame ecb-frame) + (select-frame ecb-frame) + (ecb-select-edit-window t))) + +(defun ecb-goto-window-compilation () + "Goto the ecb compilation window `ecb-compile-window'." + (interactive) + (when (and ecb-minor-mode + (equal 'visible (ecb-compile-window-state))) + (raise-frame ecb-frame) + (select-frame ecb-frame) + (select-window ecb-compile-window))) + + (defun ecb-select-ecb-frame () "Selects the `ecb-frame' if ECB is activated - otherwise reports an error." (interactive) ＠＠ -2545,7 +2643,16 ＠＠ (cond ((and (ecb-point-in-compile-window) (not ecb-compile-window-was-selected-before-command)) (ecb-layout-debug-error "ecb-layout-post-command-hook: enlarge") - (ecb-toggle-compile-window-height 1)) + ;; now we change the window-start, so we see autom. more text + ;; after the enlargement of the window. + (let ((height-before (ecb-window-full-height)) + (height-after (ecb-toggle-compile-window-height 1))) + (set-window-start ecb-compile-window + (save-excursion + (goto-char (window-start)) + (forward-line (* -1 (- height-after height-before))) + (ecb-line-beginning-pos)) + t))) ((and ecb-compile-window-was-selected-before-command (not (ecb-point-in-compile-window))) (ecb-layout-debug-error "ecb-layout-post-command-hook: shrink") ＠＠ -2645,6 +2752,12 ＠＠ result)) +(defvar ecb-layout-temporary-dedicated-windows nil + "List of windows temporary made dedicated by ECB. +Only set by the adviced `display-buffer' and only evaluated by +`ecb-canonical-edit-windows-list' and `ecb-canonical-ecb-windows-list'. This +variable is strictly only for internal usage!") + ;; This advice is the heart of the mechanism which displays all buffer in the ;; compile-window if they are are "compilation-buffers" in the sense of ;; `ecb-compilation-buffer-p'! ＠＠ -2725,6 +2838,8 ＠＠ (mapc (function (lambda (w) (set-window-dedicated-p w t))) edit-window-list) + (setq ecb-layout-temporary-dedicated-windows + edit-window-list) ;; now we perform the original `display-buffer' but ;; now the only not dedicated window is the compile ;; window so `display-buffer' MUST use this. ＠＠ -2766,7 +2881,9 ＠＠ ;; making the edit-window(s) not dedicated (mapc (function (lambda (w) (set-window-dedicated-p w nil))) - edit-window-list)) + edit-window-list) + (setq ecb-layout-temporary-dedicated-windows nil)) + ;; if called interactively we run now our ;; `ecb-toggle-compile-window-height' to set the height of ;; the compile-window according to the value of ＠＠ -2853,6 +2970,8 ＠＠ ;; now we perform the original `display-buffer' but ;; now the only not dedicated window(s) are the ;; edit-window(s) + (setq ecb-layout-temporary-dedicated-windows + (list ecb-compile-window)) (if ecb-running-xemacs (setq ad-return-value (ecb-display-buffer-xemacs (ad-get-arg 0) ＠＠ -2862,7 +2981,8 ＠＠ ad-do-it) ) ;; making the compile-window not dedicated - (set-window-dedicated-p ecb-compile-window nil)) + (set-window-dedicated-p ecb-compile-window nil) + (setq ecb-layout-temporary-dedicated-windows nil)) (if ecb-running-xemacs (setq ad-return-value (ecb-display-buffer-xemacs (ad-get-arg 0) ＠＠ -3471,6 +3591,7 ＠＠ (ecb-with-original-basic-functions (ecb-with-original-functions ad-do-it)) + (ecb-layout-debug-error "switch-to-buffer buffer: %s" (ad-get-arg 0)) (cond ((ecb-compilation-buffer-p (ad-get-arg 0)) (when (equal 'hidden (ecb-compile-window-state)) (ecb-toggle-compile-window 1)) ＠＠ -3497,7 +3618,10 ＠＠ (ecb-with-original-basic-functions (ecb-with-original-functions ad-do-it)) + (ecb-layout-debug-error "switch-to-buffer curr-buffer: %s" (current-buffer)) (when (ecb-point-in-compile-window) + (ecb-layout-debug-error "switch-to-buffer curr-buffer: %s, curr window %s" + (current-buffer) (selected-window)) ;; we set the height of the compile-window according to ;; `ecb-enlarged-compilation-window-max-height' (ecb-set-compile-window-height)))) ＠＠ -4228,48 +4352,49 ＠＠ a dedicated window \(e.g. a ECB-tree-window)." `(progn (ecb-layout-type-p (quote ,type) t) - (defun ,(intern (format "ecb-layout-function-%s" name)) (&optional create-code-fcn) - ,doc - ;; Klaus Berndl <klaus.berndl(a)sdm.de&gt;: creating the compile-window is - ;; now done in `ecb-redraw-layout-full'! -;; (when (and ecb-compile-window-height -;; (or (equal ecb-compile-window-width 'frame) -;; (equal (ecb-get-layout-type ecb-layout-name) 'top))) -;; (ecb-split-ver (- ecb-compile-window-height) t t) -;; (setq ecb-compile-window (next-window))) - ,(cond ((equal type 'left) - '(ecb-split-hor ecb-windows-width t)) - ((equal type 'right) - '(ecb-split-hor (- ecb-windows-width) nil)) - ((equal type 'top) - '(ecb-split-ver ecb-windows-height t)) - ((equal type 'left-right) - '(progn - (ecb-split-hor (- ecb-windows-width) t) - (ecb-split-hor ecb-windows-width t t)))) - ;; if create-code-fcn is not nil and we have not a left-right layout - ;; then we call this function instead of create-code - afterwards we - ;; have to select the edit-window. If create-code-fcn is nil then the - ;; leftmost-topmost ecb-window-column/bar is selected. - (if (and create-code-fcn - (not (equal (ecb-get-layout-type ecb-layout-name) 'left-right))) - (progn - (funcall create-code-fcn) - (select-window (next-window))) - ,＠create-code) - ;; Klaus Berndl <klaus.berndl(a)sdm.de&gt;: creating the compile-window is - ;; now done in `ecb-redraw-layout-full'! -;; (when (and ecb-compile-window-height -;; (equal ecb-compile-window-width 'edit-window) -;; (not (equal (ecb-get-layout-type ecb-layout-name) 'top))) -;; (ecb-split-ver (- ecb-compile-window-height) t t) -;; (setq ecb-compile-window (next-window))) - (setq ecb-edit-window (selected-window))) - (defalias (quote ,(intern - (format "ecb-delete-window-in-editwindow-%s" - name))) - (quote ,(intern - (format "ecb-delete-window-ecb-windows-%s" type)))) + (eval-and-compile + (defun ,(intern (format "ecb-layout-function-%s" name)) (&optional create-code-fcn) + ,doc + ;; Klaus Berndl <klaus.berndl(a)sdm.de&gt;: creating the compile-window is + ;; now done in `ecb-redraw-layout-full'! + ;; (when (and ecb-compile-window-height + ;; (or (equal ecb-compile-window-width 'frame) + ;; (equal (ecb-get-layout-type ecb-layout-name) 'top))) + ;; (ecb-split-ver (- ecb-compile-window-height) t t) + ;; (setq ecb-compile-window (next-window))) + ,(cond ((equal type 'left) + '(ecb-split-hor ecb-windows-width t)) + ((equal type 'right) + '(ecb-split-hor (- ecb-windows-width) nil)) + ((equal type 'top) + '(ecb-split-ver ecb-windows-height t)) + ((equal type 'left-right) + '(progn + (ecb-split-hor (- ecb-windows-width) t) + (ecb-split-hor ecb-windows-width t t)))) + ;; if create-code-fcn is not nil and we have not a left-right layout + ;; then we call this function instead of create-code - afterwards we + ;; have to select the edit-window. If create-code-fcn is nil then the + ;; leftmost-topmost ecb-window-column/bar is selected. + (if (and create-code-fcn + (not (equal (ecb-get-layout-type ecb-layout-name) 'left-right))) + (progn + (funcall create-code-fcn) + (select-window (next-window))) + ,＠create-code) + ;; Klaus Berndl <klaus.berndl(a)sdm.de&gt;: creating the compile-window is + ;; now done in `ecb-redraw-layout-full'! + ;; (when (and ecb-compile-window-height + ;; (equal ecb-compile-window-width 'edit-window) + ;; (not (equal (ecb-get-layout-type ecb-layout-name) 'top))) + ;; (ecb-split-ver (- ecb-compile-window-height) t t) + ;; (setq ecb-compile-window (next-window))) + (setq ecb-edit-window (selected-window))) + (defalias (quote ,(intern + (format "ecb-delete-window-in-editwindow-%s" + name))) + (quote ,(intern + (format "ecb-delete-window-ecb-windows-%s" type))))) (ecb-available-layouts-add ,name (quote ,type)))) ;; Only a test for the macro above ＠＠ -4464,8 +4589,6 ＠＠ (car oops) (cdr oops)))) ad-return-value) - - (defun ecb-current-window-configuration () "Return the current ecb-window-configuration" (progn ＠＠ -4478,6 +4601,15 ＠＠ `set-window-configuration'." (set-window-configuration (car ecb-window-config))) +(defmacro ecb-save-window-excursion (&rest body) + "Same as `save-window-excursion' but it takes care of the ECB-needs." + (let ((current-window-config (make-symbol "curr-win-conf"))) + `(let ((,current-window-config (ecb-current-window-configuration))) + (unwind-protect + (progn + ,＠body) + (ecb-set-window-configuration ,current-window-config))))) + ;; test of the advices of set-window-configuration and ;; current-window-configuration. ＠＠ -4573,15 +4705,16 ＠＠ (defun ecb-repair-only-ecb-window-layout () - (interactive) + "Repair the ecb-window layout if it has been destroyed." ;; In the following situation repairing the layout with preserving all ;; states of all edit-windows and the compile-window (incl. all sizes) makes ;; sense: - ;; 1. Ther is a permanent compile-window visible + ;; 1. There is a permanent compile-window visible ;; 2. The ecb-windows are not hidden ;; 3. there is no ecb-window maximized - ;; 4. we have less ecb-windows than we should have - ;; 5. Emacs does not wait for output of a running process where the + ;; 4. There is no active minibuffer + ;; 5. we have less ecb-windows than we should have + ;; 6. Emacs does not wait for output of a running process where the ;; associated process-buffer is visible in the ecb-frame ;; Then we redraw the layout with the current window-configuration-data ＠＠ -4591,6 +4724,7 ＠＠ (if (and (ecb-compile-window-live-p) (not ecb-windows-hidden) (null ecb-current-maximized-ecb-buffer-name) + (not (minibuffer-window-active-p (minibuffer-window ecb-frame))) (not (equal (mapcar 'buffer-name (ecb-get-current-visible-ecb-buffers)) ecb-special-ecb-buffers-of-current-layout)) ＠＠ -4606,8 +4740,10 ＠＠ ecb-frame)))) (process-list))))) (let ((config-data (ecb-window-configuration-data)) - (win-config-before (ecb-current-window-configuration)) + ;; (win-config-before (ecb-current-window-configuration)) (success nil)) + (ecb-layout-debug-error "ecb-repair-ecb-window-layout: Current ecb-windows: %s" + (ecb-get-current-visible-ecb-buffers)) (ecb-layout-debug-error "ecb-repair-ecb-window-layout: We repair with data: %s" config-data) (setq success (condition-case oops ＠＠ -4623,7 +4759,7 ＠＠ (when (not success) ;; Reseting to the window-config before is good when done ;; interactively but not with an idle-times because then this reset - ;; would be done until the user creates a window-config where the no + ;; would be done until the user creates a window-config where no ;; repair is necessary or at least the repair doesn't fail. So we ;; have to implement a smarter mechanism.............. nil ;; (ecb-set-window-configuration win-config-before) ＠＠ -5078,21 +5214,30 ＠＠ (ignore-errors (enlarge-window enlarge-height))))))) (defun ecb-set-ecb-window-sizes (window-sizes) - (ecb-do-with-unfixed-ecb-buffers - (let ((sizes (or window-sizes ecb-layout-default-window-sizes)) - (windows (ecb-canonical-ecb-windows-list)) - (ref-width (frame-width ecb-frame)) - (ref-height (if (ecb-compile-window-live-p) - (- (frame-height ecb-frame) - (ecb-window-full-height ecb-compile-window)) - (frame-height ecb-frame)))) - (when sizes - (if (= (length windows) (length sizes)) - (dolist (size sizes) - (ecb-set-window-size (car windows) size (cons ref-width ref-height)) - (setq windows (cdr windows))) - (ecb-error "Stored sizes of layout %s not applicable for current window layout!" - ecb-layout-name)))))) + (unless ecb-windows-hidden + (ecb-do-with-unfixed-ecb-buffers + (let ((sizes (or window-sizes ecb-layout-default-window-sizes)) + (windows (ecb-canonical-ecb-windows-list)) + (ref-width (frame-width ecb-frame)) + (ref-height (if (ecb-compile-window-live-p) + (- (frame-height ecb-frame) + (ecb-window-full-height ecb-compile-window)) + (frame-height ecb-frame)))) + (ecb-layout-debug-error "ecb-set-ecb-window-sizes: window-sizes: %s, sizes: %s, windows: %s, length-s: %d, length-w: %d" + window-sizes sizes windows + (length sizes) (length windows)) + (mapcar (lambda (win) + (ecb-layout-debug-error "ecb-set-ecb-window-sizes: win %s, ded: %s" + win (window-dedicated-p win))) + windows) + (when sizes + (if (= (length windows) (length sizes)) + (dolist (size sizes) + (ecb-set-window-size (car windows) size (cons ref-width ref-height)) + (setq windows (cdr windows))) + (when (interactive-p) + (ecb-error "Stored sizes of layout %s not applicable for current window layout!" + ecb-layout-name)))))))) ;; Klaus Berndl <klaus.berndl(a)sdm.de&gt;: frame-width is smaller than ;; ecb-window-full-width for only one window in the frame. But for now this ＠＠ -5179,6 +5324,9 ＠＠ ecb-compile-window-height-lines)) (ecb-current-window-configuration)))) +;; Klaus Berndl <klaus.berndl(a)sdm.de&gt;: returns curently always nil because +;; currently ecb-store-compile-window-specified-height-config is never called +;; - see comment above! (defun ecb-reset-compile-window-specified-height-config () "Set the ecb-window-configuration of `ecb-compile-window-specified-height-config' if it is a still valid ＠＠ -5201,7 +5349,8 ＠＠ value of `ecb-enlarged-compilation-window-max-height'. But never shrink below the value of `ecb-compile-window-height'. If ARG <= 0 then shrink `ecb-compile-window' to `ecb-compile-window-height' and if ARG is nil then -toggle the enlarge-state." +toggle the enlarge-state. Returns the new height of the compile-window or nil +if no compile-window is visible." (interactive "P") (if (and ecb-minor-mode (equal (selected-frame) ecb-frame) ＠＠ -5233,8 +5382,15 ＠＠ (shrink-window (max 0 (- (ecb-window-full-height) ecb-compile-window-height-lines))) ;; we restore the window-sizes (either the default or the - ;; stored sizes - (ecb-restore-window-sizes) + ;; stored sizes. because this function is often called + ;; during display-buffer (e.g. when completions, help-buffers, + ;; choosing a completion are performed) and XEmacs often + ;; destroyes the window-layout (e.g. the topmost + ;; ecb-window disappears, when doing completion etc..) we + ;; hav to ignore errors here.... it's not easy to find out + ;; what is precisely happening here but with this error + ;; ignoring all seems to work... + (ignore-errors (ecb-restore-window-sizes)) )) (if (equal ecb-enlarged-compilation-window-max-height 'best) ;; With GNU Emacs we could use `fit-window-to-buffer' but ＠＠ -5251,8 +5407,7 ＠＠ (progn (setq max-height (max (min (floor (/ (1- (frame-height)) 2)) - (or (if (equal (derived-mode-class major-mode) - 'compilation-mode) + (or (if (ecb-derived-mode-p 'compilation-mode) compilation-window-height (if ecb-running-xemacs (ignore-errors ; if temp-buffer-... is nil! ＠＠ -5282,8 +5437,12 ＠＠ ;; now we set the window-start (when (and (not (equal major-mode 'compilation-mode)) (not compile-window-selected-p)) - (set-window-start ecb-compile-window (point-min))))))) - (message "No compile-window in current ECB-layout!"))) + (set-window-start ecb-compile-window (point-min)))) + ;; return the new compile-window height + (ecb-window-full-height)))) + (if (interactive-p) + (ecb-info-message "No compile-window in current ECB-layout!")) + nil)) ;; This function takes into account the value of of ;; `temp-buffer-shrink-to-fit' (XEmacs) and `temp-buffer-resize-mode' (GNU Index: ecb-makedef.mk =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb-makedef.mk,v retrieving revision 1.1 diff -u -r1.1 ecb-makedef.mk --- ecb-makedef.mk 7 Feb 2004 16:15:43 -0000 1.1 +++ ecb-makedef.mk 1 Dec 2004 15:59:48 -0000 ＠＠ -12,7 +12,7 ＠＠ ecb-speedbar.el ecb-examples.el ecb-tod.el ecb-autogen.el \ ecb-jde.el ecb-file-browser.el ecb-method-browser.el \ ecb-winman-support.el ecb-semantic-wrapper.el \ - ecb-compatibility.el + ecb-compatibility.el ecb-common-browser.el ecb_LISP_ELC=$(ecb_LISP_EL:.el=.elc) Index: ecb-method-browser.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb-method-browser.el,v retrieving revision 1.6 diff -u -r1.6 ecb-method-browser.el --- ecb-method-browser.el 31 Aug 2004 16:00:43 -0000 1.6 +++ ecb-method-browser.el 1 Dec 2004 15:59:49 -0000 ＠＠ -24,7 +24,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: ecb-method-browser.el,v 1.6 2004/08/31 16:00:43 berndl Exp $ +;; $Id: ecb-method-browser.el,v 1.62 2004/11/22 16:59:16 berndl Exp $ ;;; Commentary: ＠＠ -38,6 +38,7 ＠＠ (require 'ecb-navigate) (require 'ecb-face) (require 'ecb-speedbar) +(require 'ecb-common-browser) (require 'ecb-semantic-wrapper) ;; This loads the semantic-setups for the major-modes. ＠＠ -70,11 +71,23 ＠＠ (defvar ecb-methods-root-node nil "Path to currently selected source.") -(defun ecb-method-browser-initialize () +(defconst ecb-methods-nodetype-tag 0) +(defconst ecb-methods-nodetype-bucket 1) +(defconst ecb-methods-nodetype-externtag 2) + +(defun ecb-method-browser-initialize-caches () + "Initialize the caches of the method-browser of ECB." + (ecb-clear-tag-tree-cache)) + +(defun ecb-method-browser-initialize (&optional no-caches) + "Initialize the method-browser of ECB. If optional arg NO-CACHES is not nil +then the caches used by the method-browser will not be initialized." (setq ecb-selected-tag nil) (setq ecb-methods-root-node nil) (setq ecb-methods-user-filter-alist nil) - (setq ecb-current-post-processed-tag-table nil)) + (setq ecb-current-post-processed-tag-table nil) + (unless no-caches + (ecb-method-browser-initialize-caches))) ;;==================================================== ;; Customization ＠＠ -514,8 +527,8 ＠＠ (match-string 2 text))) (setq col-type-name text)) (when (and (equal major-mode 'c++-mode) - (fboundp 'ecb--semantic-c-template-string)) - (setq template-text (ecb--semantic-c-template-string + (fboundp 'semantic-c-template-string)) + (setq template-text (semantic-c-template-string tag parent-tag colorize)) ;; Removing {...} from within the template-text. ;; Normally the semantic-formatters should not add this ＠＠ -886,7 +899,7 ＠＠ :value 0.25)) :set (function (lambda (symbol value) (set symbol value) - (if ecb-minor-mode + (if (and (boundp 'ecb-minor-mode) ecb-minor-mode) (ecb-activate-ecb-autocontrol-functions value 'ecb-tag-sync)))) :initialize 'custom-initialize-default) ＠＠ -1216,12 +1229,35 ＠＠ (defmacro ecb-exec-in-methods-window (&rest body) + "Evaluates BODY in the methods-window of ECB. If that window is not +visible then return the symbol 'window-not-visible. Otherwise the return +value of BODY is returned." `(unwind-protect - (when (ecb-window-select ecb-methods-buffer-name) + (if (not (ecb-window-select ecb-methods-buffer-name)) + 'window-not-visible ,＠body) )) +(defun ecb-goto-window-methods () + "Make the ECB-methods window the current window. +If `ecb-use-speedbar-instead-native-tree-buffer' is 'method then goto to the +speedbar-window." + (interactive) + (or (ecb-goto-ecb-window ecb-methods-buffer-name) + (and (equal ecb-use-speedbar-instead-native-tree-buffer 'method) + (ecb-goto-window-speedbar)))) + +(defun ecb-maximize-window-methods () + "Maximize the ECB-methods-window. +I.e. delete all other ECB-windows, so only one ECB-window and the +edit-window\(s) are visible \(and maybe a compile-window). Works also if the +ECB-methods-window is not visible in current layout." + (interactive) + (if (equal ecb-use-speedbar-instead-native-tree-buffer 'method) + (ecb-maximize-window-speedbar) + (ecb-display-one-ecb-buffer ecb-methods-buffer-name))) + (defun ecb-create-node (parent-node display name data type) (if (eq 'hidden display) nil ＠＠ -1366,36 +1402,23 ＠＠ (t nil))))))))) -(defun ecb-generate-node-name (text-name first-chars icon-name) - "Generate a new name from TEXT-NAME by adding an appropriate image according -to ICON-NAME to the first FIRST-CHARS of TEXT-NAME. If FIRST-CHARS is < 0 then -a string with length abs\(FIRST-CHARS) is created, the image is applied to -this new string and this \"image\"-string is added to the front of TEXT-NAME. -If no image can be found for ICON-NAME then the original TEXT-NAME is -returned." - (let ((image nil)) - (save-excursion - (set-buffer ecb-methods-buffer-name) - (setq image (and icon-name - (ecb-use-images-for-semantic-tags) - (tree-buffer-find-image icon-name))) - (if image - (if (> first-chars 0) - (tree-buffer-add-image-icon-maybe - 0 first-chars text-name image) - (concat (tree-buffer-add-image-icon-maybe - 0 1 (make-string (- first-chars) ? ) image) - text-name)) - text-name)))) - - +(defun ecb-tag-generate-node-name (text-name first-chars icon-name) + "Generate an suitable node name. Add needed image-icons if possible and +necessary. For the arguments TEXT-NAME, FIRST-CHARS and ICON-NAME see +`ecb-generate-node-name'." + (if (ecb-use-images-for-semantic-tags) + (ecb-generate-node-name text-name first-chars icon-name + ecb-methods-buffer-name) + text-name)) + + (defun ecb-add-tag-bucket (node bucket display sort-method &optional parent-tag no-bucketize) "Adds a tag bucket to a node unless DISPLAY equals 'hidden." (when bucket (let* ((name-bucket (ecb-format-bucket-name (car bucket))) (image-name (format "%s-bucket" (ecb--semantic-tag-class (cadr bucket)))) - (name (ecb-generate-node-name name-bucket -1 image-name)) + (name (ecb-tag-generate-node-name name-bucket -1 image-name)) ;;(type (ecb--semantic-tag-class (cadr bucket))) (bucket-node node)) (unless (eq 'hidden display) ＠＠ -1405,7 +1428,7 ＠＠ ;; bucket is forbidden to be displayed (not (ecb-show-at-least-one-tag-p (cdr bucket)))) (setq bucket-node - (tree-node-new name 1 + (tree-node-new name ecb-methods-nodetype-bucket (list 'ecb-bucket-node (car bucket) (ecb--semantic-tag-class (car (cdr bucket)))) ＠＠ -1417,7 +1440,8 ＠＠ ;; not forbidden to be displayed. (if (not (ecb-tag-forbidden-display-p tag)) (ecb-update-tag-node tag - (tree-node-new "" 0 tag t bucket-node + (tree-node-new "" ecb-methods-nodetype-tag + tag t bucket-node (if ecb-truncate-long-names 'end)) parent-tag no-bucketize)) ;; now we allow each tag to be displayed. This can be done because ＠＠ -1621,9 +1645,9 ＠＠ '(type function variable))) 'unknown) (ecb--semantic-tag-protection tag parent-tag)))) - (tag-name (ecb-generate-node-name plain-tag-name - (if has-protection 1 -1) - icon-name))) + (tag-name (ecb-tag-generate-node-name plain-tag-name + (if has-protection 1 -1) + icon-name))) (tree-node-set-name node tag-name) (unless (eq 'function (ecb--semantic-tag-class tag)) (ecb-add-tags node children tag no-bucketize) ＠＠ -1639,6 +1663,8 ＠＠ (and (tree-node-is-expandable node) (ecb-type-tag-expansion type-specifier)))))))) +;; (ecb-tag-generate-node-name "klaus" 1 "function-public") + (defun ecb-post-process-taglist (taglist) "If for current major-mode post-process functions are found in `ecb-post-process-semantic-taglist' then these functions are called with ＠＠ -1846,7 +1872,7 ＠＠ (let ((parent (tree-node-get-parent node))) (catch 'found (while (not (eq (tree-buffer-get-root) parent)) - (if (equal (and (= (tree-node-get-type parent) 0) + (if (equal (and (= (tree-node-get-type parent) ecb-methods-nodetype-tag) (ecb--semantic-tag-class (tree-node-get-data parent))) 'type) (throw 'found parent) ＠＠ -1866,7 +1892,7 ＠＠ (let ((type-hierarchy nil) (curr-node (tree-buffer-get-node-at-point))) (when (and curr-node - (= (tree-node-get-type curr-node) 0)) + (= (tree-node-get-type curr-node) ecb-methods-nodetype-tag)) (while (progn (setq type-hierarchy (cons (ecb--semantic-tag-name (tree-node-get-data curr-node)) ＠＠ -2366,14 +2392,15 ＠＠ (let ((parents (ecb-get-tag-parents parent-tag))) (when parents (let* ((name-bucket (ecb-format-bucket-name "Parents")) - (name (ecb-generate-node-name name-bucket -1 "parent-bucket")) + (name (ecb-tag-generate-node-name name-bucket -1 + "parent-bucket")) (parent-node nil)) (setq parent-node (ecb-create-node node display name (list 'ecb-bucket-node "Parents" 'parent) - 1)) + ecb-methods-nodetype-bucket)) (when node (dolist (parent (if sort-method (sort parents 'ecb-string<) parents)) ＠＠ -2386,11 +2413,12 ＠＠ ;; the protection of the inheritance (like possible ;; in C++) then we have to adjust this code and ;; compute the correct icon-name. - (parent-name (ecb-generate-node-name plain-parent-name - -1 - "parent-unknown"))) + (parent-name (ecb-tag-generate-node-name plain-parent-name + -1 + "parent-unknown"))) (tree-node-new parent-name - 2 parent t parent-node + ecb-methods-nodetype-externtag + parent t parent-node (if ecb-truncate-long-names 'end)))))))))) (t (ecb-find-add-tag-bucket node type display sort-method buckets parent-tag no-bucketize))))) ＠＠ -2410,7 +2438,33 ＠＠ ;; a mechanism where only the UPDATED-TAGS are used and only this ones are ;; updated. But for this we need also a tree-buffer-update which can update ;; single nodes without refreshing the whole tree-buffer like now. - (ecb-rebuild-methods-buffer-with-tagcache (ecb--semantic-fetch-tags t))) + + ;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: here we could check if + ;; UPDATED-TAGS contains only one tag and if this tag contains no childrens + ;; then we could use the new function `tree-buffer-update-node' to simply + ;; updating the associated node instead of a full reparse and then full + ;; tree-buffer-update. + (if (and (= 1 (length updated-tags)) + (null (ecb--semantic-tag-children-compatibility (car updated-tags) t))) + ;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: + ;; we could update this single node if we can find this node. But this + ;; could be difficult (or impossible?) because here we only know the new + ;; semantic-tag but our nodes contain only outdated semantic-tags as + ;; data so how to find the associated node??!! + ;; Maybe we could search the node which contaisn the parent-tag of the + ;; updated tag and then we compute the position p of this tag in the list + ;; of the children of its parent-tag and then we update that node which + ;; comes on the same position p in the list of childrens of the + ;; associated parent-node - hmm, but can we be sure that the sequence of + ;; children-tags and children-nodes is the same?? probably not because + ;; the nodes are ordered alphabetically and the tags are are ordered in + ;; that sequence they are code in the source-buffer! Hmmm........... + ;; Until this question is solved we must use the full reparse/rebuild + ;; :-( One possible solution: tempor. ordering the + ;; semantic-tag-childrens by name and getting the position p of the + ;; updated tag in that ordered tag-sequence... + (ecb-rebuild-methods-buffer-with-tagcache (ecb--semantic-fetch-tags t)) + (ecb-rebuild-methods-buffer-with-tagcache (ecb--semantic-fetch-tags t)))) (defun ecb-semantic-active-for-file (filename) ＠＠ -3097,9 +3151,9 ＠＠ (defun ecb-methods-node-get-semantic-type (node) - (cond ((= 1 (tree-node-get-type node)) + (cond ((= ecb-methods-nodetype-bucket (tree-node-get-type node)) (nth 2 (tree-node-get-data node))) - ((= 0 (tree-node-get-type node)) + ((= ecb-methods-nodetype-tag (tree-node-get-type node)) (ignore-errors (ecb--semantic-tag-class (tree-node-get-data node)))) (t nil))) ＠＠ -3166,7 +3220,8 ＠＠ function will be called for each of the root-children. Otherwise it will only expand/collaps NODE. -For description of LEVEL and FORCE-ALL see `ecb-expand-methods-nodes'. +For a description of LEVEL see `tree-buffer-expand-node' and for a description +of FORCE-ALL see `ecb-expand-methods-nodes'. If RESYNC-TAG is not nil then after expanding/collapsing the methods-buffer is resynced to the current tag of the edit-window. ＠＠ -3318,8 +3373,8 ＠＠ ;; Klaus Berndl <klaus.berndl(a)sdm.de&gt;: We must highlight the tag (tree-buffer-highlight-node-data data) (cond - ;; Type 0 = a tag - ((= type 0) + ;; Type ecb-methods-nodetype-tag = a tag + ((= type ecb-methods-nodetype-tag) (setq tag data) ;; If we have a virtual faux-group type-tag then we try to find it via ;; semanticdb ＠＠ -3330,17 +3385,17 ＠＠ (when faux-group (setq tag (cdr faux-group)) (setq filename (car faux-group)))))) - ;; Type 1 = a title of a group + ;; Type ecb-methods-nodetype-bucket = a title of a group ;; Just expand/collapse the node - ((= type 1) + ((= type ecb-methods-nodetype-bucket) (tree-node-toggle-expanded node) ;; Update the tree-buffer with optimized display of NODE (tree-buffer-update node)) - ;; Type 2 = a tag name for a tag not defined in current buffer; e.g. - ;; parent or include tags can be such tags! - ;; Try to find the tag - ((= type 2) + ;; Type ecb-methods-nodetype-externtag = a tag name for a tag not defined + ;; in current buffer; e.g. parent or include tags can be such tags! Try + ;; to find the tag + ((= type ecb-methods-nodetype-externtag) (set-buffer (get-file-buffer ecb-path-selected-source)) ;; Try to find source using JDE (setq found (ecb-jde-show-class-source data)) ＠＠ -3561,7 +3616,9 ＠＠ ecb-methods-buffer-name)) (concat (tree-node-get-name node) - (if (and (= 0 (tree-node-get-type node)) (tree-node-get-data node) + (if (and (= ecb-methods-nodetype-tag + (tree-node-get-type node)) + (tree-node-get-data node) (equal (ecb-show-node-info-what ecb-methods-buffer-name) 'name+type)) (concat ", " ＠＠ -3692,26 +3749,47 ＠＠ "Collapse all expandable and expanded nodes" (ecb-expand-methods-node-internal (tree-buffer-get-root) -1 nil t t)) +(tree-buffer-defpopup-command ecb-methods-menu-collapse-current + "Collapse the current node" + (let ((ecb-methods-nodes-collapse-spec 'all)) + (ecb-expand-methods-node-internal node -1 nil t t))) -(tree-buffer-defpopup-command ecb-methods-menu-expand-0 - "Expand all nodes with level 0." +(tree-buffer-defpopup-command ecb-methods-menu-expand-all-0 + "Expand all nodes exactly to level 0." (ecb-expand-methods-node-internal (tree-buffer-get-root) 0 nil t t)) +(tree-buffer-defpopup-command ecb-methods-menu-expand-current-0 + "Expand current node exactly to level 0." + (let ((ecb-methods-nodes-expand-spec 'all)) + (ecb-expand-methods-node-internal node 0 nil t t))) -(tree-buffer-defpopup-command ecb-methods-menu-expand-1 - "Expand all nodes with level 1." +(tree-buffer-defpopup-command ecb-methods-menu-expand-all-1 + "Expand all nodes to exactly level 1." (ecb-expand-methods-node-internal (tree-buffer-get-root) 1 nil t t)) +(tree-buffer-defpopup-command ecb-methods-menu-expand-current-1 + "Expand current node exactly to level 0." + (let ((ecb-methods-nodes-expand-spec 'all)) + (ecb-expand-methods-node-internal node 1 nil t t))) -(tree-buffer-defpopup-command ecb-methods-menu-expand-2 - "Expand all nodes with level 2." +(tree-buffer-defpopup-command ecb-methods-menu-expand-all-2 + "Expand all nodes to exactly level 2." (ecb-expand-methods-node-internal (tree-buffer-get-root) 2 nil t t)) +(tree-buffer-defpopup-command ecb-methods-menu-expand-current-2 + "Expand current node exactly to level 0." + (let ((ecb-methods-nodes-expand-spec 'all)) + (ecb-expand-methods-node-internal node 2 nil t t))) -(tree-buffer-defpopup-command ecb-methods-menu-expand-all - "Expand all expandable nodes recursively." +(tree-buffer-defpopup-command ecb-methods-menu-expand-all-full + "Expand all expandable nodes recursively, i.e. completely." (ecb-expand-methods-node-internal (tree-buffer-get-root) 100 nil t t)) +(tree-buffer-defpopup-command ecb-methods-menu-expand-current-full + "Expand the current node recursively, i.e. completely." + (let ((ecb-methods-nodes-expand-spec 'all)) + (ecb-expand-methods-node-internal node 100 nil t t))) + (defvar ecb-common-methods-menu nil "Built-in menu for the methods-buffer.") ＠＠ -3720,11 +3798,18 ＠＠ (setq ecb-common-methods-menu '( ;;("---") ("Expand/Collapse" - (ecb-methods-menu-collapse-all "Collapse all") - (ecb-methods-menu-expand-0 "Expand level 0") - (ecb-methods-menu-expand-1 "Expand level 1") - (ecb-methods-menu-expand-2 "Expand level 2") - (ecb-methods-menu-expand-all "Expand all")) + (ecb-methods-menu-collapse-current "Collapse this node completely") + (ecb-methods-menu-expand-current-0 "Expand this node to level 0") + (ecb-methods-menu-expand-current-1 "Expand this node to level 1") + (ecb-methods-menu-expand-current-2 "Expand this node to level 2") + (ecb-methods-menu-expand-current-full "Expand this node completely") + ("---") + (ecb-methods-menu-collapse-all "Collapse all completely") + (ecb-methods-menu-expand-all-0 "Expand all to level 0") + (ecb-methods-menu-expand-all-1 "Expand all to level 1") + (ecb-methods-menu-expand-all-2 "Expand all to level 2") + (ecb-methods-menu-expand-all-full "Expand all completely") + ) ("---") (ecb-maximize-ecb-window-menu-wrapper "Maximize window"))) ＠＠ -3743,7 +3828,8 ＠＠ (defvar ecb-methods-menu-title-creator (function (lambda (node) (let ((data (tree-node-get-data node))) - (if (and data (/= 1 (tree-node-get-type node))) + (if (and data (/= ecb-methods-nodetype-bucket + (tree-node-get-type node))) (cond ((ecb--semantic-tag-p data) (ecb--semantic-tag-name data)) ((stringp data) ＠＠ -3900,25 +3986,28 ＠＠ (funcall ecb-methods-menu-user-extension-function))) (dyn-builtin-extension-edit-win (ecb-methods-menu-editwin-entries)) (dyn-builtin-extension-tagfilter (ecb-methods-menu-tagfilter-entries))) - (list (cons 0 (funcall (or ecb-methods-menu-sorter - 'identity) - (append dyn-user-extension - ecb-methods-menu-user-extension - dyn-builtin-extension-tagfilter - ecb-methods-tag-menu - dyn-builtin-extension-edit-win))) - (cons 1 (funcall (or ecb-methods-menu-sorter - 'identity) - (append dyn-user-extension - ecb-methods-menu-user-extension - dyn-builtin-extension-tagfilter - ecb-common-methods-menu))) - (cons 2 (funcall (or ecb-methods-menu-sorter - 'identity) - (append dyn-user-extension - ecb-methods-menu-user-extension - dyn-builtin-extension-tagfilter - ecb-common-methods-menu)))))) + (list (cons ecb-methods-nodetype-tag + (funcall (or ecb-methods-menu-sorter + 'identity) + (append dyn-user-extension + ecb-methods-menu-user-extension + dyn-builtin-extension-tagfilter + ecb-methods-tag-menu + dyn-builtin-extension-edit-win))) + (cons ecb-methods-nodetype-bucket + (funcall (or ecb-methods-menu-sorter + 'identity) + (append dyn-user-extension + ecb-methods-menu-user-extension + dyn-builtin-extension-tagfilter + ecb-common-methods-menu))) + (cons ecb-methods-nodetype-externtag + (funcall (or ecb-methods-menu-sorter + 'identity) + (append dyn-user-extension + ecb-methods-menu-user-extension + dyn-builtin-extension-tagfilter + ecb-common-methods-menu)))))) (defconst ecb-methods-incr-searchpattern-node-prefix '("\\([-+#(]\\|[^-+#(][^ \n]+ \\)?" . 1) ＠＠ -3963,12 +4052,12 ＠＠ 'ecb-tree-buffer-node-collapsed-callback 'ecb-mouse-over-method-node 'ecb-compare-methods-buffer-node-data - (list 1) + (list ecb-methods-nodetype-bucket) nil 'ecb-methods-menu-creator - (list (cons 0 ecb-methods-menu-title-creator) - (cons 1 ecb-methods-menu-title-creator) - (cons 2 ecb-methods-menu-title-creator)) + (list (cons ecb-methods-nodetype-tag ecb-methods-menu-title-creator) + (cons ecb-methods-nodetype-bucket ecb-methods-menu-title-creator) + (cons ecb-methods-nodetype-externtag ecb-methods-menu-title-creator)) (nth 2 ecb-truncate-lines) t ecb-tree-indent ＠＠ -3994,7 +4083,7 ＠＠ 'ecb-toggle-maximize-ecb-window-with-mouse)) (setq ecb-methods-root-node (tree-buffer-get-root))))) ecb-common-tree-buffer-after-create-hook - ecb-directories-buffer-after-create-hook))) + ecb-methods-buffer-after-create-hook))) (defun ecb-dump-semantic-toplevel () "Dump the current semantic-tags in special buffer and display them." ＠＠ -4007,15 +4096,18 ＠＠ (ecb-dump-semantic-tags-internal tags nil source-buf 1) (switch-to-buffer-other-window (get-buffer-create "*ecb-tag-dump*")) (goto-char (point-min))))) - (defun ecb-dump-semantic-tags-internal (table parent source-buffer indent) (dolist (tag table) - (insert (format "%s%s, tag-class: %s\n" (make-string indent ? ) + ;; we ca not use format here because XEmacs-format removes all + ;; text-properties! + (insert (concat (make-string indent ? ) (save-excursion (set-buffer source-buffer) (ecb--semantic-format-tag-uml-prototype tag parent t)) - (ecb--semantic-tag-class tag))) + ", tag-class: " + (format "%s" (ecb--semantic-tag-class tag)) + "\n")) (ecb-dump-semantic-tags-internal (ecb--semantic-tag-children-compatibility tag t) (if (equal (ecb--semantic-tag-class tag) 'type) Index: ecb-navigate.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb-navigate.el,v retrieving revision 1.14 diff -u -r1.14 ecb-navigate.el --- ecb-navigate.el 31 Aug 2004 16:00:43 -0000 1.14 +++ ecb-navigate.el 1 Dec 2004 15:59:49 -0000 ＠＠ -26,7 +26,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: ecb-navigate.el,v 1.14 2004/08/31 16:00:43 berndl Exp $ +;; $Id: ecb-navigate.el,v 1.21 2004/03/05 16:46:32 berndl Exp $ ;;; Commentary: Index: ecb-semantic-wrapper.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb-semantic-wrapper.el,v retrieving revision 1.6 diff -u -r1.6 ecb-semantic-wrapper.el --- ecb-semantic-wrapper.el 31 Aug 2004 16:00:43 -0000 1.6 +++ ecb-semantic-wrapper.el 1 Dec 2004 15:59:49 -0000 ＠＠ -23,7 +23,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: ecb-semantic-wrapper.el,v 1.6 2004/08/31 16:00:43 berndl Exp $ +;; $Id: ecb-semantic-wrapper.el,v 1.20 2004/09/24 12:21:16 berndl Exp $ ;;; Commentary: ＠＠ -118,7 +118,6 ＠＠ (semantic-current-nonterminal-parent . semantic-current-tag-parent) (semantic-adopt-external-members . semantic-adopt-external-members) (semantic-bucketize . semantic-bucketize) - (semantic-c-template-string . semantic-c-template-string) (semantic-clear-toplevel-cache . semantic-clear-toplevel-cache) (semantic-colorize-text . semantic--format-colorize-text) (semantic-current-nonterminal . semantic-current-tag) ＠＠ -175,7 +174,6 ＠＠ equivalent new function of semanticdb 2.X. This alist should contain every function ECB uses from the semanticdb library.") - ;; new let us create the aliase. Each alias has the name "ecb--"<function of ;; semantic 2.0>. (dolist (f-elem (append ecb--semantic-function-alist ＠＠ -186,6 +184,7 ＠＠ (cdr f-elem) (car f-elem)))) + (defsubst ecb--semantic-tag (name class &rest ignore) "Create a new semantic tag with name NAME and tag-class CLASS." (if (fboundp 'semantic-tag) ＠＠ -362,28 +361,6 ＠＠ (cons (car result-nth) (ecb--semanticdb-full-filename (cdr result-nth))) (cons (car result-nth) nil)))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: Add this code to semantic-el.el -;; after a cedet-upgrade. It has to be added to the function -;; `semantic-elisp-use-read' direct before the (t ...)-clause in the cond! -;; -;; ((eq ts 'tree-buffer-defpopup-command) -;; ;; tree-buffer-defpopup-command -;; (semantic-tag-new-function -;; sn nil nil -;;:user-visible-flag nil -;;:documentation (semantic-elisp-do-doc (nth 2 rt)) -;; ) -;; ) -;; ((eq ts 'ecb-layout-define) -;; ;; ecb-layout-define -;; (semantic-tag-new-function -;; tss nil (semantic-elisp-desymbolify (list (nth 2 rt))) -;;:user-visible-flag nil -;;:documentation (semantic-elisp-do-doc (nth 3 rt)) -;; ) -;; ) - (silentcomp-provide 'ecb-semantic-wrapper) Index: ecb-speedbar.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb-speedbar.el,v retrieving revision 1.10 diff -u -r1.10 ecb-speedbar.el --- ecb-speedbar.el 31 Aug 2004 16:00:43 -0000 1.10 +++ ecb-speedbar.el 1 Dec 2004 15:59:49 -0000 ＠＠ -26,7 +26,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: ecb-speedbar.el,v 1.59 2004/05/06 09:02:05 berndl Exp $ +;; $Id: ecb-speedbar.el,v 1.61 2004/11/17 17:28:23 berndl Exp $ ;;; Commentary: ＠＠ -69,6 +69,8 ＠＠ (require 'speedbar) (require 'ecb-util) (require 'ecb-semantic-wrapper) +(require 'ecb-common-browser) + ;; imenu (silentcomp-defvar imenu--rescan-item) ＠＠ -319,6 +321,21 ＠＠ speedbar-buffer (buffer-live-p speedbar-buffer)) (ecb-speedbar-update-contents))))) + +(defun ecb-goto-window-speedbar () + "Make the ECB-speedbar window the current window. +This command does nothing if no integrated speedbar is visible in the +ECB-frame." + (interactive) + (ecb-goto-ecb-window ecb-speedbar-buffer-name)) + +(defun ecb-maximize-window-speedbar () + "Maximize the ECB-speedbar-window. +I.e. delete all other ECB-windows, so only one ECB-window and the +edit-window\(s) are visible \(and maybe a compile-window). Does nothing if the +speedbar-window is not visible within the ECB-frame." + (interactive) + (ecb-display-one-ecb-buffer ecb-speedbar-buffer-name)) ;; Handling of files which can not be parsed by semantic (i.e. there is no Index: ecb-tod.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb-tod.el,v retrieving revision 1.14 diff -u -r1.14 ecb-tod.el --- ecb-tod.el 31 Aug 2004 16:00:43 -0000 1.14 +++ ecb-tod.el 1 Dec 2004 15:59:49 -0000 ＠＠ -26,7 +26,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: ecb-tod.el,v 1.14 2004/08/31 16:00:43 berndl Exp $ +;; $Id: ecb-tod.el,v 1.19 2004/12/01 14:19:39 berndl Exp $ ;;; Commentary: ;; ＠＠ -114,7 +114,12 ＠＠ "You can toggle having a compile window with `ecb-toggle-compile-window' if `ecb-compile-window-height' is not nil." "Start ECB automatically after Emacs is started. Use option `ecb-auto-activate'" "Maximize a tree-buffer via modeline - ECB supports the standard-mechanism of (X)Emacs for deleting other windows." - "Easy horizontal scrolling the tree-buffers with the mouse with [M-mouse-1] and [M-mouse-3]; see `ecb-tree-easy-hor-scroll'." ;; + "Easy horizontal scrolling the tree-buffers with the mouse with [M-mouse-1] and [M-mouse-3]; see `ecb-tree-easy-hor-scroll'." + "Expand and collapse very precisely the current node in a tree-buffer with commands in the popup-menu." + "Let ECB display the version-control-state of your files in the tree-buffers. See `ecb-vc-enable-support'." + "Work with remote paths (e.g. TRAMP-, ANGE-FTP-, or EFS-paths) as with local paths in `ecb-source-path'." + "Exclude certain files from being displayed in the history-buffer. See `ecb-history-exclude-file-regexps'." + "Get the most important options of ECB at a glance by viewing the customization group \"ecb-most-important\"." ) "List of all available tips of the day.") Index: ecb-upgrade.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb-upgrade.el,v retrieving revision 1.15 diff -u -r1.15 ecb-upgrade.el --- ecb-upgrade.el 31 Aug 2004 16:00:43 -0000 1.15 +++ ecb-upgrade.el 1 Dec 2004 15:59:49 -0000 ＠＠ -26,7 +26,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: ecb-upgrade.el,v 1.15 2004/08/31 16:00:43 berndl Exp $ +;; $Id: ecb-upgrade.el,v 1.96 2004/12/01 14:19:38 berndl Exp $ ;;; Commentary: ;; ＠＠ -159,7 +159,7 ＠＠ ;; IMPORTANT: The version-number is auto-frobbed from the Makefile. Do not ;; change it here! -(defconst ecb-version "2.27" +(defconst ecb-version "2.30.1" "Current ECB version.") (eval-when-compile ＠＠ -168,6 +168,7 ＠＠ (require 'ecb-util) (silentcomp-defun widget-convert) +(silentcomp-defun ecb-find-optionsym-for-tree-buffer-name) ;; ------------------------------------------------------------------------- ;; define in this defconst all important NEWS which a user should know after ＠＠ -176,7 +177,10 ＠＠ ;; Each NEWS-string should be a one-liner shorter than 70 chars (defconst ecb-upgrade-news - '( + '(("2.30" . ("Support for displaying the VC-state in the tree-buffers; see NEWS." + "ECB is now capable of handling remote paths (e.g. TRAMP-paths)" + "Precisely expanding of current node via popup-menu of the methods-buffer." + "Time consuming tasks are performed stealthy; see `ecb-stealthy-tasks-delay'")) ("2.27" . ("Much saver resizing-mechanism for permanent compile-window. See NEWS.")) ("2.26" . ("Some regexp-options has been changed to regexp-list-options. See NEWS." "New option `ecb-history-exclude-file-regexps'." ＠＠ -286,7 +290,16 ＠＠ (ecb-exclude-parents-regexp . (ecb-exclude-parents-regexps ecb-upgrade-exclude-parents-regexp)) (ecb-auto-expand-tag-tree-collapse-other . (ecb-auto-expand-tag-tree-collapse-other - ecb-upgrade-auto-expand-tag-tree-collapse-other))) + ecb-upgrade-auto-expand-tag-tree-collapse-other)) + (ecb-tree-RET-selects-edit-window . (ecb-tree-RET-selects-edit-window + ecb-upgrade-tree-RET-selects-edit-window)) + (ecb-prescan-directories-for-emptyness . (ecb-prescan-directories-for-emptyness + ecb-upgrade-prescan-directories-for-emptyness)) + (ecb-sources-perform-read-only-check . (ecb-sources-perform-read-only-check + ecb-upgrade-sources-perform-read-only-check)) + (ecb-vc-enable-support . (ecb-vc-enable-support + ecb-upgrade-vc-enable-support)) + ) "Alist of all options which should be upgraded for current ECB-version. There are several reasons why an option should be contained in this alist: a) An old option has just be renamed in current-ECB version but has still the ＠＠ -574,6 +587,20 ＠＠ 'only-if-on-tag nil)) +(defun ecb-upgrade-tree-RET-selects-edit-window (old-val) + (mapcar (function (lambda (e) + (ecb-find-optionsym-for-tree-buffer-name e))) + old-val)) + +(defun ecb-upgrade-prescan-directories-for-emptyness (old-val) + (if old-val 'unless-remote nil)) + +(defun ecb-upgrade-sources-perform-read-only-check (old-val) + (if old-val 'unless-remote nil)) + +(defun ecb-upgrade-vc-enable-support (old-val) + (if old-val 'unless-remote nil)) + ;; ---------------------------------------------------------------------- ;; internal functions. Dot change anything below this line ;; ---------------------------------------------------------------------- ＠＠ -589,23 +616,29 ＠＠ :type 'string) (defun ecb-custom-file-writeable-p () - (ignore-errors (file-writable-p (ecb-custom-file)))) + "Returns not nil if and only if the custom-file is writable for ECB, which +means it is neither a bytecompiled-file nor a read-only-file." + (let ((file (ecb-custom-file))) + (and (not (equal (file-name-extension file) "elc")) + (ignore-errors (file-writable-p (ecb-custom-file)))))) (defun ecb-customize-save-variable (option value) ;; because the adviced version of `custom-save-all' do only all the special ;; needed things if `ecb-minor-mode' is on we must temporally set here this - ;; variable to not nil because the that time this function is called this - ;; variable is still nil (will be first set to t if the ecb-activation can - ;; not fail). + ;; variable to not nil because at that time this function is called this + ;; variable is maybe still nil. (let ((ecb-minor-mode t)) (if (ecb-custom-file-writeable-p) (customize-save-variable option value) (customize-set-variable option value)))) +(defun ecb-customize-set-variable (option value) + (customize-set-variable option value)) + (defun ecb-option-set-default (option) "Save the ECB-option OPTION with current default value." - (ecb-customize-save-variable option - (ecb-option-get-value option 'standard-value))) + (ecb-customize-set-variable option + (ecb-option-get-value option 'standard-value))) (defun ecb-option-upgrade (old-option) "Upgrade the old ECB-option OLD-OPTION if the following conditions are ALL ＠＠ -651,7 +684,7 ＠＠ (when (not (equal new-value 'ecb-no-upgrade-conversion)) ;; the old-value has been transformed successfully into the new type ;; so we can save it. - (ecb-customize-save-variable (nth 0 upgrade-elem) new-value)) + (ecb-customize-set-variable (nth 0 upgrade-elem) new-value)) ;; we return the value of the transforming-function even if it is ;; 'ecb-no-upgrade-conversion! (list new-value)))) ＠＠ -667,10 +700,14 ＠＠ "Only not nil if ECB has upgraded the options to a newer options-version after an ECB-upgrade.") +(defun ecb-options-version=ecb-version-p () + "Return not nil if the saved value of `ecb-options-version' is equal to +`ecb-version'." + (equal (ecb-option-get-value 'ecb-options-version 'saved-value) + ecb-version)) + (defun ecb-store-current-options-version () - (when (not (equal (ecb-option-get-value 'ecb-options-version - 'saved-value) - ecb-version)) + (when (not (ecb-options-version=ecb-version-p)) (setq ecb-old-ecb-version (ecb-option-get-value 'ecb-options-version 'saved-value)) (ecb-customize-save-variable 'ecb-options-version ecb-version))) ＠＠ -732,9 +769,7 ＠＠ (when (or (null upgrade-result) ;; no upgrade necessary or allowed ;; the upgrade has been tried but has failed. (equal (car upgrade-result) 'ecb-no-upgrade-conversion)) - (ecb-option-set-default (car option))))) - ;; Now we store the version of the options - (ecb-store-current-options-version))) + (ecb-option-set-default (car option))))))) (defvar ecb-renamed-options nil) ＠＠ -770,92 +805,231 ＠＠ (ecb-option-get-value (car option) 'saved-value) (car (cdr option)) (car new-value-list)) - ecb-renamed-options)))))) - ;; Now we store the version of the options - (ecb-store-current-options-version))) + ecb-renamed-options)))))))) +(require 'wid-edit) +(silentcomp-defvar widget-button-keymap) +(silentcomp-defvar widget-keymap) + +(defvar ecb-upgrade-button-keymap + (let (parent-keymap mouse-button1 keymap) + (if ecb-running-xemacs + (setq parent-keymap widget-button-keymap + mouse-button1 [button1]) + (setq parent-keymap widget-keymap + mouse-button1 [down-mouse-1])) + (setq keymap (copy-keymap parent-keymap)) + (define-key keymap mouse-button1 #'widget-button-click) + keymap) + "Keymap used inside buttons.") + + +(defun ecb-not-compatible-or-renamed-options-detected () + (or ecb-not-compatible-options ecb-renamed-options)) + +(defun ecb-upgrade-make-copy-of-custom-file () + "Make a backup of the file returned by `ecb-custom-file' in the same directory." + (let* ((file (ecb-custom-file)) + (backup-file-base (format "%s.before_ecb_%s" file ecb-version)) + (backup-file backup-file-base) + (i 0)) + (while (file-exists-p backup-file) + (setq i (1+ i)) + (setq backup-file (format "%s__%d" backup-file-base i))) + (copy-file file backup-file))) + (defun ecb-display-upgraded-options () - "Display a message-buffer which options have been upgraded or reset." + "Display a information-buffer which options have been upgraded or reset. +Offers two buttons where the user can decide if the upgraded options should +also being saved by ECB for future settings or if the buffer should be +killed. + +If saving is possible this command display where the options would be saved. +It is that file Emacs uses to save customize-settings. This file is +\"computed\" from the settings in `custom-file' and `user-init-file' \(see the +documentation of these variables). + +ECB automatically makes a backup-file of that file which will be modified by +storing the upgraded rsp. renamed ECB-options. This backup file gets a unique +name by adding a suffix \".before_ecb_<version>\" to the name of the modified +file. If such a file already exists ECB adds a unique number to the end of the +filename to make the filename unique. This is a safety mechanism if something +fails during storing the upgraded options, so you never lose the contents of +your customization-file!" (interactive) - (if (or ecb-not-compatible-options ecb-renamed-options) + (if (ecb-not-compatible-or-renamed-options-detected) (progn - (with-output-to-temp-buffer "*ECB upgraded options*" - (when (and (or ecb-not-compatible-options ecb-renamed-options) - (not (ecb-custom-file-writeable-p))) - (princ "Emacs can not save the upgraded options because the needed file\n") - (princ (if (ecb-custom-file) - (concat (ecb-custom-file) " is not writeable!") - "does not exist!")) - (princ "\nPlease ensure that the new values will be stored!\n\n")) + (with-current-buffer (get-buffer-create "*ECB upgraded options*") + (switch-to-buffer (current-buffer)) + (kill-all-local-variables) + (let ((inhibit-read-only t)) + (erase-buffer)) + (if (not (ecb-custom-file-writeable-p)) + (progn + (widget-insert "Emacs can not save the upgraded options because the needed file\n") + (widget-insert (if (ecb-custom-file) + (concat (ecb-custom-file) " is not writeable by Emacs!") + "does not exist!")) + (widget-insert "\nPlease ensure that the new values will be stored!\n\n")) + (when (not (get 'ecb-display-upgraded-options + 'ecb-upgrades-saved)) + (widget-insert (format "Click on [Save] to save all changed options into %s.\n" + (ecb-custom-file))) + (widget-insert (format "This makes a backup of this file unique named with a suffix .before_ecb_%s.\n\n" + ecb-version)))) + (widget-insert "Click on [Cancel] to kill this buffer.\n\n") (when ecb-not-compatible-options - (princ "The values of the following options are incompatible with current type.\nECB has tried to transform the old-value to the new type. In cases where\nthis was not possible ECB has reset to the current default-value.") - (princ "\n\n")) + (widget-insert "The values of the following options are incompatible with current type.\nECB has tried to transform the old-value to the new type. In cases where\nthis was not possible ECB has reset to the current default-value.") + (widget-insert "\n\n")) (dolist (option ecb-not-compatible-options) (let ((option-name (symbol-name (car option))) (old-value (cdr option)) (new-value (symbol-value (car option)))) - (princ (concat "+ Option: " option-name)) - (princ "\n") - (princ (concat " Old value: " - (if (and (not (equal old-value nil)) - (not (equal old-value t)) - (or (symbolp old-value) - (listp old-value))) - "'") - (prin1-to-string old-value))) - (princ "\n") - (princ (concat " New value: " - (if (and (not (equal new-value nil)) - (not (equal new-value t)) - (or (symbolp new-value) - (listp new-value))) - "'") - (prin1-to-string new-value))) - (princ "\n\n"))) + (widget-insert (concat "+ Option: " option-name)) + (widget-insert "\n") + (widget-insert (concat " Old value: " + (if (and (not (equal old-value nil)) + (not (equal old-value t)) + (or (symbolp old-value) + (listp old-value))) + "'") + (prin1-to-string old-value))) + (widget-insert "\n") + (widget-insert (concat " New value: " + (if (and (not (equal new-value nil)) + (not (equal new-value t)) + (or (symbolp new-value) + (listp new-value))) + "'") + (prin1-to-string new-value))) + (widget-insert "\n\n"))) (when ecb-renamed-options - (princ "The following options are not longer valid and have now new names. ECB has\ntried to transform the old value to the new option. In cases where this\nwas not possible the current default value is active!") - (princ "\n\n")) + (widget-insert "The following options are not longer valid and have now new names. ECB has\ntried to transform the old value to the new option. In cases where this\nwas not possible the current default value is active!") + (widget-insert "\n\n")) (dolist (option ecb-renamed-options) (let ((old-option-name (symbol-name (nth 0 option))) (old-value (nth 1 option)) (new-option-name (symbol-name (nth 2 option))) (new-value (nth 3 option))) - (princ (concat "+ Old option: " old-option-name)) - (princ "\n") - (princ (concat " Old value: " - (if (and (not (equal old-value nil)) - (not (equal old-value t)) - (or (symbolp old-value) - (listp old-value))) - "'") - (prin1-to-string old-value))) - (princ "\n") - (princ (concat " New option: " new-option-name)) - (princ "\n") - (princ (concat " New value: " - (if (equal new-value 'ecb-no-upgrade-conversion) - ;; we print the new default value. - (prin1-to-string (symbol-value (nth 2 option))) - (concat (if (and (not (equal new-value nil)) - (not (equal new-value t)) - (or (symbolp new-value) - (listp new-value))) - "'") - (prin1-to-string new-value))))) + (widget-insert (concat "+ Old option: " old-option-name)) + (widget-insert "\n") + (widget-insert (concat " Old value: " + (if (and (not (equal old-value nil)) + (not (equal old-value t)) + (or (symbolp old-value) + (listp old-value))) + "'") + (prin1-to-string old-value))) + (widget-insert "\n") + (widget-insert (concat " New option: " new-option-name)) + (widget-insert "\n") + (widget-insert (concat " New value: " + (if (equal new-value 'ecb-no-upgrade-conversion) + ;; we print the new default value. + (prin1-to-string (symbol-value (nth 2 option))) + (concat (if (and (not (equal new-value nil)) + (not (equal new-value t)) + (or (symbolp new-value) + (listp new-value))) + "'") + (prin1-to-string new-value))))) (if (equal new-value 'ecb-no-upgrade-conversion) - (princ "\n (The old value couldn't be transformed - this is the current default!)")) - (princ "\n\n"))) - (princ "If the new values are not what you want please re-customize!") - (princ "\n\n") - (princ "For a list of the most important NEWS call `ecb-display-news-for-upgrade'!\n\n") - (print-help-return-message)) + (widget-insert "\n (The old value couldn't be transformed - this is the current default!)")) + (widget-insert "\n\n"))) + (widget-insert "If the new values are not what you want please re-customize!") + (widget-insert "\n\n") + (widget-insert "For a list of the most important NEWS call `ecb-display-news-for-upgrade'!\n\n") + (widget-insert "\n") + (when (ecb-custom-file-writeable-p) + (when (not (get 'ecb-display-upgraded-options + 'ecb-upgrades-saved)) + ;; Insert the Save button + (widget-create 'push-button +:button-keymap ecb-upgrade-button-keymap ; XEmacs +:keymap ecb-upgrade-button-keymap ; Emacs +:notify (lambda (&rest ignore) + (if (get 'ecb-display-upgraded-options + 'ecb-upgrades-saved) + (ecb-info-message "Upgraded options are already saved!") + (ecb-upgrade-make-copy-of-custom-file) + (dolist (option ecb-not-compatible-options) + (ecb-customize-save-variable + (car option) (symbol-value (car option)))) + (dolist (option ecb-renamed-options) + (ecb-customize-save-variable + (nth 2 option) + (symbol-value (nth 2 option)))) + ;; store the information that the + ;; upgradings have already been saved now + (put 'ecb-display-upgraded-options + 'ecb-upgrades-saved t) + (ecb-store-current-options-version) + (ecb-info-message "Upgraded options saved!"))) + "Save") + (widget-insert " "))) + ;; Insert the Cancel button + (widget-create 'push-button +:button-keymap ecb-upgrade-button-keymap ; XEmacs +:keymap ecb-upgrade-button-keymap ; Emacs +:notify (lambda (&rest ignore) + (kill-buffer (current-buffer))) + "Cancel") + (widget-setup) + (goto-char (point-min))) t) - (message "There are no incompatible or renamed options!") + ;; now we display only the choice to save the ecb-options-version but only + ;; if ecb-options-version != ecb-version and (either the command is called + ;; interactively or first-time called by program) + (when (and (or (interactive-p) + (not (get 'ecb-display-upgraded-options + 'ecb-options-version-save-displayed))) + (not (ecb-options-version=ecb-version-p))) + (put 'ecb-display-upgraded-options 'ecb-options-version-save-displayed t) + (with-current-buffer (get-buffer-create "*ECB upgraded options*") + (switch-to-buffer (current-buffer)) + (kill-all-local-variables) + (let ((inhibit-read-only t)) + (erase-buffer)) + (widget-insert "There are no incompatible or renamed options. Your settings are correct.\n") + (widget-insert (format "But ECB must store that the ecb-settings are uptodate with %s.\n\n" + ecb-version)) + (if (not (ecb-custom-file-writeable-p)) + (progn + (widget-insert "Emacs can not save the `ecb-options-version' because the needed file\n") + (widget-insert (if (ecb-custom-file) + (concat (ecb-custom-file) " is not writeable by Emacs!") + "does not exist!")) + (widget-insert "\nPlease ensure that `ecb-options-version' will be saved!\n\n")) + (widget-insert (format "Click on [Save] to save `ecb-options-version' into %s.\n" + (ecb-custom-file))) + (widget-insert (format "This makes a backup of this file unique named with a suffix .before_ecb_%s.\n\n" + ecb-version))) + (widget-insert "Click on [Cancel] to kill this buffer.\n\n") + (widget-insert "For a list of the most important NEWS call `ecb-display-news-for-upgrade'!\n\n") + (widget-insert "\n") + (when (ecb-custom-file-writeable-p) + ;; Insert the Save button + (widget-create 'push-button +:button-keymap ecb-upgrade-button-keymap ; XEmacs +:keymap ecb-upgrade-button-keymap ; Emacs +:notify (lambda (&rest ignore) + (ecb-upgrade-make-copy-of-custom-file) + (ecb-store-current-options-version) + (ecb-info-message "ecb-options-version saved!")) + "Save") + (widget-insert " ")) + ;; Insert the Cancel button + (widget-create 'push-button +:button-keymap ecb-upgrade-button-keymap ; XEmacs +:keymap ecb-upgrade-button-keymap ; Emacs +:notify (lambda (&rest ignore) + (kill-buffer (current-buffer))) + "Cancel") + (widget-setup) + (goto-char (point-min)))) nil)) -(defvar ecb-news-for-upgrade-displayed nil) - (defun ecb-display-news-for-upgrade (&optional full-news) "Display the most important NEWS after an ECB-upgrade. If you call this function but no ECB-upgrade has been performed before ＠＠ -866,7 +1040,8 ＠＠ (if full-news (find-file-other-window (concat ecb-ecb-dir "NEWS")) (if (and ecb-old-ecb-version - (or (not ecb-news-for-upgrade-displayed) + (or (not (get 'ecb-display-news-for-upgrade + 'ecb-news-for-upgrade-displayed)) (interactive-p))) (progn (with-output-to-temp-buffer "*News for the new ECB-version*" ＠＠ -882,7 +1057,7 ＠＠ ecb-upgrade-news) (princ "\nFor more details see the attached NEWS-file.")) ;; We want this being displayed only once - (setq ecb-news-for-upgrade-displayed t)) + (put 'ecb-display-news-for-upgrade 'ecb-news-for-upgrade-displayed t)) (message "There are no NEWS to display.")))) ＠＠ -1195,10 +1370,14 ＠＠ (defconst ecb-download-buffername " *ecb-download*") +(defvar ecb-wget-path nil) +(defvar ecb-tar-path nil) +(defvar ecb-gzip-path nil) + ;; Klaus: Arrghhhhhhhhhhhhhhh... the cygwin version of tar does not accept ;; args in windows-style file-format :-( Therefore we convert it with cygpath. ;; Cause of the need of wget we can assume the the user has cygwin installed! -(defmacro ecb-create-shell-argument (arg) +(defmacro ecb-create-shell-file-argument (arg) `(if (eq system-type 'windows-nt) (progn (require 'executable) ＠＠ -1483,7 +1662,7 ＠＠ (downloaded-filename (concat download-install-dir package "-download.tar.gz")) (success t) - process-result) + (process-result nil)) ;; a first simple check if the new version is already installed ＠＠ -1508,12 +1687,22 ＠＠ ;; Emacs 20.X does not autoload executable-find :-( (require 'executable) - (if (not (and (executable-find + (setq ecb-wget-path + (or ecb-wget-path + (or (executable-find (if (eq system-type 'windows-nt) "wget.exe" "wget")) - (executable-find + (read-file-name "Insert full path to wget: " nil nil t)))) + (setq ecb-tar-path + (or ecb-tar-path + (or (executable-find (if (eq system-type 'windows-nt) "tar.exe" "tar")) - (executable-find - (if (eq system-type 'windows-nt) "gzip.exe" "gzip")))) + (read-file-name "Insert full path to tar: " nil nil t)))) + (setq ecb-gzip-path + (or ecb-gzip-path + (or (executable-find + (if (eq system-type 'windows-nt) "gzip.exe" "gzip")) + (read-file-name "Insert full path to gzip: " nil nil t)))) + (if (not (and ecb-wget-path ecb-tar-path ecb-gzip-path)) (ecb-error (concat "Cannot find wget, tar and gzip. These utilities are needed " "to download and install ECB or required packages.")) ＠＠ -1522,42 +1711,32 ＠＠ ;; Downloading with working-display - (ecb-working-status-call-process - 0.1 - (concat "Downloading new " package) - "done" - (if (eq system-type 'windows-nt) - "wget.exe" - "wget") - nil - ecb-download-buffername - nil - "-C" - "off" - "-O" - downloaded-filename - (concat url package "-" version ".tar.gz")) - - ;; checking the download-result - - (save-excursion - (set-buffer ecb-download-buffername) - (setq process-result (buffer-string)) - (goto-char (point-min)) - (when (not (and (save-excursion - (search-forward-regexp "200" nil t)) - (search-forward-regexp - (concat (regexp-quote downloaded-filename) ".*saved.*") - nil t) - (file-exists-p downloaded-filename))) - (setq success nil))) - (unless success + (setq success + (if (= 0 (ecb-working-status-call-process + 0.1 + (concat "Downloading new " package) + "done" + ecb-wget-path + nil + ecb-download-buffername + nil + "-C" + "off" + "-O" + downloaded-filename + (concat url package "-" version ".tar.gz"))) + t + nil)) + + (when (or (not success) (not (file-exists-p downloaded-filename))) (with-output-to-temp-buffer "*ECB-download-failure*" (princ (format "The download of %s has failed cause of the following wget-failure:" package)) (princ "\n") (princ "______________________________________________________________________________\n\n") - (princ process-result) + (princ (save-excursion + (set-buffer ecb-download-buffername) + (buffer-string))) (princ "\n______________________________________________________________________________") (princ "\n\n") (princ "Please check the wget configuration in \"~/.wgetrc\" and also the values\n") ＠＠ -1573,7 +1752,7 ＠＠ (when success (message "Uncompressing new %s..." package) (setq process-result - (shell-command-to-string (concat "gzip -d " downloaded-filename))) + (shell-command-to-string (concat ecb-gzip-path " -d " downloaded-filename))) (when (> (length process-result) 0) (setq success nil) (with-output-to-temp-buffer "*ECB-uncompressing-failure*" ＠＠ -1589,10 +1768,10 ＠＠ (message "Unpacking new %s..." package) (setq process-result (shell-command-to-string - (concat "tar -C " - (ecb-create-shell-argument download-install-dir) + (concat ecb-tar-path " -C " + (ecb-create-shell-file-argument download-install-dir) " -xf " - (ecb-create-shell-argument + (ecb-create-shell-file-argument (file-name-sans-extension downloaded-filename))))) (when (> (length process-result) 0) (setq success nil) ＠＠ -1620,12 +1799,15 ＠＠ for details about using \"wget\"." (let ((downloaded-filename (concat ecb-temp-dir "package-index.html")) (success t) - (version-list nil) - process-result) + (version-list nil)) (require 'executable) - (if (not (executable-find - (if (eq system-type 'windows-nt) "wget.exe" "wget"))) + (setq ecb-wget-path + (or ecb-wget-path + (or (executable-find + (if (eq system-type 'windows-nt) "wget.exe" "wget")) + (read-file-name "Insert full path to wget: " nil nil t)))) + (if (not ecb-wget-path) (ecb-error (concat "Cannot find wget. This utility is needed " "to get available-package-list.")) ＠＠ -1645,40 +1827,30 ＠＠ ;; Downloading with working-display - (ecb-working-status-call-process - 0.1 - (concat "Getting list of available versions of package " package) - "done" - (if (eq system-type 'windows-nt) - "wget.exe" - "wget") - nil - ecb-download-buffername - nil - "-O" - downloaded-filename - package-url) - - ;; checking the download-result - - (save-excursion - (set-buffer ecb-download-buffername) - (setq process-result (buffer-string)) - (goto-char (point-min)) - (when (not (and (save-excursion - (search-forward-regexp "200" nil t)) - (search-forward-regexp - (concat (regexp-quote downloaded-filename) ".*saved.*") - nil t) - (file-exists-p downloaded-filename))) - (setq success nil))) - (unless success + (setq success + (if (= 0 (ecb-working-status-call-process + 0.1 + (concat "Getting list of available versions of package " package) + "done" + ecb-wget-path + nil + ecb-download-buffername + nil + "-O" + downloaded-filename + package-url)) + t + nil)) + + (when (or (not success) (not (file-exists-p downloaded-filename))) (with-output-to-temp-buffer "*ECB-download-failure*" (princ (format "Checking available versions for %s has failed cause of the following\nwget-failure:" package)) (princ "\n") (princ "______________________________________________________________________________\n\n") - (princ process-result) + (princ (save-excursion + (set-buffer ecb-download-buffername) + (buffer-string))) (princ "\n______________________________________________________________________________") (princ "\n\n") (princ "Please check the wget configuration in \"~/.wgetrc\" and also the value\n") ＠＠ -1689,10 +1861,6 ＠＠ (princ (concat " " package-url)) (princ "\n\n") (princ "Maybe this URL does not exist...please check this!\n\n"))) -;; (princ "______________________________________________________________________________\n\n") -;; (princ process-result) -;; (princ "\n______________________________________________________________________________") -;; (princ "\n\n"))) (kill-buffer ecb-download-buffername) ;; getting the list from downloaded-filename. ＠＠ -1733,5 +1901,8 ＠＠ (silentcomp-provide 'ecb-upgrade) + + + ;;; ecb-upgrade.el ends here Index: ecb-util.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb-util.el,v retrieving revision 1.12 diff -u -r1.12 ecb-util.el --- ecb-util.el 31 Aug 2004 16:00:42 -0000 1.12 +++ ecb-util.el 1 Dec 2004 15:59:49 -0000 ＠＠ -26,7 +26,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: ecb-util.el,v 1.111 2004/08/25 15:09:06 berndl Exp $ +;; $Id: ecb-util.el,v 1.124 2004/11/25 18:10:12 berndl Exp $ ;;; Commentary: ;; ＠＠ -47,6 +47,8 ＠＠ (eval-when-compile (require 'cl)) +;;; ----- Silentcomp-Defs ---------------------------------- + ;; XEmacs (silentcomp-defun frame-property) (silentcomp-defun point-at-bol) ＠＠ -64,7 +66,6 ＠＠ (silentcomp-defun posn-window) (silentcomp-defun event-start) ;; XEmacs -(silentcomp-defun mswindows-cygwin-to-win32-path) (silentcomp-defun make-dialog-box) (silentcomp-defun display-message) (silentcomp-defun clear-message) ＠＠ -86,18 +87,14 ＠＠ (silentcomp-defun custom-file) -;; Some constants +;;; ----- Some constants ----------------------------------- + +;;;###autoload (defconst ecb-running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)) +;;;###autoload (defconst ecb-running-emacs-21 (and (not ecb-running-xemacs) (> emacs-major-version 20))) -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: Test this with native -;; Windows-XEmacs if it works with this change correct and also if it works -;; without this change incorrect! -(defconst ecb-directory-sep-char - (if ecb-running-xemacs directory-sep-char ?/)) -(defconst ecb-directory-sep-string (char-to-string ecb-directory-sep-char)) - (defconst ecb-temp-dir (file-name-as-directory (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") ＠＠ -133,7 +130,8 ＠＠ (display-images-p) window-system))) -;; ------------------------------------------------------------------- +;;; ----- Tracing ------------------------------------------ + ;; Tracing - currently not used because we use the trace.el library! ;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: Offer conveniant wrappers for the ;; trace-function-background stuff so users can easily trace a set of ＠＠ -167,55 +165,90 ＠＠ (ecb-defun-trace 'leave (quote ,name))))))))) -;; ------------------------------------------------------------------- - - -;; ---------- compatibility between GNU Emacs and XEmacs --------------------- +;;; ----- Compatibility between GNU Emacs and XEmacs ------- ;; miscellaneous differences -(if ecb-running-xemacs - (progn -;;; Compatibility - (defun ecb-facep (face) - (memq face (face-list))) - (defun ecb-noninteractive () - "Return non-nil if running non-interactively, i.e. in batch mode." - (noninteractive)) - (defun ecb-subst-char-in-string (fromchar tochar string &optional inplace) - "Replace FROMCHAR with TOCHAR in STRING each time it occurs. +(defmacro when-ecb-running-xemacs (&rest body) + "Evaluates BODY when `ecb-running-xemacs' is true. Use this macro when you +want the BODY being parsed by semantic!. If not use the variable +`ecb-running-xemacs'." + `(when ecb-running-xemacs + ,＠body)) + +(defmacro when-ecb-running-emacs-21 (&rest body) + "Evaluates BODY when `ecb-running-emacs-21' is true. Use this macro when you +want the BODY being parsed by semantic!. If not use the variable +`ecb-running-emacs-21'." + `(when ecb-running-emacs-21 + ,＠body)) + +(defmacro when-ecb-running-emacs-20 (&rest body) + "Evaluates BODY when ECB runs Emacs 20. Use this macro when you want the +BODY being parsed by semantic!. If not use the form +\(and \(not ecb-running-emacs-21) \(not ecb-running-xemacs))." + `(when (and (not ecb-running-emacs-21) (not ecb-running-xemacs)) + ,＠body)) + +(defmacro when-ecb-running-emacs (&rest body) + "Evaluates BODY when `ecb-running-xemacs' is false. Use this macro when you +want the BODY being parsed by semantic!. If not use the variable +`ecb-running-xemacs'." + `(when (not ecb-running-xemacs) + ,＠body)) + +;; I do not want all this compatibitly stuff being parsed by semantic, +;; therefore i do not use the macro `when-ecb-running-xemacs'! + +(when ecb-running-xemacs + (defun ecb-facep (face) + (memq face (face-list))) + (defun ecb-noninteractive () + "Return non-nil if running non-interactively, i.e. in batch mode." + (noninteractive)) + (defun ecb-subst-char-in-string (fromchar tochar string &optional inplace) + "Replace FROMCHAR with TOCHAR in STRING each time it occurs. Unless optional argument INPLACE is non-nil, return a new string." - (let ((i (length string)) - (newstr (if inplace string (copy-sequence string)))) - (while (> i 0) - (setq i (1- i)) - (if (eq (aref newstr i) fromchar) - (aset newstr i tochar))) - newstr)) - (defalias 'ecb-frame-parameter 'frame-property) - (defalias 'ecb-line-beginning-pos 'point-at-bol) - (defalias 'ecb-line-end-pos 'point-at-eol) - (defalias 'ecb-event-window 'event-window) - (defalias 'ecb-event-point 'event-point) - (defalias 'ecb-event-buffer 'event-buffer) - (defalias 'ecb-window-full-width 'window-full-width) - (defalias 'ecb-window-full-height 'window-height) - (defun ecb-frame-char-width (&optional frame) - (/ (frame-pixel-width frame) (frame-width frame))) - (defun ecb-frame-char-height (&optional frame) - (/ (frame-pixel-height frame) (frame-height frame))) - (defun ecb-window-edges (&optional window) - (let ((pix-edges (window-pixel-edges window))) - (list (/ (nth 0 pix-edges) (ecb-frame-char-width)) - (/ (nth 1 pix-edges) (ecb-frame-char-height)) - (/ (nth 2 pix-edges) (ecb-frame-char-width)) - (/ (nth 3 pix-edges) (ecb-frame-char-height)))))) - + (let ((i (length string)) + (newstr (if inplace string (copy-sequence string)))) + (while (> i 0) + (setq i (1- i)) + (if (eq (aref newstr i) fromchar) + (aset newstr i tochar))) + newstr)) + (defun ecb-derived-mode-p (&rest modes) + "Non-nil if the current major mode is derived from one of MODES. +Uses the `derived-mode-parent' property of the symbol to trace backwards." + (let ((parent major-mode)) + (while (and (not (memq parent modes)) + (setq parent (get parent 'derived-mode-parent)))) + parent)) + (defalias 'ecb-frame-parameter 'frame-property) + (defalias 'ecb-line-beginning-pos 'point-at-bol) + (defalias 'ecb-line-end-pos 'point-at-eol) + (defalias 'ecb-event-window 'event-window) + (defalias 'ecb-event-point 'event-point) + (defalias 'ecb-event-buffer 'event-buffer) + (defalias 'ecb-window-full-width 'window-full-width) + (defalias 'ecb-window-full-height 'window-height) + (defun ecb-frame-char-width (&optional frame) + (/ (frame-pixel-width frame) (frame-width frame))) + (defun ecb-frame-char-height (&optional frame) + (/ (frame-pixel-height frame) (frame-height frame))) + (defun ecb-window-edges (&optional window) + (let ((pix-edges (window-pixel-edges window))) + (list (/ (nth 0 pix-edges) (ecb-frame-char-width)) + (/ (nth 1 pix-edges) (ecb-frame-char-height)) + (/ (nth 2 pix-edges) (ecb-frame-char-width)) + (/ (nth 3 pix-edges) (ecb-frame-char-height)))))) + +(when (not ecb-running-xemacs) (defalias 'ecb-facep 'facep) (defun ecb-noninteractive () "Return non-nil if running non-interactively, i.e. in batch mode." noninteractive) (defalias 'ecb-subst-char-in-string 'subst-char-in-string) + (defalias 'ecb-derived-mode-p 'derived-mode-p) (defalias 'ecb-frame-parameter 'frame-parameter) (defalias 'ecb-line-beginning-pos 'line-beginning-position) (defalias 'ecb-line-end-pos 'line-end-position) ＠＠ -292,115 +325,7 ＠＠ (delete-itimer timer)) ) -;; ---------- End of compatibility between GNU Emacs and XEmacs ------------- - -(if (fboundp 'compare-strings) - (defalias 'ecb-compare-strings 'compare-strings) - (defun ecb-compare-strings (str1 start1 end1 str2 start2 end2 &optional ignore-case) - "Compare the contents of two strings. -In string STR1, skip the first START1 characters and stop at END1. -In string STR2, skip the first START2 characters and stop at END2. -END1 and END2 default to the full lengths of the respective strings. - -Case is significant in this comparison if IGNORE-CASE is nil. - -The value is t if the strings (or specified portions) match. -If string STR1 is less, the value is a negative number N; - - 1 - N is the number of characters that match at the beginning. -If string STR1 is greater, the value is a positive number N; - N - 1 is the number of characters that match at the beginning." - (or start1 (setq start1 0)) - (or start2 (setq start2 0)) - (setq end1 (if end1 - (min end1 (length str1)) - (length str1))) - (setq end2 (if end2 - (min end2 (length str2)) - (length str2))) - (let ((i1 start1) - (i2 start2) - result c1 c2) - (while (and (not result) (< i1 end1) (< i2 end2)) - (setq c1 (aref str1 i1) - c2 (aref str2 i2) - i1 (1+ i1) - i2 (1+ i2)) - (if ignore-case - (setq c1 (upcase c1) - c2 (upcase c2))) - (setq result (cond ((< c1 c2) (- i1)) - ((> c1 c2) i1)))) - (or result - (cond ((< i1 end1) (1+ (- i1 start1))) - ((< i2 end2) (1- (- start1 i1))) - (t))) - ))) - -(defsubst ecb-string= (str1 str2 &optional ignore-case) - (let ((s1 (or (and (stringp str1) str1) (symbol-name str1))) - (s2 (or (and (stringp str2) str2) (symbol-name str2)))) - (eq (ecb-compare-strings s1 nil nil s2 nil nil ignore-case) t))) - -(defsubst ecb-string< (str1 str2 &optional ignore-case) - (let ((s1 (or (and (stringp str1) str1) (symbol-name str1))) - (s2 (or (and (stringp str2) str2) (symbol-name str2))) - (result nil)) - (setq result (ecb-compare-strings s1 nil nil s2 nil nil ignore-case)) - (and (numberp result) (< result 0)))) - -;; Emacs 20 has no window-list function and the XEmacs and Emacs 21 one has no -;; specified ordering. The following one is stolen from XEmacs and has fixed -;; this lack of a well defined order. We preserve also point of current -;; buffer! IMPORTANT: When the window-ordering is important then currently -;; these function should only be used with WINDOW = (frame-first-window -;; ecb-frame)! -(defun ecb-window-list (&optional frame minibuf window) - "Return a list of windows on FRAME, beginning with WINDOW. The -windows-objects in the result-list are in the same canonical windows-ordering -of `next-window'. If omitted, WINDOW defaults to the selected window. FRAME and -WINDOW default to the selected ones. Optional second arg MINIBUF t means count -the minibuffer window even if not active. If MINIBUF is neither t nor nil it -means not to count the minibuffer even if it is active." - (if ecb-running-emacs-21 - ;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: There seems to be - ;; mysterious behavior when running our own window-list version with - ;; GNU Emacs >= 21.3 - especially when running an igrep when the - ;; igrep-buffer is already in another window. We can here savely use the - ;; function `window-list' because it returns an ordered list - (window-list frame minibuf window) - (setq window (or window (selected-window)) - frame (or frame (selected-frame))) - (if (not (eq (window-frame window) frame)) - (error "Window must be on frame.")) - (let ((current-frame (selected-frame)) - (current-point (point)) - list) - (unwind-protect - (save-window-excursion - (select-frame frame) - ;; this is needed for correct start-point - (select-window window) - (walk-windows - (function (lambda (cur-window) - (if (not (eq window cur-window)) - (setq list (cons cur-window list))))) - minibuf - 'selected) - ;; This is needed to get the right canonical windows-order, i.e. the - ;; same order of windows than `walk-windows' walks through! - (setq list (nreverse list)) - (setq list (cons window list))) - (select-frame current-frame) - ;; we must reset the point of the buffer which was current at call-time - ;; of this function - (goto-char current-point))))) - -(defun ecb-canonical-windows-list () - "Return a list of all current visible windows in the `ecb-frame' \(starting - from the left-most top-most window) in the order `other-window' would walk - through these windows." - (ecb-window-list ecb-frame 0 (frame-first-window ecb-frame))) - +;;; ----- advice stuff ------------------------------------- ;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: Attention. Current mechanism of ;; (de)activating the basic advices and the intelligent window advices of ＠＠ -413,6 +338,8 ＠＠ (shrink-window-if-larger-than-buffer . around) (show-temp-buffer-in-current-frame . around) (pop-to-buffer . around) + (find-file . around) + (find-file-other-window . around) (current-window-configuration . after) (set-window-configuration . after) (scroll-other-window . around) ＠＠ -426,6 +353,8 ＠＠ (mouse-drag-vertical-line . around) (mouse-drag-mode-line . around) (pop-to-buffer . around) + (find-file . around) + (find-file-other-window . around) (current-window-configuration . after) (set-window-configuration . after) (enlarge-window . around) ＠＠ -495,7 +424,7 ＠＠ (put 'ecb-with-ecb-advice 'lisp-indent-function 2) -;; some basic advices +;;; ----- Customize stuff ---------------------------------- (defun ecb-custom-file () "Filename of that file which is used by \(X)Emacs to store the ＠＠ -554,7 +483,24 ＠＠ (kill-buffer (find-file-noselect (ecb-custom-file))))) ad-do-it)) -;; assoc helpers +(defun ecb-option-get-value (option &optional type) + "Return the value of a customizable ECB-option OPTION with TYPE, where TYPE +can either be 'standard-value \(the default-value of the defcustom) or +'saved-value \(the value stored durable by the user via customize) or +'customized-value \(the value set but not saved in the customize buffer). +If TYPE is nil then the most recent set value is returned, means it +tries the customized-value, then the saved-value and then the standard-value +in exactly this sequence." + (let ((val (car (if type + (get option type) + (or (get option 'customized-value) + (get option 'saved-value) + (get option 'standard-value)))))) + (cond ((not (listp val)) val) + ((equal 'quote (car val)) (car (cdr val))) + (t (car val))))) + +;;; ----- Assoc helpers ------------------------------------ (defun ecb-remove-assoc (key list) (delete nil ＠＠ -575,7 +521,7 ＠＠ (assoc key list)) -;; some function from cl - but we do not want to call cl-functions at runtime +;;; ----- Some function from cl ---------------------------- (defun ecb-filter (seq pred) "Filter out those elements of SEQUENCE for which PREDICATE returns nil." ＠＠ -630,23 +576,6 ＠＠ (member item list) (memq item list))) -(defsubst ecb-match-regexp-list (str regexp-list &optional elem-accessor - return-accessor) - "Return not nil if STR matches one of the regexps in REGEXP-LIST. If -ELEM-ACCESSOR is a function then it is used to get the regexp from the -processed elem of REGEXP-LIST. If nil the elem itself is used. If -RETURN-ACCESSOR is a function then it is used to get from the matching elem -the object to return. If nil then the matching elem itself is returned." - (let ((elem-acc (or elem-accessor 'identity)) - (return-acc (or return-accessor 'identity))) - (catch 'exit - (dolist (elem regexp-list) - (let ((case-fold-search t)) - (save-match-data - (if (string-match (funcall elem-acc elem) str) - (throw 'exit (funcall return-acc elem)))) - nil))))) - (defun ecb-set-elt (seq n val) "Set VAL as new N-th element of SEQ. SEQ can be any sequence. SEQ will be ＠＠ -685,132 +614,430 ＠＠ (setq list (ecb-replace-first-occurence list elem nil))) list))) -;; canonical filenames +(defun ecb-subseq (seq start &optional end) + "Return the subsequence of SEQ from START to END. +If END is omitted, it defaults to the length of the sequence. +If START or END is negative, it counts from the end." + (if (stringp seq) (substring seq start end) + (let (len) + (and end (< end 0) (setq end (+ end (setq len (length seq))))) + (if (< start 0) (setq start (+ start (or len (setq len (length seq)))))) + (cond ((listp seq) + (if (> start 0) (setq seq (nthcdr start seq))) + (if end + (let ((res nil)) + (while (>= (setq end (1- end)) start) + (push (pop seq) res)) + (nreverse res)) + (copy-sequence seq))) + (t + (or end (setq end (or len (length seq)))) + (let ((res (make-vector (max (- end start) 0) nil)) + (i 0)) + (while (< start end) + (aset res i (aref seq start)) + (setq i (1+ i) start (1+ start))) + res)))))) + +(defun ecb-concatenate (type &rest seqs) + "Concatenate, into a sequence of type TYPE, the argument SEQUENCES. +TYPE can be 'string, 'vector or 'list." + (cond ((eq type 'vector) (apply 'vconcat seqs)) + ((eq type 'string) (apply 'concat seqs)) + ((eq type 'list) (apply 'append (append seqs '(nil)))) + (t (ecb-error "Not a sequence type name: %s" type)))) + +(defun ecb-rotate (seq start-elem) + "Rotate SEQ so START-ELEM is the new first element of SEQ. SEQ is an +arbitrary sequence. Example: \(ecb-rotate '\(a b c d e f) 'c) results in \(c d +e f a b). If START-ELEM is not contained in SEQ then nil is returned." + (let ((start-pos (ecb-position seq start-elem))) + (when start-pos + (ecb-concatenate (cond ((listp seq) 'list) + ((stringp seq) 'string) + ((vectorp seq) 'vector)) + (ecb-subseq seq start-pos) + (ecb-subseq seq 0 start-pos))))) -(defun ecb-fix-path (path) - "Fixes an annoying behavior of the native windows-version of XEmacs: -When PATH contains only a drive-letter and a : then `expand-file-name' does -not interpret this PATH as root of that drive. So we add a trailing -`directory-sep-char' and return this new path because then `expand-file-name' -treats this as root-dir of that drive. For all \(X)Emacs-version besides the -native-windows-XEmacs PATH is returned." - (if (and ecb-running-xemacs - (equal system-type 'windows-nt)) - (if (and (= (length path) 2) - (equal (aref path 1) ?:)) - (concat path ecb-directory-sep-string) - path) - path)) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: What about the new cygwin-version -;; of GNU Emacs 21? We have to test if this function and all locations where -;; `ecb-fix-path' is used work correctly with the cygwin-port of GNU Emacs. -(defun ecb-fix-filename (path &optional filename substitute-env-vars) - "Normalizes path- and filenames for ECB. If FILENAME is not nil its pure -filename \(i.e. without directory part) will be concatenated to PATH. The -result will never end with the directory-separator! If SUBSTITUTE-ENV-VARS is -not nil then in both PATH and FILENAME env-var substitution is done. If the -`system-type' is 'cygwin32 then the path is converted to win32-path-style!" - (when (stringp path) - (let (norm-path) - (setq norm-path (if ecb-running-xemacs - (cond ((equal system-type 'cygwin32) - (mswindows-cygwin-to-win32-path - (expand-file-name path))) - ((equal system-type 'windows-nt) - (expand-file-name (ecb-fix-path path))) - (t (expand-file-name path))) - (expand-file-name path))) - ;; For windows systems we normalize drive-letters to downcase - (setq norm-path (if (and (member system-type '(windows-nt cygwin32)) - (> (length norm-path) 1) - (equal (aref norm-path 1) ?:)) - (concat (downcase (substring norm-path 0 2)) - (substring norm-path 2)) - norm-path)) - ;; substitute environment-variables - (setq norm-path (expand-file-name (if substitute-env-vars - (substitute-in-file-name norm-path) - norm-path))) - ;; delete a trailing directory-separator if there is any - (setq norm-path (if (and (> (length norm-path) 1) - (= (aref norm-path - (1- (length norm-path))) ecb-directory-sep-char)) - (substring norm-path 0 (1- (length norm-path))) - norm-path)) - (concat norm-path - (if (stringp filename) - (concat (if (> (length norm-path) 1) - ecb-directory-sep-string) - (file-name-nondirectory (if substitute-env-vars - (substitute-in-file-name filename) - filename)))))))) +(defun ecb-position (seq elem) + "Return the position of ELEM within SEQ counting from 0. Comparison is done +with `equal'." + (if (listp seq) + (let ((pos (- (length seq) (length (member elem seq))))) + (if (= pos (length seq)) + nil + pos)) + (catch 'found + (dotimes (i (length seq)) + (if (equal elem (aref seq i)) + (throw 'found i))) + nil))) +(defun ecb-last (seq) + "Return the last elem of the sequence SEQ." + (if (listp seq) + (car (last seq)) + (if seq + (aref seq (1- (length seq))) + nil))) -(defun ecb-nolog-message (&rest args) - "Works exactly like `message' but does not log the message" - (let ((msg (cond ((or (null args) - (null (car args))) - nil) - ((null (cdr args)) - (car args)) - (t - (apply 'format args))))) - ;; Now message is either nil or the formated string. - (if ecb-running-xemacs - ;; XEmacs way of preventing log messages. - (if msg - (display-message 'no-log msg) - (clear-message 'no-log)) - ;; Emacs way of preventing log messages. - (let ((message-log-max nil) - (message-truncate-lines nil)) - (if msg - (message "%s" msg) - (message nil)))) - msg)) +(defun ecb-first (seq) + "Return the first elem of the sequence SEQ." + (if (listp seq) + (car seq) + (if seq + (aref seq 0) + nil))) + -(defun ecb-confirm (text) - (yes-or-no-p text)) +(defun ecb-next-listelem (list elem &optional nth-next) + "Return that element of LIST which follows directly ELEM when ELEM is an +element of LIST. If ELEM is the last element of LIST then return the first +element of LIST. If ELEM is not an element of LIST nil is returned. Elements +are compared with `equal'. -(defun ecb-delete-file (file) - (let ((exp-file (expand-file-name file))) - (if (file-exists-p exp-file) - (delete-file exp-file)))) +If NTH-NEXT is an integer then the NTH-NEXT element of LIST in the meaning +described above is returned, i.e. the algorithm above is applied NTH-NEXT +times. Example: Suppose LIST = '\(a b c d), ELEM is 'c and NTH-NEXT = 3 then +'b is returned - same result for NTH-NEXT = 7, 11... It works also for +negative integers, so when NTH-NEXT is -1 in the example above then 'b is +returned." + (let ((elem-pos (ecb-position list elem)) + (next (or nth-next 1))) + (and elem-pos + (nth (mod (+ elem-pos next) + (length list)) + list)))) -(defun ecb-enlarge-window(window &optional val) - "Enlarge the given window. -If VAL is nil then WINDOW is enlarged so that it is 1/2 of the current frame. -If VAL is a positive integer then WINDOW is enlarged so that its new height is -VAL lines. If VAL is > 0 and < 1 then WINDOW is enlarged so that its new -height is that fraction of the frame." - (if (and window (window-live-p window)) - (let* ((norm-val (if val - (ecb-normalize-number val (1- (frame-height))) - (/ (1- (frame-height)) 2))) - (enlargement (- norm-val (ecb-window-full-height window)))) - (save-selected-window - (select-window window) - (if (> enlargement 0) - (enlarge-window enlargement)))) - (error "Window is not alive!"))) +;;; ----- Some regexp stuff ------------------------------- -;; stolen from query.el and slightly enhanced -;; This is for a small number of choices each of them a short string -(defun ecb-query-string (prompt choices &optional other-prompt) - "Prints PROMPT and returns a string which must be one of CHOICES. -CHOICES is either a list of strings whereas the first choice is the default -\(which is returned if the user simply types RET) or nil \(then only a simple -RET quits the query and returns nil). If OTHER-PROMPT is not nil and a string -then the choice \"other\" is added to CHOICES and after selecting this choice -the user is prompted with OTHER-PROMPT to insert any arbitrary string." - (let* ((new-choices (if other-prompt - ;; Emacs 20.X add-to-list can not append at the end - (append choices (list "other")) - choices)) - (default (car new-choices)) - answer) - (setq prompt (concat prompt +(defsubst ecb-match-regexp-list (str regexp-list &optional elem-accessor + return-accessor) + "Return not nil if STR matches one of the regexps in REGEXP-LIST. If +ELEM-ACCESSOR is a function then it is used to get the regexp from the +processed elem of REGEXP-LIST. If nil the elem itself is used. If +RETURN-ACCESSOR is a function then it is used to get the object to return from +the matching elem. If nil then the matching elem itself is returned." + (let ((elem-acc (or elem-accessor 'identity)) + (return-acc (or return-accessor 'identity))) + (catch 'exit + (dolist (elem regexp-list) + (let ((case-fold-search t)) + (save-match-data + (if (string-match (funcall elem-acc elem) str) + (throw 'exit (funcall return-acc elem)))) + nil))))) + +;;; ----- Multicache --------------------------------------- + +;; internal functions +(defsubst ecb-multicache-init (cache-var) + "Initialize the ecb-multicache of CACHE-VAR. If CACHE-VAR contains already +a valid cache then nothing is done otherwise a new cache is created." + (or (ecb-multicache-p cache-var) + (set cache-var (make-hash-table :size (get cache-var 'ecb-multicache-size) +:test (get cache-var 'ecb-multicache-test))))) + +(defun ecb-multicache-add-empty-key (cache-var key) + "Checks if KEY is already cached in the cache of CACHE-VAR. If yes nothing +is done otherwise a new cache-element with empty subcaches is added to the +cache. All subcaches defined via `defecb-multicache' are created with a +value nil. CACHE-VAR has to be a symbol for which an assoc cache has been +defined with `defecb-multicache'!" + (ecb-multicache-init cache-var) + (or (gethash key (symbol-value cache-var)) + ;; now we add as value an assoc-list with an element for each registered + ;; subcache-element + (puthash key (mapcar (function (lambda (sc) + (cons sc nil))) + (get cache-var + 'ecb-multicache-subcache-list)) + (symbol-value cache-var)))) + +(defun ecb-multicache-get-subcache (cache-var key subcache) + "Return that cons-cell which is associated with KEY in the cache of +CACHE-VAR and which has the symbol SUBCACHE as its car. The cdr of this +cons-cell is the currently stored SUBCACHE-value for KEY. If KEY is not cached +then nil is returned." + (ecb-multicache-init cache-var) + (let ((hash-val (gethash key (symbol-value cache-var)))) + (and hash-val + (assoc subcache hash-val)))) + +;; public interface for the multi-cache + +(defmacro defecb-multicache (name size test subcache docstring) + "Defines NAME as variable and makes it an ecb-multicache. +This means that for each cache-item of the cache NAME informations can be +associated to different subcaches. SUBCACHE is either a symbol or a list of +symbols. For each symbol in SUBCACHE a subcache is reserved in the cache NAME. + +Such a cache is especially senseful if different informations should be +associated to one key. + +SIZE is a hint as to how many elements will be put in the cache. If SIZE is +nil then the default is 100. If the cache exceeds SIZE it will be increased +automatically. + +TEST must be a symbol that specifies how to compare keys. If TEST is nil then +the default is `equal'. + +After defining the cache with this macro the cache can be used immediately\; +there is no need for special initialization. The following functions are +available for accessing values in such a cache: + + `ecb-multicache-put-value' + `ecb-multicache-apply-to-value' + `ecb-multicache-get-value' + `ecb-multicache-mapsubcache' + `ecb-multicache-clear-value' + `ecb-multicache-clear-subcache' + `ecb-multicache-remove' + `ecb-multicache-clear' + `ecb-multicache-print-subcache' + `ecb-multicache-p' + +The lookup in this assoc cache is really fast because the time required is +essentially _independent_ of how many elements are stored in the cache." + `(progn + (eval-and-compile + (defvar ,name nil ,docstring)) + (unless (get ',name 'ecb-multicache-p) + (setq ,name nil) + (put ',name 'ecb-multicache-subcache-list + (if (listp ,subcache) + ,subcache + (list ,subcache))) + (put ',name 'ecb-multicache-p t) + (put ',name 'ecb-multicache-size ,(or size 100)) + (put ',name 'ecb-multicache-test ,(or test (quote 'equal))) + ))) +(put 'defecb-multicache 'lisp-indent-function 4) + +;; (insert (pp (macroexpand '(defecb-multicache klaus nil 'equal '(A B C) "docstring")))) + + + +(defun ecb-multicache-p (cache-var) + "Return not nil if the value of CACHE-VAR is a cache defined with +`defecb-multicache'." + (and (hash-table-p (symbol-value cache-var)) + (get cache-var 'ecb-multicache-p))) + +(defun ecb-multicache-get-value (cache-var key subcache) + "Return the currently associated value for KEY in the subcache SUBCACHE of +the cache of CACHE-VAR. CACHE-VAR has to be a symbol for which an assoc cache +has been defined with `defecb-multicache'! + +Be aware that the semantic of nil is not unique because nil can have the +following meanings: +- There is no cached item with KEY at all +- There is an item with KEY in the cache but there is no assigned value for + SUBCACHE. +- nil has been set as value for KEY and SUBCACHE \(via + `ecb-multicache-put-value' or `ecb-multicache-apply-to-value') - but this + is not recommended, see `ecb-multicache-apply-to-value'." + (cdr (ecb-multicache-get-subcache cache-var key subcache))) + +(defun ecb-multicache-get-values (cache-var key &optional subcache-list) + "Return an assoc-list with the subcaches listed in SUBCACHE-LIST. If +SUBCACHE-LIST is nil then all currently registered subcaches of CACHE-VAR are +returned. The result is an assoc-list where each element is a cons-cell: +- car: subcache-symbol. +- cdr: The currenty cached value for the subcache in the car. + +So apply `assoc' and `cdr' to the result of this function.to get the value of +a certain subcache. + +This function is useful when the values of more than one subcache for a key are +needed at the same time, i.e. with one cache-lookup." + (ecb-multicache-init cache-var) + (let ((cache-val (gethash key (symbol-value cache-var)))) + (when cache-val + (if (null subcache-list) + cache-val + (mapcar (function (lambda (s) + (assoc s cache-val))) + subcache-list))))) + +(defun ecb-multicache-apply-to-value (cache-var key subcache apply-fcn + &optional only-if-key-exist) + "Apply the function APPLY-FCN to the old SUBCACHE-value of the cached item +with key KEY. APPLY-FCN is called with the old SUBCACHE-value as argument and +should return the new value which is then set as new SUBCACHE-value of the +cached-item. If optional argument ONLY-IF-KEY-EXIST is not nil then nothing +will be done if no cached item with key KEY exists. Otherwise a new item with +KEY will be added to the cache and APPLY-FCN will be called with nil. +CACHE-VAR has to be a symbol for which an assoc cache has been defined with +`defecb-multicache'! + +With this function an already cached SUBCACHE-value for KEY can be evaluated +and then modified with only one cache-lookup because APPLY-FCN gets the +old-value as argument and has to return the new value which is then set as new +SUBCACHE-value of the cached item. This is more efficient than a call-sequence +of `ecb-multicache-get-value' \(to get the old-value) and then +`ecb-multicache-put-value' to set a new value. + +It is recommended that APPLY-FCN doesn't return nil \(unless the SUBCACHE for +KEY should be cleared within APPLY-FCN) because then this will be set as new +value and then the returned value of next call to `ecb-multicache-get-value' +can have an ambiguous semantic - see documentation of +`ecb-multicache-get-value'. nil should be reserved to indicate that either no +item with KEY is cached or that no value has been put for SUBCACHE." + (let ((subcache-conscell + (or (ecb-multicache-get-subcache cache-var key subcache) + ;; key is currently not cached + (unless only-if-key-exist + (ecb-multicache-add-empty-key cache-var key) + (ecb-multicache-get-subcache cache-var key subcache))))) + (when subcache-conscell + (setcdr subcache-conscell + (funcall apply-fcn (cdr subcache-conscell)))))) + +(defun ecb-multicache-put-value (cache-var key subcache value) + "Put VALUE as SUBCACHE-value of the cached item with key KEY. If there is +already a value for this subcache and key then it will be replaced with VALUE. +CACHE-VAR has to be a symbol for which an assoc cache has been defined with +`defecb-multicache'! + +Return VALUE. + +It is recommended not to put nil as value - see +`ecb-multicache-apply-to-value' for an explanation. If the SUBCACHE for KEY +should be cleared use `ecb-multicache-clear-value'." + (ecb-multicache-apply-to-value cache-var key subcache + (function (lambda (old-val) + value)))) + +(defun ecb-multicache-clear-value (cache-var key subcache) + "Put nil as value of the cached item with key KEY under the subcache +SUBCACHE. This clears in fact the subcache SUBCACHE for a cached item with key +KEY. CACHE-VAR has to be a symbol for which an assoc cache has been defined +with `defecb-multicache'!" + (ecb-multicache-put-value cache-var key subcache nil)) + +(defun ecb-multicache-remove (cache-var key) + "Remove the cache item with key KEY from the cache of CACHE-VAR. CACHE-VAR +has to be a symbol for which an assoc cache has been defined with +`defecb-multicache'!" + (ecb-multicache-init cache-var) + (remhash key (symbol-value cache-var))) + +(defun ecb-multicache-mapsubcache (cache-var subcache mapfcn) + "Iterate over all item of the cache of CACHE-VAR and call the function +MAPFCN for each item for the subcache SUBCACHE. MAPFCN is called with two +arguments, the key and the SUBCACHE-value of the currently processed +cache-item. The SUBCACHE-value of this cache-item will be set to the +return-value of MAPFCN. So if MAPFCN is not intended to change the +SUBCACHE-value it should return the value of its second argument! CACHE-VAR +has to be a symbol for which an assoc cache has been defined with +`defecb-multicache'!" + (ecb-multicache-init cache-var) + (maphash (function (lambda (key value) + (let ((cache (assoc subcache value))) + (and cache + (setcdr cache + (funcall mapfcn + key (cdr cache))))))) + (symbol-value cache-var))) + +(defun ecb-multicache-clear-subcache (cache-var subcache) + "Put nil as SUBCACHE-value for each cached item. This clears in fact the +whole SUBCACHE. CACHE-VAR has to be a symbol for which an assoc cache has been +defined with `defecb-multicache'!" + (ecb-multicache-mapsubcache cache-var subcache + (function (lambda (key value) + nil)))) + +(defun ecb-multicache-clear (cache-var) + "Clears the whole cache of CACHE-VAR, i.e. remove all items. CACHE-VAR has +to be a symbol for which an assoc cache has been defined with +`defecb-multicache'!" + (ecb-multicache-init cache-var) + (clrhash (symbol-value cache-var))) + +(defun ecb-multicache-print-subcache (cache-var subcache &optional no-nil-value) + "Print the contents of SUBCACHE of the cache of CACHE-VAR in another window +in a special buffer. This is mostly for debugging the cache-contents. +CACHE-VAR has to be a symbol for which an assoc cache has been defined with +`defecb-multicache'! + +The output has the following form: + +Key: <the key of a cached element> + Value: <the associated value in the subcache SUBCACHE> +Key: <the key of a cached element> + Value: <the associated value in the subcache SUBCACHE> +... +Key: <the key of a cached element> + Value: <the associated value in the subcache SUBCACHE> + +If NO-NIL-VALUE is not nil then Keys with a SUBCACHE-value nil will be +excluded from the output." + (let ((dump-buffer-name (format "*ecb-multicache - subcache: %s*" + subcache)) + (key-str "Key:") + (value-str "Value:") + ;; Because XEmacs is not able to get a face-attributes-plist as value + ;; for the special property 'face we have to create two temporary + ;; faces here :-( + (key-face (copy-face 'default 'ecb-multicache-print-key-face)) + (value-str-face (copy-face 'italic + 'ecb-multicache-print-value-str-face))) + (set-face-foreground key-face "blue") + (set-face-foreground value-str-face "forest green") + (put-text-property 0 (length key-str) 'face 'bold key-str) + (put-text-property 0 (length value-str) 'face value-str-face value-str) + (save-selected-window + (set-buffer (get-buffer-create dump-buffer-name)) + (erase-buffer) + (ecb-multicache-mapsubcache + cache-var subcache + (function (lambda (key value) + ;; if key is a string we colorize it blue but we must du + ;; this with a copy of key because otherwise we would + ;; colorize the key-object itself which maybe is not what + ;; we want if key is displayed somewhere else (e.g. in a + ;; tree-buffer). + (let ((key-cp (and (stringp key) + (concat key)))) + (and key-cp (put-text-property 0 (length key-cp) + 'face key-face key-cp)) + (unless (and no-nil-value (null value)) + (insert (concat key-str " " + (if key-cp + key-cp + (format "%s" key)) + "\n " + value-str " " + (format "%s" value) + "\n"))) + value)))) + (switch-to-buffer-other-window (get-buffer-create dump-buffer-name)) + (goto-char (point-min))))) + + +;;; ----- User-interaction --------------------------------- + +(defun ecb-confirm (text) + (yes-or-no-p text)) + +;; stolen from query.el and slightly enhanced +;; This is for a small number of choices each of them a short string +(defun ecb-query-string (prompt choices &optional other-prompt) + "Prints PROMPT and returns a string which must be one of CHOICES. +CHOICES is either a list of strings whereas the first choice is the default +\(which is returned if the user simply types RET) or nil \(then only a simple +RET quits the query and returns nil). If OTHER-PROMPT is not nil and a string +then the choice \"other\" is added to CHOICES and after selecting this choice +the user is prompted with OTHER-PROMPT to insert any arbitrary string." + (let* ((new-choices (if other-prompt + ;; Emacs 20.X add-to-list can not append at the end + (append choices (list "other")) + choices)) + (default (car new-choices)) + answer) + (setq prompt (concat prompt " [" (if new-choices (mapconcat (function (lambda (x) x)) ＠＠ -895,61 +1122,6 ＠＠ (car choices) answer))) -(defun ecb-normalize-number (value &optional ref-value) - "Normalize VALUE in the following manner and return: -* VALUE > -1.0 and < +1.0 and REF-VALUE a number: `floor' of VALUE * REF-VALUE -* all other cases: `floor' of VALUE" - (floor (if (and (< value 1.0) - (> value -1.0) - (numberp ref-value)) - (* ref-value value) - value))) - -(defmacro ecb-with-readonly-buffer (buffer &rest body) - "Make buffer BUFFER current but do not display it. Evaluate BODY in buffer -BUFFER \(not read-only an evaluation-time of BODY) and make afterwards BUFFER -read-only. Note: All this is done with `save-excursion' so after BODY that -buffer is current which was it before calling this macro." - `(if (buffer-live-p ,buffer) - (save-excursion - (set-buffer ,buffer) - (unwind-protect - (progn - (setq buffer-read-only nil) - ,＠body) - (setq buffer-read-only t))) - (ecb-error "Try to set a not existing buffer."))) - -(put 'ecb-with-readonly-buffer 'lisp-indent-function 1) - -(defmacro ecb-do-if-buffer-visible-in-ecb-frame (buffer-name-symbol &rest body) - "Evaluate BODY if the following conditions are all true: -- The symbol BUFFER-NAME-SYMBOL is bound -- The value of BUFFER-NAME-SYMBOL is a name of a living buffer B -- The buffer B is visible and displayed in a window of the `ecb-frame' -- ECB is active -- The current frame is the `ecb-frame' -- The window of buffer B is not a window in the edit-area. -If one of these conditions is false then nothing will be done. - -During the evaluation of BODY the following local variables are bound: -- visible-buffer: The buffer-object which name is the value of - BUFFER-NAME-SYMBOL. -- visible-window: The window which displays visible-buffer" - `(let* ((visible-buffer (if (and (boundp ,buffer-name-symbol) - (stringp (symbol-value ,buffer-name-symbol))) - (get-buffer (symbol-value ,buffer-name-symbol)))) - (visible-window (if (bufferp visible-buffer) - (get-buffer-window visible-buffer)))) - (when (and ecb-minor-mode - (equal (selected-frame) ecb-frame) - visible-window - (window-live-p visible-window) - (not (member visible-window (ecb-canonical-edit-windows-list)))) - ,＠body))) - -(put 'ecb-do-if-buffer-visible-in-ecb-frame 'lisp-indent-function 1) - (defun ecb-read-number (prompt &optional init-value) "Ask in the minibuffer for a number with prompt-string PROMPT. Optional INIT-VALUE can be either a number or a string-representation of a number." ＠＠ -969,23 +1141,6 ＠＠ (not (= 0 (string-to-number result))))))) (string-to-number result))) -(defun ecb-option-get-value (option &optional type) - "Return the value of a customizable ECB-option OPTION with TYPE, where TYPE -can either be 'standard-value \(the default-value of the defcustom) or -'saved-value \(the value stored durable by the user via customize) or -'customized-value \(the value set but not saved in the customize buffer). -If TYPE is nil then the most recent set value is returned, means it -tries the customized-value, then the saved-value and then the standard-value -in exactly this sequence." - (let ((val (car (if type - (get option type) - (or (get option 'customized-value) - (get option 'saved-value) - (get option 'standard-value)))))) - (cond ((not (listp val)) val) - ((equal 'quote (car val)) (car (cdr val))) - (t (car val))))) - (defun ecb-message-box (message-str &optional title-text button-text) "Display a message-box with message MESSAGE-STR and title TITLE-TEXT if TITLE-TEXT is not nil - otherwise \"Message-box\" is used as title. The title ＠＠ -1016,6 +1171,49 ＠＠ t) (message (concat title " " message-str))))) +;;; ----- Information-display - errors, warnings, infos ---- + +(defun ecb-nolog-message (&rest args) + "Works exactly like `message' but does not log the message" + (let ((msg (cond ((or (null args) + (null (car args))) + nil) + ((null (cdr args)) + (car args)) + (t + (apply 'format args))))) + ;; Now message is either nil or the formated string. + (if ecb-running-xemacs + ;; XEmacs way of preventing log messages. + (if msg + (display-message 'no-log msg) + (clear-message 'no-log)) + ;; Emacs way of preventing log messages. + (let ((message-log-max nil) + (message-truncate-lines nil)) + (if msg + (message "%s" msg) + (message nil)))) + msg)) + +(defun ecb-error (&rest args) + "Signals an error but prevents it from entering the debugger. This is +useful if an error-message should be signaled to the user and evaluating +should stopped but no debugging is senseful." + (let ((debug-on-error nil)) + (error (concat "ECB " ecb-version " - Error: " + (apply 'format args))))) + +(defun ecb-warning (&rest args) + "Displays a warning." + (message (concat "ECB " ecb-version " - Warning: " (apply 'format args)))) + +(defun ecb-info-message (&rest args) + "Displays an information." + (message (concat "ECB " ecb-version " - Info: " (apply 'format args)))) + +;;; ----- Text and string-stuff ---------------------------- + (defun ecb-merge-face-into-text (text face) "Merge FACE to the already precolored TEXT so the values of all face-attributes of FACE take effect and but the values of all face-attributes ＠＠ -1063,23 +1261,59 ＠＠ text)) text)) -(defun ecb-error (&rest args) - "Signals an error but prevents it from entering the debugger. This is -useful if an error-message should be signaled to the user and evaluating -should stopped but no debugging is senseful." - (let ((debug-on-error nil)) - (error (concat "ECB " ecb-version " - Error: " - (apply 'format args))))) +(if (fboundp 'compare-strings) + (defalias 'ecb-compare-strings 'compare-strings) + (defun ecb-compare-strings (str1 start1 end1 str2 start2 end2 &optional ignore-case) + "Compare the contents of two strings. +In string STR1, skip the first START1 characters and stop at END1. +In string STR2, skip the first START2 characters and stop at END2. +END1 and END2 default to the full lengths of the respective strings. -(defun ecb-warning (&rest args) - "Displays a warning." - (message (concat "ECB " ecb-version " - Warning: " (apply 'format args)))) +Case is significant in this comparison if IGNORE-CASE is nil. -(defun ecb-info-message (&rest args) - "Displays an information." - (message (concat "ECB " ecb-version " - Info: " (apply 'format args)))) +The value is t if the strings (or specified portions) match. +If string STR1 is less, the value is a negative number N; + - 1 - N is the number of characters that match at the beginning. +If string STR1 is greater, the value is a positive number N; + N - 1 is the number of characters that match at the beginning." + (or start1 (setq start1 0)) + (or start2 (setq start2 0)) + (setq end1 (if end1 + (min end1 (length str1)) + (length str1))) + (setq end2 (if end2 + (min end2 (length str2)) + (length str2))) + (let ((i1 start1) + (i2 start2) + result c1 c2) + (while (and (not result) (< i1 end1) (< i2 end2)) + (setq c1 (aref str1 i1) + c2 (aref str2 i2) + i1 (1+ i1) + i2 (1+ i2)) + (if ignore-case + (setq c1 (upcase c1) + c2 (upcase c2))) + (setq result (cond ((< c1 c2) (- i1)) + ((> c1 c2) i1)))) + (or result + (cond ((< i1 end1) (1+ (- i1 start1))) + ((< i2 end2) (1- (- start1 i1))) + (t))) + ))) + +(defsubst ecb-string= (str1 str2 &optional ignore-case) + (let ((s1 (or (and (stringp str1) str1) (symbol-name str1))) + (s2 (or (and (stringp str2) str2) (symbol-name str2)))) + (eq (ecb-compare-strings s1 nil nil s2 nil nil ignore-case) t))) -;; trimming +(defsubst ecb-string< (str1 str2 &optional ignore-case) + (let ((s1 (or (and (stringp str1) str1) (symbol-name str1))) + (s2 (or (and (stringp str2) str2) (symbol-name str2))) + (result nil)) + (setq result (ecb-compare-strings s1 nil nil s2 nil nil ignore-case)) + (and (numberp result) (< result 0)))) (defun ecb-excessive-trim (str) "Return a string where all double-and-more whitespaces in STR are replaced ＠＠ -1093,8 +1327,8 ＠＠ ;; Klaus Berndl <klaus.berndl(a)sdm.de&gt;: we have to take account that GNU Emacs ;; > 21.3 has changed its split-string function! For the new split-string is -;; > (cdr (split-string ...)) not nil (at least in our context below), -;; > for GNU Emacs <= 21.3 nil! +;; (cdr (split-string ...)) not nil (at least in our context below), for GNU +;; Emacs <= 21.3 nil! (defun ecb-left-trim (str) "Return a string stripped of all leading whitespaces of STR." (let ((split-result (split-string str "^[\n\t ]*"))) ＠＠ -1115,8 +1349,37 ＠＠ "Applies `ecb-trim' and `ecb-middle-trim' to STR." (ecb-excessive-trim (ecb-trim str))) +(defun ecb-fit-str-to-width (str width from) + "If STR is longer than WIDTH then fit it to WIDTH by stripping from left or +right \(depends on FROM which can be 'left or 'right) and prepend \(rsp. +append) \"...\" to signalize that the string is stripped. If WIDTH >= length +of STR the always STR is returned. If either WIDTH or length of STR is < 5 +then an empty string is returned because stripping makes no sense here." + (let ((len-str (length str))) + (if (>= width len-str) + str + (if (or (< len-str 5) ;; we want at least two characters visible of str + (< width 5)) + "" + (if (equal from 'left) + (concat "..." (substring str (* -1 (- width 3)))) + (concat (substring str 0 (- width 3)) "...")))))) + +;;; ----- Number-stuff ------------------------------------- + +(defun ecb-normalize-number (value &optional ref-value) + "Normalize VALUE in the following manner and return: +* VALUE > -1.0 and < +1.0 and REF-VALUE a number: `floor' of VALUE * REF-VALUE +* all other cases: `floor' of VALUE" + (floor (if (and (< value 1.0) + (> value -1.0) + (numberp ref-value)) + (* ref-value value) + value))) +;;; ----- Working-display ---------------------------------- + ;; code for a working display - complete stolen from the semantic-package. ;; ECB has thrown away all code which is not needed by ECB ;; The original code is written by Eric M. Ludlam <zappo(a)gnu.org&gt; ＠＠ -1125,8 +1388,7 ＠＠ ;; download eieio and semantic even if the user has not installed any version ;; of semantic. -;;; Variables used in stages -;; +;; Variables used in stages (defvar ecb-working-message nil "Message stored when in a status loop.") (defvar ecb-working-donestring nil ＠＠ -1217,11 +1479,13 ＠＠ MESSAGE is the message to show, and DONESTR is the string to add when done. CALLPROCESSARGS are the same style of args as passed to `call-process'. The are: PROGRAM, INFILE, BUFFER, DISPLAY, and ARGS. -Since it actually calls `start-process', not all features will work." +Since it actually calls `start-process', not all features will work. +It returns the exit-status of the called PROGRAM." (ecb-working-status-timeout timeout message donestr - (let ((proc (apply 'start-process "ecb-working" - (if (listp buffer) (car buffer) buffer) - program args))) + (let* ((process-environment (cons "LC_ALL=C" process-environment)) + (proc (apply 'start-process "ecb-working" + (if (listp buffer) (car buffer) buffer) + program args))) (set-process-sentinel proc 'list) (while (eq (process-status proc) 'run) (accept-process-output proc) ＠＠ -1229,57 +1493,70 ＠＠ ;; If this is unreliable for you, use the below which will work ;; in that situation. ;; (if (not (sit-for timeout)) (read-event)) - )))) + ) + (process-exit-status proc)))) -(defun ecb-position (seq elem) - "Return the position of ELEM within SEQ counting from 0. Comparison is done -with `equal'." - (if (listp seq) - (let ((pos (- (length seq) (length (member elem seq))))) - (if (= pos (length seq)) - nil - pos)) - (catch 'found - (dotimes (i (length seq)) - (if (equal elem (aref seq i)) - (throw 'found i))) - nil))) +;;; ----- Buffers and files -------------------------------- -(defun ecb-last (seq) - "Return the last elem of the sequence SEQ." - (if (listp seq) - (car (last seq)) - (if seq - (aref seq (1- (length seq))) - nil))) +(defsubst ecb-current-line () + "Return the current line-number - the first line in a buffer has number 1." + (+ (count-lines 1 (point)) (if (= (current-column) 0) 1 0))) -(defun ecb-first (seq) - "Return the first elem of the sequence SEQ." - (if (listp seq) - (car seq) - (if seq - (aref seq 0) - nil))) - +(defmacro ecb-with-readonly-buffer (buffer &rest body) + "Make buffer BUFFER current but do not display it. Evaluate BODY in buffer +BUFFER \(not read-only an evaluation-time of BODY) and make afterwards BUFFER +read-only. Note: All this is done with `save-excursion' so after BODY that +buffer is current which was it before calling this macro." + `(if (buffer-live-p ,buffer) + (save-excursion + (set-buffer ,buffer) + (unwind-protect + (progn + (setq buffer-read-only nil) + ,＠body) + (setq buffer-read-only t))) + (ecb-error "Try to set a not existing buffer."))) -(defun ecb-next-listelem (list elem &optional nth-next) - "Return that element of LIST which follows directly ELEM when ELEM is an -element of LIST. If ELEM is the last element of LIST then return the first -element of LIST. If ELEM is not an element of LIST nil is returned. Elements -are compared with `equal'. +(put 'ecb-with-readonly-buffer 'lisp-indent-function 1) -If NTH-NEXT is an integer then the NTH-NEXT element of LIST in the meaning -described above is returned, i.e. the algorithm above is applied NTH-NEXT -times. Example: Suppose LIST = '\(a b c d), ELEM is 'c and NTH-NEXT = 3 then -'b is returned - same result for NTH-NEXT = 7, 11... It works also for -negative integers, so when NTH-NEXT is -1 in the example above then 'b is -returned." - (let ((elem-pos (ecb-position list elem)) - (next (or nth-next 1))) - (and elem-pos - (nth (mod (+ elem-pos next) - (length list)) - list)))) +(defmacro ecb-do-if-buffer-visible-in-ecb-frame (buffer-name-symbol &rest body) + "Evaluate BODY if a buffer is visible in the ECB-frame. + +This means in fact if the following conditions are all true: +- The symbol BUFFER-NAME-SYMBOL is bound +- The value of BUFFER-NAME-SYMBOL is a name of a living buffer B +- The buffer B is visible and displayed in a window of the `ecb-frame' +- ECB is active +- The current frame is the `ecb-frame' +- The window of buffer B is not a window in the edit-area. +If one of these conditions is false then nothing will be done. + +During the evaluation of BODY the following local variables are bound: +- visible-buffer: The buffer-object which name is the value of + BUFFER-NAME-SYMBOL. +- visible-window: The window which displays visible-buffer" + `(let* ((visible-buffer (if (and (boundp ,buffer-name-symbol) + (stringp (symbol-value ,buffer-name-symbol))) + (get-buffer (symbol-value ,buffer-name-symbol)))) + (visible-window (if (bufferp visible-buffer) + (get-buffer-window visible-buffer)))) + (when (and ecb-minor-mode + (equal (selected-frame) ecb-frame) + visible-window + (window-live-p visible-window) + (not (member visible-window (ecb-canonical-edit-windows-list)))) + ,＠body))) +(put 'ecb-do-if-buffer-visible-in-ecb-frame 'lisp-indent-function 1) + +(defun ecb-delete-file (file) + "Delete FILE if it eexists." + (let ((exp-file (expand-file-name file))) + (if (file-exists-p exp-file) + (delete-file exp-file)))) + +(defun ecb-buffer-select (buffer-or-name) + "Make buffer of BUFFER-OR-NAME current - do not display it." + (set-buffer (ecb-buffer-obj buffer-or-name))) (defun ecb-buffer-name (buffer-or-name) "Return the buffer-name of BUFFER-OR-NAME." ＠＠ -1299,6 +1576,17 ＠＠ (t nil))) +(defun ecb-buffer-local-value (sym buffer) + "Get the buffer-local value of variable SYM in BUFFER. If there is no +buffer-local value in BUFFER then the global value of SYM is used." + (if (fboundp 'buffer-local-value) + (buffer-local-value sym buffer) + (or (cdr (assoc sym (buffer-local-variables buffer))) + (save-excursion + (set-buffer buffer) + (symbol-value sym))))) + + (defun ecb-file-content-as-string (file) "If FILE exists and is readable returns the contents as a string otherwise return nil. ＠＠ -1334,22 +1622,87 ＠＠ (ecb-current-buffer-archive-extract-p)) (ecb-current-buffer-archive-extract-p)))))) -(defun ecb-fit-str-to-width (str width from) - "If STR is longer than WIDTH then fit it to WIDTH by stripping from left or -right \(depends on FROM which can be 'left or 'right) and prepend \(rsp. -append) \"...\" to signalize that the string is stripped. If WIDTH >= length -of STR the always STR is returned. If either WIDTH or length of STR is < 5 -then an empty string is returned because stripping makes no sense here." - (let ((len-str (length str))) - (if (>= width len-str) - str - (if (or (< len-str 5) ;; we want at least two characters visible of str - (< width 5)) - "" - (if (equal from 'left) - (concat "..." (substring str (* -1 (- width 3)))) - (concat (substring str 0 (- width 3)) "...")))))) +;;; ----- Windows ------------------------------------------ + +;; Emacs 20 has no window-list function and the XEmacs and Emacs 21 one has no +;; specified ordering. The following one is stolen from XEmacs and has fixed +;; this lack of a well defined order. We preserve also point of current +;; buffer! IMPORTANT: When the window-ordering is important then currently +;; these function should only be used with WINDOW = (frame-first-window +;; ecb-frame)! +(defun ecb-window-list (&optional frame minibuf window) + "Return a list of windows on FRAME, beginning with WINDOW. The +windows-objects in the result-list are in the same canonical windows-ordering +of `next-window'. If omitted, WINDOW defaults to the selected window. FRAME and +WINDOW default to the selected ones. Optional second arg MINIBUF t means count +the minibuffer window even if not active. If MINIBUF is neither t nor nil it +means not to count the minibuffer even if it is active." + (if ecb-running-emacs-21 + ;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: There seems to be + ;; mysterious behavior when running our own window-list version with + ;; GNU Emacs >= 21.3 - especially when running an igrep when the + ;; igrep-buffer is already in another window. We can here savely use the + ;; function `window-list' because it returns an ordered list + (window-list frame minibuf window) + (setq window (or window (selected-window)) + frame (or frame (selected-frame))) + (if (not (eq (window-frame window) frame)) + (error "Window must be on frame.")) + (let ((current-frame (selected-frame)) + (current-point (point)) + list) + (unwind-protect + (save-window-excursion + (select-frame frame) + ;; this is needed for correct start-point + (select-window window) + (walk-windows + (function (lambda (cur-window) + (if (not (eq window cur-window)) + (setq list (cons cur-window list))))) + minibuf + 'selected) + ;; This is needed to get the right canonical windows-order, i.e. the + ;; same order of windows than `walk-windows' walks through! + (setq list (nreverse list)) + (setq list (cons window list))) + (select-frame current-frame) + ;; we must reset the point of the buffer which was current at call-time + ;; of this function + (goto-char current-point))))) + +(defun ecb-canonical-windows-list () + "Return a list of all current visible windows in the `ecb-frame' \(starting + from the left-most top-most window) in the order `other-window' would walk + through these windows." + (ecb-window-list ecb-frame 0 (frame-first-window ecb-frame))) + +(defun ecb-enlarge-window(window &optional val) + "Enlarge the given window. +If VAL is nil then WINDOW is enlarged so that it is 1/2 of the current frame. +If VAL is a positive integer then WINDOW is enlarged so that its new height is +VAL lines. If VAL is > 0 and < 1 then WINDOW is enlarged so that its new +height is that fraction of the frame." + (if (and window (window-live-p window)) + (let* ((norm-val (if val + (ecb-normalize-number val (1- (frame-height))) + (/ (1- (frame-height)) 2))) + (enlargement (- norm-val (ecb-window-full-height window)))) + (save-selected-window + (select-window window) + (if (> enlargement 0) + (enlarge-window enlargement)))) + (error "Window is not alive!"))) + +(defun ecb-window-select (name) + "Select that window which displays the buffer with NAME in the `ecb-frame' +and return the window-object. If that buffer is not displayed in the +`ecb-frame' then nothing happens and nil is returned." + (let ((window (get-buffer-window name ecb-frame))) + (if window + (select-window window) + nil))) (defun ecb-make-windows-not-dedicated (&optional frame) "Make all windows of FRAME not dedicated." ＠＠ -1387,20 +1740,48 ＠＠ (ecb-canonical-windows-list) (window-list))))))) +;;; ----- Time stuff ----------------------------------------- -(defun ecb-buffer-local-value (sym buffer) - "Get the buffer-local value of variable SYM in BUFFER. If there is no -buffer-local value in BUFFER then the global value of SYM is used." - (if (fboundp 'buffer-local-value) - (buffer-local-value sym buffer) - (or (cdr (assoc sym (buffer-local-variables buffer))) - (save-excursion - (set-buffer buffer) - (symbol-value sym))))) - - +;; next three functions stolen from gnus +(defun ecb-time-to-seconds (time) + "Convert TIME to a floating point number." + (+ (* (car time) 65536.0) + (cadr time) + (/ (or (nth 2 time) 0) 1000000.0))) + +(defun ecb-seconds-to-time (seconds) + "Convert SECONDS (a floating point number) to an Emacs time structure." + (list (floor seconds 65536) + (floor (mod seconds 65536)) + (floor (* (- seconds (ffloor seconds)) 1000000)))) + +(defun ecb-subtract-time (t1 t2) + "Subtract two internal times and return the result as internal time." + (let ((borrow (< (cadr t1) (cadr t2)))) + (list (- (car t1) (car t2) (if borrow 1 0)) + (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))) + +(defun ecb-time-diff (t1 t2 &optional rounded) + "Return the difference between time T1 and T2 in seconds \(can be a +floating-point number). If optional arg ROUNDED is not nil the result is a +rounded integer." + (funcall (if rounded 'round 'identity) + (ecb-time-to-seconds (ecb-subtract-time t1 t2)))) + +;; (let ((t1 nil) +;; (t2 nil)) +;; (setq t1 (current-time)) +;; (sit-for 5) +;; (setq t2 (current-time)) +;; (ecb-time-diff t2 t1 t)) + +(defun ecb-time-less-p (t1 t2) + "Say whether time T1 is less than time T2." + (or (< (car t1) (car t2)) + (and (= (car t1) (car t2)) + (< (nth 1 t1) (nth 1 t2))))) -;; ringstuff +;;; ----- Ringstuff ---------------------------------------- (require 'ring) (defalias 'ecb-make-ring 'make-ring) ＠＠ -1413,6 +1794,8 ＠＠ "Return a list of the lements of RING." (mapcar #'identity (cddr ring))) +;;; ----- Menu stuff --------------------------------------- + (defvar ecb-max-submenu-depth 4 "The maximum depth of nesting submenus for the tree-buffers.") ＠＠ -1434,7 +1817,14 ＠＠ (list 'string ':tag "Submenu-title") (ecb-create-menu-user-ext-type (1+ curr-level) max-level))))))) -(silentcomp-provide 'ecb-util) -;;; ecb-util.el ends here +;;; net-stuff + + +;;; ----- Provide ------------------------------------------ + +(silentcomp-provide 'ecb-util) +;;; Local Variables: *** +;;; mode:outline-minor *** +;;; End: *** Index: ecb-winman-support.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb-winman-support.el,v retrieving revision 1.8 diff -u -r1.8 ecb-winman-support.el --- ecb-winman-support.el 31 Aug 2004 16:00:42 -0000 1.8 +++ ecb-winman-support.el 1 Dec 2004 15:59:49 -0000 ＠＠ -21,7 +21,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: ecb-winman-support.el,v 1.8 2004/08/31 16:00:42 berndl Exp $ +;; $Id: ecb-winman-support.el,v 1.12 2004/07/15 15:26:27 berndl Exp $ ;;; Commentary ;; Index: ecb.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb.el,v retrieving revision 1.14 diff -u -r1.14 ecb.el --- ecb.el 31 Aug 2004 16:00:40 -0000 1.14 +++ ecb.el 1 Dec 2004 15:59:49 -0000 ＠＠ -26,7 +26,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: ecb.el,v 1.400 2004/08/27 15:42:14 berndl Exp $ +;; $Id: ecb.el,v 1.417 2004/12/01 14:19:37 berndl Exp $ ;;; Commentary: ;; ＠＠ -220,8 +220,10 ＠＠ ;; XEmacs (silentcomp-defun redraw-modeline) (silentcomp-defvar modeline-map) +(silentcomp-defvar progress-feedback-use-echo-area) ;; Emacs (silentcomp-defun force-mode-line-update) +(silentcomp-defun font-lock-add-keywords) (silentcomp-defvar dired-directory) (silentcomp-defvar current-menubar) ＠＠ -232,7 +234,6 ＠＠ (silentcomp-defvar ediff-quit-hook) (silentcomp-defun Info-goto-node) -(silentcomp-defun ecb-speedbar-active-p) (silentcomp-defun ecb-speedbar-deactivate) (silentcomp-defvar ecb-speedbar-buffer-name) ＠＠ -250,12 +251,12 ＠＠ "Only true if any item in any tree-buffer has been selected in recent command.") -(defun ecb-initialize-internal-vars () +(defun ecb-initialize-all-internals (&optional no-caches) (setq ecb-tree-buffers nil ecb-major-mode-selected-source nil ecb-item-in-tree-buffer-selected nil) - (ecb-file-browser-initialize) - (ecb-method-browser-initialize)) + (ecb-file-browser-initialize no-caches) + (ecb-method-browser-initialize no-caches)) ;; Klaus Berndl <klaus.berndl(a)sdm.de&gt;: FRAME-LOCAL (defvar ecb-minor-mode nil ＠＠ -279,11 +280,6 ＠＠ :group 'ecb :prefix "ecb-") -(defgroup ecb-tree-buffer nil - "General settings related to the tree-buffers of ECB." -:group 'ecb -:prefix "ecb-") - (defgroup ecb-most-important nil "The most important settings of ECB you should know." :group 'ecb ＠＠ -344,71 +340,6 ＠＠ :group 'ecb-general :type 'boolean) -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defcustom ecb-bucket-node-display '("" "" ecb-bucket-node-face) - "*How ECB displays bucket-nodes in a ECB tree-buffer. -Bucket-nodes have only one job: Nodes with similar properties will be dropped -into one bucket for such a common property and all these nodes will be added -as children to the bucket-node. Besides being expandable and collapsable a -bucket-node has no senseful action assigned. Examples for bucket-nodes are -\"[+] Variables\", \"[+] Dependencies\" etc. in the Methods-buffer or buckets -which combine filenames with same extension under a bucket-node with name this -extension. - -This option defines how bucket-node should be displayed. The name of the -bucket-node is computed by ECB but you can define a prefix, a suffix and a -special face for the bucket-node - -The default are empty prefix/suffix-strings and 'ecb-bucket-node-face'. But -an alternative can be for example '\(\"[\" \"]\" nil) which means no special -face and a display like \"[+] [<bucket-name>]\"." -:group 'ecb-general -:set (function (lambda (symbol value) - (set symbol value) - (ecb-clear-tag-tree-cache))) -:type '(list (string :tag "Bucket-prefix" :value "[") - (string :tag "Bucket-suffix" :value "]") - (choice :tag "Bucket-face" :menu-tag "Bucket-face" - (const :tag "No special face" :value nil) - (face :tag "Face" :value ecb-bucket-node-face))) -:initialize 'custom-initialize-default) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defcustom ecb-use-speedbar-instead-native-tree-buffer nil - "*If true then uses speedbar for directories, sources or methods. -This means that speedbar is integrated in the ECB-frame and is displayed in -that window normally displaying the standard ECB-directories-buffer, -ECB-sources-buffer or ECB-methods-buffer. - -This option takes effect in all layouts which contain either a directory -window, a sources window or a method window. - -This option can have four valid values: -- nil: Do not use speedbar \(default) -- dir: Use speedbar instead of the standard directories-buffer -- source: Use speedbar instead of the standard sources-buffer -- method: Use speedbar instead of the standard methods-buffer - -Note: For directories and sources a similar effect and usability is available -by setting this option to nil \(or 'method) and setting -`ecb-show-sources-in-directories-buffer' to not nil, because this combination -displays also directories and sources in one window. - -`ecb-use-speedbar-instead-native-tree-buffer' is for people who like the -speedbar way handling directories and source-files or methods and want it in -conjunction with ECB." -:group 'ecb-general -:group 'ecb-directories -:group 'ecb-sources -:group 'ecb-methods -:type '(radio (const :tag "Do not use speedbar" :value nil) - (const :tag "For directories" :value dir) - (const :tag "For sources" :value source) - (const :tag "For methods" :value method)) -:set (function (lambda (sym val) - (set sym val) - (ecb-redraw-layout-full)))) - (defcustom ecb-grep-function (if (fboundp 'igrep) 'igrep 'grep) "*Function used for performing a grep. The popup-menu of the tree-buffers \"Directories\", \"Sources\" and ＠＠ -442,241 +373,6 ＠＠ :group 'ecb-general :type 'function) -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defvar ecb-tree-RET-selects-edit-window--internal nil - "Only set by customizing `ecb-tree-RET-selects-edit-window' or calling -`ecb-toggle-RET-selects-edit-window'! -Do not set this variable directly, it is only for internal uses!") - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defcustom ecb-tree-RET-selects-edit-window - (list ecb-directories-buffer-name - ecb-sources-buffer-name - ecb-methods-buffer-name - ecb-history-buffer-name) - "*In which tree-buffers RET should finally select an edit-window. -If a name of an ECB tree-buffer is contained in this list then hitting RET in -this tree-buffer selects as last action the right edit-window otherwise only -the right action is performed \(opening a new source, selecting a method etc.) -but point stays in the tree-buffer. - -A special remark for the `ecb-directories-buffer-name': Of course here the -edit-window is only selected if the name of the current layout is contained in -`ecb-show-sources-in-directories-buffer' or if the value of -`ecb-show-sources-in-directories-buffer' is 'always \(otherwise this would not -make any sense)! - -The setting in this option is only the default for each tree-buffer. With -`ecb-toggle-RET-selects-edit-window' the behavior of RET can be changed fast -and easy in a tree-buffer without customizing this option, but of course not -for future Emacs sessions!" -:group 'ecb-tree-buffer -:set (function (lambda (sym val) - (set sym val) - (setq ecb-tree-RET-selects-edit-window--internal - (ecb-copy-list val)))) -:type `(set (const :tag ,ecb-directories-buffer-name -:value ,ecb-directories-buffer-name) - (const :tag ,ecb-sources-buffer-name -:value ,ecb-sources-buffer-name) - (const :tag ,ecb-methods-buffer-name -:value ,ecb-methods-buffer-name) - (const :tag ,ecb-history-buffer-name -:value ,ecb-history-buffer-name))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defcustom ecb-tree-indent 4 - "*Indent size for tree buffer. -If you change this during ECB is activated you must deactivate and activate -ECB again to take effect." -:group 'ecb-tree-buffer -:group 'ecb-most-important -:type 'integer) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defcustom ecb-tree-expand-symbol-before t - "*Show the expand symbol before the items in a tree. -When the expand-symbol is located before the items then the tree looks like: - -\[-] ECB - \[+] code-save - \[-] ecb-images - \[-] directories - -When located after then the tree looks like: - -ECB \[-] - code-save \[+] - ecb-images \[-] - directories \[-] - -The after-example above use a value of 2 for `ecb-tree-indent' whereas the -before-example uses a value of 4. - -It is recommended to display the expand-symbol before because otherwise it -could be that with a deep nested item-structure with and/or with long -item-names \(e.g. a deep directory-structure with some long -subdirectory-names) the expand-symbol is not visible in the tree-buffer and -the tree-buffer has to be horizontal scrolled to expand an item." -:group 'ecb-tree-buffer -:group 'ecb-most-important -:type 'boolean) - - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defcustom ecb-tree-buffer-style (if ecb-images-can-be-used - 'image - 'ascii-guides) - "*The style of the tree-buffers. -There are three different styles available: - -Image-style \(value 'image): -Very nice and modern - just try it. For this style the options -`ecb-tree-indent' and `ecb-tree-expand-symbol-before' have no effect! -Note: GNU Emacs <= 21.3.X for Windows does not support image-display so ECB -uses always 'ascii-guides even when here 'image is set! - -Ascii-style with guide-lines \(value 'ascii-guides): -\[-] ECB - | \[+] code-save - `- \[-] ecb-images - | \[-] directories - | | \[-] height-15 - | | | * close.xpm - | | | * empty.xpm - | | | * leaf.xpm - | | `- * open.xpm - | | \[+] height-17 - | | \[+] height-19 - | `- \[+] height-21 - | \[x] history - | \[x] methods - `- \[x] sources - -Ascii-style without guide-lines \(value 'ascii-no-guides) - this is the style -used by ECB <= 1.96: -\[-] ECB - \[+] code-save - \[-] ecb-images - \[-] directories - \[-] height-15 - * close.xpm - * empty.xpm - * leaf.xpm - * open.xpm - \[+] height-17 - \[+] height-19 - \[+] height-21 - \[x] history - \[x] methods - \[x] sources - -With both ascii-styles the tree-layout can be affected with the options -`ecb-tree-indent' and `ecb-tree-expand-symbol-before'." -:group 'ecb-tree-buffer -:group 'ecb-most-important -:type '(radio (const :tag "Images-style" :value image) - (const :tag "Ascii-style with guide-lines" :value ascii-guides) - (const :tag "Ascii-style w/o guide-lines" :value ascii-no-guides))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defcustom ecb-tree-image-icons-directories - (let ((base (concat (if ecb-regular-xemacs-package-p - (format "%s" (locate-data-directory "ecb")) - ecb-ecb-dir) - "ecb-images/"))) - (append (mapcar (function (lambda (i) - (if i - (concat base i)))) - '("default/height-17" - "directories/height-17" - nil - "methods/height-14_to_21" - nil)))) - "*Directories where the images for the tree-buffer can be found. -This is a five-element list where: -1. element: Default directory where the default images for the tree-buffer can - be found. It should contain an image for every name of - `tree-buffer-tree-image-names'. The name of an image-file must be: - \"ecb-<NAME of TREE-BUFFER-TREE-IMAGE-NAMES>.<ALLOWED EXTENSIONS>\". -2. element: Directory for special images for the Directories-buffer. -3. element: Directory for special images for the Sources-buffer. -4. element: Directory for special images for the Methods-buffer. -5. element: Directory for special images for the History-buffer. - -The directories of the elements 2 - 5 are additional image-directories which -are searched first for images needed for the respective tree-buffer. If the -image can not be found in this directory then the default-directory \(1. -element) is searched. If the image can't even be found there the related -ascii-symbol is used - which is defined in `tree-buffer-tree-image-names'. - -All but the first element \(the default directory) can be nil. - -ECB comes with images defined in four different heights - so for the most -senseful font-heights of a tree-buffer a fitting image-size should be -available. The images reside either in the subdirectory \"ecb-images\" of the -ECB-installation or - if ECB is installed as regular XEmacs-package - in the -ECB-etc data-directory \(the directory returned by \(locate-data-directory -\"ecb\")." -:group 'ecb-tree-buffer -:type '(list (directory :tag "Full default image-path") - (choice :tag "Directories" :menu-tag "Directories" - (const :tag "No special path" :value nil) - (directory :tag "Full image-path for directories")) - (choice :tag "Sources" :menu-tag "Sources" - (const :tag "No special path" :value nil) - (directory :tag "Full image-path for sources")) - (choice :tag "Methods" :menu-tag "Methods" - (const :tag "No special path" :value nil) - (directory :tag "Full image-path for methods")) - (choice :tag "History" :menu-tag "History" - (const :tag "No special path" :value nil) - (directory :tag "Full image-path for history")))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defcustom ecb-truncate-lines '(t t t t) - "*Truncate lines in ECB buffers. -If you change this during ECB is activated you must deactivate and activate -ECB again to take effect." -:group 'ecb-tree-buffer -:group 'ecb-most-important -:type '(list (boolean :tag "Directories buffer") - (boolean :tag "Sources buffer") - (boolean :tag "Methods buffer") - (boolean :tag "History buffer"))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defcustom ecb-tree-easy-hor-scroll 5 - "*Scroll step for easy hor. scrolling via mouse-click in tree-buffers. -XEmacs has horizontal scroll-bars so invisible parts beyond the right -window-border of a tree-buffer can always made visible very easy. - -GNU Emacs does not have hor. scroll-bars so especially with the mouse it is -quite impossible to scroll smoothly right and left. The functions -`scroll-left' and `scroll-right' can be annoying and are also not bound to -mouse-buttons. - -If this option is a positive integer S then in all ECB-tree-buffers the keys -\[M-mouse-1] and \[M-mouse-3] are bound to scrolling left rsp. right with -scroll-step S - clicking with mouse-1 or mouse-2 onto the edge of the modeline -has the same effect, i.e. if you click with mouse-1 onto the left \(rsp. -right) edge of the modeline you will scroll left \(rsp. right). Additionally -\[C-M-mouse-1] and \[C-M-mouse-3] are bound to scrolling left rsp. right with -scroll-step `window-width' - 2. Default is a scroll-step of 5. If the value is -nil then no keys for horizontal scrolling are bound." -:group 'ecb-tree-buffer -:type '(radio :value 5 - (const :tag "No hor. mouse scrolling" :value nil) - (integer :tag "Scroll step"))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defcustom ecb-truncate-long-names t - "*Truncate long names that don't fit in the width of the ECB windows. -If you change this during ECB is activated you must deactivate and activate -ECB again to take effect." -:group 'ecb-tree-buffer -:group 'ecb-most-important -:type 'boolean) (defcustom ecb-window-sync '(Info-mode dired-mode) "*Synchronize the ECB-windows automatically with current edit window. ＠＠ -724,252 +420,35 ＠＠ value 'ecb-window-sync-function)))) :initialize 'custom-initialize-default) -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defcustom ecb-tree-incremental-search 'prefix - "*Enable incremental search in the ECB-tree-buffers. -For a detailed explanation see the online help section \"Working with the -keyboard in the ECB buffers\". If you change this during ECB is activated you -must deactivate and activate ECB again to take effect." -:group 'ecb-tree-buffer -:type '(radio (const :tag "Match only prefix" -:value prefix) - (const :tag "Match every substring" -:value substring) - (const :tag "No incremental search" -:value nil))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defcustom ecb-tree-navigation-by-arrow t - "*Enable smart navigation in the tree-windows by horizontal arrow-keys. -If not nil then the left- and right-arrow keys work in the ECB tree-window in -the following smart way if onto an expandable node: -+ Left-arrow: If node is expanded then it will be collapsed otherwise point - jumps to the next \"higher\" node in the hierarchical tree \(higher means - the next higher tree-level or - if no higher level available - the next - higher node on the same level). -+ Right-arrow: If node is not expanded then it will be expanded. -Onto a not expandable node the horizontal arrow-keys go one character in the -senseful correct direction. - -If this option is changed the new value takes first effect after deactivating -ECB and then activating it again!" -:group 'ecb-tree-buffer -:type 'boolean) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defcustom ecb-show-node-info-in-minibuffer '((if-too-long . path) - (if-too-long . name) - (always . path) - (if-too-long . name+type)) - "*Node info to display in a tree-buffer. -Define which node info should displayed in a tree-buffer after -mouse moving over the node or after a shift click onto the node. - -For every tree-buffer you can define \"when\" node info should be displayed: -- always: Node info is displayed by moving with the mouse over a node. -- if-too-long: Node info is only displayed by moving with the mouse over a - node does not fit into the window-width of the tree-buffer window. - In the ECB directories buffer this means also if a node is shortend or if - the node has an alias \(see `ecb-source-path'). -- shift-click: Node info is only displayed after a shift click with the - primary mouse button onto the node. -- never: Node info is never displayed. - -For every tree-buffer you can define what info should be displayed: -+ Directory-buffer: - - name: Only the full node-name is displayed. - - path: The full-path of the node is displayed. -+ Sources-buffer: - - name: Only the full node-name is displayed. - - file-info: File infos for this file are displayed. - - file-info-full: Fill infos incl. full path for this file are displayed. -+ History-buffer: - see Directories-buffer. -+ Methods-buffer: - - name: Only the full node name is displayed. - - name+type: The full name + the type of the node \(function, class, - variable) is displayed. +(defcustom ecb-stealthy-tasks-delay 1 + "*Time Emacs must be idle before ECB runs its stealthy tasks. +Currently ECB performes the following stealthy tasks: + + Prescann directories for emptyness: Prescann directories and display them as + empty or not-empty in the directories-buffer. See the documentation of the + option `ecb-prescan-directories-for-emptyness' for a description. + + File is read only: Check if sourcefile-items of the directories- or + sources-buffer are read-only or not. See documentation of the option + `ecb-sources-perform-read-only-check'. + + Version-control-state: Checks the version-control-state of files in + directories which are managed by a VC-backend. See the option + `ecb-vc-enable-support'. + +Here the interval is defined ECB has to be idle before starting with these +stealthy tasks. It can be a floating-point value in seconds. The value can +also be changed during running ECB." +:group 'ecb-general +:type '(number :tag "Idle time before running stealthy tasks" +:value 1) +:initialize 'custom-initialize-default +:set (function (lambda (sym val) + (set sym val) + (ecb-activate-ecb-autocontrol-functions + val 'ecb-stealthy-updates)))) + -Do NOT set this option directly via setq but use always customize!" -:group 'ecb-tree-buffer -:group 'ecb-most-important -:set (function (lambda (symbol value) - (set symbol value) - (if (and (boundp 'ecb-minor-mode) - ecb-minor-mode) - (let ((when-list (mapcar (lambda (elem) - (car elem)) - value))) - (if (or (member 'if-too-long when-list) - (member 'always when-list)) - (tree-buffer-activate-follow-mouse) - (tree-buffer-deactivate-follow-mouse) - (tree-buffer-deactivate-mouse-tracking)))))) -:type '(list (cons :tag "* Directories-buffer" - (choice :tag "When" - (const :tag "Always" :value always) - (const :tag "If too long" :value if-too-long) - (const :tag "After shift click" :value shift-click) - (const :tag "Never" :value never)) - (choice :tag "What" - (const :tag "Node-name" :value name) - (const :tag "Full path" :value path))) - (cons :tag "* Sources-buffer" - (choice :tag "When" - (const :tag "Always" :value always) - (const :tag "If too long" :value if-too-long) - (const :tag "After shift click" :value shift-click) - (const :tag "Never" :value never)) - (choice :tag "What" - (const :tag "Node-name" :value name) - (const :tag "File info" :value file-info) - (const :tag "File info \(full path)" -:value file-info-full))) - (cons :tag "* History-buffer" - (choice :tag "When" - (const :tag "Always" :value always) - (const :tag "If too long" :value if-too-long) - (const :tag "After shift click" :value shift-click) - (const :tag "Never" :value never)) - (choice :tag "What" - (const :tag "Node-name" :value name) - (const :tag "Full path" :value path))) - (cons :tag "* Method-buffer" - (choice :tag "When" - (const :tag "Always" :value always) - (const :tag "If too long" :value if-too-long) - (const :tag "After shift click" :value shift-click) - (const :tag "Never" :value never)) - (choice :tag "What" - (const :tag "Node-name" :value name) - (const :tag "Node-name + type" :value name+type))))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defun ecb-show-any-node-info-by-mouse-moving-p () - "Return not nil if for at least one tree-buffer showing node info only by -moving the mouse over a node is activated. See -`ecb-show-node-info-in-minibuffer'." - (let ((when-list (mapcar (lambda (elem) - (car elem)) - ecb-show-node-info-in-minibuffer))) - (or (member 'if-too-long when-list) - (member 'always when-list)))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defun ecb-show-node-info-index (tree-buffer-name) - (cond ((ecb-string= tree-buffer-name ecb-directories-buffer-name) - 0) - ((ecb-string= tree-buffer-name ecb-sources-buffer-name) - 1) - ((ecb-string= tree-buffer-name ecb-history-buffer-name) - 2) - ((ecb-string= tree-buffer-name ecb-methods-buffer-name) - 3))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defun ecb-show-node-info-when (tree-buffer-name) - (car (nth (ecb-show-node-info-index tree-buffer-name) - ecb-show-node-info-in-minibuffer))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defun ecb-show-node-info-what (tree-buffer-name) - (cdr (nth (ecb-show-node-info-index tree-buffer-name) - ecb-show-node-info-in-minibuffer))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defcustom ecb-primary-secondary-mouse-buttons 'mouse-2--C-mouse-2 - "*Primary- and secondary mouse button for using the ECB-buffers. -A click with the primary button causes the main effect in each ECB-buffer: -- ECB Directories: Expanding/collapsing nodes and displaying files in the ECB - Sources buffer. -- ECB sources/history: Opening the file in that edit-window specified by the - option `ecb-mouse-click-destination'. -- ECB Methods: Jumping to the method in that edit-window specified by the - option `ecb-mouse-click-destination'. - -A click with the primary mouse-button while the SHIFT-key is pressed called -the POWER-click and does the following \(depending on the ECB-buffer where the -POWER-click occurs): -+ Directory-buffer: Refreshing the directory-contents-cache \(see - `ecb-cache-directory-contents'). -+ Sources- and History-buffer: Only displaying the source-contents in the - method-buffer but not displaying the source-file in the edit-window. -+ Methods-buffer: Narrowing to the clicked method/variable/ect... \(see - `ecb-tag-visit-post-actions'). This works only for sources supported by - semantic! - -In addition always the whole node-name is displayed in the minibuffer after a -POWER-click \(for this see also `ecb-show-node-info-in-minibuffer'). - -The secondary mouse-button is for opening \(jumping to) the file in another -edit-window \(see the documentation `ecb-mouse-click-destination'). - -The following combinations are possible: -- primary: mouse-2, secondary: C-mouse-2 \(means mouse-2 while CTRL-key is - pressed). This is the default setting. -- primary: mouse-1, secondary: C-mouse-1 -- primary: mouse-1, secondary: mouse-2 - -Note: If the tree-buffers are used with the keyboard instead with the mouse -then [RET] is interpreted as primary mouse-button and [C-RET] as secondary -mouse-button! - -If you change this during ECB is activated you must deactivate and activate -ECB again to take effect!" -:group 'ecb-tree-buffer -:group 'ecb-most-important -:type '(radio (const :tag "Primary: mouse-2, secondary: Ctrl-mouse-2" -:value mouse-2--C-mouse-2) - (const :tag "Primary: mouse-1, secondary: Ctrl-mouse-1" -:value mouse-1--C-mouse-1) - (const :tag "Primary: mouse-1, secondary: mouse-2" -:value mouse-1--mouse-2))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defcustom ecb-tree-mouse-action-trigger 'button-release - "*When the tree-buffer mouse-action should be triggered. -This option determines the moment a mouse-action in a tree-buffer is -triggered. This can be either direct after pressing a mouse-button \(value -'button-press) or not until releasing the mouse-button \(value: -'button-release). - -If you change this during ECB is activated you must deactivate and activate -ECB again to take effect!" -:group 'ecb-tree-buffer -:type '(radio (const :tag "After button release" :value button-release) - (const :tag "After button press" :value button-press))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defcustom ecb-mouse-click-destination 'last-point - "*Destination of a mouse-button click. -Defines in which edit-window \(if splitted) ECB does the \"right\" action -\(opening a source, jumping to a method/variable etc.) after clicking with a -mouse-button \(see `ecb-primary-secondary-mouse-buttons') onto a node. There -are two possible choices: -- left-top: Does the \"right\" action always in the left/topmost edit-window. -- last-point: Does the \"right\" action always in that edit-window which had - the point before. -This is if the user has clicked either with the primary mouse-button or -has activated a popup-menu in the tree-buffer. - -A click with the secondary mouse-button \(see again -`ecb-primary-secondary-mouse-buttons') does the \"right\" action always in -another edit-window related to the setting in this option: If there are two -edit-windows then the \"other\" edit-window is used and for more than 2 -edit-windows the \"next\" edit-window is used \(whereas the next edit-window -of the last edit-window is the first edit-window). - -If the edit-window is not splitted this setting has no effect. - -Note: If the tree-buffers are used with the keyboard instead with the mouse -then this option takes effect too because [RET] is interpreted as primary -mouse-button and [C-RET] as secondary mouse-button!" -:group 'ecb-general -:group 'ecb-most-important -:type '(radio (const :tag "Left/topmost edit-window" -:value left-top) - (const :tag "Last edit-window with point" -:value last-point))) (defcustom ecb-minor-mode-text " ECB" "*String to display in the mode line when ECB minor mode is active. ＠＠ -1112,218 +591,11 ＠＠ :group 'ecb-general :type 'hook) -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defcustom ecb-common-tree-buffer-after-create-hook nil - "*Local hook running at the end of each tree-buffer creation. -Every function of this hook is called once without arguments direct after -creating a tree-buffer of ECB and it's local key-map. So for example a function -could be added which performs calls of `local-set-key' to define new -key-bindings for EVERY tree-buffer. - -The following keys must not be rebind in all tree-buffers: -- <RET> and all combinations with <Shift> and <Ctrl> -- <TAB> -- `C-t'" -:group 'ecb-tree-buffer -:type 'hook) - ;;==================================================== ;; Internals ;;==================================================== -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> layout -(defun ecb-window-select (name) - "Select that window which displays the buffer with NAME in the `ecb-frame' -and return the window-object. If that buffer is not displayed in the -`ecb-frame' then nothing happens and nil is returned." - (let ((window (get-buffer-window name ecb-frame))) - (if window - (select-window window) - nil))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> layout -(defun ecb-goto-ecb-window (name) - "Select that special ecb-window with name NAME. Only names defined -for the current layout \(see `ecb-special-ecb-buffers-of-current-layout') or -the buffer-name of the integrated speedbar are accepted. If such a window can -not be selected then probably because another ecb-window of current layout is -currently maximized; therefore in such a case the layout has been redrawn and -then tried to select the window again. This function does nothing if NAME -fulfills not the described conditions or if the ecb-windows are hidden or ECB -is not active. If necessary the `ecb-frame' will be first raised." - (when (and ecb-minor-mode - (not ecb-windows-hidden) - (or (equal name ecb-speedbar-buffer-name) - (member name ecb-special-ecb-buffers-of-current-layout))) - (raise-frame ecb-frame) - (select-frame ecb-frame) - (or (ecb-window-select name) - ;; the window is not visible because another one is maximized; - ;; therefore we first redraw the layout - (progn - (ecb-redraw-layout-full nil nil nil nil) - ;; now we can go to the window - (ecb-window-select name))))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> file-browser -(defun ecb-goto-window-directories () - "Make the ECB-directories window the current window. -If `ecb-use-speedbar-instead-native-tree-buffer' is 'dir then goto to the -speedbar-window." - (interactive) - (or (ecb-goto-ecb-window ecb-directories-buffer-name) - (and (equal ecb-use-speedbar-instead-native-tree-buffer 'dir) - (ecb-goto-window-speedbar)))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> file-browser -(defun ecb-goto-window-sources () - "Make the ECB-sources window the current window. -If `ecb-use-speedbar-instead-native-tree-buffer' is 'source then goto to the -speedbar-window." - (interactive) - (or (ecb-goto-ecb-window ecb-sources-buffer-name) - (and (equal ecb-use-speedbar-instead-native-tree-buffer 'source) - (ecb-goto-window-speedbar)))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> methods-browser -(defun ecb-goto-window-methods () - "Make the ECB-methods window the current window. -If `ecb-use-speedbar-instead-native-tree-buffer' is 'method then goto to the -speedbar-window." - (interactive) - (or (ecb-goto-ecb-window ecb-methods-buffer-name) - (and (equal ecb-use-speedbar-instead-native-tree-buffer 'method) - (ecb-goto-window-speedbar)))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> file-browser -(defun ecb-goto-window-history () - "Make the ECB-history window the current window." - (interactive) - (ecb-goto-ecb-window ecb-history-buffer-name)) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> speedbar??? -(defun ecb-goto-window-speedbar () - "Make the ECB-speedbar window the current window. -This command does nothing if no integrated speedbar is visible in the -ECB-frame." - (interactive) - (ecb-goto-ecb-window ecb-speedbar-buffer-name)) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> layout -(defun ecb-goto-window-edit-last () - "Make the last selected edit-window window the current window. This is the -same as if `ecb-mouse-click-destination' is set to 'last-point." - (interactive) - (when ecb-minor-mode - (raise-frame ecb-frame) - (select-frame ecb-frame) - (let ((ecb-mouse-click-destination 'last-point)) - (ecb-select-edit-window)))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> layout -(defun ecb-goto-window-edit1 () - "Make the \(first) edit-window window the current window." - (interactive) - (when ecb-minor-mode - (raise-frame ecb-frame) - (select-frame ecb-frame) - (ecb-select-edit-window 1))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> layout -(defun ecb-goto-window-edit2 () - "Make the second edit-window \(if available) window the current window." - (interactive) - (when ecb-minor-mode - (raise-frame ecb-frame) - (select-frame ecb-frame) - (ecb-select-edit-window t))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> layout -(defun ecb-goto-window-compilation () - "Goto the ecb compilation window `ecb-compile-window'." - (interactive) - (when (and ecb-minor-mode - (equal 'visible (ecb-compile-window-state))) - (raise-frame ecb-frame) - (select-frame ecb-frame) - (select-window ecb-compile-window))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> layout -(defun ecb-buffer-select (name) - (set-buffer (get-buffer name))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> file-browser -(defun ecb-maximize-window-directories () - "Maximize the ECB-directories-window. -I.e. delete all other ECB-windows, so only one ECB-window and the -edit-window\(s) are visible \(and maybe a compile-window). Works also if the -ECB-directories-window is not visible in current layout." - (interactive) - (if (equal ecb-use-speedbar-instead-native-tree-buffer 'dir) - (ecb-maximize-window-speedbar) - (ecb-display-one-ecb-buffer ecb-directories-buffer-name))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> file-browser -(defun ecb-maximize-window-sources () - "Maximize the ECB-sources-window. -I.e. delete all other ECB-windows, so only one ECB-window and the -edit-window\(s) are visible \(and maybe a compile-window). Works also if the -ECB-sources-window is not visible in current layout." - (interactive) - (if (equal ecb-use-speedbar-instead-native-tree-buffer 'source) - (ecb-maximize-window-speedbar) - (ecb-display-one-ecb-buffer ecb-sources-buffer-name))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> methods-browser -(defun ecb-maximize-window-methods () - "Maximize the ECB-methods-window. -I.e. delete all other ECB-windows, so only one ECB-window and the -edit-window\(s) are visible \(and maybe a compile-window). Works also if the -ECB-methods-window is not visible in current layout." - (interactive) - (if (equal ecb-use-speedbar-instead-native-tree-buffer 'method) - (ecb-maximize-window-speedbar) - (ecb-display-one-ecb-buffer ecb-methods-buffer-name))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> file-browser -(defun ecb-maximize-window-history () - "Maximize the ECB-history-window. -I.e. delete all other ECB-windows, so only one ECB-window and the -edit-window\(s) are visible \(and maybe a compile-window). Works also if the -ECB-history-window is not visible in current layout." - (interactive) - (ecb-display-one-ecb-buffer ecb-history-buffer-name)) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> speedbar??? -(defun ecb-maximize-window-speedbar () - "Maximize the ECB-speedbar-window. -I.e. delete all other ECB-windows, so only one ECB-window and the -edit-window\(s) are visible \(and maybe a compile-window). Does nothing if the -speedbar-window is not visible within the ECB-frame." - (interactive) - (ecb-display-one-ecb-buffer ecb-speedbar-buffer-name)) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defun ecb-toggle-RET-selects-edit-window () - "Toggles if RET in a tree-buffer should finally select the edit-window. -See also the option `ecb-tree-RET-selects-edit-window'." - (interactive) - (let ((tree-buffer (ecb-point-in-ecb-tree-buffer))) - (if tree-buffer - (if (member (buffer-name tree-buffer) - ecb-tree-RET-selects-edit-window--internal) - (progn - (setq ecb-tree-RET-selects-edit-window--internal - (delete (buffer-name tree-buffer) - ecb-tree-RET-selects-edit-window--internal)) - (message "RET does not select the edit-window.")) - (setq ecb-tree-RET-selects-edit-window--internal - (append ecb-tree-RET-selects-edit-window--internal - (list (buffer-name tree-buffer)))) - (message "RET selects the edit-window.")) - (message "Point must stay in an ECB tree-buffer!")))) - (defun ecb-kill-buffer-hook () "Function added to the `kill-buffer-hook' during ECB activation. It does several tasks: ＠＠ -1401,27 +673,37 ＠＠ ;; * KB: With current ECB implementation this sit-for seems not ;; longer necessary, it works with every Emacs version correct. ;; Therefore i comment out the sit-for until this error occurs - ;; again. + ;; again. ;; (sit-for 0.1) ;; if the file is not located in any of the paths in ;; `ecb-source-path' or in the paths returned from - ;; `ecb-source-path-functions' we must at least add the new source - ;; path temporally to our paths. But the uses has also the choice to - ;; save it for future sessions too. + ;; `ecb-source-path-functions' we must at least add the new + ;; source path temporally to our paths. But the user has also + ;; the choice to save it for future sessions too. (if (null (ecb-matching-source-paths filename)) (let* ((norm-filename (ecb-fix-filename filename)) + (remote-path (ecb-remote-path norm-filename)) (source-path (if (car ecb-add-path-for-not-matching-files) - (if (= (aref norm-filename 0) ?/) - ;; for Unix-style-path we add the - ;; root-dir - (substring norm-filename 0 1) - ;; for win32-style-path we add the - ;; drive; because `ecb-fix-filename' - ;; also converts cygwin-path-style to - ;; win32-path-style here also the - ;; drive is added. - (substring norm-filename 0 2)) + ;; we always add the only the root + ;; as source-path + (if remote-path + ;; for a remote-path we add the + ;; host+ the root of the host + (concat (car remote-path) "/") + ;; filename is a local-path + (if (= (aref norm-filename 0) ?/) + ;; for Unix-style-path we add the + ;; root-dir + (substring norm-filename 0 1) + ;; for win32-style-path we add + ;; the drive; because + ;; `ecb-fix-filename' also + ;; converts cygwin-path-style + ;; to win32-path-style here + ;; also the drive is added. + (substring norm-filename 0 2))) + ;; add the full directory as source-path (file-name-directory norm-filename)))) (ecb-add-source-path source-path source-path (not (cdr ecb-add-path-for-not-matching-files))))) ＠＠ -1508,41 +790,6 ＠＠ (if new-value "on" "off") new-value))) -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser?? -(defun ecb-combine-ecb-button/edit-win-nr (ecb-button edit-window-nr) - "Depending on ECB-BUTTON and EDIT-WINDOW-NR return one value: -- nil if ECB-BUTTON is 1. -- t if ECB-BUTTON is 2 and the edit-area of ECB is splitted. -- EDIT-WINDOW-NR if ECB-BUTTON is 3." - (cond ((eq ecb-button 1) nil) - ((eq ecb-button 2) (ecb-edit-window-splitted)) - ((eq ecb-button 3) edit-window-nr))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser?? -(defun ecb-get-edit-window (other-edit-window) - "Get the correct edit-window. Which one is the correct one depends on the -value of OTHER-EDIT-WINDOW \(which is a value returned by -`ecb-combine-ecb-button/edit-win-nr') and `ecb-mouse-click-destination'. -- OTHER-EDIT-WINDOW is nil: Get the edit-window according to the option - `ecb-mouse-click-destination'. -- OTHER-EDIT-WINDOW is t: Get the next edit-window in the cyclic list of - current edit-windows starting either from the left-top-most one or from the - last edit-window with point (depends on - `ecb-mouse-click-destination'). -- OTHER-EDIT-WINDOW is an integer: Get exactly the edit-window with that - number > 0." - (let ((edit-win-list (ecb-canonical-edit-windows-list))) - (cond ((null other-edit-window) - (if (eq ecb-mouse-click-destination 'left-top) - (car edit-win-list) - ecb-last-edit-window-with-point)) - ((integerp other-edit-window) - (ecb-get-edit-window-by-number other-edit-window edit-win-list)) - (t - (ecb-next-listelem edit-win-list - (if (eq ecb-mouse-click-destination 'left-top) - (car edit-win-list) - ecb-last-edit-window-with-point)))))) (defun ecb-customize () "Open a customize-buffer for all customize-groups of ECB." ＠＠ -1556,161 +803,6 ＠＠ (ecb-select-edit-window) (customize-group "ecb-most-important")) -;;==================================================== -;; Mouse functions -;;==================================================== - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defun ecb-tree-buffer-node-select-callback (node - mouse-button - shift-pressed - control-pressed - meta-pressed - tree-buffer-name) - "This is the callback-function ecb.el gives to every tree-buffer to call -when a node has been selected. This function does nothing if the click -combination is invalid \(see `ecb-interpret-mouse-click'." - (let* ((ecb-button-list (ecb-interpret-mouse-click mouse-button - shift-pressed - control-pressed - meta-pressed - tree-buffer-name)) - (ecb-button (car ecb-button-list)) - (shift-mode (cadr ecb-button-list)) - (meta-mode (nth 2 ecb-button-list))) - ;; we need maybe later that something has clicked in a tree-buffer, e.g. - ;; in `ecb-handle-major-mode-visibilty'. - (setq ecb-item-in-tree-buffer-selected t) - (if (/= mouse-button 0) - (setq ecb-layout-prevent-handle-ecb-window-selection t)) - ;; first we dispatch to the right action - (when ecb-button-list - (cond ((ecb-string= tree-buffer-name ecb-directories-buffer-name) - (ecb-directory-clicked node ecb-button nil shift-mode meta-mode)) - ((ecb-string= tree-buffer-name ecb-sources-buffer-name) - (ecb-source-clicked node ecb-button nil shift-mode meta-mode)) - ((ecb-string= tree-buffer-name ecb-history-buffer-name) - (ecb-history-clicked node ecb-button nil shift-mode meta-mode)) - ((ecb-string= tree-buffer-name ecb-methods-buffer-name) - (ecb-method-clicked node ecb-button nil shift-mode meta-mode)) - (t nil))) - - ;; TODO: IMHO the mechanism how the physical keys are mapped and - ;; interpreted to logical ecb-buttons and -actions should now slightly be - ;; redesigned because now we evaluate below MOUSE-PRESSED outside - ;; ecb-interpret-mouse-click and this is not very good. But for now it - ;; works and it is the only location where such an outside-interpretation is - ;; performed (Klaus). - - ;; now we go back to the tree-buffer but only if all of the following - ;; conditions are true: - ;; 1. mouse-button is 0, i.e. RET is pressed in the tree-buffer - ;; 2. The tree-buffer-name is not contained in - ;; ecb-tree-RET-selects-edit-window--internal - ;; 3. Either it is not the ecb-directories-buffer-name or - ;; at least `ecb-show-sources-in-directories-buffer-p' is true. - (when (and (equal 0 mouse-button) - (not (member tree-buffer-name - ecb-tree-RET-selects-edit-window--internal)) - (or (not (ecb-string= tree-buffer-name ecb-directories-buffer-name)) - (ecb-show-sources-in-directories-buffer-p))) - (ecb-goto-ecb-window tree-buffer-name) - (tree-buffer-remove-highlight)))) - - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defun ecb-tree-buffer-node-collapsed-callback (node - mouse-button - shift-pressed - control-pressed - meta-pressed - tree-buffer-name) - "This is the callback-function ecb.el gives to every tree-buffer to call -when a node has been collapsed." - (if (/= mouse-button 0) - (setq ecb-layout-prevent-handle-ecb-window-selection t))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defun ecb-tree-buffer-node-expand-callback (node - mouse-button - shift-pressed - control-pressed - meta-pressed - tree-buffer-name) - "This is the callback-function ecb.el gives to every tree-buffer to call -when a node should be expanded. This function does nothing if the click -combination is invalid \(see `ecb-interpret-mouse-click')." - (let* ((ecb-button-list (ecb-interpret-mouse-click mouse-button - shift-pressed - control-pressed - meta-pressed - tree-buffer-name)) - (ecb-button (nth 0 ecb-button-list)) - (shift-mode (nth 1 ecb-button-list)) - (meta-mode (nth 2 ecb-button-list))) - (if (/= mouse-button 0) - (setq ecb-layout-prevent-handle-ecb-window-selection t)) - (when ecb-button-list - (cond ((ecb-string= tree-buffer-name ecb-directories-buffer-name) - (ecb-update-directory-node node)) - ((ecb-string= tree-buffer-name ecb-sources-buffer-name) - (ecb-source-clicked node ecb-button nil shift-mode meta-mode)) - ((ecb-string= tree-buffer-name ecb-history-buffer-name) - (ecb-history-clicked node ecb-button nil shift-mode meta-mode)) - ((ecb-string= tree-buffer-name ecb-methods-buffer-name) - nil) - (t nil))))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(defun ecb-interpret-mouse-click (mouse-button - shift-pressed - control-pressed - meta-pressed - tree-buffer-name) - "Converts the physically pressed MOUSE-BUTTON \(1 = mouse-1, 2 = mouse-2, 0 = -no mouse-button but RET or TAB) to ECB-mouse-buttons: either primary or -secondary mouse-button depending on the value of CONTROL-PRESSED and the -setting in `ecb-primary-secondary-mouse-buttons'. Returns a list '\(ECB-button -shift-mode meta-mode) where ECB-button is either 1 \(= primary) or 2 \(= -secondary) and shift-mode and meta-mode are non nil if SHIFT-PRESSED rsp. -META-PRESSED is non nil. For an invalid and not accepted click combination nil -is returned. - -Note: If MOUSE-BUTTON is 0 \(means no mouse-button but a key like RET or TAB -was hitted) then CONTROL-PRESSED is interpreted as ECB-button 2. - -Currently the fourth argument TREE-BUFFER-NAME is not used here." - (if (eq mouse-button 0) - (list (if control-pressed 2 1) shift-pressed meta-pressed) - (if (and (not (eq mouse-button 1)) (not (eq mouse-button 2))) - nil - (cond ((eq ecb-primary-secondary-mouse-buttons 'mouse-1--mouse-2) - (if control-pressed - nil - (list mouse-button shift-pressed meta-pressed))) - ((eq ecb-primary-secondary-mouse-buttons 'mouse-1--C-mouse-1) - (if (not (eq mouse-button 1)) - nil - (list (if control-pressed 2 1) shift-pressed meta-pressed))) - ((eq ecb-primary-secondary-mouse-buttons 'mouse-2--C-mouse-2) - (if (not (eq mouse-button 2)) - nil - (list (if control-pressed 2 1) shift-pressed meta-pressed))) - (t nil))))) - -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser?? -(defun ecb-show-minibuffer-info (node window tree-buffer-name) - "Checks if in the minibuffer should be displayed any info about the current -node in the ECB-window WINDOW for the tree-buffer TREE-BUFFER-NAME only by -mouse-moving." - (let ((when-elem (ecb-show-node-info-when tree-buffer-name))) - (or (eq when-elem 'always) - (and (eq when-elem 'if-too-long) - window - (>= (+ (length (tree-node-get-name node)) - (tree-buffer-get-node-indent node)) - (window-width window)))))) - (defvar ecb-idle-timer-alist nil) (defvar ecb-post-command-hooks nil) (defvar ecb-pre-command-hooks nil) ＠＠ -2071,6 +1163,12 ＠＠ :help "Customize ECB history" ]) (ecb-menu-item + ["Version control..." + (customize-group "ecb-version-control") +:active t +:help "Customize the version-control-support" + ]) + (ecb-menu-item ["Layout..." (customize-group "ecb-layout") :active t ＠＠ -2431,8 +1529,30 ＠＠ "Contains the last `ecb-current-window-configuration' directly before ECB has been deactivated. Do not set this variable!") -(defvar ecb-max-specpdl-size-old nil) -(defvar ecb-max-lisp-eval-depth-old nil) +(defvar ecb-temporary-changed-emacs-variables-alist nil + "Internal alist which stores old values of emacs variables/options which +have to be changed during running ECB. Use only `ecb-modify-emacs-variable' +for modifying this alist.") + +(defun ecb-modify-emacs-variable (var action &optional new-value) + "Stores or restores the old value of the Emacs-variable symbol VAR. +VAR has to be a bound symbol for a variable. ACTION is either 'store or +'restore. The optional arg NEW-VALUE is only used when ACTION is 'store and is +that value VAR should be set to. After calling with ACTION is 'restore the +value of VAR is as before storing a NEW-VALUE for variable-symbol VAR." + (cond ((equal action 'store) + (or (ecb-find-assoc var ecb-temporary-changed-emacs-variables-alist) + (progn + (setq ecb-temporary-changed-emacs-variables-alist + (ecb-add-assoc (cons var (symbol-value var)) + ecb-temporary-changed-emacs-variables-alist)) + (set var new-value)))) + ((equal action 'restore) + (let ((elem (ecb-find-assoc var ecb-temporary-changed-emacs-variables-alist))) + (when elem + (set var (cdr elem)) + (setq ecb-temporary-changed-emacs-variables-alist + (ecb-remove-assoc var ecb-temporary-changed-emacs-variables-alist))))))) (defun ecb-activate--impl () "See `ecb-activate'. This is the implementation of ECB activation." ＠＠ -2447,307 +1567,315 ＠＠ (ecb-select-ecb-frame) (ecb-update-directories-buffer)) - ;; we activate only if all before-hooks return non nil - (when (run-hook-with-args-until-failure 'ecb-before-activate-hook) - - ;; max-specpdl-size and max-lisp-eval-depth - (when (< max-specpdl-size 3000) - (setq ecb-max-specpdl-size-old max-specpdl-size) - (setq max-specpdl-size 3000)) - (when (< max-lisp-eval-depth 1000) - (setq ecb-max-lisp-eval-depth-old max-lisp-eval-depth) - (setq max-lisp-eval-depth 1000)) + (let ((stack-trace-on-error t)) + ;; we activate only if all before-hooks return non nil + (when (run-hook-with-args-until-failure 'ecb-before-activate-hook) + + ;; temporary changing some emacs-vars + (when (< max-specpdl-size 3000) + (ecb-modify-emacs-variable 'max-specpdl-size 'store 3000)) + (when (< max-lisp-eval-depth 1000) + (ecb-modify-emacs-variable 'max-lisp-eval-depth 'store 1000)) + (when (and ecb-running-xemacs + (boundp 'progress-feedback-use-echo-area)) + (ecb-modify-emacs-variable 'progress-feedback-use-echo-area 'store t)) - (condition-case err-obj - (progn - ;; checking the requirements - (ecb-check-requirements) - - ;; initialize the navigate-library - (ecb-nav-initialize) - - ;; enable basic advices (we need the custom-save-all advice - ;; already here! Maybe it would be better to remove this advice - ;; from the basic-advices and add it to upgrade-advices.....) - (ecb-enable-advices ecb-basic-adviced-functions) - - ;; maybe we must upgrade some not anymore compatible or even renamed - ;; options - (when (and ecb-auto-compatibility-check - (not ecb-upgrade-check-done)) - (ecb-check-not-compatible-options) - (ecb-upgrade-not-compatible-options) - (ecb-upgrade-renamed-options) - (setq ecb-upgrade-check-done t)) - - ;; first initialize the whole layout-engine - (ecb-initialize-layout) + (condition-case err-obj + (progn + ;; checking the requirements + (ecb-check-requirements) - ;; clear the tag-tree-cache, the files-subdir-cache, the - ;; sources-cache and the history-filter. - (when ecb-clear-caches-before-activate - (ecb-clear-tag-tree-cache) - (ecb-clear-files-and-subdirs-cache) - (ecb-clear-directory-empty-cache) - (ecb-sources-cache-clear) - (ecb-reset-history-filter)) + ;; initialize the navigate-library + (ecb-nav-initialize) + + ;; enable basic advices (we need the custom-save-all advice + ;; already here! Maybe it would be better to remove this advice + ;; from the basic-advices and add it to upgrade-advices.....) + (ecb-enable-advices ecb-basic-adviced-functions) + + ;; maybe we must upgrade some not anymore compatible or even renamed + ;; options + (when (and ecb-auto-compatibility-check + (not ecb-upgrade-check-done)) + (ecb-check-not-compatible-options) + (ecb-upgrade-not-compatible-options) + (ecb-upgrade-renamed-options) + (setq ecb-upgrade-check-done t)) + + ;; first initialize the whole layout-engine + (ecb-initialize-layout) - ;; initialize internal vars - (ecb-initialize-internal-vars) + ;; initialize internals + (ecb-initialize-all-internals (not ecb-clear-caches-before-activate)) - ;; enable permanent advices - these advices will never being - ;; deactivated after first activation of ECB unless - ;; `ecb-split-edit-window-after-start' is not 'before-activation - ;; (see `ecb-deactivate-internal') - (ecb-enable-advices ecb-permanent-adviced-functions) + ;; enable permanent advices - these advices will never being + ;; deactivated after first activation of ECB unless + ;; `ecb-split-edit-window-after-start' is not 'before-activation + ;; (see `ecb-deactivate-internal') + (ecb-enable-advices ecb-permanent-adviced-functions) - ;; enable advices for not supported window-managers - (ecb-enable-advices ecb-winman-not-supported-function-advices) + ;; enable advices for not supported window-managers + (ecb-enable-advices ecb-winman-not-supported-function-advices) - ;; enable advices for the compatibility with other packages - (ecb-enable-advices ecb-compatibility-advices) + ;; enable advices for the compatibility with other packages + (ecb-enable-advices ecb-compatibility-advices) - ;; set the ecb-frame - (let ((old-ecb-frame ecb-frame)) - (if ecb-new-ecb-frame - (progn - (run-hooks 'ecb-activate-before-new-frame-created-hook) - (setq ecb-frame (make-frame)) - (put 'ecb-frame 'ecb-new-frame-created t)) - (setq ecb-frame (selected-frame)) - (put 'ecb-frame 'ecb-new-frame-created nil)) - ;; If ECB is acivated in a frame unequal to that frame which was - ;; the ecb-frame at last deactivation then we initialize the - ;; `ecb-edit-area-creators'. - (if (not (equal ecb-frame old-ecb-frame)) - (ecb-edit-area-creators-init))) - (raise-frame ecb-frame) - (select-frame ecb-frame) + ;; set the ecb-frame + (let ((old-ecb-frame ecb-frame)) + (if ecb-new-ecb-frame + (progn + (run-hooks 'ecb-activate-before-new-frame-created-hook) + (setq ecb-frame (make-frame)) + (put 'ecb-frame 'ecb-new-frame-created t)) + (setq ecb-frame (selected-frame)) + (put 'ecb-frame 'ecb-new-frame-created nil)) + ;; If ECB is acivated in a frame unequal to that frame which was + ;; the ecb-frame at last deactivation then we initialize the + ;; `ecb-edit-area-creators'. + (if (not (equal ecb-frame old-ecb-frame)) + (ecb-edit-area-creators-init))) + (raise-frame ecb-frame) + (select-frame ecb-frame) - (ecb-enable-own-temp-buffer-show-function t) + (ecb-enable-own-temp-buffer-show-function t) - ;; now we can activate ECB - (let ((curr-buffer-list (mapcar (lambda (buff) - (buffer-name buff)) - (buffer-list)))) - ;; create all the ECB-buffers if they don´t already exist - (unless (member ecb-directories-buffer-name curr-buffer-list) - (ecb-create-directories-tree-buffer)) + ;; now we can activate ECB + (let ((curr-buffer-list (mapcar (lambda (buff) + (buffer-name buff)) + (buffer-list)))) + ;; create all the ECB-buffers if they don´t already exist + (unless (member ecb-directories-buffer-name curr-buffer-list) + (ecb-create-directories-tree-buffer)) - (unless (member ecb-sources-buffer-name curr-buffer-list) - (ecb-create-sources-tree-buffer)) + (unless (member ecb-sources-buffer-name curr-buffer-list) + (ecb-create-sources-tree-buffer)) - (unless (member ecb-methods-buffer-name curr-buffer-list) - (ecb-create-methods-tree-buffer)) + (unless (member ecb-methods-buffer-name curr-buffer-list) + (ecb-create-methods-tree-buffer)) - (unless (member ecb-history-buffer-name curr-buffer-list) - (ecb-create-history-tree-buffer))) + (unless (member ecb-history-buffer-name curr-buffer-list) + (ecb-create-history-tree-buffer))) - ;; Now store all tree-buffer-names used by ECB ECB must not use - ;; the variable `tree-buffers' but must always refer to - ;; `ecb-tree-buffers'!! - (setq ecb-tree-buffers (list ecb-directories-buffer-name - ecb-sources-buffer-name - ecb-methods-buffer-name - ecb-history-buffer-name)) - - ;; activate the eshell-integration - does not load eshell but prepares - ;; ECB to run eshell right - if loaded and activated - (ecb-eshell-activate-integration) + ;; Now store all tree-buffer-names used by ECB ECB must not use + ;; the variable `tree-buffers' but must always refer to + ;; `ecb-tree-buffers'!! + (setq ecb-tree-buffers (list ecb-directories-buffer-name + ecb-sources-buffer-name + ecb-methods-buffer-name + ecb-history-buffer-name)) + + ;; activate the eshell-integration - does not load eshell but prepares + ;; ECB to run eshell right - if loaded and activated + (ecb-eshell-activate-integration) - ;; we need some hooks - (add-hook (ecb--semantic-after-partial-cache-change-hook) - 'ecb-update-after-partial-reparse t) - (add-hook (ecb--semantic-after-toplevel-cache-change-hook) - 'ecb-rebuild-methods-buffer-with-tagcache t) - (ecb-activate-ecb-autocontrol-functions ecb-highlight-tag-with-point-delay - 'ecb-tag-sync) - (ecb-activate-ecb-autocontrol-functions ecb-window-sync-delay - 'ecb-window-sync-function) - (ecb-activate-ecb-autocontrol-functions ecb-compilation-update-idle-time - 'ecb-compilation-buffer-list-changed-p) - (ecb-activate-ecb-autocontrol-functions 'post - 'ecb-layout-post-command-hook) - (ecb-activate-ecb-autocontrol-functions 'pre - 'ecb-layout-pre-command-hook) - (ecb-activate-ecb-autocontrol-functions 0.25 - 'ecb-repair-only-ecb-window-layout) - (add-hook 'after-save-hook 'ecb-update-methods-after-saving) - (add-hook 'kill-buffer-hook 'ecb-kill-buffer-hook) - - (add-hook 'find-file-hooks 'ecb-find-file-hook) - - ;; after adding all idle-timers and post- and pre-command-hooks we - ;; activate the monitoring - (ecb-activate-ecb-autocontrol-functions 1 'ecb-monitor-autocontrol-functions) - - ;; running the compilation-buffer update first time - (ecb-compilation-buffer-list-init) + ;; we need some hooks + (add-hook (ecb--semantic-after-partial-cache-change-hook) + 'ecb-update-after-partial-reparse t) + (add-hook (ecb--semantic-after-toplevel-cache-change-hook) + 'ecb-rebuild-methods-buffer-with-tagcache t) + (ecb-activate-ecb-autocontrol-functions ecb-highlight-tag-with-point-delay + 'ecb-tag-sync) + (ecb-activate-ecb-autocontrol-functions ecb-window-sync-delay + 'ecb-window-sync-function) + (ecb-activate-ecb-autocontrol-functions ecb-compilation-update-idle-time + 'ecb-compilation-buffer-list-changed-p) + (ecb-activate-ecb-autocontrol-functions 'post + 'ecb-layout-post-command-hook) + (ecb-activate-ecb-autocontrol-functions 'pre + 'ecb-layout-pre-command-hook) + (ecb-activate-ecb-autocontrol-functions 0.5 + 'ecb-repair-only-ecb-window-layout) + (add-hook 'after-save-hook 'ecb-update-methods-after-saving) + (add-hook 'kill-buffer-hook 'ecb-kill-buffer-hook) + + (add-hook 'find-file-hooks 'ecb-find-file-hook) + + ;; after adding all idle-timers and post- and pre-command-hooks we + ;; activate the monitoring + (ecb-activate-ecb-autocontrol-functions 1 'ecb-monitor-autocontrol-functions) + + ;; We activate the stealthy update mechanism + (ecb-stealthy-function-state-init) + (ecb-activate-ecb-autocontrol-functions ecb-stealthy-tasks-delay + 'ecb-stealthy-updates) + + ;; running the compilation-buffer update first time + (ecb-compilation-buffer-list-init) - ;; ediff-stuff; we operate here only with symbols to avoid bytecompiler - ;; warnings - (if (boundp 'ediff-quit-hook) - (put 'ediff-quit-hook 'ecb-ediff-quit-hook-value - ediff-quit-hook)) - (add-hook 'ediff-quit-hook 'ediff-cleanup-mess) - (add-hook 'ediff-quit-hook 'ecb-ediff-quit-hook t) - ;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: suspending ediff and - ;; especially reactivating does currently not really work good... - ;; (add-hook 'ediff-suspend-hook 'ecb-ediff-quit-hook t) - (add-hook 'ediff-before-setup-hook - 'ecb-ediff-before-setup-hook) + ;; ediff-stuff; we operate here only with symbols to avoid bytecompiler + ;; warnings + (if (boundp 'ediff-quit-hook) + (put 'ediff-quit-hook 'ecb-ediff-quit-hook-value + ediff-quit-hook)) + (add-hook 'ediff-quit-hook 'ediff-cleanup-mess) + (add-hook 'ediff-quit-hook 'ecb-ediff-quit-hook t) + ;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: suspending ediff and + ;; especially reactivating does currently not really work well... + ;; (add-hook 'ediff-suspend-hook 'ecb-ediff-quit-hook t) + (add-hook 'ediff-before-setup-hook + 'ecb-ediff-before-setup-hook) + + ;; enabling the VC-support + (ecb-vc-enable-internals 1) - ;; menus - dealing with the menu for XEmacs is really a pain... - (when ecb-running-xemacs - (let ((dummy-buf-name " *dummytogetglobalmap*")) + ;; menus - dealing with the menu for XEmacs is really a pain... + (when ecb-running-xemacs + (let ((dummy-buf-name " *dummytogetglobalmap*")) + (save-excursion + (set-buffer (get-buffer-create dummy-buf-name)) + (add-submenu nil ecb-minor-menu) + (kill-buffer dummy-buf-name))) (save-excursion - (set-buffer (get-buffer-create dummy-buf-name)) - (add-submenu nil ecb-minor-menu) - (kill-buffer dummy-buf-name))) - (save-excursion - (dolist (buf (buffer-list)) - (set-buffer buf) - (if (null (car (find-menu-item current-menubar - (list ecb-menu-name)))) - (add-submenu nil ecb-minor-menu))))) - - (add-hook (if ecb-running-xemacs - 'activate-menubar-hook - 'menu-bar-update-hook) - 'ecb-compilation-update-menu) - - ;; modeline for xemacs - (if ecb-running-xemacs - (ecb-activate-xemacs-modeline-menu 1)) - ) - (error - (ecb-clean-up-after-activation-failure - "Errors during the basic setup of ECB." err-obj))) - - (condition-case err-obj - ;; run personal hooks before drawing the layout - (run-hooks 'ecb-activate-before-layout-draw-hook) - (error - (ecb-clean-up-after-activation-failure - "Errors during the hooks of ecb-activate-before-layout-draw-hook." - err-obj))) + (dolist (buf (buffer-list)) + (set-buffer buf) + (if (null (car (find-menu-item current-menubar + (list ecb-menu-name)))) + (add-submenu nil ecb-minor-menu))))) + + (add-hook (if ecb-running-xemacs + 'activate-menubar-hook + 'menu-bar-update-hook) + 'ecb-compilation-update-menu) + + ;; modeline for xemacs + (if ecb-running-xemacs + (ecb-activate-xemacs-modeline-menu 1)) + ) + (error + ;; (backtrace) + (ecb-clean-up-after-activation-failure + "Errors during the basic setup of ECB." err-obj))) + + (condition-case err-obj + ;; run personal hooks before drawing the layout + (run-hooks 'ecb-activate-before-layout-draw-hook) + (error + (ecb-clean-up-after-activation-failure + "Errors during the hooks of ecb-activate-before-layout-draw-hook." + err-obj))) - (setq ecb-minor-mode t) + (setq ecb-minor-mode t) - ;; now we draw the screen-layout of ECB. - (condition-case err-obj - ;; now we draw the layout chosen in `ecb-layout'. This function - ;; activates at its end also the adviced functions if necessary! - ;; Here the directories- and history-buffer will be updated. - (let ((ecb-redraw-layout-quickly nil) - (use-last-win-conf (and ecb-last-window-config-before-deactivation - (equal ecb-split-edit-window-after-start - 'before-deactivation) - (not (ecb-window-configuration-invalidp - ecb-last-window-config-before-deactivation))))) - (ecb-enable-temp-buffer-shrink-to-fit ecb-compile-window-height) - (if use-last-win-conf - (setq ecb-edit-area-creators - (nth 4 ecb-last-window-config-before-deactivation))) - (ecb-redraw-layout-full 'no-buffer-sync - nil - (if use-last-win-conf - (nth 6 ecb-last-window-config-before-deactivation)) - (if use-last-win-conf - (nth 5 ecb-last-window-config-before-deactivation) - nil)) - ;; if there was no compile-window before deactivation then we have - ;; to hide the compile-window after activation - (if (and use-last-win-conf - (null (nth 2 ecb-last-window-config-before-deactivation))) - (ecb-toggle-compile-window -1)) - - (when (member ecb-split-edit-window-after-start - '(vertical horizontal nil)) - (ecb-with-adviced-functions - (delete-other-windows) - (cond ((equal ecb-split-edit-window-after-start 'horizontal) - (split-window-horizontally)) - ((equal ecb-split-edit-window-after-start 'vertical) - (split-window-vertically))))) + ;; now we draw the screen-layout of ECB. + (condition-case err-obj + ;; now we draw the layout chosen in `ecb-layout'. This function + ;; activates at its end also the adviced functions if necessary! + ;; Here the directories- and history-buffer will be updated. + (let ((ecb-redraw-layout-quickly nil) + (use-last-win-conf (and ecb-last-window-config-before-deactivation + (equal ecb-split-edit-window-after-start + 'before-deactivation) + (not (ecb-window-configuration-invalidp + ecb-last-window-config-before-deactivation))))) + (ecb-enable-temp-buffer-shrink-to-fit ecb-compile-window-height) + (if use-last-win-conf + (setq ecb-edit-area-creators + (nth 4 ecb-last-window-config-before-deactivation))) + (ecb-redraw-layout-full 'no-buffer-sync + nil + (if use-last-win-conf + (nth 6 ecb-last-window-config-before-deactivation)) + (if use-last-win-conf + (nth 5 ecb-last-window-config-before-deactivation) + nil)) + ;; if there was no compile-window before deactivation then we have + ;; to hide the compile-window after activation + (if (and use-last-win-conf + (null (nth 2 ecb-last-window-config-before-deactivation))) + (ecb-toggle-compile-window -1)) + + (when (member ecb-split-edit-window-after-start + '(vertical horizontal nil)) + (ecb-with-adviced-functions + (delete-other-windows) + (cond ((equal ecb-split-edit-window-after-start 'horizontal) + (split-window-horizontally)) + ((equal ecb-split-edit-window-after-start 'vertical) + (split-window-vertically))))) - ;; now we synchronize all ECB-windows - (ecb-window-sync) + ;; now we synchronize all ECB-windows + (ecb-window-sync) - ;; now update all the ECB-buffer-modelines - (ecb-mode-line-format)) - (error - (ecb-clean-up-after-activation-failure - "Errors during the layout setup of ECB." err-obj))) - - (condition-case err-obj - (let ((edit-window (car (ecb-canonical-edit-windows-list)))) - (when (and ecb-display-default-dir-after-start - (null (buffer-file-name - (window-buffer edit-window)))) - (ecb-set-selected-directory - (ecb-fix-filename (save-excursion - (set-buffer (window-buffer edit-window)) - default-directory))))) - (error - (ecb-clean-up-after-activation-failure - "Errors during setting the default directory." err-obj))) - - (condition-case err-obj - ;; we run any personal hooks - (run-hooks 'ecb-activate-hook) - (error - (ecb-clean-up-after-activation-failure - "Errors during the hooks of ecb-activate-hook." err-obj))) - - (condition-case err-obj - ;; enable mouse-tracking for the ecb-tree-buffers; we do this after - ;; running the personal hooks because if a user put´s activation of - ;; follow-mouse.el (`turn-on-follow-mouse') in the - ;; `ecb-activate-hook' then our own ECB mouse-tracking must be - ;; activated later. If `turn-on-follow-mouse' would be activated - ;; after our own follow-mouse stuff, it would overwrite our - ;; mechanism and the show-node-name stuff would not work! - (if (ecb-show-any-node-info-by-mouse-moving-p) - (tree-buffer-activate-follow-mouse)) - (error - (ecb-clean-up-after-activation-failure - "Errors during the mouse-tracking activation." err-obj))) - - (setq ecb-minor-mode t) - (message "The ECB is now activated.") - - (condition-case err-obj - ;; now we display all `ecb-not-compatible-options' and - ;; `ecb-renamed-options' - (if ecb-auto-compatibility-check - (if (not (ecb-display-upgraded-options)) - (ecb-display-news-for-upgrade)) - (ecb-display-news-for-upgrade)) - (error - (ecb-clean-up-after-activation-failure - "Error during the compatibility-check of ECB." err-obj))) + ;; now update all the ECB-buffer-modelines + (ecb-mode-line-format)) + (error + (ecb-clean-up-after-activation-failure + "Errors during the layout setup of ECB." err-obj))) - ;; if we activate ECB first time then we display the node "First steps" of - ;; the online-manual - (ignore-errors - (when (null ecb-source-path) - (let ((ecb-show-help-format 'info)) - (ecb-show-help) - (Info-goto-node "First steps")))) + (condition-case err-obj + (let ((edit-window (car (ecb-canonical-edit-windows-list)))) + (when (and ecb-display-default-dir-after-start + (null (buffer-file-name + (window-buffer edit-window)))) + (ecb-set-selected-directory + (ecb-fix-filename (save-excursion + (set-buffer (window-buffer edit-window)) + default-directory))))) + (error + (ecb-clean-up-after-activation-failure + "Errors during setting the default directory." err-obj))) - ;; display tip of the day if `ecb-tip-of-the-day' is not nil - (ignore-errors - (ecb-show-tip-of-the-day)) + (condition-case err-obj + ;; we run any personal hooks + (run-hooks 'ecb-activate-hook) + (error + (ecb-clean-up-after-activation-failure + "Errors during the hooks of ecb-activate-hook." err-obj))) + + (condition-case err-obj + ;; enable mouse-tracking for the ecb-tree-buffers; we do this after + ;; running the personal hooks because if a user put´s activation of + ;; follow-mouse.el (`turn-on-follow-mouse') in the + ;; `ecb-activate-hook' then our own ECB mouse-tracking must be + ;; activated later. If `turn-on-follow-mouse' would be activated + ;; after our own follow-mouse stuff, it would overwrite our + ;; mechanism and the show-node-name stuff would not work! + (if (ecb-show-any-node-info-by-mouse-moving-p) + (tree-buffer-activate-follow-mouse)) + (error + (ecb-clean-up-after-activation-failure + "Errors during the mouse-tracking activation." err-obj))) + + (setq ecb-minor-mode t) + (message "The ECB is now activated.") + + (condition-case err-obj + ;; now we display all `ecb-not-compatible-options' and + ;; `ecb-renamed-options' + (if (and ecb-auto-compatibility-check + (or (ecb-not-compatible-or-renamed-options-detected) + (not (ecb-options-version=ecb-version-p)))) + ;; we must run this with an idle-times because otherwise these + ;; options are never displayed when Emacs is started with a + ;; file-argument and ECB is automatically activated. I this + ;; case the buffer of the file-argument would be displayed + ;; after the option-display and would so hide this buffer. + (ecb-run-with-idle-timer 0.25 nil 'ecb-display-upgraded-options) + (ecb-display-news-for-upgrade)) + (error + (ecb-clean-up-after-activation-failure + "Error during the compatibility-check of ECB." err-obj))) - (condition-case err-obj - ;;now take a snapshot of the current window configuration - (setq ecb-activated-window-configuration - (ecb-current-window-configuration)) - (error - (ecb-clean-up-after-activation-failure - "Errors during the snapshot of the windows-configuration." err-obj))) - ))) + ;; if we activate ECB first time then we display the node "First steps" of + ;; the online-manual + (ignore-errors + (when (null ecb-source-path) + (let ((ecb-show-help-format 'info)) + (ecb-show-help) + (Info-goto-node "First steps")))) + + ;; display tip of the day if `ecb-tip-of-the-day' is not nil + (ignore-errors + (ecb-show-tip-of-the-day)) + + (condition-case err-obj + ;;now take a snapshot of the current window configuration + (setq ecb-activated-window-configuration + (ecb-current-window-configuration)) + (error + (ecb-clean-up-after-activation-failure + "Errors during the snapshot of the windows-configuration." err-obj))) + )))) ;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: Should we add this function to ＠＠ -2855,6 +1983,9 ＠＠ (remove-hook 'ediff-before-setup-hook 'ecb-ediff-before-setup-hook) + ;; disabling the VC-support + (ecb-vc-enable-internals -1) + ;; menus - dealing with the menu for XEmacs is really a pain... (ignore-errors (when ecb-running-xemacs ＠＠ -2966,11 +2097,13 ＠＠ (setq ecb-minor-mode nil) - ;; max-specpdl-size and max-lisp-eval-depth - (when ecb-max-specpdl-size-old - (setq max-specpdl-size ecb-max-specpdl-size-old)) - (when ecb-max-lisp-eval-depth-old - (setq max-lisp-eval-depth ecb-max-lisp-eval-depth-old)))) + ;; restoring the value of temporary modified vars + (ecb-modify-emacs-variable 'max-specpdl-size 'restore) + (ecb-modify-emacs-variable 'max-lisp-eval-depth 'restore) + (when (and ecb-running-xemacs + (boundp 'progress-feedback-use-echo-area)) + (ecb-modify-emacs-variable 'progress-feedback-use-echo-area 'restore)))) + (if (null ecb-minor-mode) (message "The ECB is now deactivated.")) ＠＠ -2996,12 +2129,6 ＠＠ ecb-minor-mode) -;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: XXX: --> common-browser -(tree-buffer-defpopup-command ecb-maximize-ecb-window-menu-wrapper - "Expand the current ECB-window from popup-menu." - (ecb-display-one-ecb-buffer (buffer-name (current-buffer)))) - - ;; ECB byte-compilation (defun ecb-compile-file-if-necessary (file &optional force) ＠＠ -3099,22 +2226,151 ＠＠ (add-hook 'emacs-startup-hook 'ecb-auto-activate-hook) -(defun ecb-run-from-menubar () - "Activate ECB from the Tools-menu. See `ecb-activate'." - (interactive) - (ecb-activate)) - -(progn - (require 'easymenu) - (easy-menu-add-item nil - '("tools") - (ecb-menu-item - [ "Start Code Browser (ECB)" - ecb-run-from-menubar -:active t -:help "Start the Emacs Code Browser." - ]))) - +(silentcomp-defvar menu-bar-tools-menu) +(condition-case oops + (progn + (require 'easymenu) + (easy-menu-add-item (if ecb-running-xemacs nil menu-bar-tools-menu) + (if ecb-running-xemacs '("tools") nil) + (ecb-menu-item + [ "Start Code Browser (ECB)" + ecb-activate +:active t +:help "Start the Emacs Code Browser." + ])) + ) + (error + (ecb-warning "Not critical error during adding menu-entry to Tools-menu (error-type: %S, error-data: %S)" + (car oops) (cdr oops)))) + + +;; some goodies for editing the ecb-elisp-code + +;; parsing of our ecb-macros + +(eval-after-load "semantic-el" + (condition-case oops + (when (fboundp 'semantic-elisp-setup-form-parser) + ;; defecb-multicache + (semantic-elisp-reuse-form-parser defvar defecb-multicache) + ;; defecb-stealthy and tree-buffer-defpopup-command + (semantic-elisp-setup-form-parser + (lambda (read-lobject start end) + (semantic-tag-new-function + (symbol-name (nth 1 read-lobject)) nil nil +:user-visible-flag nil +:documentation (semantic-elisp-do-doc (nth 2 read-lobject)))) + defecb-stealthy + tree-buffer-defpopup-command) + ;; ecb-layout-define + (semantic-elisp-setup-form-parser + (lambda (read-lobject start end) + (semantic-tag-new-function + (nth 1 read-lobject) nil + (semantic-elisp-desymbolify (list (nth 2 read-lobject))) +:user-visible-flag nil +:documentation (semantic-elisp-do-doc (nth 3 read-lobject)))) + ecb-layout-define) + ;; when-ecb-running-... macros + (semantic-elisp-reuse-form-parser eval-and-compile + when-ecb-running-xemacs + when-ecb-running-emacs-21 + when-ecb-running-emacs-20 + when-ecb-running-emacs) + ) + (error + (ecb-warning "Not critical error during supporting parsing the ecb-macros: (error-type: %S, error-data: %S)" + (car oops) (cdr oops))))) + +;; highlighting of some ecb-keywords +(condition-case oops + (progn + (defconst ecb-font-lock-keywords + (eval-when-compile + (let* ( + ;; Function declarations and exec-with-macros + (variable-defs '( + "defecb-multicache" + )) + (function-defs '( + "defecb-stealthy" + )) + (plain-keywords '( + "ecb-exec-in-history-window" + "ecb-exec-in-directories-window" + "ecb-exec-in-sources-window" + "ecb-exec-in-methods-window" + "ecb-do-with-unfixed-ecb-buffers" + "ecb-with-original-functions" + "ecb-with-adviced-functions" + "ecb-with-some-adviced-functions" + "ecb-with-original-permanent-functions" + "ecb-with-dedicated-window" + "ecb-with-original-basic-functions" + "ecb-with-ecb-advice" + "ecb-with-readonly-buffer" + "ecb-do-if-buffer-visible-in-ecb-frame" + "ecb-layout-define" + "when-ecb-running-xemacs" + "when-ecb-running-emacs-21" + "when-ecb-running-emacs-20" + "when-ecb-running-emacs" + )) + (v-regexp (regexp-opt variable-defs t)) + (f-regexp (regexp-opt function-defs t)) + (k-regexp (regexp-opt plain-keywords t)) + ;; Regexp depths + (v-depth (regexp-opt-depth v-regexp)) + (f-depth (regexp-opt-depth f-regexp)) + (k-depth (regexp-opt-depth k-regexp)) + (full (concat + ;; Declarative things: the whole parenthesis expr has always + ;; number 1 ==> The paren-expression number for a keyword + ;; contained in (append variable-defs function-defs + ;; plain-keywords) is always 1 + "(\\(" v-regexp "\\|" f-regexp "\\|" k-regexp "\\)" + ;; Whitespaces & name: The parenthesis expr for name has + ;; always the number + ;; (+ 1 -- the whole paren-expr for the declarative + ;; things + ;; v-depth -- all paren-expressions of the variable-defs + ;; f-depth -- all paren-expressions of the function-defs + ;; k-depth -- all paren-expressions of the plain keywords + ;; 1 -- The \\(\\sw+\\)?: This is the name in case + ;; of a variable- or function-def + ;; ) + ;; So variable, functions and keywords have the following + ;; numbers: + ;; - variable-match: Always 2 (The whole surrounding + ;; paren-expr + the surrounding paren-expr defined with + ;; regexp-opt for the variable-defs + ;; - function-match: 1 (for the whole surrounding + ;; paren-expr) + v-depth (to jump over the paren-expr of + ;; the variable-defs + 1 (the surrounding paren-expr + ;; defined with regexp-opt for the function-defs + "\\>[ \t]*\\(\\sw+\\)?" + )) + ) + `((,full + (1 font-lock-keyword-face) + (,(+ 1 v-depth f-depth k-depth 1) ;; see explanation above + (cond ((match-beginning 2) ;; see explanation above + font-lock-variable-name-face) + ((match-beginning ,(+ 1 v-depth 1)) ;; see explanation above + font-lock-function-name-face) + (t nil)) + nil t))) + )) + "Highlighted ecb keywords.") + + (when (fboundp 'font-lock-add-keywords) + (font-lock-add-keywords 'emacs-lisp-mode + ecb-font-lock-keywords) + )) + (error + (ecb-warning "Not critical error during supporting fontifying the ecb-macros: (error-type: %S, error-data: %S)" + (car oops) (cdr oops)))) + ;; Klaus Berndl <klaus.berndl(a)sdm.de&gt;: Cause of the magic autostart stuff of ;; the advice-package we must disable at load-time all these advices!! ＠＠ -3124,17 +2380,14 ＠＠ (ecb-disable-advices ecb-speedbar-adviced-functions) (ecb-disable-advices ecb-eshell-adviced-functions) (ecb-disable-advices ecb-permanent-adviced-functions) +(ecb-disable-advices ecb-vc-advices) (ecb-activate-adviced-functions nil) (ecb-enable-ecb-advice 'walk-windows 'around -1) (ecb-enable-ecb-advice 'one-window-p 'around -1) -;; clearing all caches at load-time -(ecb-clear-tag-tree-cache) -(ecb-clear-files-and-subdirs-cache) -(ecb-clear-directory-empty-cache) -(ecb-sources-cache-clear) -(ecb-reset-history-filter) - +;; init the method- and file-browser at load-time +(ecb-file-browser-initialize) +(ecb-method-browser-initialize) (silentcomp-provide 'ecb) Index: ecb.texi =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/ecb.texi,v retrieving revision 1.18 diff -u -r1.18 ecb.texi --- ecb.texi 31 Aug 2004 16:00:37 -0000 1.18 +++ ecb.texi 1 Dec 2004 15:59:50 -0000 ＠＠ -26,7 +26,7 ＠＠ ＠c GNU Emacs; see the file COPYING. If not, write to the Free Software ＠c Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -＠c $Id: ecb.texi,v 1.18 2004/08/31 16:00:37 berndl Exp $ +＠c $Id: ecb.texi,v 1.196 2004/11/30 18:41:39 berndl Exp $ ＠setfilename ecb.info ＠＠ -49,7 +49,7 ＠＠ ＠c edit the Makefile to change the version number. mechanism stolen ＠c from Tramp ＠macro ecbver{} -2.27 +2.30.1 ＠end macro ＠＠ -220,6 +220,7 ＠＠ * Maximizing the ECB windows:: Maximizing the ECB-windows * Back/forward navigation:: Back- and forward navigation like a browser * ECB-window synchronizing:: Auto./manual synchronizing the ECB-windows +* Stealthy background tasks:: Stealthy background-tasks of ECB * Interactive ECB commands:: All interactive user-commands of ECB Working with the keyboard in the ECB-windows ＠＠ -282,6 +283,7 ＠＠ * ecb-non-semantic:: Customizing parsing non-semantic sources * ecb-winman:: Customizing window-manager support * ecb-mode-line:: Customizing the tree-buffer-modelines +* ecb-version-control:: Customizing the version-control-support Upgrading and downloading packages ＠＠ -302,6 +304,8 ＠＠ * Integrating speedbar:: Integrating speedbar in the ECB-frame * Optimize scrolling:: Optimize scrolling in the edit-window * Large directories:: Working with large directories +* Remote directories:: Working with remote directories +* Version-control support:: Supporting Version control systems * Using eshell:: Optimal using of eshell in ECB * Grepping directories:: Grepping directories with ECB * Working with JDEE:: Working best with ECB and JDEE ＠＠ -312,6 +316,14 ＠＠ * Tree-buffer styles:: Displaying the trees with different styles * Using semanticdb:: Using semanticdb for going to external nodes +Supporting Version control systems + +* Identifying backends:: How ECB identifies the VC-backend of a dir +* Checking the state:: How ECB checks the VC-state of a file +* Remote repositories:: What you should now about this +* Refreshing the VC-state:: How to refresh when state changed outside +* Adding new backends:: Necessary steps for adding new backends + Displaying the trees of the ECB-windows with different styles * Style basics:: Basic knowledge about the styles ＠＠ -1094,6 +1106,7 ＠＠ * Maximizing the ECB windows:: Maximizing the ECB-windows * Back/forward navigation:: Back- and forward navigation like a browser * ECB-window synchronizing:: Auto./manual synchronizing the ECB-windows +* Stealthy background tasks:: Stealthy background-tasks of ECB * Interactive ECB commands:: All interactive user-commands of ECB ＠end menu ＠＠ -2151,14 +2164,14 ＠＠ ＠node Expanding, Customizing the display, Visiting tags, The Methods buffer ＠subsection Explicit and automatic expanding of the ECB-methods-buffer -＠subsubsection Explicit expanding to a certain expanding level +＠subsubsection Explicit expanding all nodes to a certain expansion level With the command ＠code{ecb-expand-methods-nodes} (bound to ＠kbd{C-c . x}) you can get a fast overlook of the contents of the source-buffer, -because this command allows precisely expanding tags with a certain -indentation-level. So you can either expand no tags (or with other -words collapse all tags) or expand all tags so see the contents of -a buffer at one glance. Or you can expand exactly that tags of a +because this command allows precisely expanding all tags with a +certain indentation-level. So you can either expand no tags (or with +other words collapse all tags) or expand all tags so see the contents +of a buffer at one glance. Or you can expand exactly that tags of a certain indentation level. Which node-types are expanded (rsp. collapsed) by this command ＠＠ -2168,6 +2181,52 ＠＠ all node-types are expanded/collapsed, i.e. the two options above takes no effect for these files. +＠subsubsection Explicit expanding of the current node to a certain level + +With the popup-menu of the methods-buffer an even more precise +expansion is possible because it allows not only expanding all tags +(see above) but offers in addition expanding only the current-node +(for which the menu was activated) to an exact level of expansion: + +All menu-entries are label with an expansion-``level'' whereas level +specifies precisely which level of nodes should be expanded. level +means the indentation-level of the NODE itself and its (recursive) +subnodes relative to the NODE itself. + +So a level value X means that all (sub)nodes with an indentation-level +<= X relative to NODE are expanded and all other are collapsed. + +Examples: + +＠itemize ＠minus +＠item Expand this node to level 0: +Expand only the NODE itself because it is the only node which has +indentation 0 to itself. All deeper indented nodes will be collapsed. +This is also the important difference between using this menu compared +to clicking onto the expand-symbol of the node: The latter one expands +the NODE to that expansion-state it has before the last collapsing (so +when deeper nodes has been expanded they will be expanded now to). The +former one expands exactly(!) to level 0, means expand only the node +itself and collapse all(!) its subnodes recursively(!). + +＠item Expand this node to level 1: +Expand the NODE itself and all of its direct subnodes - because only +the direct subnodes of NODE have indentation-level 1 relativ to NODE. +All deeper nodes will be collapsed. + +＠item Collapse this node completely: +Collapses the current node recursively, means collapse not only the +node itself but also its subnodes, the subnodes of the subnodes and so +on! This is very differnt from clicking onto the collapse symbol +because this action only collapses the node itself but preserves the +expansion-state of all its subnodes! + +＠end itemize + +Expanding the current node with the popup-menu ignores the settings in +the options ＠code{ecb-methods-nodes-expand-spec} and +＠code{ecb-methods-nodes-collapse-spec}! + ＠subsubsection Automatic expansion ot tags after buffer-parsing With the option ＠code{ecb-show-tags} you tell ECB how to display tags ＠＠ -3566,7 +3625,7 ＠＠ Now you will edit at the same place in the function. ＠end enumerate -＠node ECB-window synchronizing, Interactive ECB commands, Back/forward navigation, Usage of ECB +＠node ECB-window synchronizing, Stealthy background tasks, Back/forward navigation, Usage of ECB ＠section Synchronization of the ECB-windows Per default ECB synchronizes automatically the contents of the ＠＠ -3634,7 +3693,86 ＠＠ do a manually synchronization if the automatic one is switched off or if you just want to do this! -＠node Interactive ECB commands, , ECB-window synchronizing, Usage of ECB +＠node Stealthy background tasks, Interactive ECB commands, ECB-window synchronizing, Usage of ECB +＠section Stealthy background-tasks of ECB + +ECB performs some tasks stealthy in the background and also +interruptable by the user because these tasks can be time-consuming +and could otherwise block ECB. Currently the following tasks are +performed stealthy and in the background by ECB: + +＠table ＠asis +＠item Prescann directories for emptyness +Prescann directories and display them as empty or not-empty in the +directories-buffer. See the documentation of the option +＠code{ecb-prescan-directories-for-emptyness} for a description. + +＠item File is read only +Check if sourcefile-items of the directories- or sources-buffer are +read-only or not. See documentation of the option +＠code{ecb-sources-perform-read-only-check}. + +＠item Version-control-state +Checks the version-control-state of files in directories which are +managed by a VC-backend. See the option ＠code{ecb-vc-enable-support}. + +＠end table + +All of these tasks (e.g. checking if a directory is empty or not) +perform a certain action for all directories or sources displayed in +the current visible tree-buffers of ECB. Normally there should be no +annoying delay for the user because each of these tasks will be only +performed when Emacs is idle and will be interrupted immediatelly when +a user hits a key or clicks the mouse but especially for +remote-directories one single action (e.g. checking if a certain +directory is empty or checking the VC-state of a sourcefile in such a +remote directory) can be very time-consuming and such a single action +is not interruptable (an interrupt can only occur between the +single-actions for two directories or sources) For a further +discussion how to deal best with remote directories see ＠ref{Remote +directories}.! + +ECB offers for all stealthy tasks three steps of activation: +＠itemize ＠bullet +＠item ＠code{t}: +Switch on this feature. + +＠item ＠code{unless-remote}: +Switch on this feature but not for remote directories. The term +``remote'' means here directories which are used via tramp, ange-ftp +or efs. So mounted directories are counted not as remote directories +here even if such a directory is maybe hosted on a remote machine. But +normally only directories in a LAN are mounted so there should be no +performance-problems with such mounted directories. + +＠item ＠code{nil}: +Switch off this feature completely. +＠end itemize + +In combination with the option ＠code{ecb-stealthy-tasks-delay} these +three choices allows already adapting the stealthy tasks to most +needs. But to offer finest granularity for which directories a certain +stealthy task should be switched on and for which not ECB offers for +every stealthy task an additional option which allows a finer +adjustment: + +＠itemize ＠bullet +＠item Prescanning directories for emptyness: +＠code{ecb-prescan-directories-exclude-regexps}. + +＠item Checking the read-only-state of a sourcefile: +＠code{ecb-read-only-check-exclude-regexps} + +＠item Checking the VC-state of sourcefiles: +＠code{ecb-vc-directory-exclude-regexps} +＠end itemize + +These options take only effect when the related task is not completely +switched off but then they allow excluding certain directories (or the +sources of directories) from being processed by a certain stealthy +task. + +＠node Interactive ECB commands, ,Stealthy background tasks, Usage of ECB ＠section Interactive ECB commands ＠noindent ＠＠ -3741,9 +3879,27 ＠＠ ＠end deffn ＠deffn Command display-upgraded-options -Display a message-buffer which options have been upgraded or reset. +Display a information-buffer which options have been upgraded or +reset. Offers two buttons where the user can decide if the upgraded +options should also being saved by ECB for future settings or if the +buffer should be killed. + +If saving is possible this command display where the options would be +saved. It is that file Emacs uses to save customize-settings. This +file is ``computed'' from the settings in ＠code{custom-file} and +＠code{user-init-file} (see the documentation of these variables). + +ECB automatically makes a backup-file of that file which will be +modified by storing the upgraded rsp. renamed ECB-options. This backup +file gets a unique name by adding a suffix ``.before_ecb_<version>'' +to the name of the modified file. If such a file already exists ECB +adds a unique number to the end of the filename to make the filename +unique. This is a safety mechanism if something fails during storing +the upgraded options, so you never lose the contents of your +customization-file! ＠end deffn + ＠deffn Command download-ecb Download ECB from the ECB-website and install it. For this the option ＠code{ecb-download-url} must be set correct, whereas the default value of ＠＠ -4712,6 +4868,7 ＠＠ * ecb-non-semantic:: Customizing parsing non-semantic sources * ecb-winman:: Customizing window-manager support * ecb-mode-line:: Customizing the tree-buffer-modelines +* ecb-version-control:: Customizing the version-control-support ＠end menu ＠node ecb-general, ecb-tree-buffer, Customizable options, Customizable options ＠＠ -5046,6 +5203,34 ＠＠ ecb-frame but this can also be a newly created frame or any other frame. ＠end defopt +＠defopt stealthy-tasks-delay +Time Emacs must be idle before ECB runs its stealthy tasks. Currently +ECB performes the following stealthy tasks: + +＠table ＠asis +＠item Prescann directories for emptyness +Prescann directories and display them as empty or not-empty in the +directories-buffer. See the documentation of the option +＠code{ecb-prescan-directories-for-emptyness} for a description. + +＠item File is read only +Check if sourcefile-items of the directories- or sources-buffer are +read-only or not. See documentation of the option +＠code{ecb-sources-perform-read-only-check}. + +＠item Version-control-state +Checks the version-control-state of files in directories which are +managed by a VC-backend. See the option ＠code{ecb-vc-enable-support}. + +＠end table + +Here the interval is defined ECB has to be idle before starting with +these stealthy tasks. It can be a floating-point value in seconds. The +value can also be changed during running ECB. +＠end defopt + + + ＠defopt tip-of-the-day Show tip of the day at start time of ECB. ＠end defopt ＠＠ -5241,16 +5426,21 ＠＠ ＠end defopt ＠defopt tree-RET-selects-edit-window -In which tree-buffers RET should finally select an edit-window. If a -name of an ECB tree-buffer is contained in this list then hitting RET -in this tree-buffer selects as last action the right edit-window -otherwise only the right action is performed (opening a new source, -selecting a method etc.) but point stays in the tree-buffer. +In which tree-buffers RET should finally select an edit-window. If one +of the symbols ＠code{ecb-directories-buffer-name}, +＠code{ecb-sources-buffer-name}, ＠code{ecb-methods-buffer-name} or +＠code{ecb-history-buffer-name} is contained in this list then hitting +RET in the associated tree-buffer selects as last action the right +edit-window otherwise only the right action is performed (opening a +new source, selecting a method etc.) but point stays in the +tree-buffer. A special remark for the ＠code{ecb-directories-buffer-name}: Of course -here the edit-window is only selected if -＠code{ecb-show-sources-in-directories-buffer} is not nil (otherwise -this would not make any sense)! +here the edit-window is only selected if the name of the current +layout is contained in ＠code{ecb-show-sources-in-directories-buffer} +or if the value of ＠code{ecb-show-sources-in-directories-buffer} is +'always and the hitted node represents a sourcefile (otherwise this +would not make any sense)! The setting in this option is only the default for each tree-buffer. With ＠code{ecb-toggle-RET-selects-edit-window} the behavior of RET can ＠＠ -5482,6 +5672,10 ＠＠ Should only the root-part (which means for Unix-like systems always '/' and for windows-like systems the drive) of the new file be added as source-path to ＠code{ecb-source-path} or the whole directory-part? +For remote-files (e.g. tramp, ange-ftp- or efs-files) the root-part is +the complete host-part + the root-dir at that host (example: +/berndl＠＠ecb.sourceforge.net:/ would be the root-part of +/berndl＠＠ecb.sourceforge.net:/tmp/test.txt). ＠item Should this path be added for future sessions too? ＠end enumerate ＠＠ -5507,16 +5701,40 ＠＠ ＠end itemize ＠end defopt +＠defopt after-directory-change-hook +Hook which run directly after the selected directory has changed. This +means not onyl after a click onto a directory in the directory-window +of ECB but it means this hook runs always when the current directory +changes regardless of the trigger of this change. So for example it +runs also when you just switches from one buffer to another via +＠code{switch-to-buffer} or ＠code{switch-to-buffer-other-window} and +the directory of these filebuffers is different but only when +auto-synchronizing of the ECB-windows is on (see +＠code{ecb-window-sync}). It runs not when switching between buffers +and the associated files reside in the same directory. + +Each function added to this hook will be called with two arguments: +The directory which was current _before_ the directory-change-trigger +and the directory which was now the current (i.e. after the trigger). + +Example: If you switch from a filebuffer ``~/.emacs'' to a filebuffer +``/tmp/test.txt'' then the functions of this hook will be called with +the two arguments ``~'' and ``/tmp''. +＠end defopt + + + ＠defopt cache-directory-contents Cache contents of directories. This can be useful if ＠code{ecb-source-path} contains directories with many files and subdirs, especially if these directories are mounted -net-drives (``many'' means here something > 500, dependent of the speed -of the net-connection and the machine). For these directories -actualizing the sources- and/or directories- buffer of ECB (if -displayed in current layout!) can slow down dramatically so a caching -increases speed a lot. +net-drives (``many'' means here something > 500, dependent of the +speed of the net-connection and the machine). Or if it contains +remote-source-paths which means paths in the sense of tramp, ange-ftp +or efs. For these directories actualizing the sources- and/or +directories- buffer of ECB (if displayed in current layout!) can slow +down dramatically so a caching increases speed a lot. The value of this option is a list where each element is a cons-cell and looks like: ＠＠ -5542,18 +5760,23 ＠＠ ＠code{ecb-primary-secondary-mouse-buttons}) in the directories-buffer of ECB (＠pxref{Using the mouse}). +Default-value: ECB caches the contents of all remote directories +regardless of the size and all other directories if more than 50 +entries are contained. + Examples: -A value of ＠code{(("/usr/home/john_smith/bigdir*" . 1000))} means the +An entry ＠code{("/usr/home/john_smith/bigdir*" . 1000)} means the contents of every subdirectory of the home-directory of John Smith will be cached if the directory contains more than 1000 entries and its name begins with ``bigdir''. -A value of ＠code{((".*" . 1000))} caches every directory which has more +An entry ＠code{(".*" . 1000)} caches every directory which has more than 1000 entries. -A value of ＠code{((".*" . 0))} caches every directory regardless of the -number of entries." +An entry ＠code{("^/\\([^:/]*＠＠\\)?\\([^＠＠:/]*\\):.*" . 0)} caches +every remote (in the sense of tramp, ange-ftp or efs) directory +regardless of the number of entries." Please note: If you want your home-dir being cached then you MUST NOT use ``~'' because ECB tries always to match full path-names! ＠＠ -5726,18 +5949,85 ＠＠ ＠end defopt ＠defopt prescan-directories-for-emptyness -ECB does this so directories are displayed as empty in the -directories-buffer even without user-interaction (i.e. in previous -ECB-versions the emptyness of a directory has been first checked when -the user has clicked onto a directory). ECB optimizes this check as -best as possible but if a directory contains a lot of subdirectories -which contain in turn a lot of entries, then expanding such a -directory or selecting it takes of course more time as without this -check - at least at the first time (all following selects of a -directory uses the cached information if its subdirectories are empty -or not). Therefore this feature can be switched of via this option." +Prescan directories for emptyness. ECB does this so directories are +displayed as empty in the directories-buffer even without +user-interaction (i.e. in previous ECB-versions the emptyness of a +directory has been first checked when the user has clicked onto a +directory). ECB optimizes this check as best as possible but if a +directory contains a lot of subdirectories which contain in turn a lot +of entries, then expanding such a directory or selecting it would take +of course more time as without this check - at least at the first time +(all following selects of a directory uses the cached information if +its subdirectories are empty or not). Therefore ECB performs this +check stealthy (see ＠code{ecb-stealthy-tasks-delay}) so normally there +should no performance-decrease or additional waiting-time for the +user. There is one exception: For remote directories (in the sense of +tramp, ange-ftp, or efs) this check can descrease performance even if +performed stealthy and interruptable. Therefore this option offers +three possible settings: + +＠itemize ＠bullet +＠item ＠code{t} +Switch on this feature + +＠item ＠code{unless-remote} +Switch on this feature but not for remote directories. The term +``remote'' means here directories which are used via tramp, ange-ftp +or efs. So mounted directories are counted not as remote directories +here even if such a directory is maybe hosted on a remote machine. But +normally only directories in a LAN are mounted so there should be no +performance-problems with such mounted directories. + +＠item ＠code{nil} +Switch off this feature completely. +＠end itemize + +The option ＠code{ecb-prescan-directories-exclude-regexps} offers are +more fine granularity to exclude certain directories from this +prescan. +＠end defopt + +＠defopt host-accessible-check-valid-time +Time in seconds a cached accessible-state of a remote host is valid. +This option is a list where each element specifies how long for a +certain remote host the cached ping-state (i.e. if the host is +accessible or not) should be valid. During this time-intervall ECB +pings such a remote host only once, all other checks use the cached +value of that real check. But it the cached value is older than the +value of this option ECB will ping again. + +Per default ECB discards after 1 minute the cached ping-state of each +remote host. But if you are sure that a certain remote host is always +accessible (i.e. means in consequence that you are always online when +working with ECB and remote-paths) then add an entry to this option +with a high valid-interval. + +Examples: An entry (``.*sourceforge.*'' . 3600) ensures that all +remote hosts machting the string ``sourceforge'' will only once pinged +during one hour. Or (``.*'' . 300) would ensure that every remote host +would be pinged only once during 5 minutes. +＠end defopt + +＠defopt ping-options +List of options for the ping program. These options can be used to +limit how many ICMP packets are emitted. Ping is used to test if a +remote host of a remote path (e.g. a tramp-, ange-ftp- or efs-path) is +accessible See also ＠code{ecb-ping-program}. +＠end defopt + +＠defopt ping-program +Program to send network test packets to a host. See also +＠code{ecb-ping-options}. +＠end defopt + +＠defopt prescan-directories-exclude-regexps +Which directories should be excluded from the empty-prescan. If a +directory matches any of the regexps of this option it will not be +prescanned for emptyness - This option takes only effect if +＠code{ecb-prescan-directories-for-emptyness} is not nil. ＠end defopt + ＠defopt show-sources-in-directories-buffer Show source files in directories buffer. ＠end defopt ＠＠ -5748,6 +6038,28 ＠＠ used as display name. ＠end defopt +＠defopt source-path +Paths where to find code sources. Each path can have an optional alias +that is used as it's display name. If no alias is set, the path is +used as display name. + +Lisp-type of tis option: The value must be a list L whereas each +element of L is either +＠itemize ＠minus +＠item +a simple string which has to be the full path of a directory (this +string is displayed in the directory-browser of ECB) or + +＠item +a 2-element list whereas the first element is the full path of a +directory (string) and the second element is an arbitrary alias +(string) for this directory which is then displayed instead of the +underlying directory. +＠end itemize +＠end defopt + + + ＠defopt use-speedbar-instead-native-tree-buffer If true then uses speedbar for directories, sources or methods. This means that speedbar is integrated in the ECB-frame and is displayed in ＠＠ -5783,6 +6095,13 ＠＠ ＠noindent This group contains settings for the sources-buffer in the ECB: +＠defopt read-only-check-exclude-regexps +Which directories should be excluded from the sources-read-only-check. +If a directory matches any of the regexps of this option their sources +will not be checked if they are writable - This option takes only +effect if ＠code{ecb-sources-perform-read-only-check} is not nil. +＠end defopt + ＠defopt show-source-file-extension Show the file extension of source files. ＠end defopt ＠＠ -5910,6 +6229,27 ＠＠ whole menu can be re-arranged with ＠code{ecb-sources-menu-sorter}. ＠end defopt + +＠defopt sources-perform-read-only-check +Check if source-items in the tree-buffers are read-only. If a +sourcefile is read-only then it will be displayed with that face set +in the option ＠code{ecb-source-read-only-face}. + +Because this check can be take some time if files are used via a +mounted net-drive ECB performs this check stealthy (see +＠code{ecb-stealthy-tasks-delay}) so normally there should no +performance-decrease or additional waiting-time for the user. But to +get sure this option offers three choices: ＠code{t}, +＠code{unless-remote} and ＠code{nil}. See +＠code{ecb-prescan-directories-for-emptyness} for an explanation for +these three choices. + +The option ＠code{ecb-read-only-check-exclude-regexps} offers are more +fine granularity to exclude the sources of certain directories from +the read-only state-check. +＠end defopt + + ＠defopt sources-sort-ignore-case Ignore case for sorting the source-files of the Sources-buffer. See also ＠code{ecb-sources-sort-method}. ＠＠ -7546,6 +7886,10 ＠＠ Changes take first effect after finishing and reactivating ECB! ＠end defopt +＠defopt directory-not-accessible-face +Face for not accessible dirs in the directories buffer. +＠end defopt + ＠defopt history-face Face used for highlighting current history-entry in the history buffer. If the face ＠code{ecb-default-highlight-face} is used then the ＠＠ -7615,6 +7959,10 ＠＠ Changes take first effect after finishing and reactivating ECB! ＠end defopt +＠defopt source-read-only-face +Face for read-only sources. +＠end defopt + ＠defopt tag-header-face Face used for highlighting the tag header after jumping to it by clicking onto a node in the methods buffer. ＠＠ -7677,6 +8025,9 ＠＠ Define face used for highlighting current directory in the directories buffer. +＠item ecb-directory-not-accessible-face +Define a face for not accessible dirs in the directories buffer. + ＠item ecb-history-face: Define face used for highlighting current history-entry in the history buffer. ＠＠ -7715,6 +8066,9 ＠＠ Basic face for the ECB sources buffer. It´s recommended to define here the font-family, the font-size, the basic color etc. +＠item ecb-source-read-only-face +Define a face for read-only sources + ＠item ecb-tag-header-face: Define face used for highlighting the tag header after jumping to it by clicking onto a node in the methods buffer. ＠＠ -7911,7 +8265,7 ＠＠ ＠node ecb-speedbar, ecb-non-semantic, ecb-eshell, Customizable options ＠subsection Group ecb-speedbar -TODO +＠c TODO ＠node ecb-non-semantic, ecb-winman, ecb-speedbar, Customizable options ＠subsection Group ecb-non-semantic ＠＠ -8026,7 +8380,7 ＠＠ window-configuration are configurations with deactivated ECB! ＠end defopt -＠node ecb-mode-line, , ecb-winman, Customizable options +＠node ecb-mode-line, ecb-version-control, ecb-winman, Customizable options ＠subsection Group ecb-mode-line ＠noindent ＠＠ -8140,6 +8494,156 ＠＠ inherit from the face ＠code{modeline} (see ＠code{set-face-parent})! ＠end defopt +＠node ecb-version-control, ,ecb-mode-line, Customizable options +＠subsection Group ecb-version-control + +＠noindent +This group contains settings for the version-control-support of ECB: + +＠defopt vc-directory-exclude-regexps +Which directories should be excluded from VC-state-check. If a +directory matches any of the regexps of this option the VC-state of +its sources will not be checked - This option takes only effect if +＠code{ecb-vc-enable-support} is not nil. +＠end defopt + + +＠defopt vc-enable-support +Enable support for version-control (VC) systems. If on then in the +directories-buffer (if the value of the option +＠code{ecb-show-sources-in-directories-buffer} is on for current +layout), the sources-buffer and the history-buffer all file-items are +displayed with an appropriate icon in front of the item-name to +indicate the VC-state of this item. If off then no +version-control-state checking is done. + +Because this check can be take some time if files are managed by a not +local Version-control-server ECB performs this check stealthy (see +＠code{ecb-stealthy-tasks-delay}) so normally there should no +performance-decrease or additional waiting-time for the user. But to +get sure this option offers three choices: ＠code{t}, +＠code{unless-remote} and ＠code{nil}. See the option +＠code{ecb-prescan-directories-for-emptyness} for an explanation for +these three choices. + +The option ＠code{ecb-vc-directory-exclude-regexps} offers are more +fine granularity to exclude the sources of certain directories from +the VC-state-check. + +See ＠code{ecb-vc-supported-backends} and ＠code{ecb-vc-state-mapping} +how to customize the VC-support itself. +＠end defopt + +＠defopt vc-state-mapping +Mapping between VC-states from the backends and ECB-known VC-states. +ECB understands the following state-values: + +＠table ＠code +＠item up-to-date +The working file is unmodified with respect to the latest version on +the current branch, and not locked. + +＠item edited +The working file has been edited by the user. If locking is used for +the file, this state means that the current version is locked by the +calling user. + +＠item needs-patch +The file has not been edited by the user, but there is a more recent +version on the current branch stored in the master file. + +＠item needs-merge +The file has been edited by the user, and there is also a more recent +version on the current branch stored in the master file. This state +can only occur if locking is not used for the file. + +＠item added +The working file has already been added/registered to the VC-system +but not yet commited. + +＠item unlocked-changes +The current version of the working file is not locked, but the working +file has been changed with respect to that version. This state can +only occur for files with locking; it represents an erroneous +condition that should be resolved by the user. + +＠item ignored +The version-control-system ignores this file (e.g. because included in +a .cvsignore-file in case of CVS). + +＠item unknown +The state of the file can not be retrieved; probably the file is not +under a version-control-system. + +＠end table + +All state-values a check-vc-state-function of +＠code{ecb-vc-supported-backends} can return must have a mapping to one +of the ECB-state-values listed above. If for a certain +backend-VC-state no mapping can be found then per default 'edited is +assumed! + +The default value of this option maps already the possible returned +state-values of ＠code{vc-state} and ＠code{vc-recompute-state} (both +GNU Emacs) and ＠code{vc-cvs-status} (Xemacs) to the +ECB-VC-state-values. +＠end defopt + +＠defopt vc-supported-backends +Define how to to identify the VC-backend and how to check the state. +The value of this option is a list containing cons-cells where the car +is a function which is called to identify the VC-backend for a +DIRECTORY and the cdr is a function which is called to check the +VC-state of the FILEs contained in DIRECTORY. + +Identify-backend-function: It gets a full directory-name as argument - +always without ending slash (rsp. backslash for native Windows-XEmacs) +- and has to return a unique symbol for the VC-backend which manages +that directory (e.g. 'CVS for the CVS-system or 'RCS for the +RCS-system) or nil if the file is not managed by a +version-control-system. + +Check-vc-state-function: It gets a full filename (ie. incl. the +complete directory-part) and has to return a symbol which indicates +the VC-state of that file. The possible returned values of such a +check-vc-state-function have to be mapped with +＠code{ecb-vc-state-mapping} to the allowed ECB-VC-state values. + +ECB runs for a certain DIRECTORY all identify-backend-functions in +that order they are listed in this option. For the first which returns +a value unequal nil the associated check-state-function is used to +retrieve the VC-state of all sourcefiles in that DIRECTORY. + +There is no need for the identify-backend-function or the +check-vc-state-function to cache any state because ECB automatically +caches internally all necessary informations for directories and files +for best possible performance. + +To prepend ECB from checking the VC-state for any file set +＠code{ecb-vc-enable-support} to nil. + +Default value for GNU Emacs: Support for CVS, RCS, SCCS and Subversion +(for the later one the most recent version of the VC-package incl. the +vc-svn library is needed) is added per default. To identify the +VC-backend the functions ＠code{ecb-vc-managed-by-CVS}, +＠code{ecb-vc-managed-by-RCS} rsp. ＠code{ecb-vc-managed-by-SCCS} rsp. +＠code{ecb-vc-managed-by-SVN} are used. For all three backends the +function ＠code{ecb-vc-state} of the VC-package is used. + +Default value for XEmacs: XEmacs contains only a quite outdated +VC-package, especially there is no backend-independent +check-vc-state-function available (like ＠code{vc-state} for GNU +Emacs). Only for CVS a check-vc-state-function is available: +＠code{vc-cvs-status}. Therefore ECB adds per default only support for +CVS and uses ＠code{ecb-vc-managed-by-CVS} rsp. ＠code{vc-cvs-status}. + +Example for GNU Emacs: If ＠code{vc-recompute-state} (to get real +state-values not only heuristic ones) should be used to check the +state for CVS-managed files and ＠code{vc-state} for all other backends +then an element (ecb-vc-dir-managed-by-CVS . vc-recompute-state) +should be added at the beginning of this option. +＠end defopt + ＠node Submitting problem report, Upgrading, Customizing, Top ＠chapter Submitting a problem report ＠＠ -8355,8 +8859,10 ＠＠ display of all upgraded or reset options. ＠item ＠code{ecb-display-upgraded-options}: -Displays a temp. buffer with all upgraded or reseted ECB-options with -their old and new values. +Displays an information-buffer which options have been upgraded or +reset. Offers two buttons where the user can decide if the upgraded +options should also being saved by ECB for future settings or if the +buffer should be killed. ＠end itemize If the option ＠code{ecb-auto-compatibility-check} has a non-nil value ＠＠ -8424,8 +8930,9 ＠＠ It checks all customized values of all ECB-options if they are still type-compatible. If not then it tries to upgrade the old-value to the new value-type and if this is not possible then it resets the option -to the new default value and store it via customize in the .emacs-file -(or in any file which is used for customized options). +to the new default value and offers then to store it via customize in +the .emacs-file (or in any file which is used for customized options). +But ECB does not touch any customization-file without asking the user! ＠item It offers a special constant ＠code{ecb-upgradable-option-alist} which ＠＠ -8456,6 +8963,8 ＠＠ * Integrating speedbar:: Integrating speedbar in the ECB-frame * Optimize scrolling:: Optimize scrolling in the edit-window * Large directories:: Working with large directories +* Remote directories:: Working with remote directories +* Version-control support:: Supporting Version control systems * Using eshell:: Optimal using of eshell in ECB * Grepping directories:: Grepping directories with ECB * Working with JDEE:: Working best with ECB and JDEE ＠＠ -8745,7 +9254,7 ＠＠ ＠code{scroll-step} has value 1. -＠node Large directories, Using eshell, Optimize scrolling, Tips and tricks +＠node Large directories, Remote directories, Optimize scrolling, Tips and tricks ＠section Working with large directories If ＠code{ecb-source-path} contains directories with many files and ＠＠ -8794,7 +9303,456 ＠＠ sources-buffer. This can be done via the command ＠code{ecb-sources-filter} or via the popup-menu of the sources-buffer. -＠node Using eshell, Grepping directories, Large directories, Tips and tricks +＠node Remote directories, Version-control support, Large directories, Tips and tricks +＠section Working with remote directories + +The term ``remote'' means directories which are remote in the sense of +TRAMP＠footnote{TRAMP stands for 'Transparent Remote (file) Access, +Multiple Protocol'. This package provides remote file editing, similar +to ANGE-FTP.}, ANGE-FTP＠footnote{This package attempts to make +accessing files and directories using FTP from within Emacs as simple +and transparent as possible.} or EFS＠footnote{A system for transparent +file-transfer between remote hosts using the FTP protocol within +Emacs}. Each of these Emacs-addons is intended to make editing +directories and files on remote machines as transparent as possible. + +＠subsection General remarks + +ECB supports such remote directoires out of the box and completely +transparently, i.e. you can add remote directories to the option +＠code{ecb-source-path} without any restriction. ECB will handle these +directories transparently with the appropriate tool - either TRAMP, +ANGE-FTP or EFS. So when working with such a remote directory is +possible without ECB it will be possible too with active ECB - at +least as long you are ``connected''! + +＠strong{Caution}: Suppose you have added a remote dir (e.g. +``user＠＠host.at.a.server:/dir/'') to ＠code{ecb-source-path} and you +start ECB when you are offline, means there can be no connection +established to the remote computer (e.g. ``host.at.a.server''). Each +time ECB has to process a remote path ECB pings via the ping-program +the remote host (in the example above it would ping the host +``host.at.a.server'') to test if it is accessible. If not then this +path will be ignored by ECB＠footnote{This avoids long lasting and +annoying blocking of ECB when a remote-path is not accessible: Without +a ping ECB would always try to open this directory through the +appropriate library (e.g. TRAMP) and it would depend on the +timeout-mechanism of this library (e.g. TRAMP has 60 seconds) how long +ECB would be blocked. First after this timeout ECB could start +working! A fast ``pre''-ping avoids this problem!}. Ensure that ECB +calls your ping-program (see ＠code{ecb-ping-program}) with the right +options (see ＠code{ecb-ping-options}). To avoid to many pings to the +same host ECB caches the ping result so there should be no performance +decrease. But to ensure still correct accessible-results and to avoid +using outdated cache-results ECB discards the cached value of the +accessible-state of a certain host after a customizable time-interval +(please read the documentation of +＠code{ecb-host-accessible-check-valid-time}!). + + +＠subsection Excluding remote directories from time-consuming tasks + +ECB performs some tasks stealthy and interruptable by the user (see +the option ＠code{ecb-stealthy-tasks-delay} for additional +explanations) because these tasks are time-consuming and could +otherwise ECB block. Especially for remote directories these special +tasks can cause annoying blocks of Emacs (＠pxref{Stealthy background +tasks}). + +Therefore it is probably the best to switch on each of the stealthy +tasks with the ＠code{unless-remote} which is the default activation +(＠pxref{Stealthy background tasks}). So a certain stealthy task will +be swtiched on for all local directories (and also for all mounted +drives in the LAN) but not for real remote directories used via TRAMP, +ANGE-FTP or EFS. + +＠subsection Caching the contents of remote directories + +ECB caches per default the contents of remote directories to avoid +annoying delays. The cache is done via the option +＠code{ecb-cache-directory-contents} which contains an entry which +covers the syntax of remote directories. If you do not want this +caching (which is strongly recommened) you have to remove this entry +from this option. + +＠node Version-control support, Using eshell, Remote directories, Tips and tricks +＠section Supporting Version control systems + +Beginning with version 2.30 ECB supports Version-control systems (in +the following named VC-systems). This means the special tree-buffers +of ECB display files managed by a VC-system with an appropriate +image-icon＠footnote{Of course only when Emacs is capable to display +images; otherwise a suitable ascii-icon will be displayed.} in front +of the filename. + +The following four options allow full control over this feature (see +also ＠ref{ecb-version-control}: + +＠table ＠code +＠item ecb-vc-enable-support +Enable or disable this feature. +＠item ecb-vc-supported-backends +The most important option for this feature. Allows to specify how ECB +should test if a directory is managed by a VC-system (how to identify +the VC-backend of a directory) and - if yes - how it should check the +VC-state of a certain file. The former ones are called +＠dfn{identify-backend-functions} and the latter ones +＠dfn{check-state-functions}. +＠item ecb-vc-directory-exclude-regexps +Allows excluding certain directories (on a regexp-basis) from the +VC-support even if they are managed by a VC-system. +＠item ecb-vc-state-mapping +Defines the mapping between the state-values returned by a +check-state-function (a function set in +＠code{ecb-vc-supported-backends} and used for getting the VC-state of +a file, e.g. ＠code{vc-state}) and the allowed state-values ECB can +understand. +＠end table + +Probably the default settings will fit your needs but to get sure you +should carefully read the documentation of these options! + +The following subsection give you important informations about +identify-backend-functions, check-state-functions, about working with +remote repositories. + +＠menu +* Identifying backends:: How ECB identifies the VC-backend of a dir +* Checking the state:: How ECB checks the VC-state of a file +* Remote repositories:: What you should now about this +* Refreshing the VC-state:: How to refresh when state changed outside +* Adding new backends:: Necessary steps for adding new backends +＠end menu + +＠node Identifying backends, Checking the state, Version-control support, Version-control support +＠subsection How ECB identifies the VC-backend of a dir + +ECB tries all functions added as identify-backend-funtions to the +option ＠code{ecb-vc-supported-backends} until one of them returns not +＠code{nil} but a symbol which identifies the backend (e.g. +＠code{CVS}). After this check ECB stores the result of this check +(i.e. either the identified backend or the fact that the directory is +not managed by a VC-system) for that directory in a special cache, so +the identify-backend-process will be performed only once per +directory. If for a directory a VC-backend could be identified ECB +stores not only the backend itself for that directory but also the +associated check-state-function defined in +＠code{ecb-vc-supported-backends} (＠pxref{Checking the state}). + +You can add arbitrary functions to this options as long they get one +directory-argument and return either nil oder a backend-symbol. Per +default ECB offers the following functions to identify the VC-backend +CVS, RCS, SCCS or Subversion＠footnote{For this the most recent version +of the VC-package (incl. the library vc-svn.el) is needed - as +contained in CVS Emacs}: + +＠table ＠code +＠item ecb-vc-dir-managed-by-CVS DIRECTORY +Return ＠code{CVS} if DIRECTORY is managed by CVS. nil if not. + +This function tries to be as smart as possible: First it checks if +DIRECTORY is managed by CVS by checking if there is a subdir +＠code{CVS}. If no then nil is returned. If yes then for GNU Emacs it +takes into account the value of ＠code{vc-cvs-stay-local}: If t then +just return ＠code{CVS}. Otherwise ECB checks the root repository if it +is a remote repository. If not just ＠code{CVS} is returned. If a +remote repository it checks if the value of ＠code{vc-cvs-stay-local} +is a string and matches the host of that repository. If yes then just +＠code{CVS} is returned. If not then ECB checks if that host is +currently accessible by performing a ping. If accessible ＠code{CVS} is +returned otherwise nil. This has the advantage that ECB will not be +blocked by trying to get the state from a remote repository while the +host is not accessible (e.g. because the user works offline). + +Special remark for XEmacs: XEmacs has a quite outdated VC-package +which has no option ＠code{vc-cvs-stay-local} so the user can not work +with remote CVS-repositories if working offline for example. So if +there is no option ＠code{vc-cvs-stay-local} then ECB performs always +the repository check mentioned above. + +＠item ecb-vc-dir-managed-by-RCS DIRECTORY +Return ＠code{RCS} if DIRECTORY is managed by RCS. nil if not. + +＠item ecb-vc-dir-managed-by-SCCS DIRECTORY +Return ＠code{SCCS} if DIRECTORY is managed by SCCS. nil if not. + +＠item ecb-vc-dir-managed-by-SVN DIRECTORY +Return ＠code{SVN} if DIRECTORY is managed by Subversion. nil if not. +Returns always nil if the library vc-svn.el can not be found. + +＠end table + +If ECB should support other VC-backends than CVS, RCS, SCCS or +Subversion you have to write your own identify-backend-funtion for the +used VC-backend (e.g. Clearcase)! + +＠subsubsection Special remarks for XEmacs + +XEmacs contains only a quite outdated VC-package, especially there is +no backend-independent check-vc-state-function available (like +＠code{vc-state} for GNU Emacs). Only for CVS a check-vc-state-function +is available: ＠code{vc-cvs-status}. Therefore ECB adds per default +only support for CVS and uses ＠code{ecb-vc-managed-by-CVS} rsp. +＠code{vc-cvs-status}. + +＠node Checking the state, Remote repositories, Identifying backends, Version-control support +＠subsection How ECB checks the VC-state of a file + +After ECB has identified the VC-backend of a directory it will display +the VC-state (e.g. up-to-date, edited, needs-mergs etc...) with a +suitable image-icon in the tree-windows of the ECB-file-browser. To +get this state for a certain file ECB uses that check-state-function +stored in the cache for the directory of that file (＠pxref{Identifying +backends}). + +You can add any arbitrary functions as check-state-function to +＠code{ecb-vc-supported-backends} as long they get one +filename-argument and return a state-symbol (e.g. ＠code{up-to-date}. +ECB can understand a certain set of state-values wghich are then +mapped to suitable image-icons which will in turn be displayed in +front of the filename in the file-browser. Because the values a +check-state-function return can differ from that state-values ECB +understands, ECB offers an option to define a appropriate +state-mapping. The name of this option is ＠code{ecb-vc-state-mapping}. +See the documentation of this option to get a list of all state-value +ECB understands. + +Per default ECB uses - when running under GNU Emacs - the function +＠code{vc-state} of the VC-package＠footnote{The VC-package of Emacs +offers a standardised and uniform interface for several backends; per +default CVS, RCS, SCCS and Subversion are supported by the +VC-package.} to check the state for the backends CVS, RCS, SCCS and +Subversion. So the default-value of ＠code{ecb-vc-state-mapping} +contains a mapping between these values ＠code{ecb-vc-state} can return and +that state-values ECB understands. + +If ECB should support other VC-backends than CVS, RCS, SCCS and +Subversion (e.g. Clearcase) you should add a that new backend to the +VC-package (see the initial comments of vc.el how to do this) then ECB +will automatically support this new backend. Alternatively it can be +enough if you write your own check-state-function for this backend and +add the needed mapping to ＠code{ecb-vc-state-mapping} if necessary. + +＠subsubsection Getting heuristic state-values or real ones for CVS + +The interface of GNU Emacs' VC-package offers two different ways to +get the VC-state of a file: + +＠itemize ＠bullet +＠item The real, fresh and expensive approach +VC has a function ＠code{vc-recompute-state} which always performs a +command ``cvs status'' to get a fresh and real state for a file. As +you can imagine this operation can be very expensive and long lasting +depending on the location of the repository. But the CVS-backend of VC +offers with the option ＠code{vc-cvs-stay-local} a way to tell Emacs to +stay local even for the sake of getting a real state. + +＠item The heuristic approach: +The function ＠code{vc-state} always returns a ``heuristic'' state +which should be used when a fresh and real state is not necessary. +With ＠code{vc-state} the option ＠code{vc-cvs-stay-local} will never +take effect. +＠end itemize + +VC/CVS actually does it this way (regardless if ECB is active or not): +When you visit a file, it always uses just the heuristic to get the +state (comparing file times), regardless of the setting of +＠code{vc-cvs-stay-local}. This is because the "fresh-but-slow" state +is determined by calling "cvs status" on the file, and this was deemed +unacceptably slow if done at visiting time under any conditions. + +The state is updated by calling ＠code{vc-recompute-state} prior to +＠code{vc-next-action} (C-x v v) which either checks a file in or out. +IF ＠code{vc-cvs-stay-local} is nil, then this does in fact call "cvs +status" to get the "fresh-but-slow-state", but if +＠code{vc-cvs-stay-local} is t, then it just compares the file times +again. + +But under certain conditions (e.g. if called for files not already +visited or for files their VC-state has been changed from outside +Emacs, e.g. by checking in the file via command line) ＠code{vc-state} +does not compute a new heuristic state but returns a cached one +(cached by the VC-package itself not by ECB) which does not reflect +the current VC-state. Example: if you have edited a file within Emacs +and then checked in from outside Emacs ＠code{vc-state} returns a wrong +state until you call ＠code{revert-buffer} for this file. Therefore ECB +offers the check-state-function ＠code{ecb-vc-state} which does the +same as ＠code{vc-state} but it clears the internal caches of the +VC-package for that file before calling ＠code{vc-state}. + +The bottom line for you is this: If you use ＠code{ecb-vc-state} in +＠code{ecb-vc-supported-backends} to get the version control state, +then you get the same policy that VC uses and you get always a +``correct'' heuristic state (as correct as possible a heuristic state +can be). There should no harm if you use ＠code{vc-recompute-state} as +a replacement function if you want to get fresh and real state-values, +but then (a) you must make sure to set ＠code{vc-cvs-stay-local} to +nil, and (b) fetching the state over the network under all conditions +was deemed unacceptably slow in VC. + +＠node Remote repositories, Refreshing the VC-state, Checking the state, Version-control support +＠subsection Important informations about remote repositories + +At least CVS can be used in a mode called ``Client/Server'' which +means the root repository is located on a remote machine. We call a +repository which can not being mounted by the client-machine (which +contains the working directory) a ＠dfn{remote repository}. In most +cases getting the fresh and real VC-state for such repositories will +be unacceptable slow or often users will work offline means with no +connection available to the remote host. To avoid problems like these +ECB offers first an option ＠code{ecb-vc-directory-exclude-regexps} to +exclude such directories with a remote repository from the VC-support +of ECB and secondary the identify-backend-funtion +＠code{ecb-vc-dir-managed-by-CVS} behaves smart with that respect +(＠pxref{Identifying backends}). + +＠subsubsection Remote paths and the VC-support of ECB + +ECB supports working with remote directories like TRAMP- or +EFS-directories (＠pxref{Remote directories}). Do not confuse remote +directories with remote repositories. A local directory located on +your disk and set in ＠code{ecb-source-path} can have a remote +repository if managed by a VC-system. A remote directory means a path +in the format of TRAMP, ANGE-FTP or EFS set in ＠code{ecb-source-path}. +Its very likely that getting the VC-state of files contained in such a +remote directory would be extremly expensive and therefore ECB would +be blocked quite long even if the VC-check is performed stealthy +(＠pxref{Stealthy background tasks}). + +To avoid problems with such remote directories ECB prevents per +default such directories from being processed by the VC-support of +ECB. But if a user is dying to having the VC-state being displayed in +the tree-buffers ECB offers two ways to switch on the VC-support - see +the option ＠code{ecb-vc-enable-support}: This option is set per +default to the value ＠code{unless-remote} which means remote paths +will not be processed but it can be set to ＠code{t} which means +process all directories regardless if remote or not. It's strongly +recommended to use ＠code{unless-remote}! + +＠node Refreshing the VC-state, Adding new backends, Remote repositories, Version-control support +＠subsection How to refresh ECB-state-display when changed outside + +If all actions concerning version controlling of a file are performed +within Emacs with commands offeres by VC then the displayed state for +such a file in the tree-buffers of ECB will be always correct - in +that sense that ECB will always display that state which the +check-state-function for the file will return. At least with GNU Emacs +for the backends CVS, RCS, SCCS and Subversion this will be true. With +XEmacs only for CVS. For other backends see ＠ref{Adding new backends}. + +But if the VC-state of a file will be changed outside of Emacs +(unfortunately PCL-CVS must be called ``outside'' too because PCL-CVS +doesn't use the functions of the VC-package of Emacs for checking-in +or -out) then ECB can not automatically recognize this and therefore +it can not aurtomatically update the displayed state-image-icon. You +have to tell ECB for which files in the tree-buffers the VC-state +should be recomputed. This can be done via the popup-menus of the +ECB-tree-buffers - The following popup-commands are offered in the +submenu ``Version Control'': + +＠table ＠asis +＠item ECB-directories-buffer (if sources are displayed within): +``Recompute state for file'' and ``Recompute state for dir'' whereas +the latter one recomputes the VC-state for all files of that directory +the file belongs. +＠item ECB-sources-buffer +``Recompute state for file'' and ``Recompute state for dir'' whereas +the latter one recomputes the VC-state for all files currently +displayed in the sources-buffer. +＠item ECB-history-buffer +``Recompute state for file'' and ``Recompute state for whole history'' +whereas the latter one recomputes the VC-state for all file-entries currently +displayed in the history-buffer. +＠end table + +＠strong{Caution}: The state will only recomputed right under all +situations if you use either ＠code{ecb-vc-state} or +＠code{vc-recompute-state} as check-state-function in +＠code{ecb-vc-supported-backends} (＠pxref{Checking the state}). + +Of course all these commands update the VC-state in all visible +tree-buffers the file is currently displayed (e.g. often a file is +displayed in the sources- and the history-buffer)! + +For general informations about the usage of popup-menus in ECB see +＠ref{Using the mouse} (subsection ``The right mouse button''). + +In addition to these popup-commands using the POWER- rsp. Shift-click +(＠pxref{Using the mouse}) onto a directory in the directory-window of +ECB refreshes the VC-state-values of all files contained in this +directory too. + +＠node Adding new backends, ,Refreshing the VC-state, Version-control support +＠subsection Necessary steps and informations for adding new backends + +There are mainly three necessary steps for adding a new(a)footnote{i.e. +not already supported by the VC-package because all these backends are +automatically supported by ECB too!} backend BE which should be +supported by ECB: + +＠enumerate +＠item Adding an identify-backend-function to ＠code{ecb-vc-supported-backends} +ECB needs a function how to identify the new backend BE for a certain +directory. If there exists already a library (other then VC) +supporting this backend then this library propably contains already +such a function which can be used or can be used at least with a small +elisp-wrapper. If no elisp-library for backend BE exists then you have +probably write the full identify-backend-function for your self. This +function has to be added to ＠code{ecb-vc-supported-backends}. + +＠item Adding an check-state-function to ＠code{ecb-vc-supported-backends} +Associated to the new identify-backend-function mentioned in step 1 a +new check-state-function is needed which can be used by ECB to get the +VC-state for a file. See ＠ref{Checking the state} for a description +about the needed interface of such a function. In combinatio with the +identify-backend-function from step 1 this function has to be added to +＠code{ecb-vc-supported-backends}. + +＠item Enabling automatic state-update after checkin/out + +This step is not essential if you do not need the displayed VC-state +automatically updated after a checkin/out of a file via the commands +available for backend BE (e.g. clearcase.el offers for the backend +Clearcase elisp-commands to checkin and checkout a file which then +should also update the displayed state in the ECB-tree-buffers. All +you need is a way to tell these commands that they should clear the +ECB-VC-cache for the file and then restart the ECB-VC-check-mechanism. +This should be done after these commands have finished their original +job. + +ECB enables this per default for all backends supported by the +VC-package with the following code. Maybe this is a good starting +point. + +＠example +＠group +(defvar ecb-checkedin-file nil + "Stored the filename of the most recent checked-in file. Is only set by the +after-advice of `vc-checkin' and `ecb-vc-checkin-hook' \(resets it to nil). +Evaluated only by `ecb-vc-checkin-hook'. + +This is the communication-channel between `vc-checkin' and +`ecb-vc-checkin-hook' so this hook-function gets the filename of the +checked-in file.") + +(defadvice vc-checkin (after ecb) + "Simply stores the filename of the checked-in file in `ecb-checkedin-file' +so it is available in the `vc-checkin-hook'." + (setq ecb-checkedin-file (ecb-fix-filename (ad-get-arg 0)))) + +(defun ecb-vc-checkin-hook () + "Ensures that the ECB-cache is reset and the entry for the most recent +checkedin file is cleared. Uses `ecb-checkedin-file' as last checked-in file." + (when ecb-checkedin-file + (ecb-vc-cache-remove ecb-checkedin-file) + (ecb-vc-reset-vc-stealthy-checks) + (setq ecb-checkedin-file nil))) +＠end group +＠end example + +＠end enumerate + +＠node Using eshell, Grepping directories, Version-control support, Tips and tricks ＠section Optimal using of eshell in ECB ＠cindex eshell ＠＠ -9641,6 +10599,7 ＠＠ ＠item ＠code{ecb-activate-before-new-frame-created-hook} ＠item ＠code{ecb-activate-before-layout-draw-hook} ＠item ＠code{ecb-activate-hook} +＠item ＠code{ecb-after-directory-change-hook} ＠item ＠code{ecb-before-activate-hook} ＠item ＠code{ecb-before-deactivate-hook} ＠item ＠code{ecb-common-tree-buffer-after-create-hook} ＠＠ -11478,11 +12437,79 ＠＠ ＠item Opening directories takes a long time - what can i do? ＠tab ＠tab -Read ＠ref{Large directories} and/or set the option -＠code{ecb-prescan-directories-for-emptyness} to nil. +Read ＠ref{Large directories}. -＠end multitable +＠item ＠tab ＠tab +＠item +ECB seems to be blocked sometimes - what is the reason? +＠tab ＠tab +ECB performs some stealthy tasks when idle - this can cause sometimes +a blocked Emacs but this tasks will be immetiatelly interrupted by any +user-event so there should be normally no problems. But especially for +mounted net-drives some of the stealthy tasks can take time up to some +seconds for each file - and during one file-operation it can not be +interrupted. See also ＠code{ecb-stealthy-tasks-delay}. + +＠item ＠tab ＠tab + +＠item +Can i exclude certain directories from being checked for emptyness? +＠tab ＠tab +Yes, see option ＠code{ecb-prescan-directories-exclude-regexps}. + +＠item ＠tab ＠tab + +＠item +Can i exclude certain directories from checking the VC-state of the +contained sources? +＠tab ＠tab +Yes, see option ＠code{ecb-vc-directory-exclude-regexps}. + +＠item ＠tab ＠tab + +＠item +Can i exclude certain directories from checking the read-only-state of +the contained sources? +＠tab ＠tab +Yes, see option ＠code{ecb-read-only-check-exclude-regexps}. + +＠item ＠tab ＠tab + +＠item +ECB ignores the remote-paths i have added to ＠code{ecb-source-path}. +＠tab ＠tab +Maybe you have to check the option ＠code{ecb-ping-options}. Ensure +that this option contains a value suitable for your ping-program (see +＠code{ecb-ping-program}). +＠ifinfo +＠* +＠end ifinfo +See also ＠ref{Remote directories}. + +＠item ＠tab ＠tab + +＠item +ECB seems to be blocked during the VC-state update in the +tree-windows. +＠tab ＠tab +Maybe the root repository for the current directory is a +remote-repository. This can result in a long lasting check-time per +file. +＠ifinfo +＠* +＠end ifinfo +See also ＠ref{Version-control support} for hints what you can do. + +＠item ＠tab ＠tab + +＠item +I have encountered some problems with the display of the VC-state in +the tree-buffers. +＠tab ＠tab +See also ＠ref{Version-control support} for hints what you can do. + +＠end multitable ＠node Command Index, Option Index, FAQ, Top ＠unnumbered Command Index Index: package-info.in =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/package-info.in,v retrieving revision 1.6 diff -u -r1.6 package-info.in --- package-info.in 7 Feb 2004 16:15:41 -0000 1.6 +++ package-info.in 1 Dec 2004 15:59:50 -0000 ＠＠ -13,7 +13,7 ＠＠ filename FILENAME md5sum MD5SUM size SIZE - provides (ecb-buffertab ecb-compilation ecb-create-layout ecb-cycle ecb ecb-eshell ecb-examples ecb-face ecb-file-browser ecb-help ecb-layout ecb-layout-defs ecb-method-browser ecb-mode-line ecb-navigate ecb-speedbar ecb-tod ecb-autogen ecb-jde ecb-upgrade ecb-util ecb-winman-support ecb-semantic-wrapper silentcomp tree-buffer ecb-compatibility) + provides (ecb-buffertab ecb-compilation ecb-create-layout ecb-cycle ecb ecb-eshell ecb-examples ecb-face ecb-file-browser ecb-help ecb-layout ecb-layout-defs ecb-method-browser ecb-mode-line ecb-navigate ecb-speedbar ecb-tod ecb-autogen ecb-jde ecb-upgrade ecb-util ecb-winman-support ecb-semantic-wrapper silentcomp tree-buffer ecb-compatibility ecb-common-browser) requires (REQUIRES) type regular )) Index: silentcomp.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/silentcomp.el,v retrieving revision 1.13 diff -u -r1.13 silentcomp.el --- silentcomp.el 31 Aug 2004 16:00:37 -0000 1.13 +++ silentcomp.el 1 Dec 2004 15:59:50 -0000 ＠＠ -21,7 +21,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: silentcomp.el,v 1.13 2004/08/31 16:00:37 berndl Exp $ +;; $Id: silentcomp.el,v 1.4 2003/07/31 16:02:07 berndl Exp $ ;;; Location Index: tree-buffer.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ecb/tree-buffer.el,v retrieving revision 1.14 diff -u -r1.14 tree-buffer.el --- tree-buffer.el 31 Aug 2004 16:00:37 -0000 1.14 +++ tree-buffer.el 1 Dec 2004 15:59:51 -0000 ＠＠ -26,7 +26,7 ＠＠ ;; GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;; $Id: tree-buffer.el,v 1.14 2004/08/31 16:00:37 berndl Exp $ +;; $Id: tree-buffer.el,v 1.158 2004/12/01 14:19:37 berndl Exp $ ;;; Commentary: ＠＠ -76,6 +76,7 ＠＠ (silentcomp-defun image-type-available-p) (silentcomp-defun count-screen-lines) (silentcomp-defun tmm-prompt) +(silentcomp-defun font-lock-add-keywords) ;; timer stuff for XEmacs (silentcomp-defun delete-itimer) (silentcomp-defun start-itimer) ＠＠ -251,6 +252,7 ＠＠ (defvar tree-buffer-expand-symbol-before nil) (defvar tree-buffer-mouse-action-trigger nil) (defvar tree-buffer-is-click-valid-fn nil) +(defvar tree-buffer-after-update-hook nil) (defvar tree-node-selected-fn nil) (defvar tree-node-expanded-fn nil) (defvar tree-node-collapsed-fn nil) ＠＠ -330,6 +332,224 ＠＠ (modify-syntax-entry ?\[ " " tree-buffer-syntax-table) (modify-syntax-entry ?\] " " tree-buffer-syntax-table)) +;; tree-node + +(defsubst tree-node-add-child (node child) + (tree-node-set-children node (append (tree-node-get-children node) (list child))) + (tree-node-set-parent child node)) + +(defsubst tree-node-add-child-first (node child) + (tree-node-set-children node (cons child (tree-node-get-children node))) + (tree-node-set-parent child node)) + +(defsubst tree-node-sort-children (node sortfn) + (tree-node-set-children node (sort (tree-node-get-children node) sortfn))) + +(defsubst tree-node-remove-child (node child) + "Removes the child from the node." + (tree-node-set-parent child nil) + (tree-node-set-children node + (delq child (tree-node-get-children node)))) + +(defun tree-node-find-child-data (node child-data) + "Finds the first child with the given child-data." + (catch 'exit + (dolist (child (tree-node-get-children node)) + (when (tree-buffer-node-data-equal-p (tree-node-get-data child) + child-data) + (throw 'exit child))))) + +(defun tree-node-remove-child-data (node child-data) + "Removes the first child with the given child-data. Returns the removed +child." + (catch 'exit + (let ((last-cell nil) + (cell (tree-node-get-children node))) + (while cell + (when (tree-buffer-node-data-equal-p (tree-node-get-data (car cell)) + child-data) + (if last-cell + (setcdr last-cell (cdr cell)) + (tree-node-set-children node (cdr cell))) + (setcdr cell nil) + (tree-node-set-parent (car cell) nil) + (throw 'exit cell)) + (setq last-cell cell) + (setq cell (cdr cell)))))) + +(defun tree-node-find-child-name (node child-name) + (catch 'exit + (dolist (child (tree-node-get-children node)) + (when (equal (tree-node-get-name child) child-name) + (throw 'exit child))))) + +(defun tree-node-find-data-recursively (node data) + (if (tree-buffer-node-data-equal-p data (tree-node-get-data node)) + node + (catch 'exit + (dolist (child (tree-node-get-children node)) + (let ((n (tree-node-find-data-recursively child data))) + (when n + (throw 'exit n))))))) + +(defconst tree-node-name 0) +(defconst tree-node-type 1) +(defconst tree-node-data 2) +(defconst tree-node-expanded 3) +(defconst tree-node-parent 4) +(defconst tree-node-children 5) +(defconst tree-node-expandable 6) +(defconst tree-node-shorten-name 7 + "Decides if the node name can be shortened when displayed in a narrow tree +buffer window. The following values are valid: +- beginning: The name is truncated at the beginning so the end is always + visible. +- end: The name is truncated at the end. If the node is expandable the name is + truncated so that the expand symbol is visible. +- nil: The name is never truncated." ) +(defconst tree-node-indentstr 8 + "Containes the full indentation-string for the node. So a single node can +easily redrawn.") + +(defsubst tree-node-set-indentstr (node indentstr) + (aset node tree-node-indentstr indentstr)) + +(defsubst tree-node-get-indentstr (node) + (aref node tree-node-indentstr)) + +(defsubst tree-node-get-indentlength (node) + (length (aref node tree-node-indentstr))) + +(defsubst tree-node-get-name (node) + (aref node tree-node-name)) + +(defsubst tree-node-set-name (node name) + (aset node tree-node-name name)) + +(defsubst tree-node-get-type (node) + (aref node tree-node-type)) + +(defsubst tree-node-set-type (node type) + (aset node tree-node-type type)) + +(defsubst tree-node-get-data (node) + (aref node tree-node-data)) + +(defsubst tree-node-set-data (node data) + (aset node tree-node-data data)) + +(defsubst tree-node-is-expanded (node) + (aref node tree-node-expanded)) + +(defsubst tree-node-set-expanded (node expanded) + (aset node tree-node-expanded expanded)) + +(defsubst tree-node-is-expandable (node) + (aref node tree-node-expandable)) + +(defsubst tree-node-set-expandable (node expandable) + (aset node tree-node-expandable expandable)) + +(defsubst tree-node-get-parent (node) + (aref node tree-node-parent)) + +(defsubst tree-node-set-parent (node parent) + (aset node tree-node-parent parent)) + +(defsubst tree-node-get-children (node) + (aref node tree-node-children)) + +(defsubst tree-node-set-children (node children) + (aset node tree-node-children children)) + +(defsubst tree-node-toggle-expanded (node) + (tree-node-set-expanded node (not (tree-node-is-expanded node)))) + +(defun tree-node-get-depth (node) + (let ((parent (tree-node-get-parent node))) + (if parent + (1+ (tree-node-get-depth parent)) + '0))) + +(defsubst tree-node-set-shorten-name (node shorten) + (aset node tree-node-shorten-name shorten)) + +(defsubst tree-node-get-shorten-name (node) + (aref node tree-node-shorten-name)) + +(defun tree-node-new (name type data &optional not-expandable parent shorten-name) + (let ((a (make-vector 9 nil))) + (tree-node-set-name a name) + (tree-node-set-type a type) + (tree-node-set-data a data) + (tree-node-set-expanded a nil) + (tree-node-set-children a nil) + (tree-node-set-parent a parent) + (tree-node-set-expandable a (not not-expandable)) + (tree-node-set-shorten-name a shorten-name) + (tree-node-set-indentstr a nil) + (when parent + (tree-node-add-child parent a)) + a)) + +(defun tree-node-new-root () + "Creates a new root node. The root node has always NAME=\"root\", TYPE=-1 +and DATA=nil." + (tree-node-new "root" -1 nil)) + +(defun tree-node-update (node name shorten-name type data expandable) + "Update NODE with setable datas. Each of the arguments NAME, SHORTEN-NAME, +TYPE, DATA and EXPANDABLE can have the special value 'use-old-value\; this +means that attribute of NODE will not be updated." + (unless (eq name 'use-old-value) + (tree-node-set-name node name)) + (unless (eq shorten-name 'use-old-value) + (tree-node-set-shorten-name node shorten-name)) + (unless (eq type 'use-old-value) + (tree-node-set-type node type)) + (unless (eq data 'use-old-value) + (tree-node-set-data node data)) + (unless (eq expandable 'use-old-value) + (tree-node-set-expandable node expandable))) + + +(defun tree-node-count-subnodes-to-display (node) + "Returns the number of ALL subnodes of NODE which will currently be displayed +if NODE is expanded, means the number of all the children of NODE \(if NODE is +expanded) plus recursive the number of the children of each expanded child. +Example: +\[-] NODE + \[+] child 1 + \[-] child 2 + \[+] child 2.1 + \[-] child 2.2 + \[+] child 2.2.1 + \[+] child 2.2.2 + \[+] child 2.3 + \[-] child 3 + \[+] child 3.1 + \[+] child 4 +The result for NODE here is 10" + (let ((result 0)) + (when (and (tree-node-is-expandable node) + (tree-node-is-expanded node)) + (setq result (+ result (length (tree-node-get-children node)))) + (dolist (child (tree-node-get-children node)) + (setq result (+ result (tree-node-count-subnodes-to-display child))))) + result)) + +(defun tree-node-get-all-visible-node-names (start-node) + (let ((result (if (not (equal tree-buffer-root start-node)) + (list (tree-node-get-name start-node))))) + (when (or (equal tree-buffer-root start-node) + (tree-node-is-expanded start-node)) + (dolist (child (tree-node-get-children start-node)) + (setq result (append result (tree-node-get-all-visible-node-names child))))) + result)) + + + + ;; image support (defvar tree-buffer-enable-xemacs-image-bug-hack ＠＠ -496,9 +716,13 ＠＠ (message nil)))) msg)) +(defsubst tree-buffer-current-line () + "Return the current line-number - the first line in a buffer has number 1." + (+ (count-lines 1 (point)) (if (= (current-column) 0) 1 0))) + (defun tree-buffer-get-node-name-start-column (node) "Returns the buffer column where the name of the node starts." - (+ (tree-buffer-get-node-indent node) + (+ (tree-node-get-indentlength node) (if (and tree-buffer-expand-symbol-before (or (tree-node-is-expandable node) (member (tree-node-get-type node) ＠＠ -554,6 +778,11 ＠＠ (name (car name-node)) (node (cdr name-node))) (when node + ;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: Is this the right place + ;; for this? + (ignore-errors + (let ((search-nonincremental-instead nil)) + (isearch-exit))) (if (and (tree-buffer-at-expand-symbol name node p) ;; if the expand-symbol is displayed before and mouse-button ;; = 0, means RET is pressed, we do not toggle-expand but work ＠＠ -599,9 +828,6 ＠＠ (let ((linenr (+ (count-lines 1 (point)) (if (= (current-column) 0) 0 -1)))) (nth linenr tree-buffer-nodes)))) -(defsubst tree-buffer-get-node-indent (node) - (* tree-buffer-indent (1- (tree-node-get-depth node)))) - (defun tree-buffer-node-data-equal-p (node-data-1 node-data-2) (and node-data-1 node-data-2 ;; if this comparison-function runs into an error we handle this as ＠＠ -637,19 +863,22 ＠＠ ;; especially with complex-data (e.g. semantic tags). ;; Therefore we first get the position P of the name of ;; start-node in the list of node-names of - ;; tree-buffer-nodes (list of cars of this list) and - ;; then we get that sublist of tree-buffer-nodes which - ;; begins with the P-th elemen of tree-buffer-nodes - ;; (nthcdr P tree-buffer-nodes). + ;; tree-buffer-nodes (list of names of cdrs of this + ;; list) and then we get that sublist of + ;; tree-buffer-nodes which begins with the P-th element + ;; of tree-buffer-nodes (nthcdr P tree-buffer-nodes). (or (ignore-errors - (nthcdr (ecb-position (mapcar 'car tree-buffer-nodes) + (nthcdr (ecb-position (mapcar (lambda (n) + (tree-node-get-name + (cdr n))) + tree-buffer-nodes) (tree-node-get-name start-node)) tree-buffer-nodes)) tree-buffer-nodes))) (equal-fcn 'tree-buffer-node-data-equal-p)) - (dolist (node node-list) - (when (funcall equal-fcn (tree-node-get-data (cdr node)) node-data) - (throw 'exit node)))))) + (dolist (name-node node-list) + (when (funcall equal-fcn (tree-node-get-data (cdr name-node)) node-data) + (throw 'exit name-node)))))) (defun tree-buffer-search-node-list (find-fcn) (catch 'exit ＠＠ -846,7 +1075,7 ＠＠ (if (null node) (progn ;; node can not be found because maybe the node is a subnode and - ;; it´s parent is not expanded --> then there is no node for + ;; it's parent is not expanded --> then there is no node for ;; NODE-DATA; therefore we must remove the highlighting (tree-buffer-remove-highlight) nil) ＠＠ -942,7 +1171,42 ＠＠ (tree-buffer-merge-face-into-text text facer))) (insert text)))) -(defun tree-buffer-insert-node-display (node node-display-name) +(defun tree-buffer-node-display-name (node) + "Computes that string which is used to display the name of NODE. If optional +arg INDENT-LENGTH is a number then it must be the length of the indendation of +NODE. If nil then the indent-length is computed for node." + (let* ((ww (window-width)) + (display-name (tree-node-get-name node)) + (width (+ (tree-node-get-indentlength node) + (length display-name) + (if (tree-node-is-expandable node) 4 0)))) + ;; Truncate name if necessary + (when (and (>= width ww) + (> (length display-name) + (+ (if tree-buffer-running-xemacs 5 4) ;; for the "..." + space + (- width ww) + 3))) ;; there should at least remain 3 visible chars of name + (if (eq 'beginning (tree-node-get-shorten-name node)) + (setq display-name + (concat "..." + (substring display-name (+ (if tree-buffer-running-xemacs 5 4) + (- width ww))))) + (if (and (not tree-buffer-expand-symbol-before) + (tree-node-is-expandable node) + (eq 'end (tree-node-get-shorten-name node))) + (setq display-name + (concat (substring display-name 0 + (- (+ (if tree-buffer-running-xemacs 5 4) + (- width ww)))) + "..."))))) + display-name)) + +(defun tree-buffer-insert-node-display (node &optional no-newline) + "Insert NODE into the tree-buffer with all necessary buttons before or after +the name of the NODE. This function computes also the name how the NODE has to +be displayed and returns this name. If optional arg NO-NEWLINE is not nil then +no final newline is displayed after inserting the node. Otherwise always a +newline is inserted after the node." (let* ((node-type (tree-node-get-type node)) (tree-image-name (if (and (tree-node-is-expanded node) (tree-node-is-expandable node)) ＠＠ -956,7 +1220,8 ＠＠ "leaf" nil)) "close"))) - (ascii-symbol (tree-buffer-ascii-symbol-4-image-name tree-image-name))) + (ascii-symbol (tree-buffer-ascii-symbol-4-image-name tree-image-name)) + (display-name (tree-buffer-node-display-name node))) (when (and tree-buffer-expand-symbol-before ascii-symbol tree-image-name) (tree-buffer-insert-text ＠＠ -967,13 +1232,14 ＠＠ (if (or tree-buffer-enable-xemacs-image-bug-hack (not (equal 'image (tree-buffer-style)))) (insert " "))) - (tree-buffer-insert-text node-display-name + (tree-buffer-insert-text display-name (tree-buffer-get-node-facer node) t t) (when (and (not tree-buffer-expand-symbol-before) ascii-symbol) (insert " ") (tree-buffer-insert-text ascii-symbol nil nil t)) - (insert "\n"))) + (unless no-newline (insert "\n")) + display-name)) (defsubst tree-buffer-aset (array idx newelt) (aset array idx newelt) ＠＠ -1015,6 +1281,7 ＠＠ indent-fill-up))) (list guide-str-handle guide-str-no-handle guide-end-str no-guide-str)))) + (defun tree-buffer-add-node (node indent-str-first-segs indent-str-last-seg &optional last-children) "Insert NODE in current tree-buffer at point. ＠＠ -1022,104 +1289,140 ＠＠ INDENT-STR-LAST-SEG. If LAST-CHILDREN is not nil then NODE is the last children of its parent-node; this means it must be displayed with an end-guide." - (let* ((ww (window-width)) - (name (tree-node-get-name node)) - (width (+ (length indent-str-first-segs) - (length indent-str-last-seg) - (length name) - (if (tree-node-is-expandable node) 4 0)))) - ;; Truncate name if necessary - (when (and (>= width ww) - (> (length name) - (+ (if tree-buffer-running-xemacs 5 4) ;; for the "..." + space - (- width ww) - 3))) ;; there should at least remain 3 visible chars of name - (if (eq 'beginning (tree-node-get-shorten-name node)) - (setq name - (concat "..." - (substring name (+ (if tree-buffer-running-xemacs 5 4) - (- width ww))))) - (if (and (not tree-buffer-expand-symbol-before) - (tree-node-is-expandable node) - (eq 'end (tree-node-get-shorten-name node))) - (setq name - (concat (substring name 0 - (- (+ (if tree-buffer-running-xemacs 5 4) - (- width ww)))) - "..."))))) - ;; insert the indent-string - (when tree-buffer-ascii-guide-face - (put-text-property 0 (length indent-str-first-segs) - 'face tree-buffer-ascii-guide-face - indent-str-first-segs) - (put-text-property 0 (length indent-str-last-seg) - 'face tree-buffer-ascii-guide-face - indent-str-last-seg)) - (insert (concat indent-str-first-segs indent-str-last-seg)) - ;; insert the node with all its symbols - either as image or ascii - (tree-buffer-insert-node-display node name) - ;; add the node to the `tree-buffer-nodes' - (setq tree-buffer-nodes - (append tree-buffer-nodes (list (cons name node)))) - ;; compute the indentation-strings for the children and run recursive for - ;; each child - (if (tree-node-is-expanded node) - (let* ((number-of-childs (length (tree-node-get-children node))) - (counter 0) - (guide-strings (tree-buffer-gen-guide-strings)) - (guide-str (if (and (equal 'image (tree-buffer-style)) - tree-buffer-enable-xemacs-image-bug-hack) - (nth 0 guide-strings) - (nth 1 guide-strings))) - (guide-end-str (nth 2 guide-strings)) - (no-guide-str (nth 3 guide-strings)) - (indent-str-last-seg-copy (copy-sequence indent-str-last-seg)) - (next-indent-str-first-segs - (if (= 0 (length indent-str-last-seg-copy)) - "" - (concat indent-str-first-segs - (if last-children - (tree-buffer-add-image-icon-maybe - 2 1 - (tree-buffer-add-image-icon-maybe - 0 2 no-guide-str - (tree-buffer-find-image "no-guide")) - (tree-buffer-find-image "no-handle")) + ;; here we save the indentstr in the node itself - we do this as first step + ;; so all following steps can use the indentstr from the node itself + (when tree-buffer-ascii-guide-face + (put-text-property 0 (length indent-str-first-segs) + 'face tree-buffer-ascii-guide-face + indent-str-first-segs) + (put-text-property 0 (length indent-str-last-seg) + 'face tree-buffer-ascii-guide-face + indent-str-last-seg)) + (tree-node-set-indentstr node + (concat indent-str-first-segs indent-str-last-seg)) + + ;; insert the node indentation + (insert (tree-node-get-indentstr node)) + + ;; insert the node with all its symbols - either as image or ascii and add + ;; the node to the `tree-buffer-nodes' + (setq tree-buffer-nodes + (append tree-buffer-nodes + (list (cons (tree-buffer-insert-node-display node) + node)))) + ;; compute the indentation-strings for the children and run recursive for + ;; each child + (if (tree-node-is-expanded node) + (let* ((number-of-childs (length (tree-node-get-children node))) + (counter 0) + (guide-strings (tree-buffer-gen-guide-strings)) + (guide-str (if (and (equal 'image (tree-buffer-style)) + tree-buffer-enable-xemacs-image-bug-hack) + (nth 0 guide-strings) + (nth 1 guide-strings))) + (guide-end-str (nth 2 guide-strings)) + (no-guide-str (nth 3 guide-strings)) + (indent-str-last-seg-copy (copy-sequence indent-str-last-seg)) + (next-indent-str-first-segs + (if (= 0 (length indent-str-last-seg-copy)) + "" + (concat indent-str-first-segs + (if last-children (tree-buffer-add-image-icon-maybe 2 1 - (tree-buffer-aset - indent-str-last-seg-copy - (1- (cond ((equal 'image (tree-buffer-style)) - tree-buffer-indent-with-images) - (tree-buffer-expand-symbol-before - tree-buffer-indent-w/o-images-before-min) - (t - tree-buffer-indent-w/o-images-after-min))) - ? ) - (tree-buffer-find-image "no-handle")))))) - (next-indent-str-last-seg-std - (tree-buffer-add-image-icon-maybe - 2 1 - (tree-buffer-add-image-icon-maybe - 0 2 guide-str - (tree-buffer-find-image "guide")) - (tree-buffer-find-image "handle"))) - (next-indent-str-last-seg-end - (tree-buffer-add-image-icon-maybe - 2 1 - (tree-buffer-add-image-icon-maybe - 0 2 guide-end-str - (tree-buffer-find-image "end-guide")) - (tree-buffer-find-image "handle")))) - (dolist (node (tree-node-get-children node)) - (setq counter (1+ counter)) - (tree-buffer-add-node node - next-indent-str-first-segs - (if (= counter number-of-childs ) - next-indent-str-last-seg-end - next-indent-str-last-seg-std) - (= counter number-of-childs ))))))) + (tree-buffer-add-image-icon-maybe + 0 2 no-guide-str + (tree-buffer-find-image "no-guide")) + (tree-buffer-find-image "no-handle")) + (tree-buffer-add-image-icon-maybe + 2 1 + (tree-buffer-aset + indent-str-last-seg-copy + (1- (cond ((equal 'image (tree-buffer-style)) + tree-buffer-indent-with-images) + (tree-buffer-expand-symbol-before + tree-buffer-indent-w/o-images-before-min) + (t + tree-buffer-indent-w/o-images-after-min))) + ? ) + (tree-buffer-find-image "no-handle")))))) + (next-indent-str-last-seg-std + (tree-buffer-add-image-icon-maybe + 2 1 + (tree-buffer-add-image-icon-maybe + 0 2 guide-str + (tree-buffer-find-image "guide")) + (tree-buffer-find-image "handle"))) + (next-indent-str-last-seg-end + (tree-buffer-add-image-icon-maybe + 2 1 + (tree-buffer-add-image-icon-maybe + 0 2 guide-end-str + (tree-buffer-find-image "end-guide")) + (tree-buffer-find-image "handle")))) + (dolist (node (tree-node-get-children node)) + (setq counter (1+ counter)) + (tree-buffer-add-node node + next-indent-str-first-segs + (if (= counter number-of-childs ) + next-indent-str-last-seg-end + next-indent-str-last-seg-std) + (= counter number-of-childs )))))) + +(defun tree-buffer-update-node (node name shorten-name type data expandable + &optional redisplay) + "This function updates the NODE with the new datas NAME, SHORTEN-NAME, TYPE, +DATA and EXPANDABLE. If NODE is nil then the node at current point will be +updated. Each of the arguments NAME, SHORTEN-NAME, TYPE, DATA and EXPANDABLE +can have the special value 'use-old-value\; this means that attribute of NODE +will not be updated. If first optional arg REDISLAY is not nil then NODE will +be completely redisplayed according to its new data." + (let* ((my-node (or node (tree-buffer-get-node-at-point))) + (node-line (when redisplay + ;; Klaus Berndl <klaus.berndl(a)sdm.de&gt;: We could simply + ;; here call (tree-buffer-find-node my-node) but for + ;; best possible performance we just use the + ;; current linenumber if NODE is nil (means we stay + ;; already at the right point and there is no need to + ;; waste performance by searching a node we have + ;; already "found"...maybe paranoid ;-) + (if node + (tree-buffer-find-node node) + (tree-buffer-current-line)))) + (old-node-data (tree-node-get-data my-node)) + (buffer-read-only nil)) + (tree-node-update my-node name shorten-name type data expandable) + (when node-line + (save-excursion + (goto-line node-line) + (beginning-of-line) + (delete-region (tree-buffer-line-beginning-pos) + (tree-buffer-line-end-pos)) + (insert (tree-node-get-indentstr my-node)) + (tree-buffer-insert-node-display my-node 'no-newline) + ;; rehighlight here the current highlighted node again - this is + ;; necessary if we have redisplayed the currently highlighted node. + ;; For this check we have to compare the old-node-data (before the + ;; update!) with that node-data stored in + ;; `tree-buffer-highlighted-node-data' - but the rehighlight has to be + ;; done with the new node-data (after the update) because the node is + ;; already updated so the node is only findable via the new node-data! + (when (tree-buffer-node-data-equal-p old-node-data + (car tree-buffer-highlighted-node-data)) + (tree-buffer-highlight-node-data (tree-node-get-data my-node) + nil t)))))) + +;; Klaus Berndl <klaus.berndl(a)sdm.de&gt;: Just a test-function - not used +(defun tree-buffer-test-update-node () + (tree-buffer-update-node nil + 'use-old-value + 'use-old-value + 'use-old-value + 'use-old-value + nil ;; we set the node as not-expandable + t)) + (defun tree-buffer-clear () "Clear current tree-buffer, i.e. remove all children of the root-node" (dolist (child (tree-node-get-children (tree-buffer-get-root))) ＠＠ -1144,31 +1447,6 ＠＠ (tree-node-remove-child parent node))))) -(defun tree-node-count-subnodes-to-display (node) - "Returns the number of ALL subnodes of NODE which will currently be displayed -if NODE is expanded, means the number of all the children of NODE \(if NODE is -expanded) plus recursive the number of the children of each expanded child. -Example: -\[-] NODE - \[+] child 1 - \[-] child 2 - \[+] child 2.1 - \[-] child 2.2 - \[+] child 2.2.1 - \[+] child 2.2.2 - \[+] child 2.3 - \[-] child 3 - \[+] child 3.1 - \[+] child 4 -The result for NODE here is 10" - (let ((result 0)) - (when (and (tree-node-is-expandable node) - (tree-node-is-expanded node)) - (setq result (+ result (length (tree-node-get-children node)))) - (dolist (child (tree-node-get-children node)) - (setq result (+ result (tree-node-count-subnodes-to-display child))))) - result)) - (defun tree-buffer-build-tree-buffer-nodes () "Rebuild the variable `tree-buffer-nodes' from the current children of `tree-buffer-root'." ＠＠ -1186,12 +1464,17 ＠＠ (defun tree-buffer-empty-p () (= (point-min) (point-max))) +(defun tree-buffer-run-after-update-hook () + "Run all functions of `tree-buffer-after-update-hook'" + (dolist (f tree-buffer-after-update-hook) + (funcall f))) + (defun tree-buffer-update (&optional node content) "Updates the current tree-buffer. The buffer will be completely rebuild with -it´s current nodes. Window-start and point will be preserved. If NODE is not +it's current nodes. Window-start and point will be preserved. If NODE is not nil and a valid and expanded node with at least one child then the display of -this node is optimized so the node itself and as much as possible of it´s -children \(and also recursive the children of a child if it´s already +this node is optimized so the node itself and as much as possible of it's +children \(and also recursive the children of a child if it's already expanded, see `tree-node-count-subnodes-to-display') are visible in current tree-buffer. If CONTENT is not nil then it must be a cons-cell where the car is the whole string of the tree-buffer and the cdr is the value of ＠＠ -1218,9 +1501,14 ＠＠ nil) (goto-char p) (set-window-start w ws) - ;; let´s optimize the display of the expanded node NODE and it´s children. + ;; let's optimize the display of the expanded node NODE and it's children. (when node - (tree-buffer-recenter node w)))) + (tree-buffer-recenter node w)) + ;; TODO: Klaus Berndl <klaus.berndl(a)sdm.de&gt;: Should we run regardless of + ;; content?? maybe we should define tree-buffer-after-update-hook so for + ;; each function can be defined if should be run in veery case or only if + ;; real update (not from content-cache) + (tree-buffer-run-after-update-hook))) (defun tree-buffer-scroll (point window-start) ＠＠ -1241,6 +1529,19 ＠＠ relative to NODE are expanded and all other are collapsed. A negative LEVEL value means that NODE is collapsed. +Examples: + +- LEVEL = 0: If NODE is the root-node then this means expand only all nodes + with no indentation at all. If NODE is any other node then this means expand + only the NODE itself because it is the only node which has indentation 0 to + itself. All deeper indented nodes will be collapsed. + +- LEVEL = 1: If NODE is the root-node then this means expand all nodes with no + indentation at all and all subnodes of these nodes - all deeper indented + nodes will be collapsed. If NODE is any other node then this means expand + the NODE itself and all of its direct subnodes - because only the direct + subnodes of NODE have indentation-level 1 relativ to NODE. + This function expands beginning from NODE the NODE itself and all subnodes of NODE with level <= LEVEL, so the subnodes of these nodes get visible and collapses all their \(recursive) subnodes with indentation-level > LEVEL. ＠＠ -1351,15 +1652,6 ＠＠ (let ((completion-ignore-case t)) (try-completion subs alist)))) -(defun tree-node-get-all-visible-node-names (start-node) - (let ((result (if (not (equal tree-buffer-root start-node)) - (list (tree-node-get-name start-node))))) - (when (or (equal tree-buffer-root start-node) - (tree-node-is-expanded start-node)) - (dolist (child (tree-node-get-children start-node)) - (setq result (append result (tree-node-get-all-visible-node-names child))))) - result)) - (defun tree-buffer-incremental-node-search () "Incremental search for a node in current tree-buffer. Each display-able key \(e.g. all keys normally bound to `self-insert-command') ＠＠ -1747,7 +2039,7 ＠＠ (if (tree-node-is-expanded node) (tree-buffer-tab-pressed) ;; jump to next higher node - (let* ((new-indent-factor (/ (max 0 (- (tree-buffer-get-node-indent node) + (let* ((new-indent-factor (/ (max 0 (- (tree-node-get-indentlength node) tree-buffer-indent)) tree-buffer-indent)) (search-string ＠＠ -1808,7 +2100,8 ＠＠ type-facer expand-symbol-before highlight-node-face general-face - after-create-hook) + after-create-hook + after-update-hook) "Creates a new tree buffer and returns the newly created buffer. This function creates also a special data-storage for this tree-buffer which can be accessed via `tree-buffer-set-data-store' and `tree-buffer-get-data-store'. ＠＠ -1975,7 +2268,10 ＠＠ AFTER-CREATE-HOOK: A function or a list of functions \(with no arguments) called directly after creating the tree-buffer and defining it's local keymap. For example such a function can add - additional key-bindings for this tree-buffer local keymap." + additional key-bindings for this tree-buffer local keymap. +AFTER-UPDATE-HOOK: A function or a list of functions \(with no arguments) + called each time after the tree-buffer has been updated via + `tree-buffer-update'." (let ((nop (function (lambda(e) (interactive "e")))) (a-c-h (if (functionp after-create-hook) (list after-create-hook) ＠＠ -1996,6 +2292,7 ＠＠ (make-local-variable 'tree-buffer-indent) (make-local-variable 'tree-buffer-mouse-action-trigger) (make-local-variable 'tree-buffer-is-click-valid-fn) + (make-local-variable 'tree-buffer-after-update-hook) (make-local-variable 'tree-node-selected-fn) (make-local-variable 'tree-node-expanded-fn) (make-local-variable 'tree-node-collapsed-fn) ＠＠ -2036,6 +2333,10 ＠＠ (setq tree-buffer-frame frame) (setq tree-buffer-mouse-action-trigger mouse-action-trigger) (setq tree-buffer-is-click-valid-fn is-click-valid-fn) + (setq tree-buffer-after-update-hook + (if (functionp after-update-hook) + (list after-update-hook) + after-update-hook)) (setq tree-node-selected-fn node-selected-fn) (setq tree-node-expanded-fn node-expanded-fn) (setq tree-node-collapsed-fn node-collapsed-fn) ＠＠ -2270,159 +2571,38 ＠＠ (setq tree-buffers (delq (get-buffer buffer) tree-buffers)) (ignore-errors (kill-buffer buffer)))) -;;; Tree node - -(defsubst tree-node-add-child (node child) - (tree-node-set-children node (append (tree-node-get-children node) (list child))) - (tree-node-set-parent child node)) - -(defsubst tree-node-add-child-first (node child) - (tree-node-set-children node (cons child (tree-node-get-children node))) - (tree-node-set-parent child node)) - -(defsubst tree-node-sort-children (node sortfn) - (tree-node-set-children node (sort (tree-node-get-children node) sortfn))) - -(defsubst tree-node-remove-child (node child) - "Removes the child from the node." - (tree-node-set-parent child nil) - (tree-node-set-children node - (delq child (tree-node-get-children node)))) - -(defun tree-node-find-child-data (node child-data) - "Finds the first child with the given child-data." - (catch 'exit - (dolist (child (tree-node-get-children node)) - (when (tree-buffer-node-data-equal-p (tree-node-get-data child) - child-data) - (throw 'exit child))))) - -(defun tree-node-remove-child-data (node child-data) - "Removes the first child with the given child-data. Returns the removed -child." - (catch 'exit - (let ((last-cell nil) - (cell (tree-node-get-children node))) - (while cell - (when (tree-buffer-node-data-equal-p (tree-node-get-data (car cell)) - child-data) - (if last-cell - (setcdr last-cell (cdr cell)) - (tree-node-set-children node (cdr cell))) - (setcdr cell nil) - (tree-node-set-parent (car cell) nil) - (throw 'exit cell)) - (setq last-cell cell) - (setq cell (cdr cell)))))) - -(defun tree-node-find-child-name (node child-name) - (catch 'exit - (dolist (child (tree-node-get-children node)) - (when (equal (tree-node-get-name child) child-name) - (throw 'exit child))))) - -(defun tree-node-find-data-recursively (node data) - (if (tree-buffer-node-data-equal-p data (tree-node-get-data node)) - node - (catch 'exit - (dolist (child (tree-node-get-children node)) - (let ((n (tree-node-find-data-recursively child data))) - (when n - (throw 'exit n))))))) - -;;; Tree node - -(defconst tree-node-name 0) -(defconst tree-node-type 1) -(defconst tree-node-data 2) -(defconst tree-node-expanded 3) -(defconst tree-node-parent 4) -(defconst tree-node-children 5) -(defconst tree-node-expandable 6) -(defconst tree-node-shorten-name 7 - "Decides if the node name can be shortened when displayed in a narrow tree -buffer window. The following values are valid: -- beginning: The name is truncated at the beginning so the end is always - visible. -- end: The name is truncated at the end. If the node is expandable the name is - truncated so that the expand symbol is visible. -- nil: The name is never truncated." ) - -(defun tree-node-new (name type data &optional not-expandable parent shorten-name) - (let ((a (make-vector 8 nil))) - (tree-node-set-name a name) - (tree-node-set-type a type) - (tree-node-set-data a data) - (tree-node-set-expanded a nil) - (tree-node-set-children a nil) - (tree-node-set-parent a parent) - (tree-node-set-expandable a (not not-expandable)) - (tree-node-set-shorten-name a shorten-name) - (when parent - (tree-node-add-child parent a)) - a)) - -(defun tree-node-new-root () - "Creates a new root node. The root node has always NAME=\"root\", TYPE=-1 -and DATA=nil." - (tree-node-new "root" -1 nil)) - -(defsubst tree-node-get-name (node) - (aref node tree-node-name)) -(defsubst tree-node-set-name (node name) - (aset node tree-node-name name)) - -(defsubst tree-node-get-type (node) - (aref node tree-node-type)) - -(defsubst tree-node-set-type (node type) - (aset node tree-node-type type)) - -(defsubst tree-node-get-data (node) - (aref node tree-node-data)) - -(defsubst tree-node-set-data (node data) - (aset node tree-node-data data)) - -(defsubst tree-node-is-expanded (node) - (aref node tree-node-expanded)) - -(defsubst tree-node-set-expanded (node expanded) - (aset node tree-node-expanded expanded)) - -(defsubst tree-node-is-expandable (node) - (aref node tree-node-expandable)) - -(defsubst tree-node-set-expandable (node expandable) - (aset node tree-node-expandable expandable)) +;; editor goodies +(defconst tree-buffer-font-lock-keywords + (eval-when-compile + (let* ( + ;; Function declarations + (vf '( + "tree-buffer-defpopup-command" + )) + (kf (if vf (regexp-opt vf t) "")) + ;; Regexp depths + (kf-depth (if kf (regexp-opt-depth kf) nil)) + (full (concat + ;; Declarative things + "(\\(" kf "\\)" + ;; Whitespaces & name + "\\>[ \t]*\\(\\sw+\\)?" + )) + ) + `((,full + (1 font-lock-keyword-face) + (,(+ 1 kf-depth 1) + font-lock-function-name-face + nil t))) + )) + "Highlighted tree-buffer keywords.") + +(when (fboundp 'font-lock-add-keywords) + (font-lock-add-keywords 'emacs-lisp-mode + tree-buffer-font-lock-keywords) + ) -(defsubst tree-node-get-parent (node) - (aref node tree-node-parent)) - -(defsubst tree-node-set-parent (node parent) - (aset node tree-node-parent parent)) - -(defsubst tree-node-get-children (node) - (aref node tree-node-children)) - -(defsubst tree-node-set-children (node children) - (aset node tree-node-children children)) - -(defsubst tree-node-toggle-expanded (node) - (tree-node-set-expanded node (not (tree-node-is-expanded node)))) - -(defun tree-node-get-depth (node) - (let ((parent (tree-node-get-parent node))) - (if parent - (1+ (tree-node-get-depth parent)) - '0))) - -(defsubst tree-node-set-shorten-name (node shorten) - (aset node tree-node-shorten-name shorten)) - -(defsubst tree-node-get-shorten-name (node) - (aref node tree-node-shorten-name)) (silentcomp-provide 'tree-buffer)