Rationalize specifying "where the packages are" somewhat
18 years, 12 months
Michael Sperber
Michael Sperber
This does away with the "--package-prefix" kludge and instead adds
configure options (with associated environment variables):
--with-early-packages (ultimately defaults to ~/.xemacs)
--with-late-packages (ultimately defaults to ../lib/xemacs)
--with-last-packages
that allow you to say where the packages are. What's good is that
people can specify one of these without screwing up the other ones.
It also fits much more naturally with the internal model. I've also
cleaned up some of the stuff hanging off it.
I'll wait until Sunday with this. Once it's settled down (I'm sure
I'll have screwed up something), I'll make another pass over the
documentation. (Long overdue, I know.)
Index: ChangeLog
2005-11-25 Mike Sperber <mike(a)xemacs.org>
* CHANGES-beta:
* configure.ac: Zap --with-package-prefix; instead, add
--with-early-packages, --with-late-packages, and
--with-last-packages.
Index: src/ChangeLog
2005-11-25 Mike Sperber <mike(a)xemacs.org>
* nt.c (init_mswindows_environment): Add EMACSEARLYPACKAGES,
EMACSLATEPACKAGES, EMACSLASTPACKAGES.
* config.h.in:
(PATH_EARLY_PACKAGE_DIRECTORIES, PATH_LATE_PACKAGE_DIRECTORIES)
(PATH_LAST_PACKAGE_DIRECTORIES): Add.
* paths.h.in:
(PATH_EARLY_PACKAGE_DIRECTORIES, PATH_LATE_PACKAGE_DIRECTORIES)
(PATH_LAST_PACKAGE_DIRECTORIES): Add.
* emacs.c: Add Vconfigure_early_package_directories,
Vconfigure_late_package_directories,
Vconfigure_last_package_directories.
(complex_vars_of_emacs): Set them.
Index: lisp/ChangeLog
2005-11-25 Mike Sperber <mike(a)xemacs.org>
* packages.el (packages-find-package-hierarchies-named): Use
`file-name-as-directory' to normalize something which may not
have a trailing path separator.
* package-get.el (package-get-package-index-file-location): Fix
essentially bogus definition.
* package-admin.el (package-admin-find-top-directory): Use the
existing variables rather than groking the paths from scratch, and
greatly simplify.
* packages.el (packages-find-all-package-hierarchies):
Take into account `configure-early-package-hierarchies',
`configure-late-package-hierarchies',
`configure-last-package-hierarchies', as set by configure.
Index: man/ChangeLog
2005-11-25 Mike Sperber <mike(a)xemacs.org>
* lispref/packaging.texi (The User View):
* xemacs/startup.texi (Startup Paths):
* xemacs-faq.texi (Q2.1.6): Document new configure options and
environment variables for
package locations.
Index: netinstall/ChangeLog
2005-11-25 Mike Sperber <mike(a)xemacs.org>
* reginfo.h (XEMACS_INFO_XEMACS_EARLY_PACKAGES_KEY)
(XEMACS_INFO_XEMACS_LATE_PACKAGES_KEY)
(XEMACS_INFO_XEMACS_LAST_PACKAGES_KEY): Add.
--
Cheers =8-} Mike
Friede, Völkerverständigung und überhaupt blabla
Index: CHANGES-beta
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/CHANGES-beta,v
retrieving revision 1.231
diff -u -r1.231 CHANGES-beta
--- CHANGES-beta 26 Oct 2005 13:15:44 -0000 1.231
+++ CHANGES-beta 25 Nov 2005 17:36:55 -0000
＠＠ -268,8 +268,7 ＠＠
-- New: support NetBSD sound via Linux API. -- Aidan Kehoe
-- Improve: generation of CFLAGS (Jerry James, Ben Wing
-- Improve: parallel build support. -- Malcolm Purvis
--- Improve: support --package-prefix as simple interface to --package-path
- facility. -- Ben Wing
+-- Improve: supersede --package-path by --with-{early,late,last}--packages
-- Improve: support mmdf and pop arguments to --mail-locking. -- Ben Wing
Documentation
Index: INSTALL
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/INSTALL,v
retrieving revision 1.45
diff -u -r1.45 INSTALL
--- INSTALL 7 Nov 2005 08:49:17 -0000 1.45
+++ INSTALL 25 Nov 2005 17:37:00 -0000
＠＠ -875,7 +875,7 ＠＠
--with-site-lisp Unchanged
--with-site-modules Unchanged
---package-prefix --with-package-prefix
+--package-prefix --with-late-packages
--package-path --with-package-path
--infopath --with-infopath
Index: configure.ac
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/configure.ac,v
retrieving revision 1.22
diff -u -r1.22 configure.ac
--- configure.ac 25 Nov 2005 01:41:36 -0000 1.22
+++ configure.ac 25 Nov 2005 17:37:16 -0000
＠＠ -619,11 +619,17 ＠＠
XE_MERGED_ARG([site-modules],
AC_HELP_STRING([--with-site-modules=no],[Disable site-modules directory in the XEmacs hierarchy, which is searched before the installation modules.]),
[], [])
-XE_MERGED_ARG([package-prefix],
- AC_HELP_STRING([--with-package-prefix=DIR],[Specify packages root.]),
- [AC_DEFINE(PACKAGE_PATH_USER_DEFINED)], [])
+XE_MERGED_ARG([early-packages],
+ AC_HELP_STRING([--with-early-packages=DIR],[Specify location of early packages (instead of ~/.xemacs).]),
+ [AC_DEFINE(EARLY_PACKAGE_DIRECTORIES_USER_DEFINED)], [])
+XE_MERGED_ARG([late-packages],
+ AC_HELP_STRING([--with-late-packages=DIR],[Specify location of late packages (instead of default location).]),
+ [AC_DEFINE(LATE_PACKAGE_DIRECTORIES_USER_DEFINED)], [])
+XE_MERGED_ARG([last-packages],
+ AC_HELP_STRING([--with-last-packages=DIR],[Specify location of last packages (instead of default location).]),
+ [AC_DEFINE(LAST_PACKAGE_DIRECTORIES_USER_DEFINED)], [])
XE_MERGED_ARG([package-path],
- AC_HELP_STRING([--with-package-path=PATH],[Search path for package hierarchies.]),
+ AC_HELP_STRING([--with-package-path=PATH],[Search path for package directories.]),
[AC_DEFINE(PACKAGE_PATH_USER_DEFINED)], [])
XE_MERGED_ARG([infopath],
AC_HELP_STRING([--with-infopath=PATH],[Location of info directories]),
＠＠ -5495,13 +5501,38 ＠＠
done
AC_SUBST(INFOPATH)
-if test -z "$with_package_path" && test -n "$with_package_prefix" ; then
- if test "$enable_mule" = "yes" ; then
- with_package_path="~/.xemacs::${with_package_prefix}/site-packages:${with_package_prefix}/xemacs-packages:${with_package_prefix}/mule-packages"
- else
- with_package_path="~/.xemacs::${with_package_prefix}/site-packages:${with_package_prefix}/xemacs-packages"
- fi
-fi
+AC_SUBST(early_packages,$with_early_packages)
+AC_SUBST(EARLY_PACKAGE_DIRECTORIES_USER_DEFINED)
+EARLY_PACKAGE_DIRECTORIES=$with_early_packages
+while true; do
+ case "$EARLY_PACKAGE_DIRECTORIES" in
+ *\$* ) eval "EARLY_PACKAGE_DIRECTORIES=$EARLY_PACKAGE_DIRECTORIES" ;;
+ *) break ;;
+ esac
+done
+AC_SUBST(EARLY_PACKAGE_DIRECTORIES)
+
+AC_SUBST(late_packages,$with_late_packages)
+AC_SUBST(LATE_PACKAGE_DIRECTORIES_USER_DEFINED)
+LATE_PACKAGE_DIRECTORIES=$with_late_packages
+while true; do
+ case "$LATE_PACKAGE_DIRECTORIES" in
+ *\$* ) eval "LATE_PACKAGE_DIRECTORIES=$LATE_PACKAGE_DIRECTORIES" ;;
+ *) break ;;
+ esac
+done
+AC_SUBST(LATE_PACKAGE_DIRECTORIES)
+
+AC_SUBST(last_packages,$with_last_packages)
+AC_SUBST(LAST_PACKAGE_DIRECTORIES_USER_DEFINED)
+LAST_PACKAGE_DIRECTORIES=$with_last_packages
+while true; do
+ case "$LAST_PACKAGE_DIRECTORIES" in
+ *\$* ) eval "LAST_PACKAGE_DIRECTORIES=$LAST_PACKAGE_DIRECTORIES" ;;
+ *) break ;;
+ esac
+done
+AC_SUBST(LAST_PACKAGE_DIRECTORIES)
AC_SUBST(package_path,$with_package_path)
AC_SUBST(PACKAGE_PATH_USER_DEFINED)
Index: lib-src/config.values.in
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lib-src/config.values.in,v
retrieving revision 1.24
diff -u -r1.24 config.values.in
--- lib-src/config.values.in 11 Mar 2005 11:20:00 -0000 1.24
+++ lib-src/config.values.in 25 Nov 2005 17:37:16 -0000
＠＠ -110,6 +110,7 ＠＠
c_switch_all "＠c_switch_all＠"
c_switch_general "＠c_switch_general＠"
c_switch_window_system "＠c_switch_window_system＠"
+canna_libs "＠canna_libs＠"
configuration "＠configuration＠"
configure_input "＠configure_input＠"
datadir "＠datadir＠"
Index: lisp/package-admin.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/package-admin.el,v
retrieving revision 1.25
diff -u -r1.25 package-admin.el
--- lisp/package-admin.el 27 Dec 2004 12:25:14 -0000 1.25
+++ lisp/package-admin.el 25 Nov 2005 17:37:34 -0000
＠＠ -150,12 +150,7 ＠＠
trying to find a directory for.
Optional Argument USER-DIR if non-nil use directories off
-`user-init-directory'. This overrides everything except
-\"EMACSPACKAGEPATH\".
-
-This function honours the environment variable \"EMACSPACKAGEPATH\"
-and returns directories found there as a priority. If that variable
-doesn't exist and USER-DIR is nil, check in the normal places.
+`early-package-directories'.
If we still can't find a suitable directory, return nil.
＠＠ -164,55 +159,31 ＠＠
std == For \"standard\" packages that go in '/xemacs-packages/'
mule == For \"mule\" packages that go in '/mule-packages/'
site == For \"unsupported\" packages that go in '/site-packages/'
-
-Note: Type \"site\" is not yet fully supported."
- (let* ((env-value (getenv "EMACSPACKAGEPATH"))
+"
+ (let* ((hierarchies late-package-hierarchies)
+
+ (hierarchy-suffix
+ (file-name-as-directory
+ (cond
+ ((eq type 'std) "xemacs-packages")
+ ((eq type 'mule) "mule-packages")
+ ((eq type 'site) "site-packages"))))
+ (suffix-length (length hierarchy-suffix))
top-dir)
- ;; First, check the environment var.
- (if env-value
- (let ((path-list (paths-decode-directory-path env-value 'drop-empties)))
- (cond ((eq type 'std)
- (while path-list
- (if (equal (file-name-nondirectory
- (directory-file-name (car path-list)))
- "xemacs-packages")
- (setq top-dir (car path-list)))
- (setq path-list (cdr path-list))))
- ((eq type 'mule)
- (while path-list
- (if (equal (file-name-nondirectory
- (directory-file-name (car path-list)))
- "mule-packages")
- (setq top-dir (car path-list)))
- (setq path-list (cdr path-list)))))))
- ;; Wasn't in the environment, try `user-init-directory' if
- ;; USER-DIR is non-nil.
- (if (and user-dir
- (not top-dir))
- (cond ((eq type 'std)
- (setq top-dir (file-name-as-directory
- (expand-file-name "xemacs-packages" user-init-directory))))
- ((eq type 'mule)
- (setq top-dir (file-name-as-directory
- (expand-file-name "mule-packages" user-init-directory))))))
- ;; Finally check the normal places
- (if (not top-dir)
- (let ((path-list (nth 1 (packages-find-all-package-hierarchies
- emacs-data-roots))))
- (cond ((eq type 'std)
- (while path-list
- (if (equal (substring (car path-list) -16)
- (concat "xemacs-packages" (char-to-string directory-sep-char)))
- (setq top-dir (car path-list)))
- (setq path-list (cdr path-list))))
- ((eq type 'mule)
- (while path-list
- (if (equal (substring (car path-list) -14)
- (concat "mule-packages" (char-to-string directory-sep-char)))
- (setq top-dir (car path-list)))
- (setq path-list (cdr path-list)))))))
- ;; Now return either the directory or nil.
- top-dir))
+
+ (if user-dir
+ (expand-file-name hierarchy-suffix
+ (if configure-early-package-directories
+ (car configure-early-package-directories)
+ user-init-directory))
+
+ (while hierarchies
+ (if (string-equal (substring (car hierarchies) (- suffix-length))
+ hierarchy-suffix)
+ (setq top-dir (car hierarchies)))
+ (setq hierarchies (cdr hierarchies)))
+ top-dir)))
+
(defun package-admin-get-install-dir (package &optional pkg-dir)
"Find a suitable installation directory for a package.
Index: lisp/package-get.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/package-get.el,v
retrieving revision 1.71
diff -u -r1.71 package-get.el
--- lisp/package-get.el 24 Oct 2005 22:40:21 -0000 1.71
+++ lisp/package-get.el 25 Nov 2005 17:37:35 -0000
＠＠ -171,7 +171,16 ＠＠
;;;###autoload
(defcustom package-get-package-index-file-location
- (car (split-path (or (getenv "EMACSPACKAGEPATH") user-init-directory)))
+ (cond
+ ;; historical backage
+ ((getenv "EMACSPACKAGEPATH")
+ (split-path (getenv "EMACSPACKAGEPATH")))
+ ((getenv "EMACSEARLYPACKAGES")
+ (split-path (getenv "EMACSEARLYPACKAGES")))
+ (configure-early-package-directories
+ (car configure-early-package-directories))
+ (t
+ user-init-directory))
"*The directory where the package-index file can be found."
:type 'directory
:group 'package-get)
Index: lisp/packages.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/packages.el,v
retrieving revision 1.53
diff -u -r1.53 packages.el
--- lisp/packages.el 3 Feb 2005 23:56:53 -0000 1.53
+++ lisp/packages.el 25 Nov 2005 17:37:35 -0000
＠＠ -345,7 +345,9 ＠＠
Returns list of hierarchies."
(paths-directories-which-exist
(mapcar #'(lambda (package-directory)
- (file-name-as-directory (concat package-directory base)))
+ (file-name-as-directory
+ (concat (file-name-as-directory package-directory)
+ base)))
package-directories)))
(defun packages-split-path (path)
＠＠ -387,44 +389,67 ＠＠
(paths-uniq-append (paths-find-version-directories roots "" nil nil t)
(paths-find-site-directories roots "")))
-(defun packages-find-package-hierarchies (package-directories &optional default)
+(defun packages-find-package-hierarchies (package-directories &optional envvar default)
"Find package hierarchies in a list of package directories.
PACKAGE-DIRECTORIES is a list of package directories.
-DEFAULT is a default list of package hierarchies."
- (or default
- (let ((package-hierarchies '())
- (hierarchy-directories (packages-package-hierarchy-directory-names)))
- (while hierarchy-directories
- (setq package-hierarchies
- (nconc package-hierarchies
- (packages-find-package-hierarchies-named
- package-directories
- (car hierarchy-directories))))
- (setq hierarchy-directories (cdr hierarchy-directories)))
- package-hierarchies)))
+DEFAULT is a default list of package hierarchies.
+ENVVAR is the name of an environment variable that may override
+the default."
+ (let* ((envvar-value (and envvar (getenv envvar)))
+ (package-directories
+ (if envvar-value
+ (split-path envvar-value)
+ package-directories)))
+
+ (or (and (not envvar-value) default)
+ (let ((package-hierarchies '())
+ (hierarchy-directories (packages-package-hierarchy-directory-names)))
+ (while hierarchy-directories
+ (setq package-hierarchies
+ (nconc package-hierarchies
+ (packages-find-package-hierarchies-named
+ package-directories
+ (car hierarchy-directories))))
+ (setq hierarchy-directories (cdr hierarchy-directories)))
+ package-hierarchies))))
(defun packages-find-all-package-hierarchies (roots)
- "Find the package hierarchies.
+ "Find the package hierarchies.
ROOTS is a list of installation roots.
Returns a list of three directory lists, the first being the list of early
hierarchies, the second that of the late hierarchies, and the third the
list of the last hierarchies."
+ ;; EMACSPACKAGEPATH is a historical kludge
(let ((envvar-value (getenv "EMACSPACKAGEPATH")))
- (if envvar-value
- (packages-split-package-path (paths-decode-directory-path envvar-value))
+ (cond
+ (envvar-value
+ (packages-split-package-path (paths-decode-directory-path envvar-value)))
+ (configure-package-path
(packages-deconstruct
(packages-split-package-path configure-package-path)
- #'(lambda (configure-early-package-hierarchies
- configure-late-package-hierarchies
- configure-last-package-hierarchies)
+ #'(lambda (early late last)
(list
(packages-find-package-hierarchies (list user-init-directory)
- configure-early-package-hierarchies)
+ "EMACSEARLYPACKAGES"
+ early)
(packages-find-package-hierarchies (packages-find-installation-package-directories roots)
- configure-late-package-hierarchies)
+ "EMACSLATEPACKAGES"
+
+ late)
(packages-find-package-hierarchies '()
- configure-last-package-hierarchies)))))))
-
+ "EMACSLASTPACKAGES"
+ last)))))
+ (t
+ (list
+ (packages-find-package-hierarchies (or configure-early-package-directories
+ (list user-init-directory))
+ "EMACSEARLYPACKAGES")
+ (packages-find-package-hierarchies (or configure-late-package-directories
+ (packages-find-installation-package-directories roots))
+ "EMACSLATEPACKAGES")
+ (packages-find-package-hierarchies configure-last-package-directories
+ "EMACSLASTPACKAGES"))))))
+
(defun packages-find-package-library-path (package-hierarchies suffixes)
"Construct a path into a component of the packages hierarchy.
PACKAGE-HIERARCHIES is a list of package hierarchies.
Index: man/xemacs-faq.texi
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/man/xemacs-faq.texi,v
retrieving revision 1.87
diff -u -r1.87 xemacs-faq.texi
--- man/xemacs-faq.texi 24 Oct 2005 20:39:47 -0000 1.87
+++ man/xemacs-faq.texi 25 Nov 2005 17:37:50 -0000
＠＠ -3268,7 +3268,7 ＠＠
with ＠samp{$prefix} (for example, you're a developer and are compiling
the packages yourself, and want your own private copy of everything),
you can also directly specify this using ＠file{configure}. To do this
-with 21.5 and above use the ＠samp{--with-package-prefix} parameter to
+with 21.5 and above use the ＠samp{--with-late-packages} parameter to
specify the directory under which you untarred the above tarballs.
Under 21.4 and previous you need to use ＠samp{--package-path}. Using
these options looks something like this:
＠＠ -3506,10 +3506,12 ＠＠
under ＠file{/usr/local/lib/xemacs}.
You can specify where exactly XEmacs looks for packages by using the
-＠samp{--with-package-prefix} or ＠samp{--with-package-path} parameters to
-＠file{configure} (or the equivalent settings in ＠file{config.inc}, under
-Windows), or setting the ＠samp{EMACSPACKAGEPATH} environment variable
-(which has the same format as ＠samp{--with-package-path}). ＠xref{Q2.1.1}.
+＠samp{--with-early-packages} or ＠samp{--with-late-packages} or
+＠samp{--with-last-packages} parameters to ＠file{configure} (or the
+equivalent settings in ＠file{config.inc}, under Windows), or setting the
+＠samp{EMACSEARLYPACKAGES}, ＠samp{EMACSLATEPACKAGES}, and
+＠samp{EMACSLASTPACKAGES} environment variables (which have the same format
+as the configure options). ＠xref{Q2.1.1}.
See ＠file{configure.usage} for more info about the format of these
＠file{configure} parameters.
Index: man/lispref/packaging.texi
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/man/lispref/packaging.texi,v
retrieving revision 1.12
diff -u -r1.12 packaging.texi
--- man/lispref/packaging.texi 26 Sep 2005 22:19:05 -0000 1.12
+++ man/lispref/packaging.texi 25 Nov 2005 17:37:52 -0000
＠＠ -168,8 +168,10 ＠＠
results in a very ``clean'' ＠code{load-path}.
The order of search can be changed at build time by specifying the
-＠samp{--package-path} option to ＠file{configure}, or at run-time by
-specifying the ＠code{EMACSPACKAGEPATH} environment variable.
+＠samp{--with-early-packages}, ＠samp{--with-late-packages}, and
+＠samp{--with-last-packages} option to ＠file{configure}, or at run-time
+by specifying the ＠code{EMACSEARLYPACKAGES}, ＠code{EMACSLATEPACKAGES},
+＠code{EMACSLASTPACKAGES} environment variables.
＠xref{Packages,,,xemacs}.
＠c #### The following description is quite possibly inaccurate.
Index: man/xemacs/startup.texi
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/man/xemacs/startup.texi,v
retrieving revision 1.10
diff -u -r1.10 startup.texi
--- man/xemacs/startup.texi 5 Feb 2003 08:18:58 -0000 1.10
+++ man/xemacs/startup.texi 25 Nov 2005 17:37:52 -0000
＠＠ -82,15 +82,13 ＠＠
hierarchy.
It is possible to specify at configure-time the location of the various
-package hierarchies with the ＠code{--package-path} option to configure.
+package directories with the ＠code{--with-early-packages},
+＠code{--with-late-packages}, and ＠code{--with-last-packages} options to
+configure.
＠cindex package path
-The early, late, and last components of the package path are separated
-by double instead of single colons. If all three components are
-present, they locate the early, late, and last package hierarchies
-respectively. If two components are present, they locate the early and
-late hierarchies. If only one component is present, it locates the
-late hierarchy. At run time, the package path may also be specified via
-the ＠code{EMACSPACKAGEPATH} environment variable.
+At run time, the package directories may also be specified via the
+＠code{EMACSEARLYPACKAGES}, ＠code{EMACSLATEPACKAGES}, and
+＠code{EMACSLASTPACKAGES} environment variables.
An XEmacs package hierarchy is laid out just like a normal installed
XEmacs directory. It may have ＠file{lisp}, ＠file{etc}, ＠file{info}, and
Index: netinstall/reginfo.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/netinstall/reginfo.h,v
retrieving revision 1.3
diff -u -r1.3 reginfo.h
--- netinstall/reginfo.h 9 Sep 2001 04:37:47 -0000 1.3
+++ netinstall/reginfo.h 25 Nov 2005 17:37:52 -0000
＠＠ -8,6 +8,9 ＠＠
#define XEMACS_INFO_XEMACS_ROOT_KEY "emacs_dir"
#define XEMACS_INFO_XEMACS_ROOT_TYPE "install_type"
#define XEMACS_INFO_XEMACS_PACKAGE_KEY "EMACSPACKAGEPATH"
+#define XEMACS_INFO_XEMACS_EARLY_PACKAGES_KEY "EMACSEARLYPACKAGES"
+#define XEMACS_INFO_XEMACS_LATE_PACKAGES_KEY "EMACSLATEPACKAGES"
+#define XEMACS_INFO_XEMACS_LAST_PACKAGES_KEY "EMACSLASTPACKAGES"
#define XEMACS_INFO_XEMACS_VERSION_KEY "version"
#define XEMACS_DEFAULT_ROOT "\\Program Files\\XEmacs"
Index: src/config.h.in
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/config.h.in,v
retrieving revision 1.103
diff -u -r1.103 config.h.in
--- src/config.h.in 25 Nov 2005 01:41:56 -0000 1.103
+++ src/config.h.in 25 Nov 2005 17:38:24 -0000
＠＠ -759,6 +759,9 ＠＠
#undef SITEMODULEDIR_USER_DEFINED
#undef DOCDIR_USER_DEFINED
#undef LISPDIR_USER_DEFINED
+#undef EARLY_PACKAGE_DIRECTORIES_USER_DEFINED
+#undef LATE_PACKAGE_DIRECTORIES_USER_DEFINED
+#undef LAST_PACKAGE_DIRECTORIES_USER_DEFINED
#undef PACKAGE_PATH_USER_DEFINED
#undef SITELISPDIR_USER_DEFINED
#undef ARCHLIBDIR_USER_DEFINED
Index: src/emacs.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/emacs.c,v
retrieving revision 1.161
diff -u -r1.161 emacs.c
--- src/emacs.c 25 Nov 2005 01:42:00 -0000 1.161
+++ src/emacs.c 25 Nov 2005 17:38:28 -0000
＠＠ -542,6 +542,9 ＠＠
Lisp_Object Vmodule_directory, Vconfigure_module_directory;
Lisp_Object Vsite_module_directory, Vconfigure_site_module_directory;
Lisp_Object Vconfigure_package_path;
+Lisp_Object Vconfigure_early_package_directories;
+Lisp_Object Vconfigure_late_package_directories;
+Lisp_Object Vconfigure_last_package_directories;
Lisp_Object Vdata_directory, Vconfigure_data_directory;
Lisp_Object Vdoc_directory, Vconfigure_doc_directory;
Lisp_Object Vconfigure_lock_directory;
＠＠ -4484,6 +4487,36 ＠＠
(build_ext_string (PATH_MODULESEARCH, Qfile_name));
#else
Vconfigure_module_directory = Qnil;
+#endif
+
+ DEFVAR_LISP ("configure-early-package-directories", &Vconfigure_early_package_directories /*
+For internal use by the build procedure only.
+configure's idea of what the early package directories will be.
+*/ );
+#ifdef PATH_EARLY_PACKAGE_DIRECTORIES
+ Vconfigure_early_package_directories = split_external_path (PATH_EARLY_PACKAGE_DIRECTORIES);
+#else
+ Vconfigure_early_package_directories = Qnil;
+#endif
+
+ DEFVAR_LISP ("configure-late-package-directories", &Vconfigure_late_package_directories /*
+For internal use by the build procedure only.
+configure's idea of what the late package directories will be.
+*/ );
+#ifdef PATH_LATE_PACKAGE_DIRECTORIES
+ Vconfigure_late_package_directories = split_external_path (PATH_LATE_PACKAGE_DIRECTORIES);
+#else
+ Vconfigure_late_package_directories = Qnil;
+#endif
+
+ DEFVAR_LISP ("configure-last-package-directories", &Vconfigure_last_package_directories /*
+For internal use by the build procedure only.
+configure's idea of what the last package directories will be.
+*/ );
+#ifdef PATH_LAST_PACKAGE_DIRECTORIES
+ Vconfigure_last_package_directories = split_external_path (PATH_LAST_PACKAGE_DIRECTORIES);
+#else
+ Vconfigure_last_package_directories = Qnil;
#endif
DEFVAR_LISP ("configure-package-path", &Vconfigure_package_path /*
Index: src/nt.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/nt.c,v
retrieving revision 1.47
diff -u -r1.47 nt.c
--- src/nt.c 27 Sep 2005 05:32:22 -0000 1.47
+++ src/nt.c 25 Nov 2005 17:38:29 -0000
＠＠ -443,6 +443,9 ＠＠
"EMACSDATA",
"EMACSPATH",
"EMACSPACKAGEPATH",
+ "EMACSEARLYPACKAGES",
+ "EMACSLATEPACKAGES",
+ "EMACSLASTPACKAGES",
"EMACSLOCKMETHOD",
"INFOPATH"
};
Index: src/paths.h.in
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/paths.h.in,v
retrieving revision 1.10
diff -u -r1.10 paths.h.in
--- src/paths.h.in 12 Apr 2001 18:24:10 -0000 1.10
+++ src/paths.h.in 25 Nov 2005 17:41:26 -0000
＠＠ -36,6 +36,10 ＠＠
PATH_MODULESEARCH The default value of `module-load-path'.
+ PATH_EARLY_PACKAGE_DIRECTORIES The value of `--with-early-packages'.
+ PATH_LATE_PACKAGE_DIRECTORIES The value of `--with-late-packages'.
+ PATH_EARLY_PACKAGE_DIRECTORIES The value of `--with-last-packages'.
+
PATH_PACKAGEPATH The default value of `package-path'.
PATH_SITE The default location of site-specific Lisp files.
＠＠ -82,6 +86,18 ＠＠
#ifdef SITEMODULEDIR_USER_DEFINED
#define PATH_SITE_MODULES "＠SITEMODULEDIR＠"
+#endif
+
+#ifdef EARLY_PACKAGE_DIRECTORIES_USER_DEFINED
+#define PATH_EARLY_PACKAGE_DIRECTORIES "＠EARLY_PACKAGE_DIRECTORIES＠"
+#endif
+
+#ifdef LATE_PACKAGE_DIRECTORIES_USER_DEFINED
+#define PATH_LATE_PACKAGE_DIRECTORIES "＠LATE_PACKAGE_DIRECTORIES＠"
+#endif
+
+#ifdef LAST_PACKAGE_DIRECTORIES_USER_DEFINED
+#define PATH_LAST_PACKAGE_DIRECTORIES "＠LAST_PACKAGE_DIRECTORIES＠"
#endif
#ifdef PACKAGE_PATH_USER_DEFINED
- 3 participants
- 9 comments
[COMMIT] Move the XListFonts maxnames param to INT_MAX from 5000
18 years, 12 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
SUPERSEDES m3u0dlepkn.fsf(a)zion.rcn.com
NOTE: This patch has been committed.
Vin, your patch only changed the limit on X11--the same problem arises for
GTK.
src/ChangeLog addition:
2005-12-24 Aidan Kehoe <kehoea(a)parhasard.net>
* objects-gtk.c (MAX_FONT_COUNT):
* objects-x.c (MAX_FONT_COUNT): Increase MAX_FONT_COUNT from 5000
to INT_MAX. Applies to both the X and GTK platforms.
XEmacs Trunk source patch:
Diff command: cvs -q diff -u
Files affected: src/objects-x.c src/objects-gtk.c
Index: src/objects-gtk.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-gtk.c,v
retrieving revision 1.16
diff -u -u -r1.16 objects-gtk.c
--- src/objects-gtk.c 2005/01/28 02:58:51 1.16
+++ src/objects-gtk.c 2005/12/24 17:27:52
＠＠ -485,8 +485,7 ＠＠
/* X Specific stuff */
#include <X11/Xatom.h>
-/* Unbounded, for sufficiently small values of infinity... */
-#define MAX_FONT_COUNT 5000
+#define MAX_FONT_COUNT INT_MAX
#ifdef MULE
/* find a font spec that matches font spec FONT and also matches
＠＠ -536,9 +535,6 ＠＠
return result;
}
#endif /* MULE */
-
-/* Unbounded, for sufficiently small values of infinity... */
-#define MAX_FONT_COUNT 5000
static int
valid_font_name_p (Display *dpy, char *name)
Index: src/objects-x.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-x.c,v
retrieving revision 1.33
diff -u -u -r1.33 objects-x.c
--- src/objects-x.c 2005/12/23 15:08:14 1.33
+++ src/objects-x.c 2005/12/24 17:27:53
＠＠ -693,8 +693,9 ＠＠
return result;
}
-/* Unbounded, for sufficiently small values of infinity... */
-#define MAX_FONT_COUNT 5000
+/* XListFonts doesn't allocate memory unconditionally based on this. (For
+ XFree86 in 2005, at least. */
+#define MAX_FONT_COUNT INT_MAX
static Extbyte *
truename_via_XListFonts (Display *dpy, Extbyte *font_name)
＠＠ -807,8 +808,7 ＠＠
FcChar8 *res = FcNameUnparse (FONT_INSTANCE_X_XFTFONT (f)->pattern);
if (res)
{
- FONT_INSTANCE_TRUENAME (f) =
- build_ext_string (res, Qxft_font_name_encoding);
+ FONT_INSTANCE_TRUENAME (f) = make_string (res, strlen (res));
free (res);
return FONT_INSTANCE_TRUENAME (f);
}
＠＠ -1176,7 +1176,7 ＠＠
Extbyte **names;
int count = 0;
const Extbyte *patternext;
- Lisp_Object result = Qnil;
+ Lisp_Object result = Qunbound;
int i;
/* #### with Xft need to handle second stage here -- sjt
＠＠ -1442,7 +1442,7 ＠＠
if (x_font_spec_matches_charset (XDEVICE (device), charset,
intname, Qnil, 0, -1, 0))
{
- result = build_ext_string (intname, Qx_font_name_encoding);
+ result = make_string (intname, intlen);
break;
}
}
--
I AM IN JAIL AND ALLOWED SEND ONLY ONE CABLE SINCE WAS ARRESTED WHILE
MEASURING FIFTEEN FOOT WALL OUTSIDE PALACE AND HAVE JUST FINISHED COUNTING
THIRTY EIGHT THOUSAND FIVE HUNDERED TWENTY TWO NAMES WHOS WHO IN MIDEAST.
- 2 participants
- 1 comments
[AC] Fix annoying W3 problem
18 years, 12 months
Michael Sperber
Michael Sperber
Every so often, W3 would get into this annoying mood where it creates
a buffer called "stylesheet" and modifies it, thus making it show up
with, say, `save-some-buffers'. I hate when that happens, especially
as the buffer doesn't show up in the regular buffer list. So I did
this long ago and then forgot about it÷
2003-09-08 Mike Sperber <sperber(a)informatik.uni-tuebingen.de>
* lisp/css.el (css-parse): Set `buffer-file-name' to nil after
reading stylesheet, to avoid spurious requests for saving the
file.
Index: lisp/css.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/w3/lisp/css.el,v
retrieving revision 1.5
diff -u -r1.5 css.el
--- lisp/css.el 27 Nov 1999 15:37:18 -0000 1.5
+++ lisp/css.el 26 Dec 2005 13:42:56 -0000
＠＠ -929,6 +929,7 ＠＠
(set-syntax-table css-syntax-table)
(erase-buffer)
(if url (url-insert-file-contents url))
+ (setq buffer-file-name nil)
(goto-char (point-max))
(if string (insert string))
(css-clean-buffer)
--
Cheers =8-} Mike
Friede, Völkerverständigung und überhaupt blabla
- 1 participants
- 0 comments
[COMMIT] Fix self-insert-command with X11 input methods
19 years
Aidan Kehoe
Aidan Kehoe
Zhang, I finally got fcitx working, and saw the problem with my code.
NOTE: This patch has been committed.
lisp/ChangeLog addition:
2005-12-17 Aidan Kehoe <kehoea(a)parhasard.net>
* mule/mule-cmds.el (set-language-environment-coding-systems):
Initialise keyboard-coding-system, terminal-coding-system when
applying a language environment, together with the input and
output coding systems for any active TTY console.
* mule/mule-cmds.el (init-locale-at-early-startup):
If set-current-locale returns a `more-specified version' of the
current locale when passed a zero length argument, the magic used
to work out the current language environment from the C locale
will fail. Call current-locale instead.
src/ChangeLog addition:
2005-12-17 Aidan Kehoe <kehoea(a)parhasard.net>
* console-x.c (x_perhaps_init_unseen_key_defaults):
If the key name is a single character, and the keysym is NoSymbol,
give it a default binding, if that is possible. This addresses the
problem Zhang Wei points out in <871x118lc4.fsf(a)gmail.com>
* event-Xt.c (x_to_emacs_keysym):
Print the characters of a keysym's name directly if it's printable
ASCII, or as an octal escape if it's not.
Use keyboard-coding-system rather than undecided for decoding the
keysym name passed to us by an input method.
* file-coding.c (vars_of_file_coding):
Document that keyboard-coding-system is also used for X11.
XEmacs Trunk source patch:
Diff command: cvs -q diff -u
Files affected: src/file-coding.c src/event-Xt.c src/console-x.c lisp/mule/mule-cmds.el
Index: lisp/mule/mule-cmds.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/mule-cmds.el,v
retrieving revision 1.25
diff -u -u -r1.25 mule-cmds.el
--- lisp/mule/mule-cmds.el 2005/10/04 16:43:36 1.25
+++ lisp/mule/mule-cmds.el 2005/12/17 19:39:21
＠＠ -1271,6 +1271,20 ＠＠
(warn "Invalid native-coding-system %s in language environment %s"
native language-name)))
(define-coding-system-alias 'file-name 'native)
+ ;; Set the default keyboard and terminal coding systems to the native
+ ;; coding system of the language environment.
+ ;;
+ (setq keyboard-coding-system native
+ terminal-coding-system native)
+
+ ;; And do the same for any TTYs.
+ (dolist (con (console-list))
+ (when (eq 'tty (device-type (car (console-device-list con))))
+ ;; Calling set-input-mode at the same time would be a sane thing
+ ;; to do here. I would prefer to default to accepting eight bit
+ ;; input and not using the top bit for Meta.
+ (set-console-tty-coding-system con native)))
+
;; process output should not have EOL conversion. under MS Windows
;; and Cygwin, this screws things up (`cmd' is fine with just LF and
;; `bash' chokes on CR-LF).
＠＠ -1327,7 +1341,7 ＠＠
;; locale but we should still use the right code page, etc.
(declare-fboundp (mswindows-set-current-locale userdef)))
;; Unix:
- (let ((locstring (set-current-locale "")))
+ (let ((locstring (current-locale)))
;; assume C lib locale and LANG env var are set correctly. use
;; them to find the langenv.
(setq langenv
Index: src/console-x.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-x.c,v
retrieving revision 1.15
diff -u -u -r1.15 console-x.c
--- src/console-x.c 2005/06/29 09:47:35 1.15
+++ src/console-x.c 2005/12/17 19:39:21
＠＠ -349,6 +349,26 ＠＠
xkeysym = XStringToKeysym(keysym_ext);
if (NoSymbol == xkeysym)
{
+ /* Keysym is NoSymbol; this may mean the key event passed to us came
+ from an input method, which stored the actual character intended to
+ be inserted in the key name, and didn't trouble itself to set the
+ keycode to anything useful. Thus, if the key name is a single
+ character, and the keysym is NoSymbol, give it a default binding,
+ if that is possible. */
+ Lisp_Object keychar;
+
+ if (1 != string_char_length(key_name))
+ {
+ /* Don't let them pass us more than one character. */
+ return Qnil;
+ }
+ keychar = make_char(itext_ichar(XSTRING_DATA(key_name)));
+ if (NILP (Flookup_key (Vcurrent_global_map, keychar, Qnil)))
+ {
+ Fdefine_key (Vcurrent_global_map, keychar, Qself_insert_command);
+ Fputhash (keychar, Qt, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d));
+ return Qt;
+ }
return Qnil;
}
Index: src/event-Xt.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/event-Xt.c,v
retrieving revision 1.89
diff -u -u -r1.89 event-Xt.c
--- src/event-Xt.c 2005/11/26 11:46:07 1.89
+++ src/event-Xt.c 2005/12/17 19:39:26
＠＠ -898,7 +898,16 ＠＠
int j;
stderr_out (" chars=\"");
for (j=0; j<len; j++)
- stderr_out ("%c", bufptr[j]);
+ {
+ if (040 <= bufptr[j] && bufptr[j] >= 0177)
+ {
+ stderr_out ("%c", bufptr[j]);
+ }
+ else
+ {
+ stderr_out ("\\%o", (unsigned)(bufptr[j]));
+ }
+ }
stderr_out ("\"");
}
else if (bufptr[0] <= 32 || bufptr[0] >= 127)
＠＠ -928,10 +937,18 ＠＠
fb_instream = make_fixed_buffer_input_stream (bufptr, len);
- /* #### Use get_coding_system_for_text_file (Vcomposed_input_coding_system, 0) */
+ /* [[ Use get_coding_system_for_text_file
+ (Vcomposed_input_coding_system, 0) ]]
+
+ Nope. If it is possible for the X libraries to have multiple IM
+ connections on different DISPLAYs active at once, this should be
+ a console-specific variable (like a TTY's coding system) but I've
+ seen no evidence that that is possible. Aidan Kehoe,
+ 2005-12-17. */
+
instream =
make_coding_input_stream
- (XLSTREAM (fb_instream), Qundecided, CODING_DECODE, 0);
+ (XLSTREAM (fb_instream), Qkeyboard, CODING_DECODE, 0);
istr = XLSTREAM (instream);
Index: src/file-coding.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/file-coding.c,v
retrieving revision 1.49
diff -u -u -r1.49 file-coding.c
--- src/file-coding.c 2005/10/25 11:16:24 1.49
+++ src/file-coding.c 2005/12/17 19:39:33
＠＠ -4600,8 +4600,14 ＠＠
#endif
DEFVAR_LISP ("keyboard-coding-system", &Vkeyboard_coding_system /*
-Coding system used for TTY keyboard input.
-Not used under a windowing system.
+Default coding system used for TTY and X11 keyboard input.
+Under X11, used only to interpet the character for a key event when that
+event has a KeySym of NoSymbol but does have an associated string keysym,
+something that's seen with input methods.
+
+If you need to set these things to different coding systems, call the
+function `set-console-tty-coding-system' for the TTY and use this variable
+for X11.
*/ );
Vkeyboard_coding_system = Qnil;
--
I AM IN JAIL AND ALLOWED SEND ONLY ONE CABLE SINCE WAS ARRESTED WHILE
MEASURING FIFTEEN FOOT WALL OUTSIDE PALACE AND HAVE JUST FINISHED COUNTING
THIRTY EIGHT THOUSAND FIVE HUNDERED TWENTY TWO NAMES WHOS WHO IN MIDEAST.
- 2 participants
- 1 comments
[COMMIT] Revert the alloc warning bugfix
19 years
Aidan Kehoe
Aidan Kehoe
NOTE: This patch has been committed.
src/ChangeLog addition:
2005-12-25 Aidan Kehoe <kehoea(a)parhasard.net>
* alloc.c:
* alloc.c (malloc_warning):
* alloc.c (MALLOC_BEGIN):
* alloc.c (FREE_OR_REALLOC_BEGIN):
Revert the alloc warning bugfix, in response to Stephen's mail
87acepzl6e.fsf(a)tleepslib.sk.tsukuba.ac.jp .
XEmacs Trunk source patch:
Diff command: cvs -q diff -u
Files affected: src/alloc.c
Index: src/alloc.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/alloc.c,v
retrieving revision 1.121
diff -u -u -r1.121 alloc.c
--- src/alloc.c 2005/12/24 19:06:05 1.121
+++ src/alloc.c 2005/12/25 11:20:32
＠＠ -231,6 +231,22 ＠＠
}
#endif /* not MC_ALLOC */
+/* malloc calls this if it finds we are near exhausting storage */
+void
+malloc_warning (const char *str)
+{
+ if (ignore_malloc_warnings)
+ return;
+
+ warn_when_safe
+ (Qmemory, Qemergency,
+ "%s\n"
+ "Killing some buffers may delay running out of memory.\n"
+ "However, certainly by the time you receive the 95%% warning,\n"
+ "you should clean up, kill this Emacs, and start a new one.",
+ str);
+}
+
/* Called if malloc returns zero */
DOESNT_RETURN
memory_full (void)
＠＠ -274,21 +290,18 ＠＠
}
#ifdef ERROR_CHECK_MALLOC
-static int in_malloc, in_malloc_warning;
+static int in_malloc;
extern int regex_malloc_disallowed;
#define MALLOC_BEGIN() \
do \
{ \
- assert (!in_malloc || in_malloc_warning); \
+ assert (!in_malloc); \
assert (!regex_malloc_disallowed); \
in_malloc = 1; \
} \
while (0)
-#define MALLOC_WARNING_BEGIN() (++in_malloc_warning)
-#define MALLOC_WARNING_END() (--in_malloc_warning)
-
#ifdef MC_ALLOC
#define FREE_OR_REALLOC_BEGIN(block) \
do \
＠＠ -328,33 +341,10 ＠＠
#else /* ERROR_CHECK_MALLOC */
#define MALLOC_BEGIN()
-#define MALLOC_WARNING_BEGIN()
-#define MALLOC_WARNING_END()
#define FREE_OR_REALLOC_BEGIN(block)
#define MALLOC_END()
#endif /* ERROR_CHECK_MALLOC */
-
-/* malloc calls this if it finds we are near exhausting storage */
-void
-malloc_warning (const char *str)
-{
- if (ignore_malloc_warnings)
- return;
-
- MALLOC_WARNING_BEGIN();
-
- warn_when_safe
- (Qmemory, Qemergency,
- "%s\n"
- "Killing some buffers may delay running out of memory.\n"
- "However, certainly by the time you receive the 95%% warning,\n"
- "you should clean up, kill this Emacs, and start a new one.\n"
- "On Unix, look into your resource limits; ulimit -d, especially.",
- str);
-
- MALLOC_WARNING_END();
-}
static void
malloc_after (void *val, Bytecount size)
--
I AM IN JAIL AND ALLOWED SEND ONLY ONE CABLE SINCE WAS ARRESTED WHILE
MEASURING FIFTEEN FOOT WALL OUTSIDE PALACE AND HAVE JUST FINISHED COUNTING
THIRTY EIGHT THOUSAND FIVE HUNDERED TWENTY TWO NAMES WHOS WHO IN MIDEAST.
- 1 participants
- 0 comments
[AC] [PACKAGES (xetla)] xetla--main--1.1--version-0 is released!
19 years
Steve Youngs
Steve Youngs
APPROVE COMMIT
Norbert, once you've sobered up from all the xmas cheer you're
enjoying, this is good to go. :-)
NOTE: This patch has been committed.
xetla patch:
ChangeLog files diff command: cvs -q diff -U 0
Files affected: ChangeLog
Source files diff command: cvs -q diff -uN
Files affected: ChangeLog.d/ChangeLog-1.1 ChangeLog.d/ChangeLog-1.0 ChangeLog.d/ChangeLog-0.2 ChangeLog.d/ChangeLog-0.1 xetla.el xetla-version.el xetla-tips.el xetla-core.el xetla-browse.el smerge.el package-info.in Makefile
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xetla/ChangeLog,v
retrieving revision 1.2
diff -u -p -U0 -r1.2 ChangeLog
--- ChangeLog 4 Apr 2005 19:05:48 -0000 1.2
+++ ChangeLog 25 Dec 2005 10:52:21 -0000
＠＠ -0,0 +1,15 ＠＠
+2005-12-24 Steve Youngs <steve(a)sxemacs.org>
+
+ * steve(a)eicq.org--2005/xetla--main--1.1--version-0 is released.
+ See ./ChangeLog.d/ChangeLog-1.1 for details.
+
+ * ChangeLog.d/*: New files.
+
+ * package-info.in (description): Mention (S)XEmacs in the
+ description.
+ (provides): Remove smerge, it isn't part of XEtla anymore.
+
+ * Makefile (AUTHOR_VERSION): Bump to
+ steve(a)eicq.org--2005/xetla--main--1.1--version-0
+ (ELCS): Remove smerge.el, it isn't part of XEtla anymore.
+
Index: Makefile
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xetla/Makefile,v
retrieving revision 1.2
diff -u -p -u -r1.2 Makefile
--- Makefile 4 Apr 2005 19:05:48 -0000 1.2
+++ Makefile 25 Dec 2005 10:52:07 -0000
＠＠ -18,7 +18,7 ＠＠
# Boston, MA 02111-1307, USA.
VERSION = 1.00
-AUTHOR_VERSION = steve(a)eicq.org--2005/xetla--main--1.0--version-0
+AUTHOR_VERSION = steve(a)eicq.org--2005/xetla--main--1.1--version-0
MAINTAINER = Steve Youngs <steve(a)youngs.au.com>
PACKAGE = xetla
PKG_TYPE = regular
＠＠ -27,7 +27,6 ＠＠ CATEGORY = standard
ELCS = \
ewoc.elc \
- smerge.elc \
xetla-version.elc \
xetla-browse.elc \
xetla-core.elc \
Index: package-info.in
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xetla/package-info.in,v
retrieving revision 1.1
diff -u -p -u -r1.1 package-info.in
--- package-info.in 4 Apr 2005 13:27:19 -0000 1.1
+++ package-info.in 25 Dec 2005 10:52:07 -0000
＠＠ -9,11 +9,11 ＠＠
priority low
category CATEGORY
dump nil
- description "Frontend to GNU/arch (tla)."
+ description "(S)XEmacs Frontend to GNU/arch (tla)."
filename FILENAME
md5sum MD5SUM
size SIZE
- provides (ewoc smerge xetla-browse xetla-core
+ provides (ewoc xetla-browse xetla-core
xetla-defs xetla-tips xetla-version xetla)
requires (REQUIRES)
type regular
Index: smerge.el
===================================================================
RCS file: smerge.el
diff -N smerge.el
--- smerge.el 4 Apr 2005 13:27:20 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
＠＠ -1,453 +0,0 ＠＠
-;;; smerge.el --- SAM's Merge layer on top of ediff
-
-;; Copyright (C) 2002,2003 Sean MacLennan
-;; $Revision: 1.1 $ $Date: 2005/04/04 13:27:20 $
-;; XEmacs
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with 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.
-
-;; TODO:
-;; - keymap for buffer!
-;; - ediff needs a list of args
-;; - add more documentation!!!
-
-;; smerge marks the file with the `smerge-merged-face' when the files
-;; are merged. In the case of "only in" files, merged means you copied
-;; the file over to the other directory. However, for ediffed files,
-;; merged means you ran ediff on the files. This does not mean the
-;; files are identical. And you are allowed to run ediff on the files
-;; again. It is really just a marker that you looked at the file.
-
-(require 'ediff)
-
-(defmacro smerge-do-in-gnu-emacs (&rest body)
- "Execute BODY if in GNU/Emacs."
- (unless running-xemacs `(progn ,＠body)))
-(put 'smerge-do-in-gnu-emacs 'lisp-indent-hook 'defun)
-
-(defmacro smerge-do-in-xemacs (&rest body)
- "Execute BODY if in XEmacs."
- (when running-xemacs `(progn ,＠body)))
-(put 'smerge-do-in-xemacs 'lisp-indent-hook 'defun)
-
-
-(smerge-do-in-xemacs
- (defalias 'smerge-dirlist 'directory-files))
-
-(smerge-do-in-gnu-emacs
- (require 'extent)
-
- (defun smerge-dirlist (directory &optional full match nosort files-only)
- (if (eq files-only nil)
- (directory-files directory full match nosort)
- (let ((rawlist (directory-files-and-attributes
- directory full match nosort))
- dirlist)
- (setq files-only (if (eq files-only t) nil t))
- (dolist (entry rawlist)
- (when (eq (nth 1 entry) files-only)
- (setq dirlist (cons (car entry) dirlist))))
- dirlist)))
-
- (defun temp-directory ()
- (let ((tmp (getenv "TMPDIR")))
- (if tmp tmp "/tmp")))
-
- (defun read-directory-name (prompt &optional dir default mustmatch)
- (let* ((dir (read-file-name prompt dir default mustmatch))
- (attr (file-attributes dir)))
- (unless (eq (car attr) t) (error "Must be a directory"))
- dir))
-
- (defun kill-entire-line (&optional arg)
- (let ((kill-whole-line t)) (beginning-of-line) (kill-line arg)))
- )
-
-(defvar smerge-diff-program ediff-diff-program
- "*Program to use to diff the directories. Must support --brief option.")
-
-(defvar smerge-diff-options ediff-diff-options "*See `ediff-diff-options'.")
-
-(defvar smerge-diff-excludes '("*.o" "*.obj" "*.a" "*.lib" "*~" ".#*" "CVS")
- "*List of patterns of files and subdirectories to ignore.
-smerge builds a temprorary file (`smerge-exclude-file') based on this list
-and passes it to `smerge-diff-program' with the --exclude-from option.
-Note: These excludes are wildcard expressions as used by diff, not lisp
-regular expressions.")
-
-(defvar smerge-preserve-modes t
- "*When copying files, preserver the mode of the destination file.")
-
-(defvar smerge-exclude-file (concat (temp-directory) "/smerge-excludes")
- "*Temporary file to hold the `smerge-excludes'.")
-
-(defface smerge-only1-face
- '((((class color)) (:foreground "purple"))
- (t (:underline t)))
- "Face for files/directories only in directory 1.")
-
-(defface smerge-only2-face
- '((((class color)) (:foreground "blue"))
- (t (:underline t)))
- "Face for files/directories only in directory 2.")
-
-(defface smerge-diff-face
- '((((class color)) (:foreground "red"))
- (t (:bold t)))
- "Face for files that are different.")
-
-(defface smerge-merged-face
- '((((class color)) (:foreground "black"))
- (t (:bold t)))
- "Face for files that are merged.")
-
-
-(defvar smerge-buffer "*smerge-output*" "*Name of smerge output buffer.")
-
-(defvar smerge-keymap nil "*Keymap used by smerge.")
-
-(defvar smerge-cvsignore nil
- "*If non-nil, use the .cvsignore files in `dir1' to ignore files.")
-
-;; For debugging
-(defvar smerge-raw-diff-output nil
- "*If non-nil, filename to write the raw diff output to. (dbg)")
-(defvar smerge-keep-cvsignore-buffer nil
- "*If non-nil, keep the raw cvsignore buffer. (dbg)")
-
-;; Internals
-;; SAM This should be a list?
-(defvar smerge-flags nil)
-(defvar smerge-dir1 nil)
-(defvar smerge-dir2 nil)
-(defvar smerge-file nil)
-(defvar smerge-extent nil)
-
-
-(defconst smerge-copy-menu
- (list "Copy to ..."
- [(concat smerge-dir1 smerge-file) (smerge-copy 1) (smerge-allow-dir 1)]
- [(concat smerge-dir2 smerge-file) (smerge-copy 2) (smerge-allow-dir 2)]
- ))
-
-(defun smerge-init ()
- "This creates the keymap."
- (unless smerge-keymap
- (setq smerge-keymap (make-sparse-keymap "smerge"))
- (if running-xemacs
- (progn
- (define-key smerge-keymap 'button1 'smerge-mousable)
- (define-key smerge-keymap 'button2 'smerge-mousable)
- (define-key smerge-keymap 'button3 'smerge-menu))
- (define-key smerge-keymap [mouse-1] 'smerge-mousable)
- (define-key smerge-keymap [mouse-2] 'smerge-mousable)
- (define-key smerge-keymap [mouse-3] 'smerge-menu))
-
- (define-key smerge-keymap "\C-m" 'smerge-ediff-or-copy)
- (define-key smerge-keymap "g" 'smerge-reload)
- (define-key smerge-keymap "r" 'smerge-reload)
- (define-key smerge-keymap "n" 'smerge-next)
- (define-key smerge-keymap "p" 'smerge-prev)
- ))
-
-;;;###autoload
-(defun smerge (flags &optional dir1 dir2)
- "Merge two directories recursively."
- (interactive "p")
- (smerge-init)
- (unless dir1
- (setq dir1 (read-directory-name "Directory 1: " nil nil t)))
- (unless dir2
- (setq dir2 (read-directory-name "Directory 2: " nil nil t)))
- (switch-to-buffer smerge-buffer) ;; Yes I want to be in the output buffer
- (toggle-read-only 0) ;; writable
- (setq smerge-flags flags)
- (setq smerge-dir1 (file-name-as-directory (expand-file-name dir1)))
- (setq smerge-dir2 (file-name-as-directory (expand-file-name dir2)))
- (smerge-recursive-diff)
- (smerge-fixup-filenames)
- (when smerge-cvsignore (smerge-cvsignore smerge-dir1))
- (smerge-post-process flags)
- (toggle-read-only 1) ;; read-only
- )
-
-(defun smerge-reload ()
- "Rediff two directories recursively."
- (interactive)
- (smerge smerge-flags smerge-dir1 smerge-dir2))
-
-(defun smerge-recursive-diff ()
- (let (rc)
- (erase-buffer)
- (dolist (exclude smerge-diff-excludes) (insert (concat exclude "\n")))
- (write-region (point-min) (point-max) smerge-exclude-file nil 'no-message)
- (erase-buffer)
- (let ((diff-options (concat "--exclude-from=" smerge-exclude-file
- " -r" " --brief " smerge-diff-options)))
- ;; Since we are tightly coupled with ediff, use their program!
- ;; This erases the diff buffer automatically.
- (ediff-exec-process smerge-diff-program
- (current-buffer)
- 'synchronize
- diff-options
- smerge-dir1 smerge-dir2))
- (delete-file smerge-exclude-file)
- (when smerge-raw-diff-output
- (write-region (point-min) (point-max) smerge-raw-diff-output))
- (and (numberp rc) (eq rc 0))))
-
-(defun smerge-fixup-filenames ()
- "Diff splits the `Only in' files into directory and filename.
-Top level directories end in /, subdirs do not."
- (goto-char (point-min))
- (while (re-search-forward "^\\(Only in [^:]*\\)\\(.\\): " nil t)
- (if (string= (match-string 2) "/")
- (replace-match "\\1/" nil nil)
- (replace-match "\\1\\2/" nil nil))))
-
-(defun smerge-post-process (flags)
- (let (match extent file start)
- (goto-char (point-min))
- (insert (format "Diff %s and %s\n\n" smerge-dir1 smerge-dir2))
- (setq start (point))
-
- (cond ((> flags 4) ;; c-u c-u
- ;; Remove different files
- (while (re-search-forward "^Files .*\n" nil t)
- (replace-match "")))
- ((> flags 1) ;; c-u
- ;; Remove the unique files
- (while (re-search-forward "^Only in .*\n" nil t)
- (replace-match ""))))
-
- ;; Only in 1
- (setq match (format "^Only in %s\\(.*\\)$" smerge-dir1))
- (goto-char (point-min))
- (while (re-search-forward match nil t)
- (setq file (match-string 1))
- (setq extent
- (smerge-make-extent (match-beginning 0) (match-end 0) 'smerge-only1-face))
- (set-extent-property extent 'type 2)
- (replace-match file)
- )
-
- ;; Only in 2
- (setq match (format "^Only in %s\\(.*\\)$" smerge-dir2))
- (goto-char (point-min))
- (while (re-search-forward match nil t)
- (setq file (match-string 1))
- (setq extent
- (smerge-make-extent (match-beginning 0) (match-end 0) 'smerge-only2-face))
- (set-extent-property extent 'type 1)
- (replace-match (concat "\t\t\t\t" file))
- )
-
- ;; Both
- (setq match (format "^Files %s\\(.+\\) and %s.+ differ$" smerge-dir1 smerge-dir2))
- (goto-char (point-min))
- (while (re-search-forward match nil t)
- (setq file (match-string 1))
- (setq extent
- (smerge-make-extent (match-beginning 0) (match-end 0) 'smerge-diff-face))
- (set-extent-property extent 'type 3)
- (replace-match (concat "\t\t" file))
- )
-
- ;; Back to start
- (goto-char start)
- (if (re-search-forward "\\w" nil t) (forward-char -1))
- ))
-
-(autoload 'defadvice "advice" nil nil 'macro)
-
-(defadvice ediff-quit (after smerge activate)
- (when (extentp smerge-extent)
- (set-extent-property smerge-extent 'face 'smerge-merged-face) ;; SAM
- (delete-other-windows)
- (switch-to-buffer smerge-buffer)
- (let ((next (next-extent smerge-extent))
- start)
- (when next
- (setq start (extent-start-position next))
- (goto-char start)
- (if (re-search-forward "\\w" nil t) (forward-char -1))
- ))
- (setq smerge-extent nil) ;; done
- ))
-
-(defun smerge-file (extent)
- "Given a smerge extent, return the file name."
- (let ((file (buffer-substring
- (extent-start-position extent)
- (extent-end-position extent))))
- (string-match "\t*\\(.*\\)" file)
- (match-string 1 file)))
-
-(defun smerge-menu (event)
- "This is called on a right mouse click in the display window.
-Pops up a menu that allows copying the file to directory one or two."
- (interactive "e")
- (let ((extent (extent-at (event-point event))))
- (unless extent (error "No extent at point"))
- (setq smerge-file (smerge-file extent))
- (setq smerge-extent extent)
- (popup-menu smerge-copy-menu)))
-
-
-(defun smerge-mousable (event)
- "This is called on a left or middle mouse click in the display window."
- (interactive "e")
- (smerge-ediff (extent-at (event-point event))))
-
-(defun smerge-ediff-or-copy ()
- "Ediff or copy the file."
- (interactive)
- (let* ((extent (extent-at (point)))
- (type (extent-property extent 'type)))
- (unless extent (error "No extent at point"))
- (cond ((or (eq type 1) (eq type 2))
- (setq smerge-file (smerge-file extent))
- (smerge-copy 1 t))
- ((eq type 3) (smerge-ediff extent))
- (t (beep)))))
-
-(defun smerge-ediff (&optional extent)
- "Ediff the two files."
- (interactive)
- (let (file)
- (unless extent
- (setq extent (extent-at (point)))
- (unless extent (error "No extent at point")))
- (if (eq (extent-property extent 'type) 3)
- (progn
- (setq smerge-extent extent)
- (setq file (smerge-file extent))
- (ediff-files
- (concat smerge-dir1 file) (concat smerge-dir2 file)))
- (beep))))
-
-
-(defun smerge-allow-dir (dir)
- "Are we allowed to copy to this directory."
- (let ((type (extent-property smerge-extent 'type)))
- (if type
- (> (logand (extent-property smerge-extent 'type) dir) 0)
- (message "WARNING: No type for extent!")
- 0)))
-
-;; Copy file preserving the destination modes if necessary
-(defun smerge-copy-file (src dst &optional ok-if-already-exists keep-time)
- (let ((modes (file-modes dst)))
- (copy-file src dst ok-if-already-exists keep-time)
- (and smerge-preserve-modes
- modes
- (set-file-modes dst modes))))
-
-(defun smerge-copy (dir &optional ask)
- "Do the copy to the directory specified."
- (let ((file1 (concat smerge-dir1 smerge-file))
- (file2 (concat smerge-dir2 smerge-file))
- src dst)
- (cond ((eq dir 1) (setq src file2 dst file1))
- ((eq dir 2) (setq src file1 dst file2))
- (t (error "Huh?")))
- (when (or (not ask)
- (yes-or-no-p (format "Copy to %s? " dst)))
- (smerge-copy-file src dst t t)
- ;; Mark as merged
- (set-extent-property smerge-extent 'face 'smerge-merged-face)
- ;; If this is an "only" mark as copied
- (when (< (extent-property smerge-extent 'type) 3)
- (set-extent-property smerge-extent 'type 0))
- (setq smerge-extent nil)
- )))
-
-(defun smerge-make-extent (start end face)
- (let (extent)
- (setq end (1+ end)) ;; include the NL
- (setq extent (make-extent start end))
- (set-extent-face extent face)
- (set-extent-mouse-face extent 'highlight)
- (set-extent-keymap extent smerge-keymap)
- extent
- ))
-
-;; .cvsignore code
-
-(defun smerge-find-ignores (dir)
- "Find all the .cvsignore files recursively from `dir'. `dir' must end in /."
- (let ((dirlist (smerge-dirlist dir nil "^[^.].*" nil 'dirs))
- (file (concat dir ".cvsignore"))
- filelist)
- (if (file-exists-p file) (setq filelist (list file)))
- (dolist (subdir dirlist)
- (unless (string= subdir "CVS")
- (setq filelist (append filelist
- (smerge-find-ignores (concat dir subdir "/"))))))
- filelist))
-
-(defun smerge-build-ignore-list (dir)
- "Build a list of files/directories to ignore. `dir' must end in /."
- (let ((list (smerge-find-ignores dir))
- (buff (get-buffer-create "*smerge-cvsignores*"))
- start)
- (save-excursion
- (set-buffer buff)
- (erase-buffer)
- (dolist (file list)
- (setq start (point))
- (insert-file-contents file)
- (goto-char start)
- (while (re-search-forward "^" nil t)
- (insert file)))
- (goto-char (point-min))
- (while (re-search-forward ".cvsignore" nil t)
- (replace-match ""))
- ;; Protect . from regexp
- (goto-char (point-min))
- (while (search-forward "." nil t)
- (replace-match "\\\\."))
- ;; Convert * -> .*
- (goto-char (point-min))
- (while (search-forward "*" nil t)
- (replace-match ".*"))
- ;; Build the list
- (setq list nil)
- (goto-char (point-min))
- (while (re-search-forward "^.+$" nil t)
- (setq list (cons (match-string 0) list))))
- (unless smerge-keep-cvsignore-buffer
- (kill-buffer buff))
- list))
-
-(defun smerge-cvsignore (dir)
- "smerge internal function to remove the .cvsignore matches"
- (let ((list (smerge-build-ignore-list dir))
- match)
- (dolist (ignore list)
- (goto-char (point-min))
- ;; Only match complete matches
- ;; We cannot use \b here since we are matching filenames
- (setq match (concat ignore "\\s-"))
- (while (re-search-forward match nil t)
- ;; Since we match the \n at the end of some lines...
- (goto-char (match-beginning 0))
- (kill-entire-line)
- ))))
-
-;; .cvsignore code ends
-
-(provide 'smerge)
Index: xetla-browse.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xetla/xetla-browse.el,v
retrieving revision 1.1
diff -u -p -u -r1.1 xetla-browse.el
--- xetla-browse.el 4 Apr 2005 13:27:20 -0000 1.1
+++ xetla-browse.el 25 Dec 2005 10:52:08 -0000
＠＠ -63,7 +63,8 ＠＠
;;; Code:
(eval-when-compile
(require 'cl)
- (autoload 'easy-mmode-define-keymap "easy-mmode"))
+ (autoload 'easy-mmode-define-keymap "easy-mmode")
+ (autoload 'ad-add-advice "advice"))
(require 'tree-widget)
(require 'xetla)
Index: xetla-core.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xetla/xetla-core.el,v
retrieving revision 1.1
diff -u -p -u -r1.1 xetla-core.el
--- xetla-core.el 4 Apr 2005 13:27:20 -0000 1.1
+++ xetla-core.el 25 Dec 2005 10:52:09 -0000
＠＠ -402,12 +402,18 ＠＠ ones are killed.")
It will eventually be killed when the number of buffers in
`xetla-dead-process-buffer-queue'exceeds `xetla-number-of-dead-process-buffer'."
(add-to-list 'xetla-dead-process-buffer-queue buffer t)
+ (setq xetla-dead-process-buffer-queue
+ (remove-if-not #'buffer-live-p xetla-dead-process-buffer-queue))
(when xetla-number-of-dead-process-buffer
(while (> (length xetla-dead-process-buffer-queue)
(max 2 xetla-number-of-dead-process-buffer))
- (kill-buffer (car xetla-dead-process-buffer-queue))
- (setq xetla-dead-process-buffer-queue
- (cdr xetla-dead-process-buffer-queue)))))
+ (let ((currbuf (car xetla-dead-process-buffer-queue)))
+ ;; just to be completely certain
+ (when (buffer-live-p currbuf)
+ (kill-buffer currbuf))
+ ;; now remove that killed buffer
+ (setq xetla-dead-process-buffer-queue
+ (cdr xetla-dead-process-buffer-queue))))))
(defvar xetla-last-process-buffer nil
"The last created process buffer.")
＠＠ -695,7 +701,7 ＠＠ with `xetla-open-internal-log-buffer'."
(toggle-read-only 1))
(define-derived-mode xetla-process-buffer-mode fundamental-mode
- "Xetla Process"
+ "XEtla Process"
"Major mode for process buffers. Mainly defines \\[bury-buffer]
to quit the buffer"
(toggle-read-only 1))
Index: xetla-tips.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xetla/xetla-tips.el,v
retrieving revision 1.1
diff -u -p -u -r1.1 xetla-tips.el
--- xetla-tips.el 4 Apr 2005 13:27:20 -0000 1.1
+++ xetla-tips.el 25 Dec 2005 10:52:09 -0000
＠＠ -59,7 +59,7 ＠＠
to show you interesting features that you may have missed! Disable me
by setting the variable `xetla-tips-enabled' to nil.
-Press q to exit, n to view next tip, p to view previous tip."
+Press `q' to exit, `n' to view next tip, `p' to view previous tip."
"For the available xetla commands Xetla provides a corresponding interactive
function.
Some examples:
＠＠ -70,57 +70,69 ＠＠ M-x xetla-changes ... runs tla chang
XEtla prompts for the needed parameters."
"Most interesting commands are available through a global keyboard
-shortcut. Try \"C-x T C-h\" to get a list"
+shortcut. Try `C-x T C-h' to get a list"
"XEtla provides several major modes for different buffers. Each mode
-has its own keybindings. Get help with \"C-h m\""
- "When XEtla is loaded, C-M-h in a minibuffer prompt gives you help
+has its own keybindings. Get help with `\\[describe-mode]'"
+ "When XEtla is loaded, `C-M-h' in a minibuffer prompt gives you help
about the command being run."
"When you are prompted for an archive, category, branch, version or
-revision name, lots of keybindings are available. Get a list with \"C-h\"."
- "XEtla allows you to manage a list of bookmarks. Try \"C-x T b\" and add
+revision name, lots of keybindings are available. Get a list with `C-h'."
+ "XEtla allows you to manage a list of bookmarks. Try `\\[xetla-bookmarks]' and add
bookmarks from the menu. You may also add bookmarks from an archives,
category, version or revision buffer as well as from the xetla-browse
buffer."
"From the bookmark buffer, you can select some bookmarks and make
-them partners with M-p. Afterwards, pressing 'M m' on a bookmark will
+them partners with \\<xetla-bookmarks-mode-map>`\\[xetla-bookmarks-marked-are-partners]'. Afterwards, pressing `\\[xetla-bookmarks-missing]' on a bookmark will
show you the missing patches from his partners."
- "You can add changelog style comments to your commit log by \"C-x T a\"."
+ "You can add changelog style comments to your commit log by `\\[xetla-add-log-entry]'."
"You can enable ispell, flyspell or other useful mode for editing
-log files by \"M-x customize-variable RET xetla-log-edit-mode-hook RET\"."
+log files by `M-x customize-variable RET xetla-log-edit-mode-hook RET'."
"By default, XEtla caches any log file you retrieve with
`xetla-cat-log' or `xetla-cat-archive-log' in ~/.arch-log-library. This
speeds up many XEtla operations.
You can disable this by setting `xetla-log-library-greedy' to nil."
"XEtla is highly customizable.
-Start it by \"M-x customize-group RET xetla RET\"."
+Start it by `M-x customize-group RET xetla RET'."
"In an *xetla-changes* buffer you can quickly jump to the source file by
-\"RET\", or view the source file in another window by \"v\", or start
-an ediff session by \"e\" to inspect/reject parts of the changes."
+`RET', or view the source file in another window by `v', or start
+an ediff session by `e' to inspect/reject parts of the changes."
"In a *xetla-changes* buffer, you can quickly jump from the list of
-files to the corresponding patch hunk, and come back with \"j\""
+files to the corresponding patch hunk, and come back with `j'"
"After committing, you can review the last committed patch with
-\"M-x xetla-changes-last-revision RET\".
+`M-x xetla-changes-last-revision RET'.
Usefull to review and fix a patch you've just merged without mixing
manual modifications and merge in the same patch."
- "After a merge, typing \"C-c m\" in the log buffer will generate
+ "After a merge, typing \\<xetla-log-edit-mode-map> `\\[xetla-log-edit-insert-log-for-merge-and-headers]' in the log buffer will generate
for you a summary line, keyword and body. This is highly
customizable."
- "Report bugs using M-x xetla-submit-bug-report RET"
- "You've got a nice, graphical, archive browser one M-x xetla-browse
-RET away."
- "In the bookmark buffer, pressing \"C-x C-f\" starts with the local
+ "Report bugs using `M-x xetla-submit-bug-report RET'"
+ "You've got a nice, graphical, archive browser one
+`M-x xetla-browse RET' away."
+ "In the bookmark buffer, pressing\\<xetla-bookmarks-mode-map> `\\[xetla-bookmarks-find-file] starts with the local
tree of the bookmark at point for the default directory."
- "SMerge mode is an Emacs minor mode usefull to resolve conflicts
-after a -three-way merge. XEtla will enter this mode automatically
-when you open a file with conflicts. Type M-x xetla-conflicts-finish RET
-to exit smerge mode and delete the corresponding .rej file."
- "\"C-x T e\" in a source file will open an ediff session with the
+ "`\\[xetla-file-ediff]' in a source file will open an ediff session with the
unmodified version of the file. From here, you can undo patch hunks
-one by one with the key \"b\""
+one by one with the key `b'"
"In the *tree-lint* buffer, with your cursor on a message, most
commands will apply to all the files listed under this message."
+ "Many XEtla commands accept one or more prefix arguments. For example,
+from the *xetla-log-edit* buffer:
+\\<xetla-log-edit-mode-map>
+ `\\[xetla-log-edit-done]' -- Save and kill the log buffer
+ `\\[universal-argument] \\[xetla-log-edit-done]' -- Save and kill the log, plus commit the changes
+ `\\[universal-argument] \\[universal-argument] \\[xetla-log-edit-done]' -- Save and kill the log, plus commit and \"seal\"
+`\\[universal-argument] \\[universal-argument] \\[universal-argument] \\[xetla-log-edit-done]' -- Save and kill the log, plus commit and \"fix\"
+
+All of the XEtla commands that accept prefix arguments are documented,
+so use `\\[describe-function] xetla-[command] RET' to see more nifty
+tricks."
+ "Give a prefix argument to M-x xetla-changelog and you'll be prompted
+for a version to display a ChangeLog for. This is handy if you want to
+see a ChangeLog for a previous version of a project."
+ "In a *xetla-changes* buffer, hit RET with point somewhere in the diff
+and you'll be taken to that exact spot in the source file."
]
"List of tips. Add more !")
＠＠ -152,7 +164,7 ＠＠ Commands:
"************************* Did you know? *************************"
'xetla-messages)
"\n\n")
- (insert message)
+ (insert (substitute-command-keys message))
(newline 2)
(insert (xetla-face-add
"*********************************************************************"
Index: xetla-version.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xetla/xetla-version.el,v
retrieving revision 1.1
diff -u -p -u -r1.1 xetla-version.el
--- xetla-version.el 4 Apr 2005 13:27:21 -0000 1.1
+++ xetla-version.el 25 Dec 2005 10:52:09 -0000
＠＠ -1,5 +1,5 ＠＠
;;; Automatically generated file -- DO NOT EDIT OR DELETE
;;;###autoload
(defconst xetla-version
- "steve(a)eicq.org--2005/xetla--main--1.0--version-0")
+ "steve(a)eicq.org--2005/xetla--main--1.1--version-0")
(provide 'xetla-version)
Index: xetla.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xetla/xetla.el,v
retrieving revision 1.1
diff -u -p -u -r1.1 xetla.el
--- xetla.el 4 Apr 2005 13:27:21 -0000 1.1
+++ xetla.el 25 Dec 2005 10:52:11 -0000
＠＠ -1,7 +1,7 ＠＠
;;; xetla.el --- Arch (tla) interface for XEmacs
;; Copyright (C) 2003-2004 by Stefan Reichoer (GPL)
-;; Copyright (C) 2004 Steve Youngs (BSD)
+;; Copyright (C) 2004 2005 Steve Youngs (BSD)
;; Author: Steve Youngs <steve(a)eicq.org>
;; Maintainer: Steve Youngs <steve(a)eicq.org>
＠＠ -94,6 +94,123 ＠＠
;;; Code:
+;;; XEtla/Xtla safety code
+;; You can run into some problems if you have both XEtla and Xtla
+;; installed at the same time. The following attempts to guard
+;; against it by warning the user and giving them a couple of
+;; functions for disabling one of XEtla or Xtla in their current
+;; session. Dangerous stuff!!
+(defvar xetla-dont-warn-about-xtla nil)
+
+(when (and (featurep 'xtla)
+ (not xetla-dont-warn-about-xtla))
+ (xetla-warn-about-xtla))
+
+(defconst xetla-warn-about-xtla-text
+ "We have detected that you have both XEtla and Xtla installed.
+
+This is never a very good idea (unless you _really_ know what you are
+doing) because both packages share similar key bindings and install
+similar hooks.
+
+Our suggestion is that you remove either XEtla or Xtla and just use the
+other. For your convenience there is `xetla-attempt-xetla-removal' and
+`xetla-attempt-xtla-removal', which will attempt to disable one of the
+packages for the current session only.
+
+Use those functions at your own risk. The best answer is to not load
+one of XEtla or Xtla in the first place.
+
+To disable this warning: (setq xetla-dont-warn-about-xtla t).")
+
+(defun xetla-warn-about-xtla ()
+ "Pop up a big fat warning about trying to use XEtla and xtla together."
+ (get-buffer-create "*XEtla/Xtla Warning*")
+ (with-current-buffer "*XEtla/Xtla Warning*"
+ (erase-buffer)
+ (insert xetla-warn-about-xtla-text))
+ (pop-to-buffer "*XEtla/Xtla Warning*"))
+
+(defun xetla-attempt-xetla-removal ()
+ "Attempt to disable xetla.
+
+**** This is dangerous, use at your own risk. ****
+
+This function attempts to unload all the XEtla features, remove the
+`xetla-find-file-hook', remove entries from `auto-mode-alist', and
+finally, remove the XEtla lisp directory from the `load-path'. After
+all of this has happened, Xtla should run without problems. Please
+note that we do _NOT_ guarantee that this will work perfectly and you
+really should physically remove either XEtla or Xtla.
+
+Use of this function is only valid in the current session, in other
+words, it ain't saved."
+ (interactive)
+ ;; unload the features
+ (when (featurep 'xetla-tips) (unload-feature 'xetla-tips t))
+ (when (featurep 'xetla-browse) (unload-feature 'xetla-browse t))
+ (when (featurep 'xetla) (unload-feature 'xetla t))
+ (when (featurep 'xetla-core) (unload-feature 'xetla-core t))
+ (when (featurep 'xetla-defs) (unload-feature 'xetla-defs t))
+ (when (featurep 'xetla-autoloads) (unload-feature 'xetla-autoloads t))
+ ;; remove the hooks
+ (remove-hook 'find-file-hooks 'xetla-find-file-hook)
+ ;; clean out auto-mode-alist
+ (setq auto-mode-alist
+ (delete '("\\+\\+log\\." . xetla-log-edit-mode) auto-mode-alist))
+ (setq auto-mode-alist
+ (delete '("/\\(=tagging-method\\|\\.arch-inventory\\)$" . xetla-inventory-file-mode)
+ auto-mode-alist))
+ ;; clean out the load-path
+ (setq load-path
+ (remove (file-name-directory (locate-library "xetla")) load-path))
+ ;; did I miss anything?
+ ;; what can we do about key bindings?
+
+ (message "To ensure correct key bindings, please reload Xtla"))
+
+(defun xetla-attempt-xtla-removal ()
+ "Attempt to disable Xtla.
+
+**** This is dangerous, use at your own risk. ****
+
+This function attempts to unload all the Xtla features, remove the
+`tla-find-file-hook', remove entries from `auto-mode-alist', and
+finally, remove the XEtla lisp directory from the `load-path'. After
+all of this has happened, XEtla should run without problems. Please
+note that we do _NOT_ guarantee that this will work perfectly and you
+really should physically remove either XEtla or Xtla.
+
+Use of this function is only valid in the current session, in other
+words, it ain't saved."
+ (interactive)
+ ;; unload the features
+ (when (featurep 'xtla-tips) (unload-feature 'xtla-tips t))
+ (when (featurep 'xtla-browse) (unload-feature 'xtla-browse t))
+ (when (featurep 'xtla) (unload-feature 'xtla t))
+ (when (featurep 'xtla-core) (unload-feature 'xtla-core t))
+ (when (featurep 'xtla-defs) (unload-feature 'xtla-defs t))
+ (when (featurep 'xtla-emacs) (unload-feature 'xtla-emacs t))
+ (when (featurep 'xtla-xemacs) (unload-feature 'xtla-xemacs t))
+ (when (featurep 'xtla-autoloads) (unload-feature 'xtla-autoloads t))
+ ;; remove the hooks
+ (remove-hook 'find-file-hooks 'tla-find-file-hook)
+ ;; clean out auto-mode-alist
+ (setq auto-mode-alist
+ (delete '("\\+\\+log\\." . tla-log-edit-mode) auto-mode-alist))
+ (setq auto-mode-alist
+ (delete '("/\\(=tagging-method\\|\\.arch-inventory\\)$" . tla-inventory-file-mode)
+ auto-mode-alist))
+ ;; clean out the load-path
+ (setq load-path
+ (remove (file-name-directory (locate-library "xtla")) load-path))
+ ;; did I miss anything?
+ ;; what can we do about key bindings?
+ (message "To ensure correct key bindings, please reload XEtla"))
+
+;;; End XEtls/Xtla safety code
+
+
(eval-and-compile
(when (locate-library "xetla-version")
(require 'xetla-version)))
＠＠ -2731,9 +2848,72 ＠＠ correctly filled in."
(dolist (function xetla-commit-check-log-buffer-functions)
(funcall function)))
+(defcustom xetla-warn-about-conflict-files t
+ "*When non-`nil' ask whether to commit if conflict files are present.
+When `nil' commit anyway."
+:group 'xetla)
+
+(defun xetla-commit-find-conflict-files (dir)
+ "Searches for conflict files in the current working directory."
+ (when (file-readable-p dir)
+ (let* ((dirs (directory-files dir t "^[^.]+$" nil 'subdirs))
+ (cur (directory-files dir t "\\.rej"))
+ (sub (mapcar #'xetla-commit-find-conflict-files dirs)))
+ (setq cur (delete nil cur))
+ (setq sub (delete nil sub))
+ (if sub
+ (append cur sub)
+ cur))))
+
+(defun xetla-commit-seal (&optional force)
+ "Commit a `version-0' revision to seal a repo.
+
+This calls `tla commit --seal'. With optional argument FORCE, don't
+prompt for confirmation."
+ (interactive)
+ (when (or force
+ (y-or-n-p
+ (format "Do you really want to seal `%s'? "
+ (xetla-tree-version))))
+ (if (string-match "--version\\(-\\|fix-\\)+"
+ (xetla-get-current-revision default-directory))
+ (error "Revision already sealed, use `xetla-commit-fix' instead")
+ (xetla-commit
+ (lambda (output error status args)
+ (xetla-tips-popup-maybe))
+ 'seal))))
+
+(defun xetla-commit-fix (&optional force)
+ "Commit a `versionfix' revision.
+
+This calls `tla commit --fix'. With optional argument FORCE, don't
+prompt for confirmation."
+ (interactive)
+ (when (or force
+ (y-or-n-p
+ (format "Do you really want to versionfix `%s'? "
+ (xetla-tree-version))))
+ (if (not (string-match "--version\\(-\\|fix-\\)+"
+ (xetla-get-current-revision default-directory)))
+ (error "Revision not sealed")
+ (xetla-commit
+ (lambda (output error status args)
+ (xetla-tips-popup-maybe))
+ 'fix))))
+
;;;###autoload
-(defun xetla-commit (&optional handler)
- "Run tla commit."
+(defun xetla-commit (&optional handler version-flag)
+ "Run tla commit.
+
+Optional argument HANDLER is the process handler for the commit
+command.
+
+Optional argument VERSION-FLAG may be one of the symbols
+'seal to commit a sealed version
+'fix to commit a fix version
+If omitted it defaults to a normal commit.
+
+When the commit finishes successful, `tla-commit-done-hook' is called."
(interactive)
(with-current-buffer
(find-file-noselect (xetla-make-log))
＠＠ -2745,6 +2925,16 ＠＠ correctly filled in."
(y-or-n-p
"Commit with unsaved changes is a bad idea. Continue anyway? ")
(error "Not committing"))
+ (and xetla-warn-about-conflict-files
+ ;; fsck it, actually we dont need all the .rej files (yet), so
+ ;; speed up would be to unwind the recursion after the first
+ ;; occurrence of a .rej
+ (xetla-commit-find-conflict-files ".")
+ (or (y-or-n-p
+ (concat
+ "Commit with unresolved conflicts is a bad idea. "
+ "Continue anyway? "))
+ (error "Not committing")))
(let* ((file-list (and (buffer-live-p xetla-buffer-source-buffer)
(with-current-buffer xetla-buffer-source-buffer
xetla-buffer-marked-file-list)))
＠＠ -2755,8 +2945,13 ＠＠ correctly filled in."
(xetla-run-tla-async
(cons "commit"
(cons (when xetla-strict-commits "--strict")
- (when file-list (cons "--"
- file-list))))
+ (cons (cond
+ ((eq version-flag 'fix) "--fix")
+ ((eq version-flag 'seal) "--seal")
+ ((eq version-flag nil) nil)
+ (t (error "Wrong version flag: %s" version-flag)))
+ (when file-list (cons "--"
+ file-list)))))
:finished handler))))
(defun xetla-import ()
＠＠ -2782,16 +2977,23 ＠＠ correctly filled in."
(xetla-run-tla-sync '("pristines")))
;;;###autoload
-(defun xetla-changelog ()
+(defun xetla-changelog (&optional version)
"Run \"tla changelog\".
-display the result in an improved ChangeLog mode."
- (interactive)
- (let ((default-directory (xetla-read-project-tree-maybe)))
- (xetla-run-tla-sync '("changelog")
+Display the result in an improved ChangeLog mode.
+With prefix arg, VERSION, display that version's changelog."
+ (interactive "p")
+ (let ((default-directory (xetla-read-project-tree-maybe))
+ (version (when current-prefix-arg
+ (xetla-name-construct
+ (xetla-name-read "ChangeLog for version: "
+ 'prompt 'prompt 'prompt 'prompt)))))
+ (xetla-run-tla-sync (list "changelog" version)
:finished 'xetla-null-handler)
(xetla-show-last-process-buffer 'changelog 'xetla-changelog-mode)
- (goto-char (point-min))))
+ (goto-char (point-min))
+ (view-mode nil (lambda (&rest args)
+ (xetla-buffer-quit)))))
;;;###autoload
(defun xetla-logs ()
＠＠ -2820,6 +3022,39 ＠＠ display the result in an improved Change
(set (make-local-variable 'xetla-buffer-refresh-function)
'xetla-logs))))))
+(defun xetla-help-via-keyb ()
+ (interactive)
+ (let ((ext (extent-string (extent-at (point)))))
+ (xetla-help ext)))
+
+(defun xetla-help-via-mouse (event)
+ (interactive "e")
+ (goto-char (event-point event))
+ (let ((ext (extent-string (extent-at (point)))))
+ (xetla-help ext)))
+
+(defconst xetla-help-extent-map
+ (let* ((map (make-sparse-keymap 'xetla-help-extent-map)))
+ (define-key map [button2] 'xetla-help-via-mouse)
+ (define-key map [return] 'xetla-help-via-keyb)
+ map)
+ "A keymap for the extents in output from `tla help'.")
+
+(defun xetla-display-global-help (buffer &rest args)
+ (switch-to-buffer buffer)
+ (xetla-process-buffer-mode)
+ (goto-char (point-min))
+ (save-excursion
+ (while (re-search-forward "\\(\\w+.*\\) : " nil t)
+ (let ((extent (make-extent (match-beginning 1) (match-end 1)))
+ (echo "RET or button2 for help on this command."))
+ (set-extent-property extent 'face 'widget-button-face)
+ (set-extent-property extent 'mouse-face 'highlight)
+ (set-extent-property extent 'keymap xetla-help-extent-map)
+ (set-extent-property extent 'help-echo echo)
+ (set-extent-property extent 'balloon-help echo)
+ (set-extent-property extent 'duplicable t)))))
+
;;;###autoload
(defun xetla-help (command)
"Run tla COMMAND -H."
＠＠ -2839,7 +3074,11 ＠＠ display the result in an improved Change
(cons (list (match-string 1))
listcmd)))
listcmd)))))))
- (xetla-run-tla-sync (list command "-H")))
+ (if (string= command "")
+ (xetla-run-tla-sync
+ '("help")
+:finished 'xetla-display-global-help)
+ (xetla-run-tla-sync (list command "-H"))))
(defun xetla-tree-version-list-tla ()
"Return the tree version, or nil if not in a project tree."
＠＠ -3155,6 +3394,10 ＠＠ Limit to CATEGORY-BRANCH-VERSION. If FRO
(defun xetla-star-merge (from &optional to-tree)
"Star merge from version/revision FROM to local tree TO-TREE."
+ (interactive (list (xetla-name-construct
+ (xetla-name-read "Star merge from (version or revision): "
+ 'prompt 'prompt 'prompt 'prompt 'maybe))
+ (read-directory-name "In tree: ")))
(let ((to-tree (when to-tree (expand-file-name to-tree))))
(or (xetla-save-some-buffers (or to-tree default-directory))
(y-or-n-p
＠＠ -3320,35 +3563,14 ＠＠ Can be
(defvar xetla-bookmarks-marked-list nil
"A list of marked bookmarks.")
-(defun xetla-bookmarks-load-from-file-OBSOLETE (&optional force)
- "Load bookmarks from the bookmarks file.
-If FORCE is non-nil, reload the file even if it was loaded before."
- (when (or force (not xetla-bookmarks-loaded))
- (let ((file (xetla-config-file-full-path xetla-bookmarks-file-name t)))
- (save-excursion
- (unless (file-exists-p file)
- (with-temp-buffer
- (insert "()")
- (write-file file)))
- (unless (file-readable-p file)
- (error "Xetla bookmark file not readable"))
- (with-temp-buffer
- (insert-file-contents file)
- (setq xetla-bookmarks-alist (read (current-buffer))
- xetla-bookmarks-loaded t))))))
-
(defun xetla-bookmarks-load-from-file (&optional force)
"Load bookmarks from the file `xetla-bookmarks-file-name'.
If FORCE is non-nil, reload the file even if it was loaded before."
- ;; TODO remove condition case (after some time)
- (condition-case nil
- (when (or force (not xetla-bookmarks-loaded))
- (xetla-load-state (xetla-config-file-full-path
- xetla-bookmarks-file-name t))
- (setq xetla-bookmarks-loaded t))
- (error (progn
- (xetla-bookmarks-load-from-file-OBSOLETE force)))))
+ (when (or force (not xetla-bookmarks-loaded))
+ (xetla-load-state (xetla-config-file-full-path
+ xetla-bookmarks-file-name t))
+ (setq xetla-bookmarks-loaded t)))
(defun xetla-bookmarks-save-to-file ()
"Save `xetla-bookmarks-alist' to the file `xetla-bookmarks-file-name'."
＠＠ -3479,8 +3701,8 ＠＠ If prefix argument ARG is specified, the
if already set in the bookmarks."
(interactive "P")
(unless xetla-bookmarks-cookie
- (error "Please, run this command from the bookmarks buffer%s"
- " (M-x xetla-bookmarks RET)"))
+ (error "Wrong buffer, run: `%s' and try again"
+ (substitute-command-keys "\\[xetla-bookmarks]")))
(let ((list (or xetla-bookmarks-marked-list
(list (ewoc-data (ewoc-locate
xetla-bookmarks-cookie))))))
＠＠ -3873,17 +4095,30 ＠＠ parsed."
local-tree)))))))
(defun xetla-bookmarks-open-tree ()
- "Open a local tree in a dired buffer."
+ "Open a local tree in a dired buffer.
+
+With a prefix arg, prompt for a local tree to use."
(interactive)
- (dired-other-window (xetla-bookmarks-read-local-tree)))
+ (let ((x-dired (if (eq xetla-switch-to-buffer-mode 'single-window)
+ 'dired
+ 'dired-other-window))
+ (open (if current-prefix-arg
+ (xetla-bookmarks-read-local-tree nil 'ask)
+ (xetla-bookmarks-read-local-tree))))
+ (funcall x-dired open)))
(defun xetla-bookmarks-find-file ()
"Find a file starting from the local tree of the current bookmark.
+
This way, you can type C-x C-f in the bookmarks buffer to open a file
-of a bookmarked project."
+of a bookmarked project.
+
+With a prefix arg, prompt for the local tree to use."
(interactive)
(let ((default-directory (xetla-uniquify-file-name
- (xetla-bookmarks-read-local-tree))))
+ (if current-prefix-arg
+ (xetla-bookmarks-read-local-tree nil 'ask)
+ (xetla-bookmarks-read-local-tree)))))
(call-interactively 'find-file)))
(defun xetla-bookmarks-tag (arg)
＠＠ -3894,8 +4129,8 ＠＠ prefix argument ARG is given, explicitly
from."
(interactive "P")
(unless xetla-bookmarks-cookie
- (error "Please, run this command from the bookmarks buffer%s"
- " (M-x xetla-bookmarks RET)"))
+ (error "Not in bookmarks buffer, run: `%s' and try again"
+ (substitute-command-keys "\\[xetla-bookmarks]")))
(let ((list (or xetla-bookmarks-marked-list
(list (ewoc-data (ewoc-locate xetla-bookmarks-cookie))))))
(let ((tags (mapcar
＠＠ -3933,14 +4168,31 ＠＠ from."
(defun xetla-bookmarks-inventory ()
"Run `tla inventory' on a local tree."
(interactive)
- (let ((default-directory (xetla-bookmarks-read-local-tree)))
- (xetla-inventory nil t)))
-
-(defun xetla-bookmarks-changes ()
- "Run `xetla-changes' on a local tree."
- (interactive)
- (let ((default-directory (xetla-bookmarks-read-local-tree)))
- (xetla-changes nil nil)))
+ (let ((default-directory (if current-prefix-arg
+ (xetla-bookmarks-read-local-tree nil 'ask)
+ (xetla-bookmarks-read-local-tree))))
+ (xetla-inventory nil
+ (unless (eq xetla-switch-to-buffer-mode 'single-window)
+ t))))
+
+(defun xetla-bookmarks-changes (arg)
+ "Run `xetla-changes' on a local tree.
+
+Prefix argument, ARG, determines whether or not to use a full format or
+summary format and if it should prompt for the local tree to use.
+
+ No prefix arg -- full format, default tree.
+ One prefix arg -- summary format, default tree.
+ Two prefix args -- full format, prompt for tree.
+ Three prefix args -- summary format, prompt for tree."
+ (interactive "p")
+ (let* ((arg (car current-prefix-arg))
+ (default-directory (if (or (eq arg 16) (eq arg 64))
+ (xetla-bookmarks-read-local-tree nil 'ask)
+ (xetla-bookmarks-read-local-tree))))
+ (if (or (eq arg 4) (eq arg 64))
+ (xetla-changes t)
+ (xetla-changes))))
(defmacro xetla-make-move-fn (ewoc-direction function cookie
&optional only-unmerged)
＠＠ -3993,11 +4245,14 ＠＠ merged by another revision in the same l
;;;###autoload
(defun xetla-bookmarks (&optional arg)
- "Display xetla bookmarks in a buffer.
+ "Display XEtla bookmarks in a buffer.
+
With prefix argument ARG, reload the bookmarks file from disk."
(interactive "P")
(xetla-bookmarks-load-from-file arg)
- (pop-to-buffer "*xetla-bookmarks*")
+ (if (eq xetla-switch-to-buffer-mode 'single-window)
+ (switch-to-buffer (get-buffer-create "*xetla-bookmarks*"))
+ (pop-to-buffer (get-buffer-create "*xetla-bookmarks*")))
(let ((pos (point)))
(toggle-read-only -1)
(erase-buffer)
＠＠ -4015,11 +4270,7 ＠＠ With prefix argument ARG, reload the boo
(defun xetla-bookmarks-mode ()
- "Major mode to show xetla bookmarks.
-
-You can add a bookmark with '\\<xetla-bookmarks-mode-map>\\[xetla-bookmarks-add]', and remove one with '\\[xetla-bookmarks-delete]'. After
-marking a set of files with '\\[xetla-bookmarks-mark]', make them partners with '\\[xetla-bookmarks-marked-are-partners]', and
-you will then be able to use '\\[xetla-bookmarks-missing]' to view the missing patches.
+ "Major mode to show XEtla bookmarks.
Commands:
\\{xetla-bookmarks-mode-map}"
＠＠ -5237,6 +5488,20 ＠＠ Sets the archive location to LOCATION."
" ***")
'xetla-separator) "\n")))))))
+(defun xetla-get-current-revision (&optional directory)
+ "Return the current revision in DIRECTORY."
+ (interactive)
+ (let* ((directory (or directory
+ (xetla-read-project-tree-maybe
+ "Get current revision in: ")))
+ (revision (shell-command-to-string
+ (concat "tla revisions --full "
+ (xetla-tree-version directory)
+ "|tail -n1"))))
+ (if (interactive-p)
+ (message revision)
+ revision)))
+
(defun xetla-tree-revisions ()
"Call `xetla-revisions' in the current tree."
(interactive)
＠＠ -5521,7 +5786,7 ＠＠ Otherwise, run dired."
;;
;; Add
;;
-(defun xetla-add (id &rest files)
+(defun xetla-add-id (id &rest files)
"Using ID, add FILES to this tree."
(interactive (let ((name
(read-file-name "Add file as source: "
＠＠ -5533,11 +5798,19 ＠＠ Otherwise, run dired."
(if (and id (string= id ""))
(setq id nil))
(setq files (mapcar 'expand-file-name files))
- (if id
- (xetla-run-tla-sync `("add" "--id" ,id . ,files)
-:finished 'xetla-null-handler)
- (xetla-run-tla-sync `("add" . ,files)
-:finished 'xetla-null-handler)))
+ (let* ((arch-ver (or xetla-arch-version-number
+ (xetla-arch-version-number)))
+ (add-id-string
+ (cond ((> 2 (or (cdr-safe (assoc 'minor arch-ver)) 0))
+ "add")
+ (t "add-id"))))
+ (if id
+ (xetla-run-tla-sync `(,add-id-string "--id" ,id . ,files)
+:finished 'xetla-null-handler)
+ (xetla-run-tla-sync `(,add-id-string . ,files)
+:finished 'xetla-null-handler))))
+
+(defalias 'xetla-add 'xetla-add-id)
;;
;; Remove
＠＠ -5880,7 +6153,7 ＠＠ If INSERT-CHANGELOG is non-nil, insert a
(list (read-file-name "Add file: " default-directory
nil nil
(xetla-get-file-info-at-point))))))
- (apply 'xetla-add nil files)
+ (apply 'xetla-add-id nil files)
(xetla-inventory))
(defun xetla-inventory-remove-files (files id-only)
＠＠ -6466,7 +6739,7 ＠＠ When the list has been filled in, CALLBA
(point-at-bol) (point)))))
(if (and in-field
(string-match "^[A-Z][A-Za-z]*: $"
- (buffer-substring
+
- 1 participants
- 0 comments
[COMMIT] Allow the low-memory warning code to call malloc itself.
19 years
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
I’ve been running with this for three weeks without bad consequences. On the
upside, it’s nice not to have your XEmacs abort when it breaks 128 MB; on
the downside, now I get to see output like this from top(1):
load averages: 0.84, 0.98, 0.77 19:52:07
53 processes: 1 runnable, 49 sleeping, 1 stopped, 1 zombie, 1 on processor
CPU states: 2.2% user, 0.0% nice, 0.0% system, 0.6% interrupt, 97.2% idle
Memory: 142M Act, 71M Inact, 804K Wired, 21M Exec, 22M File, 1084K Free
Swap: 628M Total, 228M Used, 400M Free
PID USERNAME PRI NICE SIZE RES STATE TIME WCPU CPU COMMAND
302 aidan 2 0 7868K 8856K select 0:28 0.68% 0.68% beep-media-p
241 aidan 2 0 237M 28M poll 0:30 0.00% 0.00% xemacs-21.5-
Patch addresses the problem seen here:
http://list-archive.xemacs.org/xemacs-beta/200501/msg00147.html ,
16872.7244.893526.907155(a)parhasard.net
src/ChangeLog addition:
2005-12-24 Aidan Kehoe <kehoea(a)parhasard.net>
* alloc.c (MALLOC_BEGIN):
Assert that we're either not in malloc, or warning about memory
being low.
* alloc.c (MALLOC_WARNING_BEGIN, MALLOC_WARNING_END):
Add two clauses to set and clear a flag that we're in a low-memory
warning situation.
* alloc.c (malloc_warning):
Move it after the definition of MALLOC_WARNING_BEGIN,
MALLOC_WARNING_END
XEmacs Trunk source patch:
Diff command: cvs -q diff -u
Files affected: src/alloc.c
Index: src/alloc.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/alloc.c,v
retrieving revision 1.120
diff -u -u -r1.120 alloc.c
--- src/alloc.c 2005/11/25 01:41:55 1.120
+++ src/alloc.c 2005/12/24 18:46:32
＠＠ -231,22 +231,6 ＠＠
}
#endif /* not MC_ALLOC */
-/* malloc calls this if it finds we are near exhausting storage */
-void
-malloc_warning (const char *str)
-{
- if (ignore_malloc_warnings)
- return;
-
- warn_when_safe
- (Qmemory, Qemergency,
- "%s\n"
- "Killing some buffers may delay running out of memory.\n"
- "However, certainly by the time you receive the 95%% warning,\n"
- "you should clean up, kill this Emacs, and start a new one.",
- str);
-}
-
/* Called if malloc returns zero */
DOESNT_RETURN
memory_full (void)
＠＠ -290,18 +274,21 ＠＠
}
#ifdef ERROR_CHECK_MALLOC
-static int in_malloc;
+static int in_malloc, in_malloc_warning;
extern int regex_malloc_disallowed;
#define MALLOC_BEGIN() \
do \
{ \
- assert (!in_malloc); \
+ assert (!in_malloc || in_malloc_warning); \
assert (!regex_malloc_disallowed); \
in_malloc = 1; \
} \
while (0)
+#define MALLOC_WARNING_BEGIN() (++in_malloc_warning)
+#define MALLOC_WARNING_END() (--in_malloc_warning)
+
#ifdef MC_ALLOC
#define FREE_OR_REALLOC_BEGIN(block) \
do \
＠＠ -341,10 +328,33 ＠＠
#else /* ERROR_CHECK_MALLOC */
#define MALLOC_BEGIN()
+#define MALLOC_WARNING_BEGIN()
+#define MALLOC_WARNING_END()
#define FREE_OR_REALLOC_BEGIN(block)
#define MALLOC_END()
#endif /* ERROR_CHECK_MALLOC */
+
+/* malloc calls this if it finds we are near exhausting storage */
+void
+malloc_warning (const char *str)
+{
+ if (ignore_malloc_warnings)
+ return;
+
+ MALLOC_WARNING_BEGIN();
+
+ warn_when_safe
+ (Qmemory, Qemergency,
+ "%s\n"
+ "Killing some buffers may delay running out of memory.\n"
+ "However, certainly by the time you receive the 95%% warning,\n"
+ "you should clean up, kill this Emacs, and start a new one.\n"
+ "On Unix, look into your resource limits; ulimit -d, especially.",
+ str);
+
+ MALLOC_WARNING_END();
+}
static void
malloc_after (void *val, Bytecount size)
--
I AM IN JAIL AND ALLOWED SEND ONLY ONE CABLE SINCE WAS ARRESTED WHILE
MEASURING FIFTEEN FOOT WALL OUTSIDE PALACE AND HAVE JUST FINISHED COUNTING
THIRTY EIGHT THOUSAND FIVE HUNDERED TWENTY TWO NAMES WHOS WHO IN MIDEAST.
- 2 participants
- 1 comments
[COMMIT] Revert a couple of changes from those last commits
19 years
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
Bugger, as the man said. This, to me, is an argument for Subversion or some
other versioning system that doesn’t lock up your XEmacs for an
indeterminate time when you run a diff command, either that or another,
faster CVS server.
lisp/ChangeLog addition:
2005-12-24 Aidan Kehoe <kehoea(a)parhasard.net>
* mule/chinese.el:
* mule/chinese.el ('euc-china): Removed. Shouldn't have been
uncommented in the first place.
src/ChangeLog addition:
2005-12-24 Aidan Kehoe <kehoea(a)parhasard.net>
* objects-x.c (x_font_instance_truename):
* objects-x.c (x_find_charset_font):
Reintroduce my change of 2005-12-20 and Stephen's of 2005-12-23,
which my last commit overrode.
XEmacs Trunk source patch:
Diff command: cvs -q diff -u
Files affected: src/objects-x.c lisp/mule/chinese.el
Index: lisp/mule/chinese.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/chinese.el,v
retrieving revision 1.11
diff -u -u -r1.11 chinese.el
--- lisp/mule/chinese.el 2005/12/24 21:24:27 1.11
+++ lisp/mule/chinese.el 2005/12/24 22:27:52
＠＠ -266,8 +266,6 ＠＠
G2: Sisheng (PinYin - ZhuYin)"
))
-(define-coding-system-alias 'euc-china 'chinese-iso-8bit)
-
;; For consistency with euc-jp, euc-ko
(define-coding-system-alias 'euc-cn 'cn-gb-2312)
Index: src/objects-x.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-x.c,v
retrieving revision 1.34
diff -u -u -r1.34 objects-x.c
--- src/objects-x.c 2005/12/24 17:33:34 1.34
+++ src/objects-x.c 2005/12/24 22:27:56
＠＠ -808,7 +808,8 ＠＠
FcChar8 *res = FcNameUnparse (FONT_INSTANCE_X_XFTFONT (f)->pattern);
if (res)
{
- FONT_INSTANCE_TRUENAME (f) = make_string (res, strlen (res));
+ FONT_INSTANCE_TRUENAME (f) =
+ build_ext_string (res, Qxft_font_name_encoding);
free (res);
return FONT_INSTANCE_TRUENAME (f);
}
＠＠ -1176,7 +1177,7 ＠＠
Extbyte **names;
int count = 0;
const Extbyte *patternext;
- Lisp_Object result = Qunbound;
+ Lisp_Object result = Qnil;
int i;
/* #### with Xft need to handle second stage here -- sjt
＠＠ -1442,7 +1443,7 ＠＠
if (x_font_spec_matches_charset (XDEVICE (device), charset,
intname, Qnil, 0, -1, 0))
{
- result = make_string (intname, intlen);
+ result = build_ext_string (intname, Qx_font_name_encoding);
break;
}
}
--
I AM IN JAIL AND ALLOWED SEND ONLY ONE CABLE SINCE WAS ARRESTED WHILE
MEASURING FIFTEEN FOOT WALL OUTSIDE PALACE AND HAVE JUST FINISHED COUNTING
THIRTY EIGHT THOUSAND FIVE HUNDERED TWENTY TWO NAMES WHOS WHO IN MIDEAST.
- 2 participants
- 1 comments
[COMMIT] Call set-current-locale on startup
19 years
Aidan Kehoe
Aidan Kehoe
NOTE: This patch has been committed.
Call set-current-locale on startup, to better allow the language environment
init code to work out what it should do. Reverts a bug I introduced on
2005-12-17.
lisp/ChangeLog addition:
2005-12-24 Aidan Kehoe <kehoea(a)parhasard.net>
* mule/mule-cmds.el (set-language-environment-coding-systems):
* mule/mule-cmds.el (init-locale-at-early-startup):
Call set-current-locale (the wrapper for setlocale(3)) before
checking the current locale, because the C code doesn't.
XEmacs Trunk source patch:
Diff command: cvs -q diff -u
Files affected: lisp/mule/mule-cmds.el
Index: lisp/mule/mule-cmds.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/mule-cmds.el,v
retrieving revision 1.26
diff -u -u -r1.26 mule-cmds.el
--- lisp/mule/mule-cmds.el 2005/12/17 19:47:00 1.26
+++ lisp/mule/mule-cmds.el 2005/12/24 21:55:09
＠＠ -1341,12 +1341,19 ＠＠
;; locale but we should still use the right code page, etc.
(declare-fboundp (mswindows-set-current-locale userdef)))
;; Unix:
- (let ((locstring (current-locale)))
- ;; assume C lib locale and LANG env var are set correctly. use
- ;; them to find the langenv.
- (setq langenv
- (and locstring (get-language-environment-from-locale
- locstring)))))
+ (let (locstring)
+ ;; Init the POSIX locale from the environment--this calls the C
+ ;; library's setlocale(3).
+ (set-current-locale "")
+ ;; Can't let locstring be the result of (set-current-locale "")
+ ;; because that can return a more detailed string than we know how
+ ;; to handle.
+ (setq locstring (current-locale)
+ ;; assume C lib locale and LANG env var are set correctly.
+ ;; use them to find the langenv.
+ langenv
+ (and locstring (get-language-environment-from-locale
+ locstring)))))
;; All systems:
(unless langenv (setq langenv "English"))
(setq current-language-environment langenv)
--
I AM IN JAIL AND ALLOWED SEND ONLY ONE CABLE SINCE WAS ARRESTED WHILE
MEASURING FIFTEEN FOOT WALL OUTSIDE PALACE AND HAVE JUST FINISHED COUNTING
THIRTY EIGHT THOUSAND FIVE HUNDERED TWENTY TWO NAMES WHOS WHO IN MIDEAST.
- 1 participants
- 0 comments
[COMMIT] Define euc-cn as a coding system alias
19 years
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
There seem to be a lot of other things in the Chinese support that could be
rationalised--maybe some other time. This struck me in particular,
though. NetBSD’s mainland Chinese locale calls the coding system eucCN.
NOTE: This patch has been committed.
lisp/ChangeLog addition:
2005-12-24 Aidan Kehoe <kehoea(a)parhasard.net>
* mule/chinese.el:
Make euc-cn available as a coding system alias for cn-gb-2312, for
the sake of consistency with euc-jp, euc-ko and the FSF.
XEmacs Trunk source patch:
Diff command: cvs -q diff -u
Files affected: lisp/mule/chinese.el
Index: lisp/mule/chinese.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/chinese.el,v
retrieving revision 1.10
diff -u -u -r1.10 chinese.el
--- lisp/mule/chinese.el 2002/04/07 17:10:50 1.10
+++ lisp/mule/chinese.el 2005/12/24 21:18:46
＠＠ -266,9 +266,10 ＠＠
G2: Sisheng (PinYin - ZhuYin)"
))
-;; (define-coding-system-alias 'cn-gb-2312 'chinese-iso-8bit)
-;; (define-coding-system-alias 'euc-china 'chinese-iso-8bit)
-;; (define-coding-system-alias 'euc-cn 'chinese-iso-8bit)
+(define-coding-system-alias 'euc-china 'chinese-iso-8bit)
+
+;; For consistency with euc-jp, euc-ko
+(define-coding-system-alias 'euc-cn 'cn-gb-2312)
(define-coding-system-alias 'gb2312 'cn-gb-2312)
(define-coding-system-alias 'chinese-euc 'cn-gb-2312)
--
I AM IN JAIL AND ALLOWED SEND ONLY ONE CABLE SINCE WAS ARRESTED WHILE
MEASURING FIFTEEN FOOT WALL OUTSIDE PALACE AND HAVE JUST FINISHED COUNTING
THIRTY EIGHT THOUSAND FIVE HUNDERED TWENTY TWO NAMES WHOS WHO IN MIDEAST.
- 1 participants
- 0 comments