Mercurial > hg > xemacs-beta
changeset 4408:8bbabcab2c42
Merge.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Sun, 20 Jan 2008 13:09:58 +0100 |
parents | 4ee73bbe4f8e (current diff) 5998e37dc35e (diff) |
children | 3ff01259c4a2 fd8a9a4d81d9 |
files | lisp/gtk-iso8859-1.el lisp/x-iso8859-1.el src/ChangeLog |
diffstat | 54 files changed, 2122 insertions(+), 1866 deletions(-) [+] |
line wrap: on
line diff
--- a/ChangeLog Wed Dec 26 17:30:16 2007 +0100 +++ b/ChangeLog Sun Jan 20 13:09:58 2008 +0100 @@ -1,3 +1,30 @@ +2008-01-17 Aidan Kehoe <kehoea@parhasard.net> + + * configure.ac: + If using a version of the gdbm library that sticks dbm_open in + libgdbm_compat.so, also link to that library. + Correct a thinko with DBM version 4 checks. Both from Hans de + Graaff, in + http://mid.gmane.org/20050812092756.6850.qmail@graaff.xs4all.nl + and + http://mid.gmane.org/pan.2007.06.24.10.10.57@gentoo.org; thank you + Hans! + * configure: + Regenerate. + +2008-01-01 Stephen J. Turnbull <stephen@xemacs.org> + + * Makefile.in.in (mkpkgdir): Fix incorrect comment convention. + +2007-12-26 Stephen J. Turnbull <stephen@xemacs.org> + + * Makefile.in.in (mkpkgdir): Ensure only one late package directory. + +2007-12-26 Stephen J. Turnbull <stephen@xemacs.org> + + * Makefile.in.in (check-available-packages): Say where to install. + (mkpkgdir): + 2007-12-23 Stephen J. Turnbull <stephen@xemacs.org> * Makefile.in.in (mkpkgdir):
--- a/Makefile.in.in Wed Dec 26 17:30:16 2007 +0100 +++ b/Makefile.in.in Sun Jan 20 13:09:58 2008 +0100 @@ -500,21 +500,31 @@ check-available-packages: @if test -r ${pkgsrcdir}/bootstrap.tar.gz; \ - then echo "To install a set of bootstrap packages, type:"; \ + then echo "To install a set of bootstrap packages in"; \ + echo "${package_path}/xemacs-packages, type:"; \ echo " make install-bootstrap-packages"; \ fi; \ if test -r ${pkgsrcdir}/xemacs-sumo.tar.gz; \ - then echo "To install the full set of non-mule packages, type:"; \ + then echo "To install the full set of non-mule packages in"; \ + echo "${package_path}/xemacs-packages, type:"; \ echo " make install-nonmule-packages"; \ fi; \ if test -r ${pkgsrcdir}/xemacs-mule-sumo.tar.gz; \ - then echo "To install the full set of packages with mule, type:"; \ + then echo "To install the full set of packages with mule in"; \ + echo "${package_path}/mule-packages, type:"; \ echo " make install-all-packages"; \ - fi; + fi + +## The test for a non-trivial path simply checks for the conventional Unix +## path separator ":". This is reasonable because this is basically just +## a convenience feature, anyway. mkpkgdir: FRC.mkdir ${MAKEPATH} @if test -z ${package_path}; \ - then echo "not configured --with-late-packages; no place to install."; \ + then echo "Not configured --with-late-packages; no place to install."; \ + exit -1; \ + elif echo ${package_path} | grep ":"; \ + then echo "Configured with multiple late package directories; you decide where to install."; \ exit -1; \ elif test -e ${package_path}/xemacs-packages \ -o -e ${package_path}/mule-packages; \
--- a/configure Wed Dec 26 17:30:16 2007 +0100 +++ b/configure Sun Jan 20 13:09:58 2008 +0100 @@ -37246,12 +37246,81 @@ enable_database_gdbm=yes enable_database_dbm=no libdbm=-lgdbm else + { echo "$as_me:$LINENO: checking for dbm_open in -lgdbm_compat" >&5 +echo $ECHO_N "checking for dbm_open in -lgdbm_compat... $ECHO_C" >&6; } +if test "${ac_cv_lib_gdbm_compat_dbm_open+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lgdbm_compat -lgdbm $LIBS" +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dbm_open (); +int +main () +{ +return dbm_open (); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_link") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && + $as_test_x conftest$ac_exeext; then + ac_cv_lib_gdbm_compat_dbm_open=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_gdbm_compat_dbm_open=no +fi + +rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ echo "$as_me:$LINENO: result: $ac_cv_lib_gdbm_compat_dbm_open" >&5 +echo "${ECHO_T}$ac_cv_lib_gdbm_compat_dbm_open" >&6; } +if test $ac_cv_lib_gdbm_compat_dbm_open = yes; then + + enable_database_gdbm=yes enable_database_dbm=no libdbm="-lgdbm_compat -lgdbm" +else + if test "$enable_database_gdbm" = "yes"; then { echo "Error:" "Required GNU DBM support cannot be provided." >&2; exit 1; } fi enable_database_gdbm=no fi + +fi + fi if test "$enable_database_dbm" != "no"; then @@ -37902,7 +37971,7 @@ fi - if test "$enable_database_berkdb" != "yes" -a "$dbver" = "4"; then + if test "$enable_database_berkdb" = "yes" -a "$dbver" = "4"; then rm -f $tempcname echo "#include <$db_h_file>" > $tempcname echo "configure___ dbfunc=db_create" >> $tempcname
--- a/configure.ac Wed Dec 26 17:30:16 2007 +0100 +++ b/configure.ac Sun Jan 20 13:09:58 2008 +0100 @@ -5408,10 +5408,13 @@ if test "$enable_database_gdbm" != "no"; then AC_CHECK_LIB(gdbm, dbm_open, [ enable_database_gdbm=yes enable_database_dbm=no libdbm=-lgdbm], [ + AC_CHECK_LIB(gdbm_compat, dbm_open, [ + enable_database_gdbm=yes enable_database_dbm=no libdbm="-lgdbm_compat -lgdbm"], [ if test "$enable_database_gdbm" = "yes"; then XE_DIE("Required GNU DBM support cannot be provided.") fi - enable_database_gdbm=no]) + enable_database_gdbm=no], -lgdbm) + ]) fi dnl Check for DBM support in libc and libdbm. @@ -5492,7 +5495,7 @@ fi dnl Berk db 4.1 decorates public functions with version information - if test "$enable_database_berkdb" != "yes" -a "$dbver" = "4"; then + if test "$enable_database_berkdb" = "yes" -a "$dbver" = "4"; then rm -f $tempcname echo "#include <$db_h_file>" > $tempcname echo "configure___ dbfunc=db_create" >> $tempcname
--- a/etc/ChangeLog Wed Dec 26 17:30:16 2007 +0100 +++ b/etc/ChangeLog Sun Jan 20 13:09:58 2008 +0100 @@ -1,3 +1,7 @@ +2007-12-26 Stephen J. Turnbull <stephen@xemacs.org> + + * bundled-packages/README: Document restriction on --with-late-packages. + 2007-12-23 Stephen J. Turnbull <stephen@xemacs.org> * bundled-packages/README: Documentation for bundled packages.
--- a/etc/bundled-packages/README Wed Dec 26 17:30:16 2007 +0100 +++ b/etc/bundled-packages/README Sun Jan 20 13:09:58 2008 +0100 @@ -1,10 +1,13 @@ Package distributions may be placed in this directory. If present and a package-path is configured, packages can be installed -using the top-level makefile. +using the top-level Makefile. To configure the package path, use the --with-late-packages option to -configure, which specifies the path to the directory containing the -xemacs-packages and mule-packages hierarchies to install. +configure, which specifies a single directory in which to install the +xemacs-packages and mule-packages hierarchies provided. If this is null, +or contains a Unix-style search path (i.e., a colon is present in the +argument of the --with-late-packages option), you will have to install +the packages by hand. To find out if a distribution includes bundled packages, type
--- a/lisp/ChangeLog Wed Dec 26 17:30:16 2007 +0100 +++ b/lisp/ChangeLog Sun Jan 20 13:09:58 2008 +0100 @@ -1,3 +1,131 @@ +2008-01-17 Mike Sperber <mike@xemacs.org> + + * files.el (insert-directory): Bind `coding-system-for-read' to + the `file-name' coding system. (Previously, the default ended up + being undecided, which doesn't work well for UTF-8-based locales, + for example.) + +2008-01-16 Aidan Kehoe <kehoea@parhasard.net> + + * keydefs.el (global-map): + Bind '(shift delete) to #'kill-primary-selection, as described by + Glynn Clements in + 16434.49191.47038.991206@cerise.nosuchdomain.co.uk of 2004-02-08. + +2008-01-14 Jerry James <james@xemacs.org> + + * font-lock.el (font-lock-add-keywords): Adapt to differences in + Emacs and XEmacs compiled font-lock lists. + * font-lock.el (font-lock-remove-keywords): Ditto. + * font-lock.el (font-lock-set-defaults-1): Make changes specified + by font-lock-keywords-alist and font-lock-removed-keywords-alist. + +2008-01-14 Aidan Kehoe <kehoea@parhasard.net> + + * bytecomp.el (byte-compile-output-file-form): + Bind print-gensym-alist to nil, as we do within + byte-compile-output-docform. + +2008-01-04 Michael Sperber <mike@xemacs.org> + + * code-files.el (insert-file-contents): + (load): Don't call `substitute-in-file-name' on the file name. + +2008-01-03 Aidan Kehoe <kehoea@parhasard.net> + + * cus-edit.el (custom-save-all): + If the directory containing the custom file doesn't exist, try to + create it. Fixes Nick's Crabtree's bug of + 5fb265820712140145w512fa3bbh355cf76f7e2cf792@mail.gmail.com ; + thank you Nick. + * menubar-items.el (default-menubar): + In the code to edit the user's init file, try to create the + containing directory if it doesn't exist. + +2008-01-02 Aidan Kehoe <kehoea@parhasard.net> + + * gtk-init.el (init-post-gtk-win): + Trust the X11 code to give us decent default fonts. + +2008-01-02 Aidan Kehoe <kehoea@parhasard.net> + + * x-iso8859-1.el: Removed. + * gtk-iso8859-1.el: Removed. + These haven't been used in a year and a half. No need to keep them + around. + +2008-01-02 Mike Sperber <mike@xemacs.org> + + * minibuf.el (mouse-read-file-name-1): Use `window-height' instead + of `frame-height' to be consistent with `split-window''s + calculations. Bind `window-min-height' for the whole thing to + avoid geometry problems with the buttons window. + +2008-01-02 Mike Sperber <mike@xemacs.org> + + * minibuf.el (mouse-read-file-name-1): Make the buttons in the + dialog frame occupy `window-min-height' lines to avoid problems + when the window configuration changes---as it does with + `resize-minibuffer-mode'. + +2007-12-31 Aidan Kehoe <kehoea@parhasard.net> + + * menubar-items.el (default-menubar): + Byte compile the specified lambdas. Correct some compile time + warnings uncovered by this. + * menubar-items.el (tutorials-menu-filter): + If a language environment doesn't have an associated POSIX locale + specified--which indicates we don't want it used except by those + who know what they're doing--don't show its tutorial in the menu. + * behavior.el (behavior-menu-filter): + Byte compile the lambdas in the generated menu. + +2007-12-30 Aidan Kehoe <kehoea@parhasard.net> + + * iso8859-1.el: (provide 'iso8859-1) again, because one file uses + it in the packages. + +2007-12-30 Aidan Kehoe <kehoea@parhasard.net> + + * subr.el (with-case-table): New. + Idea and implementation taken from GNU's code of April 2007, + before GPL V3 was implied. Thank you GNU. + * iso8859-1.el (ascii-case-table): New. + Idea taken from GNU. + * iso8859-1.el : + Change Jamie's implicit compile-time call to a macro literal into + something comprehensible to and maintainable by mortals, using to + cl.el's #'loop. + * iso8859-1.el (ctl-arrow): + Initialise it to something more comprehensible. + +2007-12-30 Aidan Kehoe <kehoea@parhasard.net> + + * loadhist.el (symbol-file): + Accept a new TYPE argument, compatible with GNU, saying + whether function or variable definitions should be searched for. + Implement the functionality for autoloads, handling TYPE + correctly. + Pass the TYPE argument to built-in-symbol-file correctly. + Document that TYPE is not implemented for non-autoloaded Lisp + definitions. Our load-history doesn't have the relevant metadata. + +2007-12-25 Aidan Kehoe <kehoea@parhasard.net> + + * glyphs.el (init-glyphs): + Revert part of Didier's 2007-10-15 commit, which broke + #'make-image-specifier with string arguments, and more noticeably + truncation-glyph, continuation-glyph, octal-escape-glyph, + control-arrow-glyph. + +2007-12-23 Mike Sperber <mike@xemacs.org> + + * font.el (xft-font-create-object): Use + `fc-pattern-get-or-compute-size' instead of + `fc-pattern-get-size'. + + * fontconfig.el (fc-pattern-get-or-compute-size): Add. + 2007-12-22 Stephen J. Turnbull <stephen@xemacs.org> Factor out lists of operators specially treated by `make-autoload'. @@ -120,7 +248,7 @@ * keydefs.el: Bind mouse wheel movements by default, to a lambda that calls the - autoloaded #'mwheel-install and then #'mwheel-scrool with the + autoloaded #'mwheel-install and then #'mwheel-scroll with the appropriate event. 2007-12-07 Vin Shelton <acs@xemacs.org>
--- a/lisp/behavior.el Wed Dec 26 17:30:16 2007 +0100 +++ b/lisp/behavior.el Sun Jan 20 13:09:58 2008 +0100 @@ -478,23 +478,23 @@ (defun behavior-menu-filter (menu) (append - '(("%_Package Utilities" + `(("%_Package Utilities" ("%_Set Download Site" ("%_Official Releases" - :filter (lambda (&rest junk) - (menu-split-long-menu - (submenu-generate-accelerator-spec - (package-ui-download-menu))))) + :filter ,#'(lambda (&rest junk) + (menu-split-long-menu + (submenu-generate-accelerator-spec + (package-ui-download-menu))))) ("%_Pre-Releases" - :filter (lambda (&rest junk) - (menu-split-long-menu - (submenu-generate-accelerator-spec - (package-ui-pre-release-download-menu))))) + :filter ,#'(lambda (&rest junk) + (menu-split-long-menu + (submenu-generate-accelerator-spec + (package-ui-pre-release-download-menu))))) ("%_Site Releases" - :filter (lambda (&rest junk) - (menu-split-long-menu - (submenu-generate-accelerator-spec - (package-ui-site-release-download-menu)))))) + :filter ,#'(lambda (&rest junk) + (menu-split-long-menu + (submenu-generate-accelerator-spec + (package-ui-site-release-download-menu)))))) "--:shadowEtchedIn" ["%_Update Package Index" package-get-update-base] ["%_List and Install" pui-list-packages]
--- a/lisp/bytecomp.el Wed Dec 26 17:30:16 2007 +0100 +++ b/lisp/bytecomp.el Sun Jan 20 13:09:58 2008 +0100 @@ -1888,7 +1888,8 @@ (print-readably t) ; print #[] for bytecode, 'x for (quote x) (print-gensym (if (and byte-compile-print-gensym (not byte-compile-emacs19-compatibility)) - '(t) nil))) + '(t) nil)) + print-gensym-alist) (princ "\n" byte-compile-outbuffer) (prin1 form byte-compile-outbuffer) nil)))
--- a/lisp/code-files.el Wed Dec 26 17:30:16 2007 +0100 +++ b/lisp/code-files.el Sun Jan 20 13:09:58 2008 +0100 @@ -235,10 +235,10 @@ ;(defun convert-mbox-coding-system (filename visit start end) ...) -(defun load (file &optional noerror nomessage nosuffix) - "Execute a file of Lisp code named FILE, or load a binary module. -First tries to find a Lisp FILE with .elc appended, then with .el, then with - FILE unmodified. If unsuccessful, tries to find a binary module FILE with +(defun load (filename &optional noerror nomessage nosuffix) + "Execute a file of Lisp code named FILENAME, or load a binary module. +First tries to find a Lisp file FILENAME with .elc appended, then with .el, then with + FILENAME unmodified. If unsuccessful, tries to find a binary module FILE with the elements of `module-extensions' appended, one at a time. Searches directories in load-path for Lisp files, and in `module-load-path' for binary modules. @@ -250,9 +250,8 @@ .elc, .el, or elements of `module-extensions' to the specified name FILE. Return t if file exists." (declare (special load-modules-quietly)) - (let* ((filename (substitute-in-file-name file)) - (handler (find-file-name-handler filename 'load)) - (path nil)) + (let ((handler (find-file-name-handler filename 'load)) + (path nil)) (if handler (funcall handler 'load filename noerror nomessage nosuffix) ;; First try to load a Lisp file @@ -262,10 +261,10 @@ '(".elc" ".el" ""))))) ;; now use the internal load to actually load the file. (load-internal - file noerror nomessage nosuffix + filename noerror nomessage nosuffix (let ((elc ; use string= instead of string-match to keep match-data. - (equalp ".elc" (substring path -4)))) - (or (and (not elc) coding-system-for-read) ;prefer for source file + (equalp ".elc" (substring path -4)))) + (or (and (not elc) coding-system-for-read) ;prefer for source file ;; find magic-cookie (let ((codesys (find-coding-system-magic-cookie-in-file path))) @@ -401,8 +400,7 @@ See also `insert-file-contents-access-hook', `insert-file-contents-pre-hook', `insert-file-contents-error-hook', and `insert-file-contents-post-hook'." - (let* ((expanded (substitute-in-file-name filename)) - (handler (find-file-name-handler expanded 'insert-file-contents))) + (let ((handler (find-file-name-handler filename 'insert-file-contents))) (if handler (funcall handler 'insert-file-contents filename visit start end replace) (let (return-val coding-system used-codesys)
--- a/lisp/cus-edit.el Wed Dec 26 17:30:16 2007 +0100 +++ b/lisp/cus-edit.el Sun Jan 20 13:09:58 2008 +0100 @@ -3766,7 +3766,13 @@ (custom-save-variables) (custom-save-faces) (let ((find-file-hooks nil) - (auto-mode-alist)) + (auto-mode-alist) + custom-file-directory) + (unless (file-directory-p (setq custom-file-directory + (file-name-directory custom-file))) + (message "Creating %s... " custom-file-directory) + (make-directory custom-file-directory t) + (message "Creating %s... done." custom-file-directory)) (with-current-buffer (find-file-noselect custom-file) (save-buffer)))))
--- a/lisp/dumped-lisp.el Wed Dec 26 17:30:16 2007 +0100 +++ b/lisp/dumped-lisp.el Sun Jan 20 13:09:58 2008 +0100 @@ -104,7 +104,7 @@ "isearch-mode" "buffer" "buff-menu" - "paths.el" ; don't get confused if paths compiled. + "paths" "lisp" "page" "register"
--- a/lisp/files.el Wed Dec 26 17:30:16 2007 +0100 +++ b/lisp/files.el Sun Jan 20 13:09:58 2008 +0100 @@ -4177,6 +4177,9 @@ file switches wildcard full-directory-p))) (t (let* ((beg (point)) + ;; on Unix, assume that ls will output in what the + ;; file-name coding system specifies + (coding-system-for-read (get-coding-system 'file-name)) (result (if wildcard ;; Run ls in the directory of the file pattern we asked for.
--- a/lisp/font-lock.el Wed Dec 26 17:30:16 2007 +0100 +++ b/lisp/font-lock.el Sun Jan 20 13:09:58 2008 +0100 @@ -959,7 +959,7 @@ (let ((was-compiled (eq (car font-lock-keywords) t))) ;; Bring back the user-level (uncompiled) keywords. (if was-compiled - (setq font-lock-keywords (cadr font-lock-keywords))) + (setq font-lock-keywords (cdr font-lock-keywords))) ;; Now modify or replace them. (if (eq how 'set) (setq font-lock-keywords keywords) @@ -1069,7 +1069,7 @@ (let ((was-compiled (eq (car font-lock-keywords) t))) ;; Bring back the user-level (uncompiled) keywords. (if was-compiled - (setq font-lock-keywords (cadr font-lock-keywords))) + (setq font-lock-keywords (cdr font-lock-keywords))) ;; Edit them. (setq font-lock-keywords (copy-sequence font-lock-keywords)) @@ -2031,7 +2031,10 @@ font-lock-defaults (font-lock-find-font-lock-defaults major-mode))) (keywords (font-lock-choose-keywords - (nth 0 defaults) font-lock-maximum-decoration))) + (nth 0 defaults) font-lock-maximum-decoration)) + (local (cdr (assq major-mode font-lock-keywords-alist))) + (removed-keywords + (cdr-safe (assq major-mode font-lock-removed-keywords-alist)))) ;; Keywords? (setq font-lock-keywords (if (fboundp keywords) @@ -2096,7 +2099,14 @@ ;; older way: ;; defaults not specified at all, so use `beginning-of-defun'. (setq font-lock-beginning-of-syntax-function - 'beginning-of-defun))))) + 'beginning-of-defun))) + + ;; Local fontification? + (while local + (font-lock-add-keywords nil (car (car local)) (cdr (car local))) + (setq local (cdr local))) + (when removed-keywords + (font-lock-remove-keywords nil removed-keywords)))) (setq font-lock-cache-position (make-marker)) (setq font-lock-defaults-computed t)))
--- a/lisp/font.el Wed Dec 26 17:30:16 2007 +0100 +++ b/lisp/font.el Sun Jan 20 13:09:58 2008 +0100 @@ -813,7 +813,7 @@ (pattern (fc-font-match device (fc-name-parse name))) (font-obj (make-font)) (family (fc-pattern-get-family pattern 0)) - (size (fc-pattern-get-size pattern 0)) + (size (fc-pattern-get-or-compute-size pattern 0)) (weight (fc-pattern-get-weight pattern 0))) (set-font-family font-obj (and (not (equal family 'fc-result-no-match))
--- a/lisp/fontconfig.el Wed Dec 26 17:30:16 2007 +0100 +++ b/lisp/fontconfig.el Sun Jan 20 13:09:58 2008 +0100 @@ -350,6 +350,21 @@ (let ((pair (assoc str fc-font-name-weight-mapping-string-reverse))) (if pair (cdr pair)))) +(defun fc-pattern-get-or-compute-size (pattern id) + "Get the size from `pattern' associated with `id' or try to compute it. +Returns 'fc-result-no-match if unsucessful." + ;; Many font patterns don't have a "size" property, but do have a + ;; "dpi" and a "pixelsize" property". + (let ((maybe (fc-pattern-get-size pattern id))) + (if (not (eq maybe 'fc-result-no-match)) + maybe + (let ((dpi (fc-pattern-get-dpi pattern id)) + (pixelsize (fc-pattern-get-pixelsize pattern id))) + (if (and (numberp dpi) + (numberp pixelsize)) + (* pixelsize (/ 72 dpi)) + 'fc-result-no-match))))) + (defun fc-copy-pattern-partial (pattern attribute-list) "Return a copy of PATTERN restricted to ATTRIBUTE-LIST.
--- a/lisp/glyphs.el Wed Dec 26 17:30:16 2007 +0100 +++ b/lisp/glyphs.el Sun Jan 20 13:09:58 2008 +0100 @@ -1185,8 +1185,7 @@ [jpeg :data nil] 2))) ,@(if (featurep 'png) '(("\\.png\\'" [png :file nil] 2))) ,@(if (featurep 'png) '(("\\`\211PNG" [png :data nil] 2))) - ;; No, I don't think we want to inline images... -- dvl - ;; ("" [string :data nil] 2) + ("" [string :data nil] 2) ("" [nothing])))) ;; #### this should really be formatted-string, not string but we ;; don't have it implemented yet @@ -1210,8 +1209,7 @@ ("\\`\377\330\377\340\000\020JFIF" [string :data "[jpeg]"]) ("\\.png\\'" [string :data nil] 2) ("\\`\211PNG" [string :data "[png]"]) - ;; No, I don't think we want to inline images... -- dvl - ;;("" [string :data nil] 2) + ("" [string :data nil] 2) ;; this last one is here for pointers and icons and such -- ;; strings are not allowed so they will be ignored. ("" [nothing])))
--- a/lisp/gtk-init.el Wed Dec 26 17:30:16 2007 +0100 +++ b/lisp/gtk-init.el Sun Jan 20 13:09:58 2008 +0100 @@ -133,62 +133,6 @@ (defun init-post-gtk-win () (unless gtk-post-win-initted - (when (featurep 'mule) - (define-specifier-tag 'mule-fonts - (lambda (device) (eq 'gtk (device-type device)))) - (set-face-font - 'default - '("-*-fixed-medium-r-*--16-*-iso8859-1" - "-*-fixed-medium-r-*--*-iso8859-1" - "-*-fixed-medium-r-*--*-iso8859-2" - "-*-fixed-medium-r-*--*-iso8859-3" - "-*-fixed-medium-r-*--*-iso8859-4" - "-*-fixed-medium-r-*--*-iso8859-7" - "-*-fixed-medium-r-*--*-iso8859-8" - "-*-fixed-medium-r-*--*-iso8859-5" - "-*-fixed-medium-r-*--*-iso8859-9" - - ;; Following 3 fonts proposed by Teruhiko.Kurosaka@Japan.eng.sun - "-sun-gothic-medium-r-normal--14-120-75-75-c-60-jisx0201.1976-0" - "-sun-gothic-medium-r-normal--14-120-75-75-c-120-jisx0208.1983-0" - "-wadalab-gothic-medium-r-normal--14-120-75-75-c-120-jisx0212.1990-0" - ;; Other Japanese fonts - "-*-fixed-medium-r-*--*-jisx0201.1976-*" - "-*-fixed-medium-r-*--*-jisx0208.1983-*" - "-*-fixed-medium-r-*--*-jisx0212*-*" - - ;; Chinese fonts - "-*-*-medium-r-*--*-gb2312.1980-*" - - ;; Use One font specification for CNS chinese - ;; Too many variations in font naming - "-*-fixed-medium-r-*--*-cns11643*-*" - ;; "-*-fixed-medium-r-*--*-cns11643*2" - ;; "-*-fixed-medium-r-*--*-cns11643*3" - ;; "-*-fixed-medium-r-*--*-cns11643*4" - ;; "-*-fixed-medium-r-*--*-cns11643.5-0" - ;; "-*-fixed-medium-r-*--*-cns11643.6-0" - ;; "-*-fixed-medium-r-*--*-cns11643.7-0" - - "-*-fixed-medium-r-*--*-big5*-*" - "-*-fixed-medium-r-*--*-sisheng_cwnn-0" - - ;; Other fonts - - ;; "-*-fixed-medium-r-*--*-viscii1.1-1" - - ;; "-*-fixed-medium-r-*--*-mulearabic-0" - ;; "-*-fixed-medium-r-*--*-mulearabic-1" - ;; "-*-fixed-medium-r-*--*-mulearabic-2" - - ;; "-*-fixed-medium-r-*--*-muleipa-1" - ;; "-*-fixed-medium-r-*--*-ethio-*" - - "-*-mincho-medium-r-*--*-ksc5601.1987-*" ; Korean - "-*-fixed-medium-r-*--*-tis620.2529-1" ; Thai - ) - 'global '(mule-fonts) 'append)) - (setq gtk-post-win-initted t))) (push '("-geometry" . gtk-init-handle-geometry) command-switch-alist)
--- a/lisp/gtk-iso8859-1.el Wed Dec 26 17:30:16 2007 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4 +0,0 @@ -;; We can just cheat and use the same code that X does. - -(require 'x-iso8859-1) -(provide 'gtk-iso8859-1)
--- a/lisp/iso8859-1.el Wed Dec 26 17:30:16 2007 +0100 +++ b/lisp/iso8859-1.el Sun Jan 20 13:09:58 2008 +0100 @@ -28,71 +28,63 @@ ;;; Commentary: -;; created by jwz, 19-aug-92. ;; Sets the case table for the ISO-8859/1 character set. -;; Used to set the syntax table. +;; Provides ascii-case-table, for use in environments where multilingual +;; case-insensitive processing is inappropriate. ;;; Code: -(defconst iso8859/1-case-table nil - "The case table for ISO-8859/1 characters.") - -;;; This macro expands into -;;; (setq iso8859/1-case-table (purecopy '("..." nil nil nil))) -;;; doing the computation of the case table at compile-time. +(defvar ascii-case-table + (loop + for lower from (char-int ?a) to (char-int ?z) + and upper from (char-int ?A) to (char-int ?Z) + with table = (make-case-table) + do (put-case-table-pair (coerce lower 'character) + (coerce upper 'character) + table) + finally return table) + "Case table for the ASCII character set.") -((macro - . (lambda (&rest pairs) - (let ((downcase (make-string 256 0)) - (i 0)) - (while (< i 256) - (aset downcase i (if (and (>= i ?A) (<= i ?Z)) (+ i 32) i)) - (setq i (1+ i))) - (while pairs - (aset downcase (car (car pairs)) (car (cdr (car pairs)))) - (setq pairs (cdr pairs))) - (cons 'setq - (cons 'iso8859/1-case-table - (list - (list 'quote - (list downcase nil nil nil)))))))) - - (?\300 ?\340) ; Agrave - (?\301 ?\341) ; Aacute - (?\302 ?\342) ; Acircumflex - (?\303 ?\343) ; Atilde - (?\304 ?\344) ; Adiaeresis - (?\305 ?\345) ; Aring - (?\306 ?\346) ; AE - (?\307 ?\347) ; Ccedilla - (?\310 ?\350) ; Egrave - (?\311 ?\351) ; Eacute - (?\312 ?\352) ; Ecircumflex - (?\313 ?\353) ; Ediaeresis - (?\314 ?\354) ; Igrave - (?\315 ?\355) ; Iacute - (?\316 ?\356) ; Icircumflex - (?\317 ?\357) ; Idiaeresis - (?\320 ?\360) ; ETH - (?\321 ?\361) ; Ntilde - (?\322 ?\362) ; Ograve - (?\323 ?\363) ; Oacute - (?\324 ?\364) ; Ocircumflex - (?\325 ?\365) ; Otilde - (?\326 ?\366) ; Odiaeresis - (?\330 ?\370) ; Ooblique - (?\331 ?\371) ; Ugrave - (?\332 ?\372) ; Uacute - (?\333 ?\373) ; Ucircumflex - (?\334 ?\374) ; Udiaeresis - (?\335 ?\375) ; Yacute - (?\336 ?\376) ; THORN - ) +(loop + for (upper lower) + in '((?\xC0 ?\xE0) ;; A WITH GRAVE + (?\xC1 ?\xE1) ;; A WITH ACUTE + (?\xC2 ?\xE2) ;; A WITH CIRCUMFLEX + (?\xC3 ?\xE3) ;; A WITH TILDE + (?\xC4 ?\xE4) ;; A WITH DIAERESIS + (?\xC5 ?\xE5) ;; A WITH RING ABOVE + (?\xC6 ?\xE6) ;; AE + (?\xC7 ?\xE7) ;; C WITH CEDILLA + (?\xC8 ?\xE8) ;; E WITH GRAVE + (?\xC9 ?\xE9) ;; E WITH ACUTE + (?\xCA ?\xEA) ;; E WITH CIRCUMFLEX + (?\xCB ?\xEB) ;; E WITH DIAERESIS + (?\xCC ?\xEC) ;; I WITH GRAVE + (?\xCD ?\xED) ;; I WITH ACUTE + (?\xCE ?\xEE) ;; I WITH CIRCUMFLEX + (?\xCF ?\xEF) ;; I WITH DIAERESIS + (?\xD0 ?\xF0) ;; ETH + (?\xD1 ?\xF1) ;; N WITH TILDE + (?\xD2 ?\xF2) ;; O WITH GRAVE + (?\xD3 ?\xF3) ;; O WITH ACUTE + (?\xD4 ?\xF4) ;; O WITH CIRCUMFLEX + (?\xD5 ?\xF5) ;; O WITH TILDE + (?\xD6 ?\xF6) ;; O WITH DIAERESIS + (?\xD8 ?\xF8) ;; O WITH STROKE + (?\xD9 ?\xF9) ;; U WITH GRAVE + (?\xDA ?\xFA) ;; U WITH ACUTE + (?\xDB ?\xFB) ;; U WITH CIRCUMFLEX + (?\xDC ?\xFC) ;; U WITH DIAERESIS + (?\xDD ?\xFD) ;; Y WITH ACUTE + (?\xDE ?\xFE)) ;; THORN + with case-table = (standard-case-table) + do (put-case-table-pair upper lower case-table)) -(set-standard-case-table (mapcar 'copy-sequence iso8859/1-case-table)) +;; Everything Latin-1 and above should be displayed as its character value +;; by default. +(setq-default ctl-arrow #xA0) -(setq-default ctl-arrow 'iso-8859/1) - -(provide 'iso8859-1) +;; Shouldn't be necessary, but one file in the packages uses it: +(provide 'iso8859-1) ;;; iso8859-1.el ends here
--- a/lisp/keydefs.el Wed Dec 26 17:30:16 2007 +0100 +++ b/lisp/keydefs.el Sun Jan 20 13:09:58 2008 +0100 @@ -620,12 +620,16 @@ (define-key global-map '(meta delete) 'backward-or-forward-kill-word) (define-key global-map [(control x) (delete)] 'backward-or-forward-kill-sentence) +(define-key global-map '(shift delete) 'kill-primary-selection) + (define-key global-map 'kp-delete 'backward-or-forward-delete-char) (define-key global-map '(control kp-delete) 'backward-or-forward-kill-word) (define-key global-map '(meta kp-delete) 'backward-or-forward-kill-word) (define-key global-map [(control x) (kp-delete)] 'backward-or-forward-kill-sentence) +(define-key global-map '(shift kp-delete) 'kill-primary-selection) + ;; don't try this one at home, kids. (define-key global-map '(control meta delete) 'backward-or-forward-kill-sexp) (define-key global-map '(control meta kp-delete) 'backward-or-forward-kill-sexp)
--- a/lisp/loadhist.el Wed Dec 26 17:30:16 2007 +0100 +++ b/lisp/loadhist.el Sun Jan 20 13:09:58 2008 +0100 @@ -25,6 +25,8 @@ ;;; Synched up with: FSF 20.2. +;; #### Sync this file! + ;;; Commentary: ;; This file is dumped with XEmacs. @@ -37,19 +39,36 @@ ;; load-history is a list of entries that look like this: ;; ("outline" outline-regexp ... (require . wid-edit) ... (provide . outline) ...) -(defun symbol-file (sym) +(defun symbol-file (sym &optional type) "Return the input source from which SYM was loaded. -This is a file name, or nil if the source was a buffer with no associated file." +This is a file name, or nil if the source was a buffer with no associated file. + +If TYPE is nil or omitted, any kind of definition is acceptable. +If TYPE is `defun', then function, subr, special form or macro definitions +are acceptable. +If TYPE is `defvar', then variable definitions are acceptable. + +#### For the moment the difference is not implemented for non-autoloaded +Lisp symbols." (interactive "SFind source file for symbol: ") ; XEmacs (block look-up-symbol-file - (dolist (entry load-history) - (when (memq sym (cdr entry)) - (return-from look-up-symbol-file (car entry)))) - (when (or (and (boundp sym) (built-in-variable-type sym)) - (and (fboundp sym) (subrp (symbol-function sym)))) - (let ((built-in-file (built-in-symbol-file sym))) - (if built-in-file - (concat source-directory "/src/" built-in-file)))))) + (let (built-in-file autoload-cons) + (when (and + (eq 'autoload + (car-safe (setq autoload-cons + (and (fboundp sym) + (symbol-function sym))))) + (or (and (or (null type) (eq 'defvar type)) + (eq (fifth autoload-cons) 'keymap)) + (and (or (null type) (eq 'defvar type)) + (memq (fifth autoload-cons) '(nil macro))))) + (return-from look-up-symbol-file + (locate-library (second autoload-cons)))) + (dolist (entry load-history) + (when (memq sym (cdr entry)) + (return-from look-up-symbol-file (car entry)))) + (setq built-in-file (built-in-symbol-file sym type)) + (if built-in-file (concat source-directory "/src/" built-in-file))))) (defun feature-symbols (feature) "Return the file and list of symbols associated with a given FEATURE."
--- a/lisp/menubar-items.el Wed Dec 26 17:30:16 2007 +0100 +++ b/lisp/menubar-items.el Sun Jan 20 13:09:58 2008 +0100 @@ -99,23 +99,20 @@ (coding-system-list))))) (defconst default-menubar -; (purecopy-menubar ;purespace is dead - ;; note backquote. - `( - ("%_File" + ;; This is backquoted; a lambda with a preceding , will be byte-compiled. + `(("%_File" ["%_Open..." find-file] ["Open in Other %_Window..." find-file-other-window] ["Open in New %_Frame..." find-file-other-frame] ("Open with Specified %_Encoding" :filter - (lambda (menu) - (coding-system-menu-filter - (lambda (entry) - (let ((coding-system-for-read entry)) - (call-interactively 'find-file))) - (lambda (entry) t) - t)) - ) + ,#'(lambda (menu) + (coding-system-menu-filter + (lambda (entry) + (let ((coding-system-for-read entry)) + (call-interactively 'find-file))) + (lambda (entry) t) + t))) ["%_Hex Edit File..." hexl-find-file :active (fboundp 'hexl-find-file)] ["%_Insert File..." insert-file] @@ -135,7 +132,7 @@ ["Save So%_me Buffers" save-some-buffers] "-----" ,@(if (valid-specifier-tag-p 'msprinter) - '(["Page Set%_up..." generic-page-setup])) + '(["Page Set%_up..." generic-page-setup])) ["%_Print" generic-print-buffer :active (or (valid-specifier-tag-p 'msprinter) (and (not (eq system-type 'windows-nt)) @@ -152,384 +149,386 @@ :active (or buffer-file-name revert-buffer-function) :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] ("Rever%_t/Recover" - ("Revert Buffer with Specified %_Encoding" - :filter - (lambda (menu) - (coding-system-menu-filter - (lambda (entry) - (let ((coding-system-for-read entry)) - (revert-buffer))) - (lambda (entry) (or buffer-file-name revert-buffer-function)) - t)) + ("Revert Buffer with Specified %_Encoding" + :filter + ,#'(lambda (menu) + (coding-system-menu-filter + (lambda (entry) + (let ((coding-system-for-read entry)) + (revert-buffer))) + (lambda (entry) (or buffer-file-name revert-buffer-function)) + t))) + ["Re%_cover Buffer from Autosave" (recover-file buffer-file-name) + :active buffer-file-name + :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] + ["Recover %_Session..." recover-session] ) - ["Re%_cover Buffer from Autosave" (recover-file buffer-file-name) - :active buffer-file-name - :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] - ["Recover %_Session..." recover-session] - ) "-----" ["E%_xit XEmacs" save-buffers-kill-emacs] ) ("%_Edit" - ["%_Undo" undo - :active (and (not (eq buffer-undo-list t)) - (or buffer-undo-list pending-undo-list)) - :suffix (if (eq last-command 'undo) "More" "")] - ["%_Redo" redo - :included (fboundp 'redo) - :active (not (or (eq buffer-undo-list t) - (eq last-buffer-undo-list nil) - (not (or (eq last-buffer-undo-list buffer-undo-list) - (and (null (car-safe buffer-undo-list)) - (eq last-buffer-undo-list - (cdr-safe buffer-undo-list))))) - (or (eq buffer-undo-list pending-undo-list) - (eq (cdr buffer-undo-list) pending-undo-list)))) - :suffix (if (eq last-command 'redo) "More" "")] - "----" - ["Cu%_t" kill-primary-selection - :active (selection-owner-p)] - ["%_Copy" copy-primary-selection - :active (selection-owner-p)] - ["%_Paste" yank-clipboard-selection - :active (selection-exists-p 'CLIPBOARD)] - ["%_Delete" delete-primary-selection - :active (selection-owner-p)] - "----" - ["Select %_All" mark-whole-buffer] - ["Select Pa%_ge" mark-page] - ["Select Paragrap%_h" mark-paragraph] - ["Re%_select Region" activate-region :active (mark t)] - "----" - ["%_Find..." make-search-dialog] - ["R%_eplace..." query-replace] - ["Replace (Rege%_xp)..." query-replace-regexp] - ["List %_Matching Lines..." list-matching-lines] - ) + ["%_Undo" undo + :active (and (not (eq buffer-undo-list t)) + (or buffer-undo-list pending-undo-list)) + :suffix (if (eq last-command 'undo) "More" "")] + ["%_Redo" redo + :included (fboundp 'redo) + :active (not (or (eq buffer-undo-list t) + (eq last-buffer-undo-list nil) + (not (or (eq last-buffer-undo-list buffer-undo-list) + (and (null (car-safe buffer-undo-list)) + (eq last-buffer-undo-list + (cdr-safe buffer-undo-list))))) + (or (eq buffer-undo-list pending-undo-list) + (eq (cdr buffer-undo-list) pending-undo-list)))) + :suffix (if (eq last-command 'redo) "More" "")] + "----" + ["Cu%_t" kill-primary-selection + :active (selection-owner-p)] + ["%_Copy" copy-primary-selection + :active (selection-owner-p)] + ["%_Paste" yank-clipboard-selection + :active (selection-exists-p 'CLIPBOARD)] + ["%_Delete" delete-primary-selection + :active (selection-owner-p)] + "----" + ["Select %_All" mark-whole-buffer] + ["Select Pa%_ge" mark-page] + ["Select Paragrap%_h" mark-paragraph] + ["Re%_select Region" activate-region :active (mark t)] + "----" + ["%_Find..." make-search-dialog] + ["R%_eplace..." query-replace] + ["Replace (Rege%_xp)..." query-replace-regexp] + ["List %_Matching Lines..." list-matching-lines] + ) ("%_View" - ["%_Split Window" split-window-vertically] - ["S%_plit Window (Side by Side)" split-window-horizontally] - ["%_Un-Split (Keep This)" delete-other-windows - :active (not (one-window-p t))] - ["Un-Split (Keep %_Others)" delete-window - :active (not (one-window-p t))] - ["Balance %_Windows" balance-windows - :active (not (one-window-p t))] - ["Shrink Window to %_Fit" shrink-window-if-larger-than-buffer] - "----" - ("N%_arrow" - ["%_Narrow to Region" narrow-to-region :active (region-exists-p)] - ["Narrow to %_Page" narrow-to-page] - ["Narrow to %_Defun" narrow-to-defun] - "----" - ["%_Widen" widen :active (or (/= (point-min) 1) - (/= (point-max) (1+ (buffer-size))))] - ) + ["%_Split Window" split-window-vertically] + ["S%_plit Window (Side by Side)" split-window-horizontally] + ["%_Un-Split (Keep This)" delete-other-windows + :active (not (one-window-p t))] + ["Un-Split (Keep %_Others)" delete-window + :active (not (one-window-p t))] + ["Balance %_Windows" balance-windows + :active (not (one-window-p t))] + ["Shrink Window to %_Fit" shrink-window-if-larger-than-buffer] + "----" + ("N%_arrow" + ["%_Narrow to Region" narrow-to-region :active (region-exists-p)] + ["Narrow to %_Page" narrow-to-page] + ["Narrow to %_Defun" narrow-to-defun] "----" - ["%_Goto Line..." goto-line] - ["Beginning of %_Defun" beginning-of-defun] - ["%_End of Defun" end-of-defun] - ["%_Count Lines in Buffer" count-lines-buffer - :included (not (region-active-p))] - ["%_Count Lines in Region" count-lines-region - :included (region-active-p)] - "----" - ["%_Jump to Previous Mark" (set-mark-command t) - :active (mark t)] - ["Se%_t Bookmark" bookmark-set - :active (fboundp 'bookmark-set)] - ("%_Bookmarks" - :filter - (lambda (menu) - (let ((alist (and-boundp 'bookmark-alist - bookmark-alist))) - (if (not alist) - menu - (let ((items + ["%_Widen" widen :active (or (/= (point-min) 1) + (/= (point-max) (1+ (buffer-size))))] + ) + "----" + ["%_Goto Line..." goto-line] + ["Beginning of %_Defun" beginning-of-defun] + ["%_End of Defun" end-of-defun] + ["%_Count Lines in Buffer" count-lines-buffer + :included (not (region-active-p))] + ["%_Count Lines in Region" count-lines-region + :included (region-active-p)] + "----" + ["%_Jump to Previous Mark" (set-mark-command t) + :active (mark t)] + ["Se%_t Bookmark" bookmark-set + :active (fboundp 'bookmark-set)] + ("%_Bookmarks" + :filter + ,#'(lambda (menu) + (let ((alist (and-boundp 'bookmark-alist + bookmark-alist))) + (if (not alist) + menu + (let ((items + (submenu-generate-accelerator-spec + (mapcar #'(lambda (bmk) + `[,bmk (bookmark-jump ',bmk)]) + (bookmark-all-names))))) + (append menu '("---") items))))) + "---" + ["Insert %_Contents" bookmark-menu-insert + :active (fboundp 'bookmark-menu-insert)] + ["Insert L%_ocation" bookmark-menu-locate + :active (fboundp 'bookmark-menu-locate)] + "---" + ["%_Rename Bookmark" bookmark-menu-rename + :active (fboundp 'bookmark-menu-rename)] + ("%_Delete Bookmark" + :filter ,#'(lambda (menu) (submenu-generate-accelerator-spec (mapcar #'(lambda (bmk) - `[,bmk (bookmark-jump ',bmk)]) + `[,bmk (bookmark-delete ',bmk)]) (bookmark-all-names))))) - (append menu '("---") items))))) - "---" - ["Insert %_Contents" bookmark-menu-insert - :active (fboundp 'bookmark-menu-insert)] - ["Insert L%_ocation" bookmark-menu-locate - :active (fboundp 'bookmark-menu-locate)] - "---" - ["%_Rename Bookmark" bookmark-menu-rename - :active (fboundp 'bookmark-menu-rename)] - ("%_Delete Bookmark" - :filter (lambda (menu) - (submenu-generate-accelerator-spec - (mapcar #'(lambda (bmk) - `[,bmk (bookmark-delete ',bmk)]) - (bookmark-all-names))))) - ["%_Edit Bookmark List" bookmark-bmenu-list - :active (and-boundp 'bookmark-alist bookmark-alist)] - "---" - ["%_Save Bookmarks" bookmark-save - :active (and-boundp 'bookmark-alist bookmark-alist)] - ["Save Bookmarks %_As..." bookmark-write - :active (and-boundp 'bookmark-alist bookmark-alist)] - ["%_Load a Bookmark File" bookmark-load - :active (fboundp 'bookmark-load)] - ) + ["%_Edit Bookmark List" bookmark-bmenu-list + :active (and-boundp 'bookmark-alist bookmark-alist)] + "---" + ["%_Save Bookmarks" bookmark-save + :active (and-boundp 'bookmark-alist bookmark-alist)] + ["Save Bookmarks %_As..." bookmark-write + :active (and-boundp 'bookmark-alist bookmark-alist)] + ["%_Load a Bookmark File" bookmark-load + :active (fboundp 'bookmark-load)] ) + ) ("C%_mds" - ["Repeat Last Comple%_x Command..." repeat-complex-command] - ["E%_valuate Lisp Expression..." eval-expression] - ["Execute %_Named Command..." execute-extended-command] - "----" - ["Start %_Defining Macro" start-kbd-macro - :included (not defining-kbd-macro)] - ["Stop %_Defining Macro" end-kbd-macro - :included defining-kbd-macro] - ["%_Execute Last Macro" call-last-kbd-macro + ["Repeat Last Comple%_x Command..." repeat-complex-command] + ["E%_valuate Lisp Expression..." eval-expression] + ["Execute %_Named Command..." execute-extended-command] + "----" + ["Start %_Defining Macro" start-kbd-macro + :included (not defining-kbd-macro)] + ["Stop %_Defining Macro" end-kbd-macro + :included defining-kbd-macro] + ["%_Execute Last Macro" call-last-kbd-macro + :active last-kbd-macro] + ("Other %_Macro" + ["Edit %_Last Macro" edit-last-kbd-macro + :active last-kbd-macro] + ["%_Edit Macro..." edit-kbd-macro] + ["%_Append to Last Macro" (start-kbd-macro t) + :active (and (not defining-kbd-macro) last-kbd-macro)] + "---" + ["%_Name Last Macro..." name-last-kbd-macro :active last-kbd-macro] - ("Other %_Macro" - ["Edit %_Last Macro" edit-last-kbd-macro - :active last-kbd-macro] - ["%_Edit Macro..." edit-kbd-macro] - ["%_Append to Last Macro" (start-kbd-macro t) - :active (and (not defining-kbd-macro) last-kbd-macro)] - "---" - ["%_Name Last Macro..." name-last-kbd-macro - :active last-kbd-macro] - ["Assign Last Macro to %_Key..." assign-last-kbd-macro-to-key - :active (and last-kbd-macro - (fboundp 'assign-last-kbd-macro-to-key))] - "---" - ["E%_xecute Last Macro on Region Lines" - :active (and last-kbd-macro (region-exists-p))] - "---" - ["%_Query User During Macro" kbd-macro-query - :active defining-kbd-macro] - ["Enter %_Recursive Edit During Macro" (kbd-macro-query t) - :active defining-kbd-macro] - "---" - ["%_Insert Named Macro into Buffer..." insert-kbd-macro] - ["Read Macro from Re%_gion" read-kbd-macro - :active (region-exists-p)] - ) + ["Assign Last Macro to %_Key..." assign-last-kbd-macro-to-key + :active (and last-kbd-macro + (fboundp 'assign-last-kbd-macro-to-key))] + "---" + ["E%_xecute Last Macro on Region Lines" + :active (and last-kbd-macro (region-exists-p))] + "---" + ["%_Query User During Macro" kbd-macro-query + :active defining-kbd-macro] + ["Enter %_Recursive Edit During Macro" (kbd-macro-query t) + :active defining-kbd-macro] + "---" + ["%_Insert Named Macro into Buffer..." insert-kbd-macro] + ["Read Macro from Re%_gion" read-kbd-macro + :active (region-exists-p)] + ) + "----" + ["D%_ynamic Abbrev Expand" dabbrev-expand] + ["Define %_Global Abbrev for " add-global-abbrev + :suffix (truncate-string-to-width (abbrev-string-to-be-defined nil) + 40 nil nil t)] + ("Other %_Abbrev" + ["Dynamic Abbrev %_Complete" dabbrev-completion] + ["Dynamic Abbrev Complete in %_All Buffers" (dabbrev-completion 16)] "----" - ["D%_ynamic Abbrev Expand" dabbrev-expand] - ["Define %_Global Abbrev for " add-global-abbrev - :suffix (truncate-string-to-width (abbrev-string-to-be-defined nil) + "----" + ["%_Define Global Abbrev for " add-global-abbrev + :suffix (truncate-string-to-width (abbrev-string-to-be-defined nil) 40 nil nil t)] - ("Other %_Abbrev" - ["Dynamic Abbrev %_Complete" dabbrev-completion] - ["Dynamic Abbrev Complete in %_All Buffers" (dabbrev-completion 16)] - "----" - "----" - ["%_Define Global Abbrev for " add-global-abbrev - :suffix (truncate-string-to-width (abbrev-string-to-be-defined nil) + ["Define %_Mode-Specific Abbrev for " add-mode-abbrev + :suffix (truncate-string-to-width (abbrev-string-to-be-defined nil) 40 nil nil t)] - ["Define %_Mode-Specific Abbrev for " add-mode-abbrev - :suffix (truncate-string-to-width (abbrev-string-to-be-defined nil) - 40 nil nil t)] - ["Define Global Ex%_pansion for " inverse-add-global-abbrev - :suffix (truncate-string-to-width + ["Define Global Ex%_pansion for " inverse-add-global-abbrev + :suffix (truncate-string-to-width (inverse-abbrev-string-to-be-defined 1) 40 nil nil t)] - ["Define Mode-Specific Expa%_nsion for " inverse-add-mode-abbrev - :suffix (truncate-string-to-width + ["Define Mode-Specific Expa%_nsion for " inverse-add-mode-abbrev + :suffix (truncate-string-to-width (inverse-abbrev-string-to-be-defined 1) 40 nil nil t)] - "---" - ["E%_xpand Abbrev" expand-abbrev] - ["Expand Abbrevs in Re%_gion" expand-region-abbrevs - :active (region-exists-p)] - ["%_Unexpand Last Abbrev" unexpand-abbrev - :active (and (stringp last-abbrev-text) - (> last-abbrev-location 0))] - "---" - ["%_Kill All Abbrevs" kill-all-abbrevs] - ["%_Insert All Abbrevs into Buffer" insert-abbrevs] - ["%_List Abbrevs" list-abbrevs] - "---" - ["%_Edit Abbrevs" edit-abbrevs] - ["%_Redefine Abbrevs from Buffer" edit-abbrevs-redefine - :active (eq major-mode 'edit-abbrevs-mode)] - "---" - ["%_Save Abbrevs As..." write-abbrev-file] - ["L%_oad Abbrevs..." read-abbrev-file] - ) - "---" - ["%_Cut Rectangle" kill-rectangle] - ["%_Prefix Rectangle..." string-rectangle] - ("Other %_Rectangles/Register" - ["%_Yank Rectangle" yank-rectangle] - ["Rectangle %_to Register" copy-rectangle-to-register] - ["Rectangle %_from Register" insert-register] - ["%_Delete Rectangle" clear-rectangle] - ["%_Open Rectangle" open-rectangle] - ["Rectangle %_Mousing" - (customize-set-variable 'mouse-track-rectangle-p + "---" + ["E%_xpand Abbrev" expand-abbrev] + ["Expand Abbrevs in Re%_gion" expand-region-abbrevs + :active (region-exists-p)] + ["%_Unexpand Last Abbrev" unexpand-abbrev + :active (and (stringp last-abbrev-text) + (> last-abbrev-location 0))] + "---" + ["%_Kill All Abbrevs" kill-all-abbrevs] + ["%_Insert All Abbrevs into Buffer" insert-abbrevs] + ["%_List Abbrevs" list-abbrevs] + "---" + ["%_Edit Abbrevs" edit-abbrevs] + ["%_Redefine Abbrevs from Buffer" edit-abbrevs-redefine + :active (eq major-mode 'edit-abbrevs-mode)] + "---" + ["%_Save Abbrevs As..." write-abbrev-file] + ["L%_oad Abbrevs..." read-abbrev-file] + ) + "---" + ["%_Cut Rectangle" kill-rectangle] + ["%_Prefix Rectangle..." string-rectangle] + ("Other %_Rectangles/Register" + ["%_Yank Rectangle" yank-rectangle] + ["Rectangle %_to Register" copy-rectangle-to-register] + ["Rectangle %_from Register" insert-register] + ["%_Delete Rectangle" clear-rectangle] + ["%_Open Rectangle" open-rectangle] + ["Rectangle %_Mousing" + (customize-set-variable 'mouse-track-rectangle-p (not mouse-track-rectangle-p)) - :style toggle :selected mouse-track-rectangle-p] - "---" - ["%_Copy to Register..." copy-to-register :active (region-exists-p)] - ["%_Append to Register..." append-register :active (region-exists-p)] - ["%_Insert Register..." insert-register] - "---" - ["%_Save Point to Register" point-to-register] - ["%_Jump to Register" register-to-point] - ) - "---" - ["%_Sort Lines in Region" sort-lines :active (region-exists-p)] - ["%_Uppercase Region or Word" upcase-region-or-word] - ["%_Lowercase Region or Word" downcase-region-or-word] - ["%_Indent Region or Balanced Expression" - indent-region-or-balanced-expression] - ["%_Fill Paragraph or Region" fill-paragraph-or-region] - ("Other %_Text Commands" - ["Sort %_Paragraphs in Region" sort-paragraphs :active (region-exists-p)] - ["Sort Pa%_ges in Region" sort-pages :active (region-exists-p)] - ["Sort C%_olumns in Region" sort-columns :active (region-exists-p)] - ["Sort %_Regexp..." sort-regexp-fields :active (region-exists-p)] - "---" - ["%_Capitalize Region" capitalize-region :active (region-exists-p)] - ["Title-C%_ase Region" capitalize-region-as-title - :active (region-exists-p)] - "----" - ["C%_enter Region or Paragraph" - (if (region-active-p) (center-region) (center-line))] - ["Center %_Line" center-line] - "---" - ["%_Indent Region Rigidly" indent-rigidly :active (region-exists-p)] - ["In%_dent To Column..." indent-to-column] - "---" - ["%_Untabify (Tabs to Spaces)" untabify :active (and (region-exists-p) - (fboundp 'untabify))] - ["%_Tabify (Spaces to Tabs)" tabify :active (and (region-exists-p) - (fboundp 'tabify))] - ["Tab to Tab %_Stop" tab-to-tab-stop] - ["Edit Ta%_b Stops" edit-tab-stops] - ) - "---" - ("%_Tags" - ["%_Find Tag..." find-tag] - ["Find %_Other Window..." find-tag-other-window] - ["%_Next Tag..." (find-tag nil)] - ["N%_ext Other Window..." (find-tag-other-window nil)] - ["Next %_File" next-file] - "-----" - ["Tags %_Search..." tags-search] - ["Tags %_Replace..." tags-query-replace] - ["%_Continue Search/Replace" tags-loop-continue] - "-----" - ["%_Pop stack" pop-tag-mark] - ["%_Apropos..." tags-apropos] - "-----" - ["%_Set Tags Table File..." visit-tags-table] - ) - ) + :style toggle :selected mouse-track-rectangle-p] + "---" + ["%_Copy to Register..." copy-to-register :active (region-exists-p)] + ["%_Append to Register..." append-register :active (region-exists-p)] + ["%_Insert Register..." insert-register] + "---" + ["%_Save Point to Register" point-to-register] + ["%_Jump to Register" register-to-point] + ) + "---" + ["%_Sort Lines in Region" sort-lines :active (region-exists-p)] + ["%_Uppercase Region or Word" upcase-region-or-word] + ["%_Lowercase Region or Word" downcase-region-or-word] + ["%_Indent Region or Balanced Expression" + indent-region-or-balanced-expression] + ["%_Fill Paragraph or Region" fill-paragraph-or-region] + ("Other %_Text Commands" + ["Sort %_Paragraphs in Region" sort-paragraphs :active (region-exists-p)] + ["Sort Pa%_ges in Region" sort-pages :active (region-exists-p)] + ["Sort C%_olumns in Region" sort-columns :active (region-exists-p)] + ["Sort %_Regexp..." sort-regexp-fields :active (region-exists-p)] + "---" + ["%_Capitalize Region" capitalize-region :active (region-exists-p)] + ["Title-C%_ase Region" capitalize-region-as-title + :active (region-exists-p)] + "----" + ["C%_enter Region or Paragraph" + (if (region-active-p) (center-region) (center-line))] + ["Center %_Line" center-line] + "---" + ["%_Indent Region Rigidly" indent-rigidly :active (region-exists-p)] + ["In%_dent To Column..." indent-to-column] + "---" + ["%_Untabify (Tabs to Spaces)" untabify :active (and (region-exists-p) + (fboundp 'untabify))] + ["%_Tabify (Spaces to Tabs)" tabify :active (and (region-exists-p) + (fboundp 'tabify))] + ["Tab to Tab %_Stop" tab-to-tab-stop] + ["Edit Ta%_b Stops" edit-tab-stops] + ) + "---" + ("%_Tags" + ["%_Find Tag..." find-tag] + ["Find %_Other Window..." find-tag-other-window] + ["%_Next Tag..." (find-tag nil)] + ["N%_ext Other Window..." (find-tag-other-window nil)] + ["Next %_File" next-file] + "-----" + ["Tags %_Search..." tags-search] + ["Tags %_Replace..." tags-query-replace] + ["%_Continue Search/Replace" tags-loop-continue] + "-----" + ["%_Pop stack" pop-tag-mark] + ["%_Apropos..." tags-apropos] + "-----" + ["%_Set Tags Table File..." visit-tags-table] + ) + ) ;; #### Delete this entire menu as soon as the new package source is ;; committed. ("%_Tools" - ("%_Packages" - ("%_Set Download Site" - ("%_Official Releases" - :filter (lambda (&rest junk) - (menu-split-long-menu - (submenu-generate-accelerator-spec - (package-ui-download-menu))))) - ("%_Pre-Releases" - :filter (lambda (&rest junk) - (menu-split-long-menu - (submenu-generate-accelerator-spec - (package-ui-pre-release-download-menu))))) - ("%_Site Releases" - :filter (lambda (&rest junk) - (menu-split-long-menu - (submenu-generate-accelerator-spec - (package-ui-site-release-download-menu)))))) - "--:shadowEtchedIn" - ["%_Update Package Index" package-get-update-base] - ["%_List and Install" pui-list-packages] - ["U%_pdate Installed Packages" package-get-update-all] - ["%_Help" (Info-goto-node "(xemacs)Packages")]) - ("%_Internet" - ["Read Mail %_1 (VM)..." vm - :active (fboundp 'vm)] - ["Read Mail %_2 (MH)..." (mh-rmail t) - :active (fboundp 'mh-rmail)] - ["Send %_Mail..." compose-mail - :active (fboundp 'compose-mail)] - ["Usenet %_News" gnus - :active (fboundp 'gnus)] - ["Browse the %_Web" w3 - :active (fboundp 'w3)]) + ("%_Packages" + ("%_Set Download Site" + ("%_Official Releases" + :filter ,#'(lambda (&rest junk) + (menu-split-long-menu + (submenu-generate-accelerator-spec + (package-ui-download-menu))))) + ("%_Pre-Releases" + :filter ,#'(lambda (&rest junk) + (menu-split-long-menu + (submenu-generate-accelerator-spec + (package-ui-pre-release-download-menu))))) + ("%_Site Releases" + :filter ,#'(lambda (&rest junk) + (menu-split-long-menu + (submenu-generate-accelerator-spec + (package-ui-site-release-download-menu)))))) + "--:shadowEtchedIn" + ["%_Update Package Index" package-get-update-base] + ["%_List and Install" pui-list-packages] + ["U%_pdate Installed Packages" package-get-update-all] + ["%_Help" (Info-goto-node "(xemacs)Packages")]) + ("%_Internet" + ["Read Mail %_1 (VM)..." vm + :active (fboundp 'vm)] + ["Read Mail %_2 (MH)..." (mh-rmail t) + :active (fboundp 'mh-rmail)] + ["Send %_Mail..." compose-mail + :active (fboundp 'compose-mail)] + ["Usenet %_News" gnus + :active (fboundp 'gnus)] + ["Browse the %_Web" w3 + :active (fboundp 'w3)]) + "---" + ("%_Grep" + :filter + ,#'(lambda (menu) + (if-boundp 'grep-history + (if grep-history + (let ((items + (submenu-generate-accelerator-spec + (mapcar #'(lambda (label-value) + (vector (first label-value) + (list 'grep + (second label-value)))) + (Menubar-items-truncate-history + grep-history 10 50))))) + (append menu '("---") items)) + menu) + menu)) + ["%_Grep..." grep :active (fboundp 'grep)] + ["%_Kill Grep" kill-compilation + :active (and (fboundp 'kill-compilation) + (fboundp 'compilation-find-buffer) + (let ((buffer (condition-case nil + (compilation-find-buffer) + (error nil)))) + (and buffer (get-buffer-process buffer))))] "---" - ("%_Grep" - :filter - (lambda (menu) - (if (or (not (boundp 'grep-history)) (null grep-history)) - menu - (let ((items - (submenu-generate-accelerator-spec - (mapcar #'(lambda (label-value) - (vector (first label-value) - (list 'grep (second label-value)))) - (Menubar-items-truncate-history - grep-history 10 50))))) - (append menu '("---") items)))) - ["%_Grep..." grep :active (fboundp 'grep)] - ["%_Kill Grep" kill-compilation - :active (and (fboundp 'kill-compilation) - (fboundp 'compilation-find-buffer) - (let ((buffer (condition-case nil - (compilation-find-buffer) - (error nil)))) - (and buffer (get-buffer-process buffer))))] - "---" - ["Grep %_All Files in Current Directory..." - grep-all-files-in-current-directory - :active (fboundp 'grep-all-files-in-current-directory)] - ["Grep All Files in Current Directory %_Recursively..." - grep-all-files-in-current-directory-and-below - :active (fboundp 'grep-all-files-in-current-directory-and-below)] - "---" - ["Grep %_C and C Header Files in Current Directory..." - (progn - (require 'compile) - (let ((grep-command - (cons (concat grep-command " *.[chCH]" + ["Grep %_All Files in Current Directory..." + grep-all-files-in-current-directory + :active (fboundp 'grep-all-files-in-current-directory)] + ["Grep All Files in Current Directory %_Recursively..." + grep-all-files-in-current-directory-and-below + :active (fboundp 'grep-all-files-in-current-directory-and-below)] + "---" + ["Grep %_C and C Header Files in Current Directory..." + (progn + (require 'compile) + (let ((grep-command + (cons (concat grep-command " *.[chCH]" ; i wanted to also use *.cc and *.hh. ; see long comment below under Perl. - ) - (length grep-command)))) - (call-interactively 'grep))) - :active (fboundp 'grep)] - ["Grep C Hea%_der Files in Current Directory..." - (progn - (require 'compile) - (let ((grep-command - (cons (concat grep-command " *.[hH]" + ) + (length grep-command)))) + (call-interactively 'grep))) + :active (fboundp 'grep)] + ["Grep C Hea%_der Files in Current Directory..." + (progn + (require 'compile) + (let ((grep-command + (cons (concat grep-command " *.[hH]" ; i wanted to also use *.hh. ; see long comment below under Perl. - ) - (length grep-command)))) - (call-interactively 'grep))) - :active (fboundp 'grep)] - ["Grep %_E-Lisp Files in Current Directory..." - (progn - (require 'compile) - (let ((grep-command - (cons (concat grep-command " *.el") - (length grep-command)))) - (call-interactively 'grep))) - :active (fboundp 'grep)] - ["Grep %_Perl Files in Current Directory..." - (progn - (require 'compile) - (let ((grep-command - (cons (concat grep-command " *.pl" + ) + (length grep-command)))) + (call-interactively 'grep))) + :active (fboundp 'grep)] + ["Grep %_E-Lisp Files in Current Directory..." + (progn + (require 'compile) + (let ((grep-command + (cons (concat grep-command " *.el") + (length grep-command)))) + (call-interactively 'grep))) + :active (fboundp 'grep)] + ["Grep %_Perl Files in Current Directory..." + (progn + (require 'compile) + (let ((grep-command + (cons (concat grep-command " *.pl" ; i wanted to use this: ; " *.pl *.pm *.am" ; but grep complains if it can't @@ -539,601 +538,596 @@ ; each separate glob in the directory ; to see if there are any files in ; that glob, and if not, omit it. - ) - (length grep-command)))) - (call-interactively 'grep))) - :active (fboundp 'grep)] - ["Grep %_HTML Files in Current Directory..." - (progn - (require 'compile) - (let ((grep-command - (cons (concat grep-command " *.*htm*") - (length grep-command)))) - (call-interactively 'grep))) - :active (fboundp 'grep)] - "---" - ["%_Next Match" next-error - :active (and (fboundp 'compilation-errors-exist-p) - (compilation-errors-exist-p))] - ["Pre%_vious Match" previous-error - :active (and (fboundp 'compilation-errors-exist-p) - (compilation-errors-exist-p))] - ["%_First Match" first-error - :active (and (fboundp 'compilation-errors-exist-p) - (compilation-errors-exist-p))] - ["G%_oto Match" compile-goto-error - :active (and (fboundp 'compilation-errors-exist-p) - (compilation-errors-exist-p))] - "---" - ["%_Set Grep Command..." - (progn - (require 'compile) - (customize-set-variable - 'grep-command - (read-shell-command "Default Grep Command: " grep-command))) - :active (fboundp 'grep) - ] - ) - ("%_Compile" - :filter - (lambda (menu) - (if (or (not (boundp 'compile-history)) (null compile-history)) - menu - (let ((items - (submenu-generate-accelerator-spec - (mapcar #'(lambda (label-value) - (vector (first label-value) - (list 'compile (second label-value)))) - (Menubar-items-truncate-history - compile-history 10 50))))) - (append menu '("---") items)))) - ["%_Compile..." compile :active (fboundp 'compile)] - ["%_Repeat Compilation" recompile :active (fboundp 'recompile)] - ["%_Kill Compilation" kill-compilation - :active (and (fboundp 'kill-compilation) - (fboundp 'compilation-find-buffer) - (let ((buffer (condition-case nil - (compilation-find-buffer) - (error nil)))) - (and buffer (get-buffer-process buffer))))] - "---" - ["%_Next Error" next-error - :active (and (fboundp 'compilation-errors-exist-p) - (compilation-errors-exist-p))] - ["Pre%_vious Error" previous-error - :active (and (fboundp 'compilation-errors-exist-p) - (compilation-errors-exist-p))] - ["%_First Error" first-error - :active (and (fboundp 'compilation-errors-exist-p) - (compilation-errors-exist-p))] - ["G%_oto Error" compile-goto-error - :active (and (fboundp 'compilation-errors-exist-p) - (compilation-errors-exist-p))] - ) - ("%_Debug" - ["%_GDB..." gdb - :active (fboundp 'gdb)] - ["%_DBX..." dbx - :active (fboundp 'dbx)]) - ("%_Shell" - ["%_Shell" shell - :active (fboundp 'shell)] - ["S%_hell Command..." shell-command - :active (fboundp 'shell-command)] - ["Shell Command on %_Region..." shell-command-on-region + ) + (length grep-command)))) + (call-interactively 'grep))) + :active (fboundp 'grep)] + ["Grep %_HTML Files in Current Directory..." + (progn + (require 'compile) + (let ((grep-command + (cons (concat grep-command " *.*htm*") + (length grep-command)))) + (call-interactively 'grep))) + :active (fboundp 'grep)] + "---" + ["%_Next Match" next-error + :active (and (fboundp 'compilation-errors-exist-p) + (compilation-errors-exist-p))] + ["Pre%_vious Match" previous-error + :active (and (fboundp 'compilation-errors-exist-p) + (compilation-errors-exist-p))] + ["%_First Match" first-error + :active (and (fboundp 'compilation-errors-exist-p) + (compilation-errors-exist-p))] + ["G%_oto Match" compile-goto-error + :active (and (fboundp 'compilation-errors-exist-p) + (compilation-errors-exist-p))] + "---" + ["%_Set Grep Command..." + (progn + (require 'compile) + (customize-set-variable + 'grep-command + (read-shell-command "Default Grep Command: " grep-command))) + :active (fboundp 'grep) + ] + ) + ("%_Compile" + :filter + ,#'(lambda (menu) + (if-boundp 'compile-history + (if compile-history + (let ((items + (submenu-generate-accelerator-spec + (mapcar #'(lambda (label-value) + (vector (first label-value) + (list 'compile + (second label-value)))) + (Menubar-items-truncate-history + compile-history 10 50))))) + (append menu '("---") items)) + menu) + menu)) + ["%_Compile..." compile :active (fboundp 'compile)] + ["%_Repeat Compilation" recompile :active (fboundp 'recompile)] + ["%_Kill Compilation" kill-compilation + :active (and (fboundp 'kill-compilation) + (fboundp 'compilation-find-buffer) + (let ((buffer (condition-case nil + (compilation-find-buffer) + (error nil)))) + (and buffer (get-buffer-process buffer))))] + "---" + ["%_Next Error" next-error + :active (and (fboundp 'compilation-errors-exist-p) + (compilation-errors-exist-p))] + ["Pre%_vious Error" previous-error + :active (and (fboundp 'compilation-errors-exist-p) + (compilation-errors-exist-p))] + ["%_First Error" first-error + :active (and (fboundp 'compilation-errors-exist-p) + (compilation-errors-exist-p))] + ["G%_oto Error" compile-goto-error + :active (and (fboundp 'compilation-errors-exist-p) + (compilation-errors-exist-p))] + ) + ("%_Debug" + ["%_GDB..." gdb + :active (fboundp 'gdb)] + ["%_DBX..." dbx + :active (fboundp 'dbx)]) + ("%_Shell" + ["%_Shell" shell + :active (fboundp 'shell)] + ["S%_hell Command..." shell-command + :active (fboundp 'shell-command)] + ["Shell Command on %_Region..." shell-command-on-region :active (and (fboundp 'shell-command-on-region) (region-exists-p))]) - ("%_Tags" - ["%_Find Tag..." find-tag] - ["Find %_Other Window..." find-tag-other-window] - ["%_Next Tag..." (find-tag nil)] - ["N%_ext Other Window..." (find-tag-other-window nil)] - ["Next %_File" next-file] - "-----" - ["Tags %_Search..." tags-search] - ["Tags %_Replace..." tags-query-replace] - ["%_Continue Search/Replace" tags-loop-continue] - "-----" - ["%_Pop stack" pop-tag-mark] - ["%_Apropos..." tags-apropos] - "-----" - ["%_Set Tags Table File..." visit-tags-table] - ) + ("%_Tags" + ["%_Find Tag..." find-tag] + ["Find %_Other Window..." find-tag-other-window] + ["%_Next Tag..." (find-tag nil)] + ["N%_ext Other Window..." (find-tag-other-window nil)] + ["Next %_File" next-file] + "-----" + ["Tags %_Search..." tags-search] + ["Tags %_Replace..." tags-query-replace] + ["%_Continue Search/Replace" tags-loop-continue] + "-----" + ["%_Pop stack" pop-tag-mark] + ["%_Apropos..." tags-apropos] + "-----" + ["%_Set Tags Table File..." visit-tags-table] + ) - "----" + "----" - ("Ca%_lendar" - ["%_3-Month Calendar" calendar - :active (fboundp 'calendar)] - ["%_Diary" diary - :active (fboundp 'diary)] - ["%_Holidays" holidays - :active (fboundp 'holidays)] - ;; we're all pagans at heart ... - ["%_Phases of the Moon" phases-of-moon - :active (fboundp 'phases-of-moon)] - ["%_Sunrise/Sunset" sunrise-sunset - :active (fboundp 'sunrise-sunset)]) + ("Ca%_lendar" + ["%_3-Month Calendar" calendar + :active (fboundp 'calendar)] + ["%_Diary" diary + :active (fboundp 'diary)] + ["%_Holidays" holidays + :active (fboundp 'holidays)] + ;; we're all pagans at heart ... + ["%_Phases of the Moon" phases-of-moon + :active (fboundp 'phases-of-moon)] + ["%_Sunrise/Sunset" sunrise-sunset + :active (fboundp 'sunrise-sunset)]) - ("Ga%_mes" - ["%_Mine Game" xmine - :active (fboundp 'xmine)] - ["%_Tetris" tetris - :active (fboundp 'tetris)] - ["%_Sokoban" sokoban - :active (fboundp 'sokoban)] - ["Quote from %_Zippy" yow - :active (fboundp 'yow)] - ["%_Psychoanalyst" doctor - :active (fboundp 'doctor)] - ["Ps%_ychoanalyze Zippy!" psychoanalyze-pinhead - :active (fboundp 'psychoanalyze-pinhead)] - ["%_Random Flames" flame - :active (fboundp 'flame)] - ["%_Dunnet (Adventure)" dunnet - :active (fboundp 'dunnet)] - ["Towers of %_Hanoi" hanoi - :active (fboundp 'hanoi)] - ["Game of %_Life" life - :active (fboundp 'life)] - ["M%_ultiplication Puzzle" mpuz - :active (fboundp 'mpuz)]) + ("Ga%_mes" + ["%_Mine Game" xmine + :active (fboundp 'xmine)] + ["%_Tetris" tetris + :active (fboundp 'tetris)] + ["%_Sokoban" sokoban + :active (fboundp 'sokoban)] + ["Quote from %_Zippy" yow + :active (fboundp 'yow)] + ["%_Psychoanalyst" doctor + :active (fboundp 'doctor)] + ["Ps%_ychoanalyze Zippy!" psychoanalyze-pinhead + :active (fboundp 'psychoanalyze-pinhead)] + ["%_Random Flames" flame + :active (fboundp 'flame)] + ["%_Dunnet (Adventure)" dunnet + :active (fboundp 'dunnet)] + ["Towers of %_Hanoi" hanoi + :active (fboundp 'hanoi)] + ["Game of %_Life" life + :active (fboundp 'life)] + ["M%_ultiplication Puzzle" mpuz + :active (fboundp 'mpuz)]) - "----" - ) + "----" + ) ; ("%_Tools" ; :filter behavior-menu-filter) ("%_Options" - ("%_Advanced (Customize)" - ("%_Emacs" :filter (lambda (&rest junk) - (cdr (custom-menu-create 'emacs)))) - ["%_Group..." customize-group] - ["%_Variable..." customize-variable] - ["%_Face..." customize-face] - ["%_Saved..." customize-saved] - ["Se%_t..." customize-customized] - ["%_Apropos..." customize-apropos] - ["%_Browse..." customize-browse]) + ("%_Advanced (Customize)" + ("%_Emacs" :filter ,#'(lambda (&rest junk) + (cdr (custom-menu-create 'emacs)))) + ["%_Group..." customize-group] + ["%_Variable..." customize-variable] + ["%_Face..." customize-face] + ["%_Saved..." customize-saved] + ["Se%_t..." customize-customized] + ["%_Apropos..." customize-apropos] + ["%_Browse..." customize-browse]) + "---" + ("%_Editing" + ["This Buffer %_Read Only" (toggle-read-only) + :style toggle :selected buffer-read-only] + ["%_Yank/Kill Interact With Clipboard" + (if (eq interprogram-cut-function 'own-clipboard) + (progn + (customize-set-variable 'interprogram-cut-function nil) + (customize-set-variable 'interprogram-paste-function nil)) + (customize-set-variable 'interprogram-cut-function 'own-clipboard) + (customize-set-variable 'interprogram-paste-function 'get-clipboard)) + :style toggle + :selected (eq interprogram-cut-function 'own-clipboard)] + ["%_Overstrike" + (progn + (setq overwrite-mode (if overwrite-mode nil 'overwrite-mode-textual)) + (customize-set-variable 'overwrite-mode overwrite-mode)) + :style toggle :selected overwrite-mode] + ["%_Abbrev Mode" + (customize-set-variable 'abbrev-mode + (not (default-value 'abbrev-mode))) + :style toggle + :selected (default-value 'abbrev-mode)] + ["Active Re%_gions" + (customize-set-variable 'zmacs-regions (not zmacs-regions)) + :style toggle :selected zmacs-regions] + "---" + ["%_Case Sensitive Search" + (customize-set-variable 'case-fold-search + (setq case-fold-search (not case-fold-search))) + :style toggle :selected (not case-fold-search)] + ["Case %_Matching Replace" + (customize-set-variable 'case-replace (not case-replace)) + :style toggle :selected case-replace] + "---" + ("%_Newline at End of File..." + ["%_Don't Require" + (customize-set-variable 'require-final-newline nil) + :style radio :selected (not require-final-newline)] + ["%_Require" + (customize-set-variable 'require-final-newline t) + :style radio :selected (eq require-final-newline t)] + ["%_Ask" + (customize-set-variable 'require-final-newline 'ask) + :style radio :selected (and require-final-newline + (not (eq require-final-newline t)))]) + ["Add Newline When Moving Past %_End" + (customize-set-variable 'next-line-add-newlines + (not next-line-add-newlines)) + :style toggle :selected next-line-add-newlines]) + ("%_Keyboard and Mouse" + ["%_Delete Key Deletes Selection" + (customize-set-variable 'pending-delete-mode (not pending-delete-mode)) + :style toggle + :selected (and (boundp 'pending-delete-mode) pending-delete-mode) + :active (boundp 'pending-delete-mode)] + ["`kill-%_word' Stores in Clipboard" + (customize-set-variable 'kill-word-into-kill-ring + (not kill-word-into-kill-ring)) + :style toggle + :selected kill-word-into-kill-ring] + ["`kill-%_line' Kills Whole Line at Beg" + (customize-set-variable 'kill-whole-line (not kill-whole-line)) + :style toggle + :selected kill-whole-line] + ["Size for %_Block-Movement Commands..." + (customize-set-variable 'block-movement-size + (read-number "Block Movement Size: " + t block-movement-size))] + ["%_VI Emulation" + (progn + (toggle-viper-mode) + (customize-set-variable 'viper-mode viper-mode)) + :style toggle :selected (and (boundp 'viper-mode) viper-mode) + :active (fboundp 'toggle-viper-mode)] + "----" + ["S%_hifted Motion Keys Select Region" + (customize-set-variable 'shifted-motion-keys-select-region + (not shifted-motion-keys-select-region)) + :style toggle + :selected shifted-motion-keys-select-region] + ["%_After Shifted Motion, Unshifted Motion Keys Deselect" + (customize-set-variable 'unshifted-motion-keys-deselect-region + (not unshifted-motion-keys-deselect-region)) + :style toggle + :selected unshifted-motion-keys-deselect-region] + "----" + ["%_Set Key..." global-set-key] + ["%_Unset Key..." global-unset-key] + "---" + ["%_Mouse Paste at Text Cursor (not Clicked Location)" + (customize-set-variable 'mouse-yank-at-point (not mouse-yank-at-point)) + :style toggle :selected mouse-yank-at-point] "---" - ("%_Editing" - ["This Buffer %_Read Only" (toggle-read-only) - :style toggle :selected buffer-read-only] - ["%_Yank/Kill Interact With Clipboard" - (if (eq interprogram-cut-function 'own-clipboard) - (progn - (customize-set-variable 'interprogram-cut-function nil) - (customize-set-variable 'interprogram-paste-function nil)) - (customize-set-variable 'interprogram-cut-function 'own-clipboard) - (customize-set-variable 'interprogram-paste-function 'get-clipboard)) - :style toggle - :selected (eq interprogram-cut-function 'own-clipboard)] - ["%_Overstrike" - (progn - (setq overwrite-mode (if overwrite-mode nil 'overwrite-mode-textual)) - (customize-set-variable 'overwrite-mode overwrite-mode)) - :style toggle :selected overwrite-mode] - ["%_Abbrev Mode" - (customize-set-variable 'abbrev-mode - (not (default-value 'abbrev-mode))) - :style toggle - :selected (default-value 'abbrev-mode)] - ["Active Re%_gions" - (customize-set-variable 'zmacs-regions (not zmacs-regions)) - :style toggle :selected zmacs-regions] - "---" - ["%_Case Sensitive Search" - (customize-set-variable 'case-fold-search - (setq case-fold-search (not case-fold-search))) - :style toggle :selected (not case-fold-search)] - ["Case %_Matching Replace" - (customize-set-variable 'case-replace (not case-replace)) - :style toggle :selected case-replace] - "---" - ("%_Newline at End of File..." - ["%_Don't Require" - (customize-set-variable 'require-final-newline nil) - :style radio :selected (not require-final-newline)] - ["%_Require" - (customize-set-variable 'require-final-newline t) - :style radio :selected (eq require-final-newline t)] - ["%_Ask" - (customize-set-variable 'require-final-newline 'ask) - :style radio :selected (and require-final-newline - (not (eq require-final-newline t)))]) - ["Add Newline When Moving Past %_End" - (customize-set-variable 'next-line-add-newlines - (not next-line-add-newlines)) - :style toggle :selected next-line-add-newlines]) - ("%_Keyboard and Mouse" - ["%_Delete Key Deletes Selection" - (customize-set-variable 'pending-delete-mode (not pending-delete-mode)) - :style toggle - :selected (and (boundp 'pending-delete-mode) pending-delete-mode) - :active (boundp 'pending-delete-mode)] - ["`kill-%_word' Stores in Clipboard" - (customize-set-variable 'kill-word-into-kill-ring - (not kill-word-into-kill-ring)) - :style toggle - :selected kill-word-into-kill-ring] - ["`kill-%_line' Kills Whole Line at Beg" - (customize-set-variable 'kill-whole-line (not kill-whole-line)) - :style toggle - :selected kill-whole-line] - ["Size for %_Block-Movement Commands..." - (customize-set-variable 'block-movement-size - (read-number "Block Movement Size: " - t block-movement-size))] - ["%_VI Emulation" - (progn - (toggle-viper-mode) - (customize-set-variable 'viper-mode viper-mode)) - :style toggle :selected (and (boundp 'viper-mode) viper-mode) - :active (fboundp 'toggle-viper-mode)] - "----" - ["S%_hifted Motion Keys Select Region" - (customize-set-variable 'shifted-motion-keys-select-region - (not shifted-motion-keys-select-region)) - :style toggle - :selected shifted-motion-keys-select-region] - ["%_After Shifted Motion, Unshifted Motion Keys Deselect" - (customize-set-variable 'unshifted-motion-keys-deselect-region - (not unshifted-motion-keys-deselect-region)) - :style toggle - :selected unshifted-motion-keys-deselect-region] - "----" - ["%_Set Key..." global-set-key] - ["%_Unset Key..." global-unset-key] - "---" - ["%_Mouse Paste at Text Cursor (not Clicked Location)" - (customize-set-variable 'mouse-yank-at-point (not mouse-yank-at-point)) - :style toggle :selected mouse-yank-at-point] - "---" - ["%_Teach Extended Commands" - (customize-set-variable 'teach-extended-commands-p - (not teach-extended-commands-p)) - :style toggle :selected teach-extended-commands-p] + ["%_Teach Extended Commands" + (customize-set-variable 'teach-extended-commands-p + (not teach-extended-commands-p)) + :style toggle :selected teach-extended-commands-p] + ) + ("%_Printing" + ["Set Printer %_Name for Generic Print Support..." + (customize-set-variable + 'printer-name + (read-string "Set printer name: " printer-name))] + "---" + ["Command-Line %_Switches for `lpr'/`lp'..." + ;; better to directly open a customization buffer, since the value + ;; must be a list of strings, which is somewhat complex to prompt for. + (customize-variable 'lpr-switches) + (boundp 'lpr-switches)] + ("%_Pretty-Print Paper Size" + ["%_Letter" + (customize-set-variable 'ps-paper-type 'letter) + :style radio + :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'letter)) + :active (boundp 'ps-paper-type)] + ["Lette%_r-Small" + (customize-set-variable 'ps-paper-type 'letter-small) + :style radio + :selected (and (boundp 'ps-paper-type) + (eq ps-paper-type 'letter-small)) + :active (boundp 'ps-paper-type)] + ["Le%_gal" + (customize-set-variable 'ps-paper-type 'legal) + :style radio + :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'legal)) + :active (boundp 'ps-paper-type)] + ["%_Statement" + (customize-set-variable 'ps-paper-type 'statement) + :style radio + :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'statement)) + :active (boundp 'ps-paper-type)] + ["%_Executive" + (customize-set-variable 'ps-paper-type 'executive) + :style radio + :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'executive)) + :active (boundp 'ps-paper-type)] + ["%_Tabloid" + (customize-set-variable 'ps-paper-type 'tabloid) + :style radio + :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'tabloid)) + :active (boundp 'ps-paper-type)] + ["Le%_dger" + (customize-set-variable 'ps-paper-type 'ledger) + :style radio + :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'ledger)) + :active (boundp 'ps-paper-type)] + ["A%_3" + (customize-set-variable 'ps-paper-type 'a3) + :style radio + :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a3)) + :active (boundp 'ps-paper-type)] + ["%_A4" + (customize-set-variable 'ps-paper-type 'a4) + :style radio + :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a4)) + :active (boundp 'ps-paper-type)] + ["A4s%_mall" + (customize-set-variable 'ps-paper-type 'a4small) + :style radio + :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a4small)) + :active (boundp 'ps-paper-type)] + ["B%_4" + (customize-set-variable 'ps-paper-type 'b4) + :style radio + :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'b4)) + :active (boundp 'ps-paper-type)] + ["%_B5" + (customize-set-variable 'ps-paper-type 'b5) + :style radio + :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'b5)) + :active (boundp 'ps-paper-type)] + ) + ["%_Color Printing" + (cond (ps-print-color-p + (customize-set-variable 'ps-print-color-p nil) + ;; I'm wondering whether all this muck is useful. + (and (boundp 'original-face-background) + original-face-background + (set-face-background 'default original-face-background))) + (t + (customize-set-variable 'ps-print-color-p t) + (setq original-face-background + (face-background-instance 'default)) + (set-face-background 'default "white"))) + :style toggle + :selected (and (boundp 'ps-print-color-p) ps-print-color-p) + :active (boundp 'ps-print-color-p)]) + ("%_Internet" + ("%_Compose Mail With" + ["VM mail package" + (customize-set-variable 'mail-user-agent 'vm-user-agent) + :style radio + :selected (eq mail-user-agent 'vm-user-agent) + :active (get 'vm-user-agent 'composefunc)] + ["Bare-bones Emacs Mailer" + (customize-set-variable 'mail-user-agent 'sendmail-user-agent) + :style radio + :selected (eq mail-user-agent 'sendmail-user-agent)] + ["MH" + (customize-set-variable 'mail-user-agent 'mh-e-user-agent) + :style radio + :selected (eq mail-user-agent 'mh-e-user-agent) + :active (get 'mh-e-user-agent 'composefunc)] + ["GNUS" + (customize-set-variable 'mail-user-agent 'message-user-agent) + :style radio + :selected (eq mail-user-agent 'message-user-agent) + :active (get 'message-user-agent 'composefunc)] ) - ("%_Printing" - ["Set Printer %_Name for Generic Print Support..." - (customize-set-variable - 'printer-name - (read-string "Set printer name: " printer-name))] - "---" - ["Command-Line %_Switches for `lpr'/`lp'..." - ;; better to directly open a customization buffer, since the value - ;; must be a list of strings, which is somewhat complex to prompt for. - (customize-variable 'lpr-switches) - (boundp 'lpr-switches)] - ("%_Pretty-Print Paper Size" - ["%_Letter" - (customize-set-variable 'ps-paper-type 'letter) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'letter)) - :active (boundp 'ps-paper-type)] - ["Lette%_r-Small" - (customize-set-variable 'ps-paper-type 'letter-small) - :style radio - :selected (and (boundp 'ps-paper-type) - (eq ps-paper-type 'letter-small)) - :active (boundp 'ps-paper-type)] - ["Le%_gal" - (customize-set-variable 'ps-paper-type 'legal) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'legal)) - :active (boundp 'ps-paper-type)] - ["%_Statement" - (customize-set-variable 'ps-paper-type 'statement) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'statement)) - :active (boundp 'ps-paper-type)] - ["%_Executive" - (customize-set-variable 'ps-paper-type 'executive) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'executive)) - :active (boundp 'ps-paper-type)] - ["%_Tabloid" - (customize-set-variable 'ps-paper-type 'tabloid) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'tabloid)) - :active (boundp 'ps-paper-type)] - ["Le%_dger" - (customize-set-variable 'ps-paper-type 'ledger) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'ledger)) - :active (boundp 'ps-paper-type)] - ["A%_3" - (customize-set-variable 'ps-paper-type 'a3) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a3)) - :active (boundp 'ps-paper-type)] - ["%_A4" - (customize-set-variable 'ps-paper-type 'a4) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a4)) - :active (boundp 'ps-paper-type)] - ["A4s%_mall" - (customize-set-variable 'ps-paper-type 'a4small) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a4small)) - :active (boundp 'ps-paper-type)] - ["B%_4" - (customize-set-variable 'ps-paper-type 'b4) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'b4)) - :active (boundp 'ps-paper-type)] - ["%_B5" - (customize-set-variable 'ps-paper-type 'b5) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'b5)) - :active (boundp 'ps-paper-type)] - ) - ["%_Color Printing" - (cond (ps-print-color-p - (customize-set-variable 'ps-print-color-p nil) - ;; I'm wondering whether all this muck is useful. - (and (boundp 'original-face-background) - original-face-background - (set-face-background 'default original-face-background))) - (t - (customize-set-variable 'ps-print-color-p t) - (setq original-face-background - (face-background-instance 'default)) - (set-face-background 'default "white"))) - :style toggle - :selected (and (boundp 'ps-print-color-p) ps-print-color-p) - :active (boundp 'ps-print-color-p)]) - ("%_Internet" - ("%_Compose Mail With" - ["VM mail package" - (customize-set-variable 'mail-user-agent 'vm-user-agent) - :style radio - :selected (eq mail-user-agent 'vm-user-agent) - :active (get 'vm-user-agent 'composefunc)] - ["Bare-bones Emacs Mailer" - (customize-set-variable 'mail-user-agent 'sendmail-user-agent) - :style radio - :selected (eq mail-user-agent 'sendmail-user-agent)] - ["MH" - (customize-set-variable 'mail-user-agent 'mh-e-user-agent) - :style radio - :selected (eq mail-user-agent 'mh-e-user-agent) - :active (get 'mh-e-user-agent 'composefunc)] - ["GNUS" - (customize-set-variable 'mail-user-agent 'message-user-agent) - :style radio - :selected (eq mail-user-agent 'message-user-agent) - :active (get 'message-user-agent 'composefunc)] - ) - ["Set My %_Email Address..." - (customize-set-variable - 'user-mail-address - (read-string "Set email address: " user-mail-address))] - ["Set %_Machine Email Name..." - (customize-set-variable - 'mail-host-address - (read-string "Set machine email name: " mail-host-address))] - ["Set %_SMTP Server..." - (progn - (require 'smtpmail) - (customize-set-variable - 'smtpmail-smtp-server - (read-string "Set SMTP server: " smtpmail-smtp-server))) - :active (and (boundp 'send-mail-function) - (eq send-mail-function 'smtpmail-send-it))] - ["SMTP %_Debug Info" - (progn - (require 'smtpmail) - (customize-set-variable 'smtpmail-debug-info - (not smtpmail-debug-info))) - :style toggle - :selected (and (boundp 'smtpmail-debug-info) smtpmail-debug-info) - :active (and (boundp 'send-mail-function) - (eq send-mail-function 'smtpmail-send-it))]) - ("%_Troubleshooting" - ["%_Debug on Error [not saved]" - (setq debug-on-error (not debug-on-error)) - :style toggle :selected debug-on-error] - ["Debug on %_Quit [not saved]" - (setq debug-on-quit (not debug-on-quit)) - :style toggle :selected debug-on-quit] - ["Debug on S%_ignal [not saved]" - (setq debug-on-signal (not debug-on-signal)) - :style toggle :selected debug-on-signal] - ["%_Stack Trace on Error [not saved]" - (setq stack-trace-on-error (not stack-trace-on-error)) - :style toggle :selected stack-trace-on-error] - ["Stack Trace on Si%_gnal [not saved]" - (setq stack-trace-on-signal (not stack-trace-on-signal)) - :style toggle :selected stack-trace-on-signal] + ["Set My %_Email Address..." + (customize-set-variable + 'user-mail-address + (read-string "Set email address: " user-mail-address))] + ["Set %_Machine Email Name..." + (customize-set-variable + 'mail-host-address + (read-string "Set machine email name: " mail-host-address))] + ["Set %_SMTP Server..." + (progn + (require 'smtpmail) + (customize-set-variable + 'smtpmail-smtp-server + (read-string "Set SMTP server: " smtpmail-smtp-server))) + :active (and (boundp 'send-mail-function) + (eq send-mail-function 'smtpmail-send-it))] + ["SMTP %_Debug Info" + (progn + (require 'smtpmail) + (customize-set-variable 'smtpmail-debug-info + (not smtpmail-debug-info))) + :style toggle + :selected (and (boundp 'smtpmail-debug-info) smtpmail-debug-info) + :active (and (boundp 'send-mail-function) + (eq send-mail-function 'smtpmail-send-it))]) + ("%_Troubleshooting" + ["%_Debug on Error [not saved]" + (setq debug-on-error (not debug-on-error)) + :style toggle :selected debug-on-error] + ["Debug on %_Quit [not saved]" + (setq debug-on-quit (not debug-on-quit)) + :style toggle :selected debug-on-quit] + ["Debug on S%_ignal [not saved]" + (setq debug-on-signal (not debug-on-signal)) + :style toggle :selected debug-on-signal] + ["%_Stack Trace on Error [not saved]" + (setq stack-trace-on-error (not stack-trace-on-error)) + :style toggle :selected stack-trace-on-error] + ["Stack Trace on Si%_gnal [not saved]" + (setq stack-trace-on-signal (not stack-trace-on-signal)) + :style toggle :selected stack-trace-on-signal] + ) + ("Encodin%_g" + ["Automatic %_EOL Detection" + (customize-set-variable 'eol-detection-enabled-p + (not eol-detection-enabled-p)) + :style toggle + :selected eol-detection-enabled-p + :included (not (memq system-type '(windows-nt cygwin32)))] + ("Set Coding System of %_Buffer File" + :filter + ,#'(lambda (menu) + (coding-system-menu-filter + (lambda (entry) + (set-buffer-file-coding-system entry)) + (lambda (entry) t)))) + ;; not implemented yet + ("Set Coding System of %_Terminal" + :filter + ,#'(lambda (menu) + (coding-system-menu-filter + (lambda (entry) + (set-terminal-coding-system entry)) + (lambda (entry) nil))) ) - ("Encodin%_g" - ["Automatic %_EOL Detection" - (customize-set-variable 'eol-detection-enabled-p - (not eol-detection-enabled-p)) - :style toggle - :selected eol-detection-enabled-p - :included (not (memq system-type '(windows-nt cygwin32)))] - ("Set Coding System of %_Buffer File" - :filter - (lambda (menu) - (coding-system-menu-filter - (lambda (entry) - (set-buffer-file-coding-system entry)) - (lambda (entry) t) - )) - ) - ;; not implemented yet - ("Set Coding System of %_Terminal" - :filter - (lambda (menu) - (coding-system-menu-filter - (lambda (entry) - (set-terminal-coding-system entry)) - (lambda (entry) nil) - )) - ) - ;; not implemented yet - ("Set Coding System of %_Keyboard" - :filter - (lambda (menu) - (coding-system-menu-filter - (lambda (entry) - (set-keyboard-coding-system entry)) - (lambda (entry) nil) - )) - ) - ("Set Coding System of %_Process" - :filter - (lambda (menu) - (coding-system-menu-filter - (lambda (entry) - (set-buffer-process-coding-system entry)) - (lambda (entry) (get-buffer-process (current-buffer))) - )) - ) + ;; not implemented yet + ("Set Coding System of %_Keyboard" + :filter + ,#'(lambda (menu) + (coding-system-menu-filter + (lambda (entry) + (set-keyboard-coding-system entry)) + (lambda (entry) nil)))) + ("Set Coding System of %_Process" + :filter + ,#'(lambda (menu) + (coding-system-menu-filter + (lambda (entry) + (set-buffer-process-coding-system entry entry)) + (lambda (entry) (get-buffer-process (current-buffer))))))) + ,@(when (featurep 'mule) + `(("Internationa%_l" + ("Set %_Language Environment" + :filter + ,#'(lambda (menu) + (menu-split-long-menu-and-sort + (mapcar #'(lambda (entry) + `[ ,(car entry) + (set-language-environment ',(car entry)) + :style radio + :selected + ,(equal (car entry) + current-language-environment)]) + language-info-alist) + ))) + ["%_Toggle Input Method" toggle-input-method] + ["Select %_Input Method" set-input-method] + ))) + "-----" + ("%_Display" + ,@(if (featurep 'scrollbar) + '(["%_Scrollbars" + (customize-set-variable 'scrollbars-visible-p + (not scrollbars-visible-p)) + :style toggle + :selected scrollbars-visible-p])) + ["%_Wrap Long Lines" + (progn ;; becomes buffer-local + (setq truncate-lines (not truncate-lines)) + (customize-set-variable 'truncate-lines truncate-lines)) + :style toggle + :selected (not truncate-lines)] + "----" + ["%_3D Modeline" + (customize-set-variable 'modeline-3d-p + (not modeline-3d-p)) + :style toggle + :selected modeline-3d-p] + ("Modeline %_Horizontal Scrolling" + ["%_None" + (customize-set-variable 'modeline-scrolling-method nil) + :style radio + :selected (not modeline-scrolling-method)] + ["As %_Text" + (customize-set-variable 'modeline-scrolling-method t) + :style radio + :selected (eq modeline-scrolling-method t)] + ["As %_Scrollbar" + (customize-set-variable 'modeline-scrolling-method 'scrollbar) + :style radio + :selected (eq modeline-scrolling-method 'scrollbar)] ) - ,@(when (featurep 'mule) - '(("Internationa%_l" - ("Set %_Language Environment" - :filter - (lambda (menu) - (menu-split-long-menu-and-sort - (mapcar #'(lambda (entry) - `[ ,(car entry) - (set-language-environment ',(car entry)) - :style radio - :selected - ,(equal (car entry) - current-language-environment)]) - language-info-alist) - ))) - ["%_Toggle Input Method" toggle-input-method] - ["Select %_Input Method" set-input-method] - ))) + ,@(if (featurep 'toolbar) + '("---" + ["%_Toolbars Visible" + (customize-set-variable 'toolbar-visible-p + (not toolbar-visible-p)) + :style toggle + :selected toolbar-visible-p] + ["Toolbars Ca%_ptioned" + (customize-set-variable 'toolbar-captioned-p + (not toolbar-captioned-p)) + :style toggle + :active toolbar-visible-p + :selected toolbar-captioned-p] + ("Default Toolba%_r Location" + ["%_Top" + (customize-set-variable 'default-toolbar-position 'top) + :style radio + :active toolbar-visible-p + :selected (eq default-toolbar-position 'top)] + ["%_Bottom" + (customize-set-variable 'default-toolbar-position 'bottom) + :style radio + :active toolbar-visible-p + :selected (eq default-toolbar-position 'bottom)] + ["%_Left" + (customize-set-variable 'default-toolbar-position 'left) + :style radio + :active toolbar-visible-p + :selected (eq default-toolbar-position 'left)] + ["%_Right" + (customize-set-variable 'default-toolbar-position 'right) + :style radio + :active toolbar-visible-p + :selected (eq default-toolbar-position 'right)] + ) + )) + ,@(if (featurep 'gutter) + '("---" + ["B%_uffers Tab Visible" + (customize-set-variable 'gutter-buffers-tab-visible-p + (not gutter-buffers-tab-visible-p)) + :style toggle + :selected gutter-buffers-tab-visible-p] + ("Default %_Gutter Location" + ["%_Top" + (customize-set-variable 'default-gutter-position 'top) + :style radio + :selected (eq default-gutter-position 'top)] + ["%_Bottom" + (customize-set-variable 'default-gutter-position 'bottom) + :style radio + :selected (eq default-gutter-position 'bottom)] + ["%_Left" + (customize-set-variable 'default-gutter-position 'left) + :style radio + :selected (eq default-gutter-position 'left)] + ["%_Right" + (customize-set-variable 'default-gutter-position 'right) + :style radio + :selected (eq default-gutter-position 'right)] + ) + )) "-----" - ("%_Display" - ,@(if (featurep 'scrollbar) - '(["%_Scrollbars" - (customize-set-variable 'scrollbars-visible-p - (not scrollbars-visible-p)) - :style toggle - :selected scrollbars-visible-p])) - ["%_Wrap Long Lines" - (progn;; becomes buffer-local - (setq truncate-lines (not truncate-lines)) - (customize-set-variable 'truncate-lines truncate-lines)) - :style toggle - :selected (not truncate-lines)] - "----" - ["%_3D Modeline" - (customize-set-variable 'modeline-3d-p - (not modeline-3d-p)) - :style toggle - :selected modeline-3d-p] - ("Modeline %_Horizontal Scrolling" - ["%_None" - (customize-set-variable 'modeline-scrolling-method nil) - :style radio - :selected (not modeline-scrolling-method)] - ["As %_Text" - (customize-set-variable 'modeline-scrolling-method t) - :style radio - :selected (eq modeline-scrolling-method t)] - ["As %_Scrollbar" - (customize-set-variable 'modeline-scrolling-method 'scrollbar) - :style radio - :selected (eq modeline-scrolling-method 'scrollbar)] - ) - ,@(if (featurep 'toolbar) - '("---" - ["%_Toolbars Visible" - (customize-set-variable 'toolbar-visible-p - (not toolbar-visible-p)) - :style toggle - :selected toolbar-visible-p] - ["Toolbars Ca%_ptioned" - (customize-set-variable 'toolbar-captioned-p - (not toolbar-captioned-p)) - :style toggle - :active toolbar-visible-p - :selected toolbar-captioned-p] - ("Default Toolba%_r Location" - ["%_Top" - (customize-set-variable 'default-toolbar-position 'top) - :style radio - :active toolbar-visible-p - :selected (eq default-toolbar-position 'top)] - ["%_Bottom" - (customize-set-variable 'default-toolbar-position 'bottom) - :style radio - :active toolbar-visible-p - :selected (eq default-toolbar-position 'bottom)] - ["%_Left" - (customize-set-variable 'default-toolbar-position 'left) - :style radio - :active toolbar-visible-p - :selected (eq default-toolbar-position 'left)] - ["%_Right" - (customize-set-variable 'default-toolbar-position 'right) - :style radio - :active toolbar-visible-p - :selected (eq default-toolbar-position 'right)] - ) - )) - ,@(if (featurep 'gutter) - '("---" - ["B%_uffers Tab Visible" - (customize-set-variable 'gutter-buffers-tab-visible-p - (not gutter-buffers-tab-visible-p)) - :style toggle - :selected gutter-buffers-tab-visible-p] - ("Default %_Gutter Location" - ["%_Top" - (customize-set-variable 'default-gutter-position 'top) - :style radio - :selected (eq default-gutter-position 'top)] - ["%_Bottom" - (customize-set-variable 'default-gutter-position 'bottom) - :style radio - :selected (eq default-gutter-position 'bottom)] - ["%_Left" - (customize-set-variable 'default-gutter-position 'left) - :style radio - :selected (eq default-gutter-position 'left)] - ["%_Right" - (customize-set-variable 'default-gutter-position 'right) - :style radio - :selected (eq default-gutter-position 'right)] - ) - )) - "-----" - ["%_Blinking Cursor" - (customize-set-variable 'blink-cursor-mode (not blink-cursor-mode)) - :style toggle - :selected (and (boundp 'blink-cursor-mode) blink-cursor-mode) - :active (boundp 'blink-cursor-mode)] - ["Bl%_ock Cursor" - (progn - (customize-set-variable 'bar-cursor nil) - (force-cursor-redisplay)) - :style radio - :selected (null bar-cursor)] - ["Bar Cursor (%_1 Pixel)" - (progn - (customize-set-variable 'bar-cursor t) - (force-cursor-redisplay)) - :style radio - :selected (eq bar-cursor t)] - ["Bar Cursor (%_2 Pixels)" - (progn - (customize-set-variable 'bar-cursor 2) - (force-cursor-redisplay)) - :style radio - :selected (and bar-cursor (not (eq bar-cursor t)))] - "----" - ("Pa%_ren Highlighting" + ["%_Blinking Cursor" + (customize-set-variable 'blink-cursor-mode (not blink-cursor-mode)) + :style toggle + :selected (and (boundp 'blink-cursor-mode) blink-cursor-mode) + :active (boundp 'blink-cursor-mode)] + ["Bl%_ock Cursor" + (progn + (customize-set-variable 'bar-cursor nil) + (force-cursor-redisplay)) + :style radio + :selected (null bar-cursor)] + ["Bar Cursor (%_1 Pixel)" + (progn + (customize-set-variable 'bar-cursor t) + (force-cursor-redisplay)) + :style radio + :selected (eq bar-cursor t)] + ["Bar Cursor (%_2 Pixels)" + (progn + (customize-set-variable 'bar-cursor 2) + (force-cursor-redisplay)) + :style radio + :selected (and bar-cursor (not (eq bar-cursor t)))] + "----" + ("Pa%_ren Highlighting" ["%_None" (customize-set-variable 'paren-mode nil) :style radio @@ -1160,418 +1154,427 @@ ;; :selected (and (boundp 'paren-mode) (eq paren-mode 'nested)) ;; :active (boundp 'paren-mode)] ) - "------" - ["%_Line Numbers" - (progn - (customize-set-variable 'line-number-mode (not line-number-mode)) - (redraw-modeline)) - :style toggle :selected line-number-mode] - ["%_Column Numbers" - (progn - (customize-set-variable 'column-number-mode - (not column-number-mode)) - (redraw-modeline)) - :style toggle :selected column-number-mode] + "------" + ["%_Line Numbers" + (progn + (customize-set-variable 'line-number-mode (not line-number-mode)) + (redraw-modeline)) + :style toggle :selected line-number-mode] + ["%_Column Numbers" + (progn + (customize-set-variable 'column-number-mode + (not column-number-mode)) + (redraw-modeline)) + :style toggle :selected column-number-mode] - ("\"Other %_Window\" Location" - ["%_Always in Same Frame" - (customize-set-variable - 'get-frame-for-buffer-default-instance-limit nil) - :style radio - :selected (null get-frame-for-buffer-default-instance-limit)] - ["Other Frame (%_2 Frames Max)" - (customize-set-variable 'get-frame-for-buffer-default-instance-limit - 2) - :style radio - :selected (eq 2 get-frame-for-buffer-default-instance-limit)] - ["Other Frame (%_3 Frames Max)" - (customize-set-variable 'get-frame-for-buffer-default-instance-limit - 3) - :style radio - :selected (eq 3 get-frame-for-buffer-default-instance-limit)] - ["Other Frame (%_4 Frames Max)" - (customize-set-variable 'get-frame-for-buffer-default-instance-limit - 4) - :style radio - :selected (eq 4 get-frame-for-buffer-default-instance-limit)] - ["Other Frame (%_5 Frames Max)" - (customize-set-variable 'get-frame-for-buffer-default-instance-limit - 5) - :style radio - :selected (eq 5 get-frame-for-buffer-default-instance-limit)] - ["Always Create %_New Frame" - (customize-set-variable 'get-frame-for-buffer-default-instance-limit - 0) - :style radio - :selected (eq 0 get-frame-for-buffer-default-instance-limit)] - "-----" - ["%_Temp Buffers Always in Same Frame" - (customize-set-variable 'temp-buffer-show-function - 'show-temp-buffer-in-current-frame) - :style radio - :selected (eq temp-buffer-show-function - 'show-temp-buffer-in-current-frame)] - ["Temp Buffers %_Like Other Buffers" - (customize-set-variable 'temp-buffer-show-function nil) - :style radio - :selected (null temp-buffer-show-function)] - "-----" - ["%_Make Current Frame Gnuserv Target" - (customize-set-variable 'gnuserv-frame (if (eq gnuserv-frame t) nil - t)) - :style toggle - :selected (and (boundp 'gnuserv-frame) (eq gnuserv-frame t)) - :active (boundp 'gnuserv-frame)] - ) - ) - ("%_Menubars" - ["%_Frame-Local Font Menu" - (customize-set-variable 'font-menu-this-frame-only-p - (not font-menu-this-frame-only-p)) - :style toggle - :selected (and (boundp 'font-menu-this-frame-only-p) - font-menu-this-frame-only-p)] - ["%_Alt/Meta Selects Menu Items" - (if (eq menu-accelerator-enabled 'menu-force) - (customize-set-variable 'menu-accelerator-enabled nil) - (customize-set-variable 'menu-accelerator-enabled 'menu-force)) - :style toggle - :selected (eq menu-accelerator-enabled 'menu-force)] - "----" - ["Buffers Menu %_Length..." + ("\"Other %_Window\" Location" + ["%_Always in Same Frame" (customize-set-variable - 'buffers-menu-max-size - ;; would it be better to open a customization buffer ? - (let ((val - (read-number - "Enter number of buffers to display (or 0 for unlimited): "))) - (if (eq val 0) nil val)))] - ["%_Multi-Operation Buffers Sub-Menus" - (customize-set-variable 'complex-buffers-menu-p - (not complex-buffers-menu-p)) - :style toggle - :selected complex-buffers-menu-p] - ["S%_ubmenus for Buffer Groups" - (customize-set-variable 'buffers-menu-submenus-for-groups-p - (not buffers-menu-submenus-for-groups-p)) - :style toggle - :selected buffers-menu-submenus-for-groups-p] - ["%_Verbose Buffer Menu Entries" - (if (eq buffers-menu-format-buffer-line-function - 'slow-format-buffers-menu-line) - (customize-set-variable 'buffers-menu-format-buffer-line-function - 'format-buffers-menu-line) - (customize-set-variable 'buffers-menu-format-buffer-line-function - 'slow-format-buffers-menu-line)) - :style toggle - :selected (eq buffers-menu-format-buffer-line-function - 'slow-format-buffers-menu-line)] - ("Buffers Menu %_Sorting" - ["%_Most Recently Used" - (progn - (customize-set-variable 'buffers-menu-sort-function nil) - (customize-set-variable 'buffers-menu-grouping-function nil)) - :style radio - :selected (null buffers-menu-sort-function)] - ["%_Alphabetically" - (progn - (customize-set-variable 'buffers-menu-sort-function - 'sort-buffers-menu-alphabetically) - (customize-set-variable 'buffers-menu-grouping-function nil)) - :style radio - :selected (eq 'sort-buffers-menu-alphabetically - buffers-menu-sort-function)] - ["%_By Major Mode, Then Alphabetically" - (progn - (customize-set-variable - 'buffers-menu-sort-function - 'sort-buffers-menu-by-mode-then-alphabetically) - (customize-set-variable - 'buffers-menu-grouping-function - 'group-buffers-menu-by-mode-then-alphabetically)) - :style radio - :selected (eq 'sort-buffers-menu-by-mode-then-alphabetically - buffers-menu-sort-function)]) - "---" - ["%_Ignore Scaled Fonts" - (customize-set-variable 'font-menu-ignore-scaled-fonts - (not font-menu-ignore-scaled-fonts)) - :style toggle - :selected (and (boundp 'font-menu-ignore-scaled-fonts) - font-menu-ignore-scaled-fonts)] - ) - ("S%_yntax Highlighting" - ["%_In This Buffer" - (progn;; becomes buffer local - (font-lock-mode) - (customize-set-variable 'font-lock-mode font-lock-mode)) + 'get-frame-for-buffer-default-instance-limit nil) + :style radio + :selected (null get-frame-for-buffer-default-instance-limit)] + ["Other Frame (%_2 Frames Max)" + (customize-set-variable 'get-frame-for-buffer-default-instance-limit + 2) + :style radio + :selected (eq 2 get-frame-for-buffer-default-instance-limit)] + ["Other Frame (%_3 Frames Max)" + (customize-set-variable 'get-frame-for-buffer-default-instance-limit + 3) + :style radio + :selected (eq 3 get-frame-for-buffer-default-instance-limit)] + ["Other Frame (%_4 Frames Max)" + (customize-set-variable 'get-frame-for-buffer-default-instance-limit + 4) + :style radio + :selected (eq 4 get-frame-for-buffer-default-instance-limit)] + ["Other Frame (%_5 Frames Max)" + (customize-set-variable 'get-frame-for-buffer-default-instance-limit + 5) + :style radio + :selected (eq 5 get-frame-for-buffer-default-instance-limit)] + ["Always Create %_New Frame" + (customize-set-variable 'get-frame-for-buffer-default-instance-limit + 0) + :style radio + :selected (eq 0 get-frame-for-buffer-default-instance-limit)] + "-----" + ["%_Temp Buffers Always in Same Frame" + (customize-set-variable 'temp-buffer-show-function + 'show-temp-buffer-in-current-frame) + :style radio + :selected (eq temp-buffer-show-function + 'show-temp-buffer-in-current-frame)] + ["Temp Buffers %_Like Other Buffers" + (customize-set-variable 'temp-buffer-show-function nil) + :style radio + :selected (null temp-buffer-show-function)] + "-----" + ["%_Make Current Frame Gnuserv Target" + (customize-set-variable 'gnuserv-frame (if (eq gnuserv-frame t) nil + t)) :style toggle - :selected (and (boundp 'font-lock-mode) font-lock-mode) - :active (boundp 'font-lock-mode)] - ["%_Automatic" - (customize-set-variable 'font-lock-auto-fontify - (not font-lock-auto-fontify)) - :style toggle - :selected (and (boundp 'font-lock-auto-fontify) font-lock-auto-fontify) - :active (fboundp 'font-lock-mode)] - "-----" - ["Force %_Rehighlight in this Buffer" - (customize-set-variable 'font-lock-auto-fontify - (not font-lock-auto-fontify)) - :style toggle - :selected (and (boundp 'font-lock-auto-fontify) font-lock-auto-fontify) - :active (fboundp 'font-lock-mode)] - "-----" - ["%_Fonts" + :selected (and (boundp 'gnuserv-frame) (eq gnuserv-frame t)) + :active (boundp 'gnuserv-frame)] + ) + ) + ("%_Menubars" + ["%_Frame-Local Font Menu" + (customize-set-variable 'font-menu-this-frame-only-p + (not font-menu-this-frame-only-p)) + :style toggle + :selected (and (boundp 'font-menu-this-frame-only-p) + font-menu-this-frame-only-p)] + ["%_Alt/Meta Selects Menu Items" + (if (eq menu-accelerator-enabled 'menu-force) + (customize-set-variable 'menu-accelerator-enabled nil) + (customize-set-variable 'menu-accelerator-enabled 'menu-force)) + :style toggle + :selected (eq menu-accelerator-enabled 'menu-force)] + "----" + ["Buffers Menu %_Length..." + (customize-set-variable + 'buffers-menu-max-size + ;; would it be better to open a customization buffer ? + (let ((val + (read-number + "Enter number of buffers to display (or 0 for unlimited): "))) + (if (eq val 0) nil val)))] + ["%_Multi-Operation Buffers Sub-Menus" + (customize-set-variable 'complex-buffers-menu-p + (not complex-buffers-menu-p)) + :style toggle + :selected complex-buffers-menu-p] + ["S%_ubmenus for Buffer Groups" + (customize-set-variable 'buffers-menu-submenus-for-groups-p + (not buffers-menu-submenus-for-groups-p)) + :style toggle + :selected buffers-menu-submenus-for-groups-p] + ["%_Verbose Buffer Menu Entries" + (if (eq buffers-menu-format-buffer-line-function + 'slow-format-buffers-menu-line) + (customize-set-variable 'buffers-menu-format-buffer-line-function + 'format-buffers-menu-line) + (customize-set-variable 'buffers-menu-format-buffer-line-function + 'slow-format-buffers-menu-line)) + :style toggle + :selected (eq buffers-menu-format-buffer-line-function + 'slow-format-buffers-menu-line)] + ("Buffers Menu %_Sorting" + ["%_Most Recently Used" (progn - (require 'font-lock) - (font-lock-use-default-fonts) - (customize-set-variable 'font-lock-use-fonts t) - (customize-set-variable 'font-lock-use-colors nil) - (font-lock-mode 1)) - :style radio - :selected (and (boundp 'font-lock-use-fonts) font-lock-use-fonts) - :active (fboundp 'font-lock-mode)] - ["%_Colors" - (progn - (require 'font-lock) - (font-lock-use-default-colors) - (customize-set-variable 'font-lock-use-colors t) - (customize-set-variable 'font-lock-use-fonts nil) - (font-lock-mode 1)) + (customize-set-variable 'buffers-menu-sort-function nil) + (customize-set-variable 'buffers-menu-grouping-function nil)) :style radio - :selected (and (boundp 'font-lock-use-colors) font-lock-use-colors) - :active (boundp 'font-lock-mode)] - "-----" - ["%_1 Least" + :selected (null buffers-menu-sort-function)] + ["%_Alphabetically" (progn - (require 'font-lock) - (if (or (and (not (integerp font-lock-maximum-decoration)) - (not (eq t font-lock-maximum-decoration))) - (and (integerp font-lock-maximum-decoration) - (<= font-lock-maximum-decoration 0))) - nil - (customize-set-variable 'font-lock-maximum-decoration nil) - (font-lock-recompute-variables))) + (customize-set-variable 'buffers-menu-sort-function + 'sort-buffers-menu-alphabetically) + (customize-set-variable 'buffers-menu-grouping-function nil)) :style radio - :active (fboundp 'font-lock-mode) - :selected (and (boundp 'font-lock-maximum-decoration) - (or (and (not (integerp font-lock-maximum-decoration)) - (not (eq t font-lock-maximum-decoration))) - (and (integerp font-lock-maximum-decoration) - (<= font-lock-maximum-decoration 0))))] - ["%_2 More" - (progn - (require 'font-lock) - (if (and (integerp font-lock-maximum-decoration) - (= 1 font-lock-maximum-decoration)) - nil - (customize-set-variable 'font-lock-maximum-decoration 1) - (font-lock-recompute-variables))) - :style radio - :active (fboundp 'font-lock-mode) - :selected (and (boundp 'font-lock-maximum-decoration) - (integerp font-lock-maximum-decoration) - (= 1 font-lock-maximum-decoration))] - ["%_3 Even More" + :selected (eq 'sort-buffers-menu-alphabetically + buffers-menu-sort-function)] + ["%_By Major Mode, Then Alphabetically" (progn - (require 'font-lock) - (if (and (integerp font-lock-maximum-decoration) - (= 2 font-lock-maximum-decoration)) - nil - (customize-set-variable 'font-lock-maximum-decoration 2) - (font-lock-recompute-variables))) - :style radio - :active (fboundp 'font-lock-mode) - :selected (and (boundp 'font-lock-maximum-decoration) - (integerp font-lock-maximum-decoration) - (= 2 font-lock-maximum-decoration))] - ["%_4 Most" - (progn - (require 'font-lock) - (if (or (eq font-lock-maximum-decoration t) - (and (integerp font-lock-maximum-decoration) - (>= font-lock-maximum-decoration 3))) - nil - (customize-set-variable 'font-lock-maximum-decoration t) - (font-lock-recompute-variables))) + (customize-set-variable + 'buffers-menu-sort-function + 'sort-buffers-menu-by-mode-then-alphabetically) + (customize-set-variable + 'buffers-menu-grouping-function + 'group-buffers-menu-by-mode-then-alphabetically)) :style radio - :active (fboundp 'font-lock-mode) - :selected (and (boundp 'font-lock-maximum-decoration) - (or (eq font-lock-maximum-decoration t) - (and (integerp font-lock-maximum-decoration) - (>= font-lock-maximum-decoration 3))))] - "-----" - ["Lazy %_Lock" - (progn;; becomes buffer local - (lazy-lock-mode) - (customize-set-variable 'lazy-lock-mode lazy-lock-mode) - ;; this shouldn't be necessary so there has to - ;; be a redisplay bug lurking somewhere (or - ;; possibly another event handler bug) - (redraw-modeline)) - :active (and (boundp 'font-lock-mode) (boundp 'lazy-lock-mode) - font-lock-mode) - :style toggle - :selected (and (boundp 'lazy-lock-mode) lazy-lock-mode)] - ["Lazy %_Shot" - (progn;; becomes buffer local - (lazy-shot-mode) - (customize-set-variable 'lazy-shot-mode lazy-shot-mode) - ;; this shouldn't be necessary so there has to - ;; be a redisplay bug lurking somewhere (or - ;; possibly another event handler bug) - (redraw-modeline)) - :active (and (boundp 'font-lock-mode) (boundp 'lazy-shot-mode) - font-lock-mode) - :style toggle - :selected (and (boundp 'lazy-shot-mode) lazy-shot-mode)] - ["Cac%_hing" - (progn;; becomes buffer local - (fast-lock-mode) - (customize-set-variable 'fast-lock-mode fast-lock-mode) - ;; this shouldn't be necessary so there has to - ;; be a redisplay bug lurking somewhere (or - ;; possibly another event handler bug) - (redraw-modeline)) - :active (and (boundp 'font-lock-mode) (boundp 'fast-lock-mode) - font-lock-mode) - :style toggle - :selected (and (boundp 'fast-lock-mode) fast-lock-mode)] - ) - ("%_Font" :filter font-menu-family-constructor) - ("Font Si%_ze" :filter font-menu-size-constructor) - ;; ("Font Weig%_ht" :filter font-menu-weight-constructor) - ["Edit Fa%_ces..." (customize-face nil)] + :selected (eq 'sort-buffers-menu-by-mode-then-alphabetically + buffers-menu-sort-function)]) + "---" + ["%_Ignore Scaled Fonts" + (customize-set-variable 'font-menu-ignore-scaled-fonts + (not font-menu-ignore-scaled-fonts)) + :style toggle + :selected (and (boundp 'font-menu-ignore-scaled-fonts) + font-menu-ignore-scaled-fonts)] + ) + ("S%_yntax Highlighting" + ["%_In This Buffer" + (progn ;; becomes buffer local + (font-lock-mode) + (customize-set-variable 'font-lock-mode font-lock-mode)) + :style toggle + :selected (and (boundp 'font-lock-mode) font-lock-mode) + :active (boundp 'font-lock-mode)] + ["%_Automatic" + (customize-set-variable 'font-lock-auto-fontify + (not font-lock-auto-fontify)) + :style toggle + :selected (and (boundp 'font-lock-auto-fontify) font-lock-auto-fontify) + :active (fboundp 'font-lock-mode)] + "-----" + ["Force %_Rehighlight in this Buffer" + (customize-set-variable 'font-lock-auto-fontify + (not font-lock-auto-fontify)) + :style toggle + :selected (and (boundp 'font-lock-auto-fontify) font-lock-auto-fontify) + :active (fboundp 'font-lock-mode)] + "-----" + ["%_Fonts" + (progn + (require 'font-lock) + (font-lock-use-default-fonts) + (customize-set-variable 'font-lock-use-fonts t) + (customize-set-variable 'font-lock-use-colors nil) + (font-lock-mode 1)) + :style radio + :selected (and (boundp 'font-lock-use-fonts) font-lock-use-fonts) + :active (fboundp 'font-lock-mode)] + ["%_Colors" + (progn + (require 'font-lock) + (font-lock-use-default-colors) + (customize-set-variable 'font-lock-use-colors t) + (customize-set-variable 'font-lock-use-fonts nil) + (font-lock-mode 1)) + :style radio + :selected (and (boundp 'font-lock-use-colors) font-lock-use-colors) + :active (boundp 'font-lock-mode)] "-----" - ["Edit I%_nit File" - ;; #### there should be something that holds the name that the init - ;; file should be created as, when it's not present. - (let ((el-file (or user-init-file "~/.xemacs/init.el"))) - (if (string-match "\\.elc$" el-file) - (setq el-file - (substring user-init-file 0 (1- (length el-file))))) - (find-file el-file) - (or (eq major-mode 'emacs-lisp-mode) - (emacs-lisp-mode)))] - ["%_Save Options to Custom File" customize-save-customized] + ["%_1 Least" + (progn + (require 'font-lock) + (if (or (and (not (integerp font-lock-maximum-decoration)) + (not (eq t font-lock-maximum-decoration))) + (and (integerp font-lock-maximum-decoration) + (<= font-lock-maximum-decoration 0))) + nil + (customize-set-variable 'font-lock-maximum-decoration nil) + (font-lock-recompute-variables))) + :style radio + :active (fboundp 'font-lock-mode) + :selected (and (boundp 'font-lock-maximum-decoration) + (or (and (not (integerp font-lock-maximum-decoration)) + (not (eq t font-lock-maximum-decoration))) + (and (integerp font-lock-maximum-decoration) + (<= font-lock-maximum-decoration 0))))] + ["%_2 More" + (progn + (require 'font-lock) + (if (and (integerp font-lock-maximum-decoration) + (= 1 font-lock-maximum-decoration)) + nil + (customize-set-variable 'font-lock-maximum-decoration 1) + (font-lock-recompute-variables))) + :style radio + :active (fboundp 'font-lock-mode) + :selected (and (boundp 'font-lock-maximum-decoration) + (integerp font-lock-maximum-decoration) + (= 1 font-lock-maximum-decoration))] + ["%_3 Even More" + (progn + (require 'font-lock) + (if (and (integerp font-lock-maximum-decoration) + (= 2 font-lock-maximum-decoration)) + nil + (customize-set-variable 'font-lock-maximum-decoration 2) + (font-lock-recompute-variables))) + :style radio + :active (fboundp 'font-lock-mode) + :selected (and (boundp 'font-lock-maximum-decoration) + (integerp font-lock-maximum-decoration) + (= 2 font-lock-maximum-decoration))] + ["%_4 Most" + (progn + (require 'font-lock) + (if (or (eq font-lock-maximum-decoration t) + (and (integerp font-lock-maximum-decoration) + (>= font-lock-maximum-decoration 3))) + nil + (customize-set-variable 'font-lock-maximum-decoration t) + (font-lock-recompute-variables))) + :style radio + :active (fboundp 'font-lock-mode) + :selected (and (boundp 'font-lock-maximum-decoration) + (or (eq font-lock-maximum-decoration t) + (and (integerp font-lock-maximum-decoration) + (>= font-lock-maximum-decoration 3))))] + "-----" + ["Lazy %_Lock" + (progn ;; becomes buffer local + (lazy-lock-mode) + (customize-set-variable 'lazy-lock-mode lazy-lock-mode) + ;; this shouldn't be necessary so there has to + ;; be a redisplay bug lurking somewhere (or + ;; possibly another event handler bug) + (redraw-modeline)) + :active (and (boundp 'font-lock-mode) (boundp 'lazy-lock-mode) + font-lock-mode) + :style toggle + :selected (and (boundp 'lazy-lock-mode) lazy-lock-mode)] + ["Lazy %_Shot" + (progn ;; becomes buffer local + (lazy-shot-mode) + (customize-set-variable 'lazy-shot-mode lazy-shot-mode) + ;; this shouldn't be necessary so there has to + ;; be a redisplay bug lurking somewhere (or + ;; possibly another event handler bug) + (redraw-modeline)) + :active (and (boundp 'font-lock-mode) (boundp 'lazy-shot-mode) + font-lock-mode) + :style toggle + :selected (and (boundp 'lazy-shot-mode) lazy-shot-mode)] + ["Cac%_hing" + (progn ;; becomes buffer local + (fast-lock-mode) + (customize-set-variable 'fast-lock-mode fast-lock-mode) + ;; this shouldn't be necessary so there has to + ;; be a redisplay bug lurking somewhere (or + ;; possibly another event handler bug) + (redraw-modeline)) + :active (and (boundp 'font-lock-mode) (boundp 'fast-lock-mode) + font-lock-mode) + :style toggle + :selected (and (boundp 'fast-lock-mode) fast-lock-mode)] ) + ("%_Font" :filter font-menu-family-constructor) + ("Font Si%_ze" :filter font-menu-size-constructor) + ;; ("Font Weig%_ht" :filter font-menu-weight-constructor) + ["Edit Fa%_ces..." (customize-face nil)] + "-----" + ["Edit I%_nit File" + ;; #### there should be something that holds the name that the init + ;; file should be created as, when it's not present. + (let ((el-file (or user-init-file "~/.xemacs/init.el")) + el-file-directory) + (if (string-match "\\.elc$" el-file) + (setq el-file + (substring user-init-file 0 (1- (length el-file))))) + (unless (file-directory-p + (setq el-file-directory (file-name-directory el-file))) + (message "Creating %s... " el-file-directory) + (make-directory el-file-directory t) + (message "Creating %s... done." el-file-directory)) + (find-file el-file) + (or (eq major-mode 'emacs-lisp-mode) + (emacs-lisp-mode)))] + ["%_Save Options to Custom File" customize-save-customized] + ) ("%_Buffers" - :filter buffers-menu-filter - ["Go To %_Previous Buffer" switch-to-other-buffer] - ["Go To %_Buffer..." switch-to-buffer] - "----" - ["%_List All Buffers" list-all-buffers] - ["%_Delete Buffer" kill-this-buffer - :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] - "----" - ) + :filter buffers-menu-filter + ["Go To %_Previous Buffer" switch-to-other-buffer] + ["Go To %_Buffer..." switch-to-buffer] + "----" + ["%_List All Buffers" list-all-buffers] + ["%_Delete Buffer" kill-this-buffer + :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] + "----" + ) - nil ; the partition: menus after this are flushright + nil ; the partition: menus after this are flushright ("%_Help" - ["%_About XEmacs..." about-xemacs] - ["%_Home Page (www.xemacs.org)" xemacs-www-page - :active (fboundp 'browse-url)] - ["What's %_New in XEmacs" view-emacs-news] - ["B%_eta Info" describe-beta - :included (string-match "beta" emacs-version)] + ["%_About XEmacs..." about-xemacs] + ["%_Home Page (www.xemacs.org)" xemacs-www-page + :active (fboundp 'browse-url)] + ["What's %_New in XEmacs" view-emacs-news] + ["B%_eta Info" describe-beta + :included (string-match "beta" emacs-version)] + "-----" + ("%_Info (Online Docs)" + ["%_Info Contents" (Info-goto-node "(dir)")] + "-----" + ["XEmacs %_User's Manual" (Info-goto-node "(XEmacs)")] + ["XEmacs %_Lisp Reference Manual" (Info-goto-node "(Lispref)")] + ["All About %_Packages" (Info-goto-node "(xemacs)Packages")] + ["%_Getting Started with XEmacs" (Info-goto-node "(New-Users-Guide)")] + ["%_XEmacs Internals Manual" (Info-goto-node "(Internals)")] + ["%_How to Use Info" (Info-goto-node "(Info)")] + "-----" + ["Lookup %_Key Sequence in User's Manual..." + Info-goto-emacs-key-command-node] + ["Lookup %_Command in User's Manual..." Info-goto-emacs-command-node] + ["Lookup %_Function in Lisp Reference..." Info-elisp-ref] "-----" - ("%_Info (Online Docs)" - ["%_Info Contents" (Info-goto-node "(dir)")] - "-----" - ["XEmacs %_User's Manual" (Info-goto-node "(XEmacs)")] - ["XEmacs %_Lisp Reference Manual" (Info-goto-node "(Lispref)")] - ["All About %_Packages" (Info-goto-node "(xemacs)Packages")] - ["%_Getting Started with XEmacs" (Info-goto-node "(New-Users-Guide)")] - ["%_XEmacs Internals Manual" (Info-goto-node "(Internals)")] - ["%_How to Use Info" (Info-goto-node "(Info)")] - "-----" - ["Lookup %_Key Sequence in User's Manual..." - Info-goto-emacs-key-command-node] - ["Lookup %_Command in User's Manual..." Info-goto-emacs-command-node] - ["Lookup %_Function in Lisp Reference..." Info-elisp-ref] - "-----" - ["Find %_Topic in User's Manual/Lispref..." - Info-search-index-in-xemacs-and-lispref] - ["%_Search Text in User's Manual..." Info-search-text-in-xemacs] - ["S%_earch Text in Lisp Reference..." - Info-search-text-in-lispref] - ) - ("XEmacs %_FAQ" - ["%_FAQ (local)" xemacs-local-faq] - ["FAQ via %_WWW" xemacs-www-faq - :active (fboundp 'browse-url)]) - ("%_Tutorials" - :filter tutorials-menu-filter) - ("%_Samples" - ["View Sample %_init.el" view-sample-init-el - :active (locate-data-file "sample.init.el")] - ["View Sample .%_gtkrc" - (Help-find-file (locate-data-file "sample.gtkrc")) - :included (featurep 'gtk) - :active (locate-data-file "sample.gtkrc")] - ["View Sample .%_Xresources" - (Help-find-file (locate-data-file "sample.Xresources")) - :included (featurep 'x) - :active (locate-data-file "sample.Xresources")] - ["View Sample %_enriched.doc" - (Help-find-file (locate-data-file "enriched.doc")) - :active (locate-data-file "enriched.doc")]) - ("%_Commands, Variables, Keys" - ["Describe %_Mode" describe-mode] - ["%_Apropos..." hyper-apropos] - ["%_Command-Only Apropos..." command-hyper-apropos] - ["Apropos %_Docs..." apropos-documentation] - "-----" - ["Describe %_Key..." describe-key] - ["Show %_Bindings" describe-bindings] - ["Show M%_ouse Bindings" describe-pointer] - "-----" - ["Describe %_Function..." describe-function] - ["Describe %_Variable..." describe-variable] - ["%_Locate Command in Keymap..." where-is]) - ,@(when (featurep 'mule) - '(("Internationa%_l" - ("Describe %_Language Support" - :filter - (lambda (menu) - (menu-split-long-menu-and-sort - (mapcar #'(lambda (entry) - `[ ,(car entry) - (describe-language-environment - ',(car entry)) - :style radio - :selected - ,(equal (car entry) - current-language-environment)]) - language-info-alist) - ))) - ["Describe %_Input Method" describe-input-method] - ["Describe Current %_Coding Systems" - describe-current-coding-system] - ["Show Character %_Table" view-charset-by-menu] - ;; not implemented yet - ["Show %_Diagnosis for MULE" mule-diag :active nil] - ["Show \"%_hello\" in Many Languages" view-hello-file] - ))) - ("%_Other" - ["%_Current Installation Info" describe-installation - :active (boundp 'Installation-string)] - ["%_Known Problems" view-xemacs-problems ] - ["%_Obtaining the Latest Version" describe-distribution] - ["%_No Warranty" describe-no-warranty] - ["XEmacs %_License" describe-copying] - ["Find %_Packages" finder-by-keyword] - ["View %_Splash Screen" xemacs-splash-buffer] - ["%_Unix Manual..." manual-entry]) + ["Find %_Topic in User's Manual/Lispref..." + Info-search-index-in-xemacs-and-lispref] + ["%_Search Text in User's Manual..." Info-search-text-in-xemacs] + ["S%_earch Text in Lisp Reference..." + Info-search-text-in-lispref] + ) + ("XEmacs %_FAQ" + ["%_FAQ (local)" xemacs-local-faq] + ["FAQ via %_WWW" xemacs-www-faq + :active (fboundp 'browse-url)]) + ("%_Tutorials" + :filter tutorials-menu-filter) + ("%_Samples" + ["View Sample %_init.el" view-sample-init-el + :active (locate-data-file "sample.init.el")] + ["View Sample .%_gtkrc" + (Help-find-file (locate-data-file "sample.gtkrc")) + :included (featurep 'gtk) + :active (locate-data-file "sample.gtkrc")] + ["View Sample .%_Xresources" + (Help-find-file (locate-data-file "sample.Xresources")) + :included (featurep 'x) + :active (locate-data-file "sample.Xresources")] + ["View Sample %_enriched.doc" + (Help-find-file (locate-data-file "enriched.doc")) + :active (locate-data-file "enriched.doc")]) + ("%_Commands, Variables, Keys" + ["Describe %_Mode" describe-mode] + ["%_Apropos..." hyper-apropos] + ["%_Command-Only Apropos..." command-hyper-apropos] + ["Apropos %_Docs..." apropos-documentation] + "-----" + ["Describe %_Key..." describe-key] + ["Show %_Bindings" describe-bindings] + ["Show M%_ouse Bindings" describe-pointer] "-----" - ["Recent %_Messages" (view-lossage t)] - ["Recent %_Keystrokes" view-lossage] - ["Recent %_Warnings" view-warnings] - ["Send %_Bug Report..." report-xemacs-bug - :active (fboundp 'report-xemacs-bug)]))) + ["Describe %_Function..." describe-function] + ["Describe %_Variable..." describe-variable] + ["%_Locate Command in Keymap..." where-is]) + ,@(when (featurep 'mule) + `(("Internationa%_l" + ("Describe %_Language Support" + :filter + ,#'(lambda (menu) + (menu-split-long-menu-and-sort + (mapcar #'(lambda (entry) + `[ ,(car entry) + (describe-language-environment + ',(car entry)) + :style radio + :selected + ,(equal (car entry) + current-language-environment)]) + language-info-alist) + ))) + ["Describe %_Input Method" describe-input-method] + ["Describe Current %_Coding Systems" + describe-current-coding-system] + ["Show Character %_Table" view-charset-by-menu] + ;; not implemented yet + ["Show %_Diagnosis for MULE" mule-diag :active nil] + ["Show \"%_hello\" in Many Languages" view-hello-file] + ))) + ("%_Other" + ["%_Current Installation Info" describe-installation + :active (boundp 'Installation-string)] + ["%_Known Problems" view-xemacs-problems ] + ["%_Obtaining the Latest Version" describe-distribution] + ["%_No Warranty" describe-no-warranty] + ["XEmacs %_License" describe-copying] + ["Find %_Packages" finder-by-keyword] + ["View %_Splash Screen" xemacs-splash-buffer] + ["%_Unix Manual..." manual-entry]) + "-----" + ["Recent %_Messages" (view-lossage t)] + ["Recent %_Keystrokes" view-lossage] + ["Recent %_Warnings" view-warnings] + ["Send %_Bug Report..." report-xemacs-bug + :active (fboundp 'report-xemacs-bug)])) + "The default XEmacs menubar. +See the documentation for `current-menubar' for details of the syntax +used here.") (defun init-menubar-at-startup () @@ -1929,6 +1932,11 @@ ;; included it first (not (string= (car lang) current-language-environment)) + ;; Hackish approach; if a language environment + ;; doesn't have associated locale information, + ;; it's not the preferred implementation for that + ;; language. Don't use it. + (assq 'locale lang) `([,(car lang) (help-with-tutorial nil ,(car lang))])))) language-info-alist)
--- a/lisp/minibuf.el Wed Dec 26 17:30:16 2007 +0100 +++ b/lisp/minibuf.el Sun Jan 20 13:09:58 2008 +0100 @@ -2057,22 +2057,18 @@ (let* ((file-p (eq 'read-file-name-internal completer)) (filebuf (get-buffer-create "*Completions*")) (dirbuf (and file-p (generate-new-buffer " *mouse-read-file*"))) - (butbuf (generate-new-buffer " *mouse-read-file*")) + (butbuf (generate-new-buffer " *mouse-read-file-buttons*")) (frame (make-dialog-frame)) filewin dirwin - user-data) + user-data + (window-min-height 1)) ; allow button window to be height 2 (unwind-protect (progn (reset-buffer filebuf) ;; set up the frame. (focus-frame frame) - (let ((window-min-height 1)) - ;; #### should be 2 not 3, but that causes - ;; "window too small to split" errors for some - ;; people (but not for me ...) There's a more - ;; fundamental bug somewhere. - (split-window nil (- (frame-height frame) 3))) + (split-window nil (- (window-height) 2)) (if file-p (progn (split-window-horizontally 16)
--- a/lisp/subr.el Wed Dec 26 17:30:16 2007 +0100 +++ b/lisp/subr.el Sun Jan 20 13:09:58 2008 +0100 @@ -579,6 +579,19 @@ ; . ,body) ; (combine-after-change-execute))) +(defmacro with-case-table (table &rest body) + "Execute the forms in BODY with TABLE as the current case table. +The value returned is the value of the last form in BODY." + (declare (indent 1) (debug t)) + (let ((old-case-table (make-symbol "table")) + (old-buffer (make-symbol "buffer"))) + `(let ((,old-case-table (current-case-table)) + (,old-buffer (current-buffer))) + (unwind-protect + (progn (set-case-table ,table) + ,@body) + (with-current-buffer ,old-buffer + (set-case-table ,old-case-table)))))) (defvar delay-mode-hooks nil "If non-nil, `run-mode-hooks' should delay running the hooks.")
--- a/lisp/x-iso8859-1.el Wed Dec 26 17:30:16 2007 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,273 +0,0 @@ -;;; x-iso8859-1 --- Mapping between X keysym names and ISO 8859-1 - -;; Copyright (C) 1992, 1993, 1997 Free Software Foundation, Inc. - -;; Author: Jamie Zawinski <jwz@jwz.org> -;; Created: 15-jun-92 -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, internal, dumped - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: Not synched. - -;;; Commentary: - -;; created by jwz, 13-jun-92. -;; changed by Heiko Muenkel, 12-jun-1997: Added a grave keysym. - -;; Under X, when the user types a character that is ISO-8859/1 but not ASCII, -;; it comes in as a symbol instead of as a character code. This keeps things -;; nice and character-set independent. This file takes all of those symbols -;; (the symbols that are the X names for the 8859/1 characters) and puts a -;; property on them which holds the character code that should be inserted in -;; the buffer when they are typed. The self-insert-command function will look -;; at this. It also binds them all to self-insert-command. - -;; It puts the same property on the keypad keys, so that (read-char) will -;; think that they are the same as the digit characters. However, those -;; keys are bound to one-character keyboard macros, so that `kp-9' will, by -;; default, do the same thing that `9' does, in whatever the current mode is. - -;; The standard case and syntax tables are set in iso8859-1.el, since -;; that is not X-specific. - -;;; Code: - -(require 'iso8859-1) - -(defconst iso8859/1-code-to-x-keysym-table nil - "Maps iso8859/1 to an X keysym name which corresponds to it. -There may be more than one X name for this keycode; this returns the first one. -Note that this is X specific; one should avoid using this table whenever -possible, in the interest of portability.") - -;; (This esoteric little construct is how you do MACROLET in elisp. It -;; generates the most efficient code for the .elc file by unwinding the -;; loop at compile-time.) - -((macro - . (lambda (&rest syms-and-iso8859/1-codes) - (cons - 'progn - (nconc - ;; - ;; First emit code that puts the `x-iso8859/1' property on all of - ;; the keysym symbols. - ;; - (mapcar '(lambda (sym-and-code) - (list 'put (list 'quote (car sym-and-code)) - ''x-iso8859/1 (car (cdr sym-and-code)))) - syms-and-iso8859/1-codes) - ;; - ;; Then emit code that binds all of those keysym symbols to - ;; `self-insert-command'. - ;; - (mapcar '(lambda (sym-and-code) - (list 'global-set-key (list 'quote (car sym-and-code)) - ''self-insert-command)) - syms-and-iso8859/1-codes) - ;; - ;; Then emit the value of iso8859/1-code-to-x-keysym-table. - ;; - (let ((v (make-vector 256 nil))) - ;; the printing ASCII chars have 1-char names. - (let ((i 33)) - (while (< i 127) - (aset v i (intern (make-string 1 i))) - (setq i (1+ i)))) - ;; these are from the keyboard character set. - (mapcar '(lambda (x) (aset v (car x) (car (cdr x)))) - '((8 backspace) (9 tab) (10 linefeed) (13 return) - (27 escape) (32 space) (127 delete))) - (mapcar '(lambda (sym-and-code) - (or (aref v (car (cdr sym-and-code))) - (aset v (car (cdr sym-and-code)) (car sym-and-code)))) - syms-and-iso8859/1-codes) - (list (list 'setq 'iso8859/1-code-to-x-keysym-table v))) - )))) - - ;; The names and capitalization here are as per the MIT X11R4 and X11R5 - ;; distributions. If a vendor varies from this, adjustments will need - ;; to be made... - - (grave ?\140) - (nobreakspace ?\240) - (exclamdown ?\241) - (cent ?\242) - (sterling ?\243) - (currency ?\244) - (yen ?\245) - (brokenbar ?\246) - (section ?\247) - (diaeresis ?\250) - (copyright ?\251) - (ordfeminine ?\252) - (guillemotleft ?\253) - (notsign ?\254) - (hyphen ?\255) - (registered ?\256) - (macron ?\257) - (degree ?\260) - (plusminus ?\261) - (twosuperior ?\262) - (threesuperior ?\263) - (acute ?\264) ; Why is there an acute keysym that is - (mu ?\265) ; distinct from apostrophe/quote, but - (paragraph ?\266) ; no grave keysym that is distinct from - (periodcentered ?\267) ; backquote? - (cedilla ?\270) ; I've added the grave keysym, because it's - (onesuperior ?\271) ; used in x-compose (Heiko Muenkel). - (masculine ?\272) - (guillemotright ?\273) - (onequarter ?\274) - (onehalf ?\275) - (threequarters ?\276) - (questiondown ?\277) - - (Agrave ?\300) - (Aacute ?\301) - (Acircumflex ?\302) - (Atilde ?\303) - (Adiaeresis ?\304) - (Aring ?\305) - (AE ?\306) - (Ccedilla ?\307) - (Egrave ?\310) - (Eacute ?\311) - (Ecircumflex ?\312) - (Ediaeresis ?\313) - (Igrave ?\314) - (Iacute ?\315) - (Icircumflex ?\316) - (Idiaeresis ?\317) - (ETH ?\320) - (Ntilde ?\321) - (Ograve ?\322) - (Oacute ?\323) - (Ocircumflex ?\324) - (Otilde ?\325) - (Odiaeresis ?\326) - (multiply ?\327) - (Ooblique ?\330) - (Ugrave ?\331) - (Uacute ?\332) - (Ucircumflex ?\333) - (Udiaeresis ?\334) - (Yacute ?\335) - (THORN ?\336) - (ssharp ?\337) - - (agrave ?\340) - (aacute ?\341) - (acircumflex ?\342) - (atilde ?\343) - (adiaeresis ?\344) - (aring ?\345) - (ae ?\346) - (ccedilla ?\347) - (egrave ?\350) - (eacute ?\351) - (ecircumflex ?\352) - (ediaeresis ?\353) - (igrave ?\354) - (iacute ?\355) - (icircumflex ?\356) - (idiaeresis ?\357) - (eth ?\360) - (ntilde ?\361) - (ograve ?\362) - (oacute ?\363) - (ocircumflex ?\364) - (otilde ?\365) - (odiaeresis ?\366) - (division ?\367) - (oslash ?\370) - (ugrave ?\371) - (uacute ?\372) - (ucircumflex ?\373) - (udiaeresis ?\374) - (yacute ?\375) - (thorn ?\376) - (ydiaeresis ?\377) - - ) - -((macro . (lambda (&rest syms-and-iso8859/1-codes) - (cons 'progn - (mapcar '(lambda (sym-and-code) - (list 'put (list 'quote (car sym-and-code)) - ''x-iso8859/1 (car (cdr sym-and-code)))) - syms-and-iso8859/1-codes)))) - ;; - ;; Let's do the appropriate thing for some vendor-specific keysyms too... - ;; Apparently nobody agrees on what the names of these keysyms are. - ;; - (SunFA_Acute ?\264) - (SunXK_FA_Acute ?\264) - (Dacute_accent ?\264) - (DXK_acute_accent ?\264) - (hpmute_acute ?\264) - (hpXK_mute_acute ?\264) - (XK_mute_acute ?\264) - - (SunFA_Grave ?`) - (Dead_Grave ?`) - (SunXK_FA_Grave ?`) - (Dgrave_accent ?`) - (DXK_grave_accent ?`) - (hpmute_grave ?`) - (hpXK_mute_grave ?`) - (XK_mute_grave ?`) - - (SunFA_Cedilla ?\270) - (SunXK_FA_Cedilla ?\270) - (Dcedilla_accent ?\270) - (DXK_cedilla_accent ?\270) - - (SunFA_Diaeresis ?\250) - (SunXK_FA_Diaeresis ?\250) - (hpmute_diaeresis ?\250) - (hpXK_mute_diaeresis ?\250) - (XK_mute_diaeresis ?\250) - - (SunFA_Circum ?^) - (Dead_Circum ?^) - (SunXK_FA_Circum ?^) - (Dcircumflex_accent ?^) - (DXK_circumflex_accent ?^) - (hpmute_asciicircum ?^) - (hpXK_mute_asciicircum ?^) - (XK_mute_asciicircum ?^) - - (SunFA_Tilde ?~) - (Dead_Tilde ?~) - (SunXK_FA_Tilde ?~) - (Dtilde ?~) - (DXK_tilde ?~) - (hpmute_asciitilde ?~) - (hpXK_mute_asciitilde ?~) - (XK_mute_asciitilde ?~) - - (Dring_accent ?\260) - (DXK_ring_accent ?\260) - ) - -(provide 'x-iso8859-1) - -;;; x-iso8859-1.el ends here
--- a/nt/ChangeLog Wed Dec 26 17:30:16 2007 +0100 +++ b/nt/ChangeLog Sun Jan 20 13:09:58 2008 +0100 @@ -1,3 +1,13 @@ +2008-01-18 Vin Shelton <acs@xemacs.org> + + * xemacs.mak: Use debug version of Intel's libm, if appropriate. + +2008-01-17 Vin Shelton <acs@xemacs.org> + + * config.inc.samp: Added USE_INTEL_COMPILER to support the Intel + compiler. + * xemacs.mak: Use USE_INTEL_COMPILER. + 2007-10-15 Adrian Aichner <adrian@xemacs.org> * xemacs.mak (INFO_FILES): Sync nt/xemacs.mak and man/Makefile
--- a/nt/config.inc.samp Wed Dec 26 17:30:16 2007 +0100 +++ b/nt/config.inc.samp Sun Jan 20 13:09:58 2008 +0100 @@ -257,3 +257,6 @@ # *AND CURRENTLY HAPPENS WITH VC++*, at least when using pdump. Therefore, # be warned! USE_UNION_TYPE=0 + +# Set this to build XEmacs with the Intel C Compiler. +USE_INTEL_COMPILER=0
--- a/nt/xemacs.mak Wed Dec 26 17:30:16 2007 +0100 +++ b/nt/xemacs.mak Sun Jan 20 13:09:58 2008 +0100 @@ -195,8 +195,11 @@ !if !defined(SUPPORT_EDIT_AND_CONTINUE) SUPPORT_EDIT_AND_CONTINUE=0 !endif +!if !defined(BUILD_FOR_SETUP_KIT) +BUILD_FOR_SETUP_KIT=0 +!endif -!if !defined(BUILD_FOR_SETUP_KIT) || "$(BUILD_FOR_SETUP_KIT)" == "0" +!if !$(BUILD_FOR_SETUP_KIT) OK_TO_USE_MSVCRTD=1 !else OK_TO_USE_MSVCRTD=0 @@ -658,6 +661,16 @@ $(OUTDIR)\ntheap.obj $(OUTDIR)\vm-limit.obj !endif +!if $(USE_INTEL_COMPILER) +CC=icl +# Use static library if possible +INTEL_LIBS=libircmt.lib libmmt.lib +# Debugging requires DLL version of libm +!if $(DEBUG_XEMACS) +INTEL_LIBS=libircmt.lib libmmd.lib +!endif +!endif + ########################### Process options related to compilation. # @@ -1290,7 +1303,7 @@ TEMACS_LIBS=$(LASTFILE) $(OPT_LIBS) \ oldnames.lib kernel32.lib user32.lib gdi32.lib comdlg32.lib advapi32.lib \ shell32.lib wsock32.lib netapi32.lib winmm.lib winspool.lib ole32.lib \ - mpr.lib uuid.lib imm32.lib $(LIBC_LIB) + mpr.lib uuid.lib imm32.lib $(INTEL_LIBS) $(LIBC_LIB) TEMACS_COMMON_LFLAGS=-nologo $(LIBRARIES) $(DEBUG_FLAGS_LINK) \ -base:0x1000000 -stack:0x800000 $(TEMACS_ENTRYPOINT) -subsystem:windows \ -heap:0x00100000 -nodefaultlib $(PROFILE_FLAGS) setargv.obj
--- a/src/ChangeLog Wed Dec 26 17:30:16 2007 +0100 +++ b/src/ChangeLog Sun Jan 20 13:09:58 2008 +0100 @@ -28,6 +28,111 @@ occur in the buffer, given the buffer metadata about its contents. +2008-01-19 Aidan Kehoe <kehoea@parhasard.net> + + * dired.c (Ffile_attributes): If bignums are available, use them + for the file size when necessary. If they are not, be clearer + about the check for whether the file size can fit in a Lisp + integer. + +2008-01-18 Jerry James <james@xemacs.org> + + * device-x.c (x_init_device): Don't write to path or read from + format when neither has been initialized. + +2008-01-16 Aidan Kehoe <kehoea@parhasard.net> + + * elhash.c (internal_hash): + Make short lists with the same contents in a different order hash + distinctly. Gives better performance for things like three-element + lists describing colours. Thank you Sebastian Freundt! + +2008-01-15 Aidan Kehoe <kehoea@parhasard.net> + + * print.c (prin1_to_string): New. + The guts of Fprin1_to_string, without resetting + Vprint_gensym_alist. + (Fprin1_to_string): + Call prin1_to_string, wrapped with RESET_PRINT_GENSYM calls. + * doprnt.c (emacs_doprnt_1): + Call prin1_to_string, not Fprin1_to_string (dos veces). Avoids an + inappropriate reset of print-gensym-alist. + +2008-01-12 Aidan Kehoe <kehoea@parhasard.net> + + * rangetab.c (Fmap_range_table): + Clarify docstring. (If FUNCTION doesn't touch any range-table + entry, things will also be correct.) + +2008-01-09 Aidan Kehoe <kehoea@parhasard.net> + + * config.h.in: + Check that __STDC_VERSION__ is defined before examining its + value. Eliminates a Cygwin warning. + +2008-01-08 Aidan Kehoe <kehoea@parhasard.net> + + * text.h (MAX_XETCHAR_SIZE): Remove, eliminating a redefinition + warning on Win32. + * dumper.c (pdump_load): + Don't use PATH_MAX_EXTERNAL, instead allocate enough for the path + + DUMP_SLACK (space for .dmp and version information), already + used on Win32 and #defined to be 100. + +2008-01-08 Jerry James <james@xemacs.org> + + * config.h.in (INLINE_HEADER): adapt to C99 inline semantics. + +2008-01-07 Jerry James <james@xemacs.org> + + * xemacs.def.in.in: Clarify the copyright and license. + +2008-01-03 Aidan Kehoe <kehoea@parhasard.net> + + * fileio.c (Fmake_temp_name): Correct the comment to cross + reference to make-temp-file, and not to this function. + +2008-01-03 Stephen J. Turnbull <stephen@xemacs.org> + + * doc.c (Fbuilt_in_symbol_file): Improve style. + +2008-01-02 Aidan Kehoe <kehoea@parhasard.net> + + * emacs.c (main_1): + Call the new vars_of_console_gtk function. + * console-gtk.c (vars_of_console_gtk): New. + * console-gtk.c (gtk_perhaps_init_unseen_key_defaults): + Correct the initialisation of the hash table, on the model of the + MSW and TTY builds. + +2008-01-02 Aidan Kehoe <kehoea@parhasard.net> + + * doc.c (Fbuilt_in_symbol_file): + Don't check is fun zero in the condition, check that it's not + nil. Fixes the union build; thank you Stephen. + +2008-01-02 Mike Sperber <mike@xemacs.org> + + * window.c (set_window_pixsize): Factor in the modeline when + looking at window_min_width. Remove obsolete comment about + incorrect use of `default_face_height_and_width'. + (change_window_height): Remove obsolete comment about + incorrect use of `default_face_height_and_width'. + +2007-12-30 Aidan Kehoe <kehoea@parhasard.net> + + * doc.c (Fbuilt_in_symbol_file): + Take a new TYPE argument, specifying whether the function or + variable definition of the symbol should be searched for. + Handle built-in macros correctly. + +2007-12-24 Aidan Kehoe <kehoea@parhasard.net> + + * event-xlike-inc.c (x_keysym_to_character): + * event-xlike-inc.c (gtk_keysym_to_character): + Unify the typed character if possible, following the current value + for the unicode precedence list. + 2007-12-24 Aidan Kehoe <kehoea@parhasard.net> * symbols.c (Fintern_soft):
--- a/src/config.h.in Wed Dec 26 17:30:16 2007 +0100 +++ b/src/config.h.in Sun Jan 20 13:09:58 2008 +0100 @@ -1086,7 +1086,8 @@ Use `inline static' to define inline functions in .c files. See the Internals manual for examples and more information. */ -#if defined (__cplusplus) || ! defined (__GNUC__) || ! defined(emacs) +#if (defined ( __STDC_VERSION__) && __STDC_VERSION__ >= 199901L) \ + || defined (__cplusplus) || ! defined (__GNUC__) || ! defined(emacs) # define INLINE_HEADER inline static #elif defined (DONT_EXTERN_INLINE_HEADER_FUNCTIONS) # define INLINE_HEADER inline
--- a/src/console-gtk.c Wed Dec 26 17:30:16 2007 +0100 +++ b/src/console-gtk.c Sun Jan 20 13:09:58 2008 +0100 @@ -39,6 +39,8 @@ DEFINE_CONSOLE_TYPE (gtk); +Lisp_Object Vgtk_seen_characters; + static int gtk_initially_selected_for_input (struct console *UNUSED (con)) { @@ -122,13 +124,11 @@ Lisp_Object key) { Lisp_Object char_to_associate = Qnil; - extern Lisp_Object Vcurrent_global_map, Qgtk_seen_characters, - Qcharacter_of_keysym; + extern Lisp_Object Vcurrent_global_map, Qcharacter_of_keysym; if (SYMBOLP(key)) { gchar *symbol_name; - guint keyval; DECLARE_EISTRING(ei_symname); eicpy_rawz(ei_symname, XSTRING_DATA(symbol_name(XSYMBOL(key)))); @@ -154,21 +154,22 @@ else { CHECK_CHAR(key); + char_to_associate = key; } - if (!(HASH_TABLEP(Qgtk_seen_characters))) + if (!(HASH_TABLEP(Vgtk_seen_characters))) { - Qgtk_seen_characters = make_lisp_hash_table (128, HASH_TABLE_NON_WEAK, + Vgtk_seen_characters = make_lisp_hash_table (128, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); } /* Might give the user an opaque error if make_lisp_hash_table fails, but it shouldn't crash. */ - CHECK_HASH_TABLE(Qgtk_seen_characters); + CHECK_HASH_TABLE(Vgtk_seen_characters); if (EQ(char_to_associate, Qnil) /* If there's no char to bind, */ || (XCHAR(char_to_associate) < 0x80) /* or it's ASCII */ - || !NILP(Fgethash(key, Qgtk_seen_characters, Qnil))) /* Or we've seen + || !NILP(Fgethash(key, Vgtk_seen_characters, Qnil))) /* Or we've seen it already, */ { /* then don't bind the key. */ @@ -177,7 +178,7 @@ if (NILP (Flookup_key (Vcurrent_global_map, key, Qnil))) { - Fputhash(key, Qt, Qgtk_seen_characters); + Fputhash(key, Qt, Vgtk_seen_characters;) Fdefine_key (Vcurrent_global_map, key, Qself_insert_command); if (SYMBOLP(key)) { @@ -209,3 +210,10 @@ { REINITIALIZE_CONSOLE_TYPE (gtk); } + +void +vars_of_console_gtk (void) +{ + staticpro (&Vgtk_seen_characters); + Vgtk_seen_characters = Qnil; +}
--- a/src/device-x.c Wed Dec 26 17:30:16 2007 +0100 +++ b/src/device-x.c Sun Jan 20 13:09:58 2008 +0100 @@ -703,6 +703,10 @@ path = alloca_extbytes (strlen (data_dir) + 13 + strlen (locale) + 7); format = "%sapp-defaults/%s/Emacs"; } + else + { + goto no_data_directory; + } /* * The general form for $LANG is <language>_<country>.<encoding>. Try @@ -730,6 +734,7 @@ XrmCombineFileDatabase (path, &db, False); } + no_data_directory: xfree (locale, Extbyte*); } #endif /* MULE */
--- a/src/dired.c Wed Dec 26 17:30:16 2007 +0100 +++ b/src/dired.c Sun Jan 20 13:09:58 2008 +0100 @@ -824,7 +824,7 @@ First integer has high-order 16 bits of time, second has low 16 bits. 5. Last modification time, likewise. 6. Last status change time, likewise. - 7. Size in bytes. (-1, if number is out of range). + 7. Size in bytes. (-1, if number out of range and no bignum support.) 8. File modes, as a string of ten letters or dashes as in ls -l. 9. t iff file's gid would change if file were deleted and recreated. 10. inode number. @@ -900,11 +900,14 @@ values[4] = make_time (s.st_atime); values[5] = make_time (s.st_mtime); values[6] = make_time (s.st_ctime); - values[7] = make_int ((EMACS_INT) s.st_size); - /* If the size is out of range, give back -1. */ - /* #### Fix when Emacs gets bignums! */ - if (XINT (values[7]) != s.st_size) - values[7] = make_int (-1); + +#ifndef HAVE_BIGNUM + values[7] = make_integer (NUMBER_FITS_IN_AN_EMACS_INT (s.st_size) ? + (EMACS_INT)s.st_size : -1); +#else + values[7] = make_integer (s.st_size); +#endif + filemodestring (&s, modes); values[8] = make_string ((Ibyte *) modes, 10); #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
--- a/src/doc.c Wed Dec 26 17:30:16 2007 +0100 +++ b/src/doc.c Sun Jan 20 13:09:58 2008 +0100 @@ -37,7 +37,7 @@ Lisp_Object Vinternal_doc_file_name; -Lisp_Object QSsubstitute; +Lisp_Object QSsubstitute, Qdefvar; /* Work out what source file a function or variable came from, taking the information from the documentation file. */ @@ -499,21 +499,27 @@ weirdness, type, XSTRING_DATA (XSYMBOL (sym)->name), pos); } -DEFUN ("built-in-symbol-file", Fbuilt_in_symbol_file, 1, 1, 0, /* +DEFUN ("built-in-symbol-file", Fbuilt_in_symbol_file, 1, 2, 0, /* Return the C source file built-in symbol SYM comes from. Don't use this. Use the more general `symbol-file' (q.v.) instead. + +If TYPE is nil or omitted, any kind of definition is acceptable. +If TYPE is `defun', then function, subr, special form or macro definitions +are acceptable. +If TYPE is `defvar', then variable definitions are acceptable. */ - (symbol)) + (symbol, type)) { /* This function can GC */ Lisp_Object fun; Lisp_Object filename = Qnil; - if (EQ(Ffboundp(symbol), Qt)) + if (EQ(Ffboundp(symbol), Qt) && (EQ(type, Qnil) || EQ(type, Qdefun))) { fun = Findirect_function (symbol); - if (SUBRP (fun)) + if (SUBRP (fun) || (CONSP(fun) && (EQ (Qmacro, Fcar_safe (fun))) + && (fun = Fcdr_safe (fun), SUBRP (fun)))) { if (XSUBR (fun)->doc == 0) return Qnil; @@ -529,7 +535,7 @@ (make_int (- (EMACS_INT) XSUBR (fun)->doc)); } } - else if (EQ(Fboundp(symbol), Qt)) + else if (EQ(Fboundp(symbol), Qt) && (EQ(type, Qnil) || EQ(type, Qdefvar))) { Lisp_Object doc_offset = Fget (symbol, Qvariable_documentation, Qnil); @@ -1273,6 +1279,8 @@ DEFSUBR (Fsnarf_documentation); DEFSUBR (Fverify_documentation); DEFSUBR (Fsubstitute_command_keys); + + DEFSYMBOL (Qdefvar); } void
--- a/src/doprnt.c Wed Dec 26 17:30:16 2007 +0100 +++ b/src/doprnt.c Sun Jan 20 13:09:58 2008 +0100 @@ -558,7 +558,7 @@ { /* For `S', prin1 the argument and then treat like a string. */ - ls = Fprin1_to_string (obj, Qnil); + ls = prin1_to_string (obj, 0); } else if (STRINGP (obj)) ls = obj; @@ -567,7 +567,7 @@ else { /* convert to string using princ. */ - ls = Fprin1_to_string (obj, Qt); + ls = prin1_to_string (obj, 1); } string = XSTRING_DATA (ls); string_len = XSTRING_LENGTH (ls);
--- a/src/dumper.c Wed Dec 26 17:30:16 2007 +0100 +++ b/src/dumper.c Sun Jan 20 13:09:58 2008 +0100 @@ -2630,6 +2630,8 @@ return 0; } +#define DUMP_SLACK 100 /* Enough to include dump ID, version name, .DMP */ + int pdump_load (const Wexttext *argv0) { @@ -2637,7 +2639,6 @@ Wexttext *exe_path = NULL; int bufsize = 4096; int cchpathsize; -#define DUMP_SLACK 100 /* Enough to include dump ID, version name, .DMP */ /* Copied from mswindows_get_module_file_name (). Not clear if it's kosher to malloc() yet. */ @@ -2659,7 +2660,7 @@ wext_strcpy (exe_path, wexe); } #else /* !WIN32_NATIVE */ - Wexttext exe_path[PATH_MAX_EXTERNAL]; + Wexttext *exe_path; Wexttext *w; const Wexttext *dir, *p; @@ -2694,13 +2695,17 @@ { /* invocation-name includes a directory component -- presumably it is relative to cwd, not $PATH. */ + exe_path = alloca_array (Wexttext, 1 + wext_strlen (dir) + DUMP_SLACK); wext_strcpy (exe_path, dir); } else { const Wexttext *path = wext_getenv ("PATH"); /* not egetenv -- - not yet init. */ + not yet init. */ const Wexttext *name = p; + exe_path = alloca_array (Wexttext, + 1 + DUMP_SLACK + max (wext_strlen (name), + wext_strlen (path))); for (;;) { p = path;
--- a/src/elhash.c Wed Dec 26 17:30:16 2007 +0100 +++ b/src/elhash.c Sun Jan 20 13:09:58 2008 +0100 @@ -1719,12 +1719,33 @@ { if (depth > 5) return 0; - if (CONSP (obj)) + + if (CONSP(obj)) { - /* no point in worrying about tail recursion, since we're not - going very deep */ - return HASH2 (internal_hash (XCAR (obj), depth + 1), - internal_hash (XCDR (obj), depth + 1)); + Hashcode hash, h; + int s; + + depth += 1; + + if (!CONSP(XCDR(obj))) + { + /* special case for '(a . b) conses */ + return HASH2(internal_hash(XCAR(obj), depth), + internal_hash(XCDR(obj), depth)); + } + + /* Don't simply tail recurse; we want to hash lists with the + same contents in distinct orders differently. */ + hash = internal_hash(XCAR(obj), depth); + + obj = XCDR(obj); + for (s = 1; s < 6 && CONSP(obj); obj = XCDR(obj), s++) + { + h = internal_hash(XCAR(obj), depth); + hash = HASH3(hash, h, s); + } + + return hash; } if (STRINGP (obj)) {
--- a/src/emacs.c Wed Dec 26 17:30:16 2007 +0100 +++ b/src/emacs.c Sun Jan 20 13:09:58 2008 +0100 @@ -2162,6 +2162,7 @@ #ifdef HAVE_GTK vars_of_device_gtk (); + vars_of_console_gtk (); #ifdef HAVE_DIALOGS vars_of_dialog_gtk (); #endif
--- a/src/event-xlike-inc.c Wed Dec 26 17:30:16 2007 +0100 +++ b/src/event-xlike-inc.c Sun Jan 20 13:09:58 2008 +0100 @@ -708,7 +708,15 @@ return Qnil; #ifdef MULE - return make_char (make_ichar (charset, code, 0)); + { + Lisp_Object unified = Funicode_to_char + (Fchar_to_unicode (make_char (make_ichar (charset, code, 0))), Qnil); + if (!NILP (unified)) + { + return unified; + } + return make_char (make_ichar (charset, code, 0)); + } #else return make_char (code + 0x80); #endif
--- a/src/fileio.c Wed Dec 26 17:30:16 2007 +0100 +++ b/src/fileio.c Sun Jan 20 13:09:58 2008 +0100 @@ -628,7 +628,7 @@ This function is analagous to mktemp(3) under POSIX, and as with it, there exists a race condition between the test for the existence of the new file -and its creation. See `make-temp-name' for a function which avoids this +and its creation. See `make-temp-file' for a function which avoids this race condition by specifying the appropriate flags to `write-region'. */ (prefix))
--- a/src/lisp.h Wed Dec 26 17:30:16 2007 +0100 +++ b/src/lisp.h Sun Jan 20 13:09:58 2008 +0100 @@ -4932,6 +4932,7 @@ EXFUN (Fprinc, 2); EXFUN (Fprint, 2); +Lisp_Object prin1_to_string (Lisp_Object, int); /* Lower-level ways to output data: */ void default_object_printer (Lisp_Object, Lisp_Object, int);
--- a/src/print.c Wed Dec 26 17:30:16 2007 +0100 +++ b/src/print.c Sun Jan 20 13:09:58 2008 +0100 @@ -867,6 +867,26 @@ return object; } +Lisp_Object +prin1_to_string (Lisp_Object object, int noescape) +{ + /* This function can GC */ + Lisp_Object result = Qnil; + Lisp_Object stream = make_resizing_buffer_output_stream (); + Lstream *str = XLSTREAM (stream); + /* gcpro OBJECT in case a caller forgot to do so */ + struct gcpro gcpro1, gcpro2, gcpro3; + GCPRO3 (object, stream, result); + + print_internal (object, stream, !noescape); + Lstream_flush (str); + UNGCPRO; + result = make_string (resizing_buffer_stream_ptr (str), + Lstream_byte_count (str)); + Lstream_delete (str); + return result; +} + DEFUN ("prin1-to-string", Fprin1_to_string, 1, 2, 0, /* Return a string containing the printed representation of OBJECT, any Lisp object. Quoting characters are used when needed to make output @@ -877,20 +897,11 @@ { /* This function can GC */ Lisp_Object result = Qnil; - Lisp_Object stream = make_resizing_buffer_output_stream (); - Lstream *str = XLSTREAM (stream); - /* gcpro OBJECT in case a caller forgot to do so */ - struct gcpro gcpro1, gcpro2, gcpro3; - GCPRO3 (object, stream, result); RESET_PRINT_GENSYM; - print_internal (object, stream, NILP (noescape)); + result = prin1_to_string (object, !(EQ(noescape, Qnil))); RESET_PRINT_GENSYM; - Lstream_flush (str); - UNGCPRO; - result = make_string (resizing_buffer_stream_ptr (str), - Lstream_byte_count (str)); - Lstream_delete (str); + return result; }
--- a/src/rangetab.c Wed Dec 26 17:30:16 2007 +0100 +++ b/src/rangetab.c Sun Jan 20 13:09:58 2008 +0100 @@ -571,7 +571,8 @@ Results are guaranteed to be correct (i.e. each entry processed exactly once) if FUNCTION modifies or deletes the current entry \(i.e. passes the current range to `put-range-table' or -`remove-range-table'), but not otherwise. +`remove-range-table'). If FUNCTION modifies or deletes any other entry, +this guarantee doesn't hold. */ (function, range_table)) {
--- a/src/text.h Wed Dec 26 17:30:16 2007 +0100 +++ b/src/text.h Sun Jan 20 13:09:58 2008 +0100 @@ -2988,7 +2988,6 @@ /* Extra indirection needed in case of manifest constant as arg */ #define WEXTSTRING_1(arg) L##arg #define WEXTSTRING(arg) WEXTSTRING_1(arg) -#define MAX_XETCHAR_SIZE sizeof (WCHAR) #define wext_strlen wcslen #define wext_strcmp wcscmp #define wext_strncmp wcsncmp @@ -3014,7 +3013,6 @@ #else #define WEXTTEXT_ZTERM_SIZE sizeof (char) #define WEXTSTRING(arg) arg -#define MAX_XETCHAR_SIZE sizeof (char) #define wext_strlen strlen #define wext_strcmp strcmp #define wext_strncmp strncmp
--- a/src/window.c Wed Dec 26 17:30:16 2007 +0100 +++ b/src/window.c Sun Jan 20 13:09:58 2008 +0100 @@ -3520,8 +3520,6 @@ int line_size; int defheight, defwidth; - /* #### This is very likely incorrect and instead the char_to_pixel_ - functions should be called. */ default_face_height_and_width (window, &defheight, &defwidth); line_size = (set_height ? defheight : defwidth); @@ -3532,7 +3530,7 @@ if (!nodelete && !TOP_LEVEL_WINDOW_P (w) - && new_pixsize < minsize) + && (new_pixsize + window_modeline_height (w)) < minsize) { Fdelete_window (window, Qnil); return; @@ -4369,8 +4367,6 @@ if (EQ (window, FRAME_ROOT_WINDOW (f))) invalid_operation ("Won't change only window", Qunbound); - /* #### This is very likely incorrect and instead the char_to_pixel_ - functions should be called. */ default_face_height_and_width (window, &defheight, &defwidth); while (1)
--- a/src/xemacs.def.in.in Wed Dec 26 17:30:16 2007 +0100 +++ b/src/xemacs.def.in.in Sun Jan 20 13:09:58 2008 +0100 @@ -1,4 +1,23 @@ -/* Put the usual header here */ +/* The module API: core symbols that are visible to modules. + Copyright (C) 2008 Jerry James + +This file is part of XEmacs. + +XEmacs 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. + +XEmacs 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 XEmacs; see the file COPYING. If not, write to the +Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + /* The symbol to import/export is on the left. If the symbol is not meant to be used directly, but a macro or inline function in the API expands to a form containing the symbol, then the macro or
--- a/tests/ChangeLog Wed Dec 26 17:30:16 2007 +0100 +++ b/tests/ChangeLog Sun Jan 20 13:09:58 2008 +0100 @@ -1,3 +1,41 @@ +2008-01-16 Aidan Kehoe <kehoea@parhasard.net> + + * automated/mule-tests.el (test-file-name): + Call #'make-temp-file now it's available. Remove a long comment + saying, essentially, that it should be used, not + #'make-temp-name. + +2008-01-16 Aidan Kehoe <kehoea@parhasard.net> + + * automated/hash-table-tests.el: + Assert that two short lists with the same contents in distinct + orders hash differently. + +2008-01-15 Aidan Kehoe <kehoea@parhasard.net> + + * automated/lisp-tests.el (literal-with-uninterned): + Use ?\x syntax for Latin-1 characters, don't assume that the file + will be read as UTF-8. + +2008-01-15 Aidan Kehoe <kehoea@parhasard.net> + + * automated/lisp-tests.el (thing): + Check that printing a hash table literal doesn't clear + print-gensym-alist. + +2008-01-03 Stephen J. Turnbull <stephen@xemacs.org> + + * automated/symbol-tests.el (Symbol documentation): Add tests to + check documentation extraction. + +2007-12-29 Stephen J. Turnbull <stephen@xemacs.org> + + * automated/test-harness.el (test-harness-test-compiled): + Improve docstring. + + * automated/weak-tests.el (test-harness-test-compiled): + Remove debugging code. + 2007-12-21 Stephen J. Turnbull <stephen@xemacs.org> * reproduce-crashes.el: Renamed from reproduce-bugs.el. Update to-do.
--- a/tests/automated/hash-table-tests.el Wed Dec 26 17:30:16 2007 +0100 +++ b/tests/automated/hash-table-tests.el Sun Jan 20 13:09:58 2008 +0100 @@ -281,3 +281,4 @@ ;;; Test sxhash (Assert (= (sxhash "foo") (sxhash "foo"))) (Assert (= (sxhash '(1 2 3)) (sxhash '(1 2 3)))) +(Assert (/= (sxhash '(1 2 3)) (sxhash '(3 2 1))))
--- a/tests/automated/lisp-tests.el Wed Dec 26 17:30:16 2007 +0100 +++ b/tests/automated/lisp-tests.el Sun Jan 20 13:09:58 2008 +0100 @@ -1299,3 +1299,17 @@ ;; Check all-completions ignore element start with space. (Assert (not (all-completions "" '((" hidden" . "object"))))) (Assert (all-completions " " '((" hidden" . "object")))) + +(let* ((literal-with-uninterned + '(first-element + [#1=#:G32976 #2=#:G32974 #3=#:G32971 #4=#:G32969 alias + #s(hash-table size 256 data (969 ?\xF9 55 ?7 166 ?\xA6)) + #5=#:G32970 #6=#:G32972])) + (print-readably t) + (print-gensym t) + (printed-with-uninterned (prin1-to-string literal-with-uninterned)) + (awkward-regexp "#1=#") + (first-match-start (string-match awkward-regexp + printed-with-uninterned))) + (Assert (null (string-match awkward-regexp printed-with-uninterned + (1+ first-match-start)))))
--- a/tests/automated/mule-tests.el Wed Dec 26 17:30:16 2007 +0100 +++ b/tests/automated/mule-tests.el Sun Jan 20 13:09:58 2008 +0100 @@ -118,21 +118,8 @@ ;; Fixed 2007-06-22 <18043.2793.611745.734215@parhasard.net>. ;;---------------------------------------------------------------- -(let ((test-file-name - ;; The Gnus people, when they call #'make-temp-name, then loop, - ;; checking if the corresponding file exists. Our #'make-temp-name - ;; already does this loop, and the Gnus approach doesn't bring - ;; anything; there remains a race condition if you can predict the - ;; path name. The path name in question depends on the process ID and - ;; a (weak) PRNG seeded with the seconds to the power of the - ;; milliseconds of some instant close to the startup time of this - ;; XEmacs; without being able to read the address space of this - ;; XEmacs, or monitor what stat() calls it does, it is not predictable. - ;; - ;; The really kosher way to do this is to merge GNU's make-temp-file - ;; and use that. It basically has the functionality of the Unix - ;; mkstemp. - (make-temp-name (expand-file-name "tXfXsKc" (temp-directory)))) +(let ((test-file-name + (make-temp-file (expand-file-name "tXfXsKc" (temp-directory)))) revert-buffer-function kill-buffer-hook) ; paranoia (find-file test-file-name)
--- a/tests/automated/symbol-tests.el Wed Dec 26 17:30:16 2007 +0100 +++ b/tests/automated/symbol-tests.el Sun Jan 20 13:09:58 2008 +0100 @@ -332,3 +332,23 @@ ; (Assert (equal (catch 'test-tag ; (set mysym 'foo)) ; `(,mysym (foo) make-local nil nil)))) + +;; ---------------------------------------------------------------- +;; Symbol documentation +;; ---------------------------------------------------------------- + +;; built-in variable documentation +(Assert (string= (built-in-symbol-file 'internal-doc-file-name) + "doc.c")) + +;; built-in function documentation +(Assert (string= (built-in-symbol-file 'built-in-symbol-file) + "doc.c")) + +;; built-in macro documentation +(Assert (string= (built-in-symbol-file 'when) + "eval.c")) + +;; #### we should handle symbols defined in Lisp, dumped, autoloaded, +;; and required, too. +
--- a/tests/automated/test-harness.el Wed Dec 26 17:30:16 2007 +0100 +++ b/tests/automated/test-harness.el Sun Jan 20 13:09:58 2008 +0100 @@ -71,7 +71,17 @@ (defvar unexpected-test-file-failures) (defvar test-harness-test-compiled nil - "Non-nil means the test code was compiled before execution.") + "Non-nil means the test code was compiled before execution. + +You probably should not make tests depend on compilation. +However, it can be useful to conditionally change messages based on whether +the code was compiled or not. For example, the case that motivated the +implementation of this variable: + +\(when test-harness-test-compiled + ;; this ha-a-ack depends on the failing compiled test coming last + \(setq test-harness-failure-tag + \"KNOWN BUG - fix reverted; after 2003-10-31 notify stephen\n\"))") (defvar test-harness-verbose (and (not noninteractive) (> (device-baud-rate) search-slow-speed))
--- a/tests/automated/weak-tests.el Wed Dec 26 17:30:16 2007 +0100 +++ b/tests/automated/weak-tests.el Sun Jan 20 13:09:58 2008 +0100 @@ -36,11 +36,6 @@ (push (file-name-directory load-file-name) load-path) (require 'test-harness)))) -(when test-harness-test-compiled - ;; this ha-a-ack depends on the compiled test coming last - (setq test-harness-failure-tag - "KNOWN BUG - fix reverted; after 2003-10-31 bitch at stephen\n")) - (garbage-collect) ;; tests for weak-boxes