Mercurial > hg > xemacs-beta
changeset 502:7039e6323819
[xemacs-hg @ 2001-05-04 22:41:46 by ben]
----------------------- byte-comp warning fixes -----------------
New functions for cleanly eliminating byte-compiler warnings.
Their definitions require no changes at all in bytecomp.el,
meaning that any package that wants to use them and be compatible
with older versions of XEmacs need only copy the code and rename
the functions (i.e. prefix them with the package name).
Eliminate byte-compiler warnings using the new functions in
bytecomp-runtime.el.
Move coding-system-put,get,category, since they're not
Mule-specific and are used in prefer-coding-system.
font.el was incredibly ugly. Clean it up. Avoid using defsubst
for any exported functions, to avoid possible compatibility
problems if we later change the internal interface. (It happened
before, with face accessors, between 19.8 and 19.9). Fix tons
of warnings.
Clean up (new function gpm-is-supported-p eliminates duplicate
code in gpm-create/delete-device-hook) and eliminate warnings.
---------- make byte-recompile-directory work in the ---------
core `lisp' dir, even in the absence of
a Mule XEmacs (i.e. make it skip the Mule
files rather than trying to compile them).
now you should be able to do `touch *.el'
in the `lisp' dir, then
M-x byte-recompile-directory, and get no
warnings.
Avoid trying to compile Mule files in byte-recompile-directory
when we're not in a Mule XEmacs, since we're highly likely to get
syntax errors.
Add a coding-system cookie to all Mule files so that
byte-recompile-directory ignores them.
Magic cookie function moved to files.el from code-files.el (for
use by bytecomp even in a non-coding-system XEmacs), and changed
names and semantics for use by bytecomp. NOTE: IMO this is an
internal function that we can change as we like (and there is
absolutely no code anywhere else using the function).
---------------- GUI improvements: menus, help -------------------
Rearrange order of keymap declarations to be alphabetical.
Improve help on help to include all bindings, and group by
category. Add bindings for new Info commands. Remove
warnings. Use command-hyper-apropos in place of command-apropos.
Add a function to do the equivalent of command-apropos.
Evals its help-text argument so you can put expressions there.
Used now by help-for-help.
Add binding to continue text searches. Expand index searches to
work over multiple info documents. Add commands to search
text/index in User and Lispref.
Add new entry, "Uncomment Region" (parallels "Comment Out Region").
Redo Help menu; add bindings for new Info commands to search the
index or text of the User and Lispref manuals. Add command for
mark-paragraph, activate-region. Make Edit->R accelerator be
rectangle, not register (more commonly used), and put rectangle
first. Fix the Edit Init File entry to never load the .elc file.
Simplify the default-popup-menu. Add Cmds->Tabs menu.
Use kp-left not kp_left, etc.
---------------- Miscellaneous bug fixes/cleanup -------------------
byte-compiler-options: Correct doc string.
easy-menu-do-define: fix extra quote.
fill-paragraph-or-region:Rewrite to be more correct -- use
call-interactively so that we always get exactly the same
behavior as if the functions were called directly.
No need to fiddle with zmacs-region-stays, now that bogus
clearing of it (2001-04-28 src/ChangeLog) is removed.
Put dialog titles back in -- this time correctly. Fix various
other problems with leaks and such.
key-sequence-list-description:
Clean up fun to always correctly canonicalize.
Clean up Kinsoku comments, synch comment-region with FSF 20.7.
* simple.el (region-exists-p):
* simple.el (region-active-p):
Add comment about which one is correct to use in menu specs.
* sound.el (load-sound-file):
Minor code clean up.
* startup.el:
* startup.el (command-line-early):
* startup.el (initial-scratch-message):
Comment changes. Add info about sample.init.el to splash screen.
Improve initial-scratch-message and clarify purpose of Scratch
buffer. Fix byte-compile warning.
------------------------ Added features -------------------------
Add new variable to control whether etags checks all parent
directories for tag files. (On by default.)
* hash-table.el: New file, useful utility functions.
* dumped-lisp.el (preloaded-file-list): Dump hash-table.el.
------------ notable bug fix: Windows event code --------------
Get critical quit working.
------------ notable bug fix and new feature: regex code --------------
Shy groups were implemented in a horrible, half-assed way that
would cause them to screw up regex searching in most cases.
Fixed to work correctly.
Also extended back-reference syntax past 9. Only is recognized
as such if there are at least that many non-shy groups; and
optionally will warn about such uses, to catch old code that
might be using them differently. (Added variable to control
this in search.c -- `warn-about-possibly-incompatible-back-
references', on by default for the moment. Declared in lisp.h.
---------------- process/SIGIO improvements -------------------
define USE_GETADDRINFO to replace more complex conditional,
and use it. the code conditionalized on this in
unix_open_network_stream had *serious* problems handling errors.
it's now fixed, and major amounts of duplicate code between
the two versions were combined.
don't disable SIGIO and other interrupts unless
CONNECT_NEEDS_SLOWED_INTERRUPTS is defined -- don't penalize OS's
without bugs. similarly for a freebsd bug that was affecting all
OS's.
* s\ultrix.h:
define CONNECT_NEEDS_SLOWED_INTERRUPTS, since that's the OS
mentioned as having a kernel bug.
* sysdep.c (request_sigio_on_device):
* sysdep.c (unrequest_sigio_on_device):
fix SIGIO problems on Linux. add check for O_ASYNC in case it's
defined and FASYNC isn't. add comment about other ways to do
SIGIO on Linux.
* callproc.c (Fold_call_process_internal):
* process.c (Fstart_process_internal):
Deal with the possibility that `default-directory' doesn't
have terminating slash. Correct comments about vfork.
---------------- Miscellaneous bug fixes/cleanup -------------------
* callint.c (Finteractive):
Add lots of documentation -- exactly what the Lisp equivalents of
all the interactive specs are.
* console.h (struct console): change type of quit_char to Emchar.
* event-msw.c (lstream_type_create_mswindows_selectable): spacing
change.
Eliminate events-mod.h and combine into events.h.
* emacs.c:
* emacs.c (make_arg_list_1):
* emacs.c (main_1):
A couple of char->Extbyte changes, add a comment.
* glyphs-msw.c:
Correct indentation of function defns to not exceed 80 cols.
Try (sort of) to fix some code that sets the colors of the
progress gauge. (Commented out)
* keymap.c (syms_of_keymap):
use DEFSYMBOL.
* process.c (read_process_output):
No need to fiddle with zmacs_region_stays, now that bogus
clearing of it (see below) is removed.
* search.c (Freplace_match): warning fix.
line wrap: on
line diff
--- a/lib-src/ChangeLog Thu May 03 21:08:39 2001 +0000 +++ b/lib-src/ChangeLog Fri May 04 22:42:35 2001 +0000 @@ -1,3 +1,7 @@ +2001-04-29 Ben Wing <ben@xemacs.org> + + * gnuclient.c (filename_expand): Warning fix. + 2001-04-20 Ben Wing <ben@xemacs.org> * .cvsignore: Added stuff for Windows.
--- a/lib-src/gnuclient.c Thu May 03 21:08:39 2001 +0000 +++ b/lib-src/gnuclient.c Fri May 04 22:42:35 2001 +0000 @@ -195,6 +195,7 @@ { #ifdef CYGWIN char cygwinFilename[MAXPATHLEN+1]; + extern void cygwin_conv_to_posix_path(const char *, char *); #endif int len;
--- a/lisp/ChangeLog Thu May 03 21:08:39 2001 +0000 +++ b/lisp/ChangeLog Fri May 04 22:42:35 2001 +0000 @@ -1,3 +1,337 @@ +2001-04-22 Ben Wing <ben@xemacs.org> + + ----------------------- byte-comp warning fixes ----------------- + + * bytecomp-runtime.el: + * bytecomp-runtime.el (with-boundp): New. + * bytecomp-runtime.el (if-boundp): New. + * bytecomp-runtime.el (declare-boundp): New. + * bytecomp-runtime.el (globally-declare-boundp): New. + * bytecomp-runtime.el (byte-compile-with-fboundp): New. + * bytecomp-runtime.el ('with-fboundp-1): New. + * bytecomp-runtime.el (with-fboundp): New. + * bytecomp-runtime.el (if-fboundp): New. + * bytecomp-runtime.el (declare-fboundp): New. + * bytecomp-runtime.el (globally-declare-fboundp): New. + * bytecomp-runtime.el (byte-compile-with-byte-compiler-warnings-suppressed): New. + * bytecomp-runtime.el ('with-byte-compiler-warnings-suppressed-1): New. + * bytecomp-runtime.el (with-byte-compiler-warnings-suppressed): New. + * bytecomp-runtime.el (with-obsolete-variable): New. + * bytecomp-runtime.el (with-obsolete-function): New. + New functions for cleanly eliminating byte-compiler warnings. + Their definitions require no changes at all in bytecomp.el, + meaning that any package that wants to use them and be compatible + with older versions of XEmacs need only copy the code and rename + the functions (i.e. prefix them with the package name). + + * apropos.el (apropos-symbol-face): + * apropos.el (apropos-keybinding-face): + * apropos.el (apropos-label-face): + * apropos.el (apropos-property-face): + * cl-extra.el (cl-map-overlays): + * coding.el: + * coding.el (set-keyboard-coding-system): + * coding.el (set-terminal-coding-system): + * console.el (resume-pid-console): + * dialog-gtk.el: + * dialog-gtk.el (popup-builtin-open-dialog): + * dialog-gtk.el (popup-builtin-color-dialog): + * dragdrop.el (experimental-dragdrop-drop-mime-default): + * dragdrop.el (gtk-start-drag): + * dragdrop.el (gtk-start-drag-region): + * faces.el (init-face-from-resources): + * faces.el (init-device-faces): + * faces.el (init-frame-faces): + * faces.el (init-global-faces): + * faces.el (set-face-stipple): + * files.el (set-visited-file-name): + * files.el (basic-save-buffer): + * files.el (save-some-buffers-1): + * files.el (file-remote-p): + * fill.el (fill-move-forward-to-break-point): + * fill.el (find-space-insertable-point): + * font-lock.el: + * frame.el (suspend-or-iconify-emacs): + * frame.el (suspend-emacs-or-iconify-frame): + * gdk.el: + * generic-widgets.el: + * generic-widgets.el (build-ui::radio-group): + * generic-widgets.el (build-ui::button): + * glade.el: + * gnome-widgets.el: + * gnome.el: + * gtk-extra.el: + * gtk-faces.el (gtk-choose-font): + * gtk-file-dialog.el: + * gtk-file-dialog.el (gtk-file-dialog-fill-file-list): + * gtk-file-dialog.el (gtk-file-dialog-fill-directory-list): + * gtk-file-dialog.el (gtk-file-dialog-new): + * gtk-font-menu.el: + * gtk-font-menu.el (gtk-reset-device-font-menus): + * gtk-init.el: + * gtk-init.el (gtk-initialize-compose): + * gtk-package.el: + * gtk-password-dialog.el: + * gtk-widget-accessors.el: + * gtk-widgets.el: + * gtk.el: + * isearch-mode.el (isearch-help-or-delete-char): + * ldap.el: + * lib-complete.el (read-library-internal): + * lib-complete.el (read-library): + * lib-complete.el (read-library-name): + * lisp-mnt.el (lm-report-bug): + * minibuf.el (minibuffer-smart-mouse-tracker): + * minibuf.el (minibuffer-smart-select-kludge-filename): + * minibuf.el (read-file-name-internal-1): + * minibuf.el (read-color-completion-table): + * modeline.el (modeline-toggle-read-only): + * mouse.el (mouse-consolidated-yank): + * mouse.el (default-mouse-track-maybe-own-selection): + * msw-font-menu.el (mswindows-reset-device-font-menus): + * multicast.el (open-multicast-group): + * mwheel.el: + * package-get.el (package-get-update-base-from-buffer): + * scrollbar.el (init-scrollbar-from-resources): + * symbols.el: + * syntax.el (describe-syntax-table): + * toolbar.el (init-toolbar-from-resources): + * toolbar-items.el (toolbar): + * toolbar-items.el (toolbar-paste): + * tty-init.el (init-pre-tty-win): + * tty-init.el (init-post-tty-win): + * wid-browse.el (widget-browse-sexp): + * widgets-gtk.el: + * x-faces.el: + * x-font-menu.el: + * x-font-menu.el (x-font-menu-font-data): + * x-init.el: + * x-misc.el: + * x-mouse.el: + * x-scrollbar.el: + * x-select.el: + * x-win-sun.el: + * x-win-xfree86.el: + Eliminate byte-compiler warnings using the new functions in + bytecomp-runtime.el. + + * coding.el (coding-system-get): New. + * coding.el (coding-system-put): New. + * coding.el (coding-system-category): New. + * mule\mule-misc.el (coding-system-get): Removed. + * mule\mule-misc.el (coding-system-put): Removed. + * mule\mule-misc.el (coding-system-category): Removed. + Move these functions, since they're not Mule-specific and + are used in prefer-coding-system. + + * font.el: + * font.el (cl): + * font.el (set-font-family): + * font.el (set-font-weight): + * font.el (set-font-style): + * font.el (set-font-size): + * font.el (set-font-registry): + * font.el (set-font-encoding): + * font.el (font-family): + * font.el (font-weight): + * font.el (font-style): + * font.el (font-size): + * font.el (font-registry): + * font.el (font-encoding): + * font.el (set-font-style-by-keywords): + * font.el (font-properties-from-style): + * font.el (font-combine-fonts-internal): + * font.el (font-x-font-regexp): + * font.el (x-font-create-object): + * font.el (x-font-create-name): + * font.el (ns-font-create-name): + * font.el (mswindows-font-create-name): + * font.el (font-update-device-fonts): + * font.el (font-update-one-face): + * font.el (font-rgb-color-p): + * font.el (font-rgb-color-red): + * font.el (font-tty-compute-color-delta): + * font.el (font-normalize-color): + This file was incredibly ugly. Clean it up. Avoid using defsubst + for any exported functions, to avoid possible compatibility + problems if we later change the internal interface. (It happened + before, with face accessors, between 19.8 and 19.9). Fix tons + of warnings. + + * gpm.el: + * gpm.el (gpm-is-supported-p): New. + * gpm.el (gpm-delete-device-hook): + Clean up (new function gpm-is-supported-p eliminates duplicate + code in gpm-create/delete-device-hook) and eliminate warnings. + + ---------- make byte-recompile-directory work in the --------- + core `lisp' dir, even in the absence of + a Mule XEmacs (i.e. make it skip the Mule + files rather than trying to compile them). + now you should be able to do `touch *.el' + in the `lisp' dir, then + M-x byte-recompile-directory, and get no + warnings. + + * bytecomp.el: + * bytecomp.el (byte-recompile-ignore-uncompilable-mule-files): New. + * bytecomp.el (byte-compile-inbuffer): + * bytecomp.el (byte-compile-inbuffer)): New. + * bytecomp.el (byte-compile-outbuffer)): New. + * bytecomp.el (byte-compile-warn): + * bytecomp.el (byte-recompile-directory): + * bytecomp.el (byte-recompile-file): + Avoid trying to compile Mule files in byte-recompile-directory + when we're not in a Mule XEmacs, since we're highly likely to get + syntax errors. + + * mule\arabic.el: + * mule\canna-leim.el: + * mule\english.el: + * mule\greek.el: + * mule\kinsoku.el: + * mule\latin.el: + * mule\misc-lang.el: + * mule\mule-category.el: + * mule\mule-ccl.el: + * mule\mule-charset.el: + * mule\mule-cmds.el: + * mule\mule-coding.el: + * mule\mule-help.el: + * mule\mule-init.el: + * mule\mule-misc.el: + * mule\mule-tty-init.el: + * mule\mule-x-init.el: + * mule\thai-xtis-chars.el: + * mule\viet-chars.el: + Add a coding-system cookie to all Mule files so that + byte-recompile-directory ignores them. + + * code-files.el (load): + * code-files.el (find-coding-system-magic-cookie): Removed. + * files.el: + * files.el (find-coding-system-magic-cookie-in-file): New. + Magic cookie function moved to files.el from code-files.el (for + use by bytecomp even in a non-coding-system XEmacs), and changed + names and semantics for use by bytecomp. NOTE: IMO this is an + internal function that we can change as we like (and there is + absolutely no code anywhere else using the function). + + ---------------- GUI improvements: menus, help ------------------- + + * help.el: + * help.el (help-map): Removed. + * help.el (help-for-help): + * help.el (Help-princ-face): + * help.el (Help-prin1-face): + * help.el (describe-function-1): + * help.el (describe-variable): + Rearrange order of keymap declarations to be alphabetical. + Improve help on help to include all bindings, and group by + category. Add bindings for new Info commands. Remove + warnings. Use command-hyper-apropos in place of command-apropos. + + * hyper-apropos.el: + * hyper-apropos.el (hyper-apropos-programming-apropos): + * hyper-apropos.el (command-hyper-apropos): New. + Add a function to do the equivalent of command-apropos. + + * help-macro.el (make-help-screen): + Evals its help-text argument so you can put expressions there. + Used now by help-for-help. + + * info.el: + * info.el (Info-search): + * info.el (Info-search-next): New. + * info.el (Info-index): Removed. + * info.el (Info-find-index-alternatives): New. + * info.el (Info-read-search-text-regexp): New. + * info.el (Info-search-text-in-lispref): New. + * info.el (Info-search-text-in-xemacs): New. + * info.el (Info-search-index-in-lispref): New. + * info.el (Info-search-index-in-xemacs-and-lispref): New. + * info.el (Info-mode-map): + Add binding to continue text searches. Expand index searches to + work over multiple info documents. Add commands to search + text/index in User and Lispref. + + * lisp-mode.el (construct-lisp-mode-menu): + Add new entry, "Uncomment Region" (parallels "Comment Out Region"). + + * menubar-items.el (default-menubar): + * menubar-items.el (default-popup-menu): + Redo Help menu; add bindings for new Info commands to search the + index or text of the User and Lispref manuals. Add command for + mark-paragraph, activate-region. Make Edit->R accelerator be + rectangle, not register (more commonly used), and put rectangle + first. Fix the Edit Init File entry to never load the .elc file. + Simplify the default-popup-menu. Add Cmds->Tabs menu. + + * menubar.el (popup-buffer-menu): Doc fix. + * menubar.el ((boundp 'menu-accelerator-map)): + Use kp-left not kp_left, etc. + + ---------------- Miscellaneous bug fixes/cleanup ------------------- + + * bytecomp-runtime.el (byte-compiler-options): + Correct doc string. + + * easymenu.el (easy-menu-do-define): fix extra quote. + + * fill.el (fill-paragraph-or-region): + Rewrite to be more correct -- use call-interactively so that + we always get exactly the same behavior as if the functions + were called directly. + + * font-lock.el (font-lock-fontify-pending-extents): + * gutter-items.el (clear-progress-feedback): + * gutter-items.el (abort-progress-feedback): + * gutter-items.el (raw-append-progress-feedback): + * simple.el (clear-message): + * simple.el (raw-append-message): + No need to fiddle with zmacs-region-stays, now that bogus + clearing of it (2001-04-28 src/ChangeLog) is removed. + + * dialog.el (make-dialog-box): + Put dialog titles back in -- this time correctly. Fix various + other problems with leaks and such. + + * keymap.el (key-sequence-list-description): + Clean up fun to always correctly canonicalize. + + * simple.el: + * simple.el (delete-forward-p): + * simple.el (comment-padding): New. + * simple.el (comment-region): + * simple.el (do-auto-fill): + * simple.el (indent-new-comment-line): + Clean up Kinsoku comments, synch comment-region with FSF 20.7. + + * simple.el (region-exists-p): + * simple.el (region-active-p): + Add comment about which one is correct to use in menu specs. + + * sound.el (load-sound-file): + Minor code clean up. + + * startup.el: + * startup.el (command-line-early): + * startup.el (initial-scratch-message): + Comment changes. Add info about sample.init.el to splash screen. + Improve initial-scratch-message and clarify purpose of Scratch + buffer. Fix byte-compile warning. + + ------------------------ Added features ------------------------- + + * etags.el: + * etags.el (tags-check-parent-directories-for-tag-files): New. + * etags.el (buffer-tag-table-list): + Add new variable to control whether etags checks all parent + directories for tag files. (On by default.) + + * hash-table.el: New file, useful utility functions. + * dumped-lisp.el (preloaded-file-list): Dump hash-table.el. + 2001-05-03 Adrian Aichner <adrian@xemacs.org> * build-report.el: Remove CVS keywords since this file has been in
--- a/lisp/apropos.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/apropos.el Fri May 04 22:42:35 2001 +0000 @@ -69,21 +69,21 @@ Slows them down more or less. Set this non-nil if you have a fast machine.") ;; XEmacs addition -(defvar apropos-symbol-face (if (boundp 'font-lock-keyword-face) +(defvar apropos-symbol-face (if-boundp 'font-lock-keyword-face font-lock-keyword-face 'bold) "*Face for symbol name in apropos output or `nil'. This looks good, but slows down the commands several times.") ;; XEmacs addition -(defvar apropos-keybinding-face (if (boundp 'font-lock-string-face) +(defvar apropos-keybinding-face (if-boundp 'font-lock-string-face font-lock-string-face 'underline) "*Face for keybinding display in apropos output or `nil'. This looks good, but slows down the commands several times.") ;; XEmacs addition -(defvar apropos-label-face (if (boundp 'font-lock-comment-face) +(defvar apropos-label-face (if-boundp 'font-lock-comment-face font-lock-comment-face 'italic) "*Face for label (Command, Variable ...) in apropos output or `nil'. @@ -93,7 +93,7 @@ text-property list for efficiency.") ;; XEmacs addition -(defvar apropos-property-face (if (boundp 'font-lock-variable-name-face) +(defvar apropos-property-face (if-boundp 'font-lock-variable-name-face font-lock-variable-name-face 'bold-italic) "*Face for property name in apropos output or `nil'.
--- a/lisp/auto-autoloads.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/auto-autoloads.el Fri May 04 22:42:35 2001 +0000 @@ -1278,13 +1278,19 @@ ;;;*** -;;;### (autoloads (hyper-apropos-popup-menu hyper-apropos-set-variable hyper-set-variable hyper-apropos-read-variable-symbol hyper-describe-function hyper-where-is hyper-describe-variable hyper-describe-face hyper-describe-key-briefly hyper-describe-key hyper-apropos) "hyper-apropos" "lisp/hyper-apropos.el") +;;;### (autoloads (hyper-apropos-popup-menu hyper-apropos-set-variable hyper-set-variable hyper-apropos-read-variable-symbol hyper-describe-function hyper-where-is hyper-describe-variable hyper-describe-face hyper-describe-key-briefly hyper-describe-key hyper-apropos command-hyper-apropos) "hyper-apropos" "lisp/hyper-apropos.el") + +(autoload 'command-hyper-apropos "hyper-apropos" "\ +Display lists of commands and user options matching REGEXP +in buffer \"*Hyper Apropos*\". See `hyper-apropos-mode' for a +description of the available commands in a Hyper-Apropos buffer." t nil) (autoload 'hyper-apropos "hyper-apropos" "\ Display lists of functions and variables matching REGEXP in buffer \"*Hyper Apropos*\". If optional prefix arg is given, then the value of `hyper-apropos-programming-apropos' is toggled for this search. -See also `hyper-apropos-mode'." t nil) +See `hyper-apropos-mode' for a description of the available commands in +a Hyper-Apropos buffer." t nil) (autoload 'hyper-describe-key "hyper-apropos" nil t nil) @@ -1327,7 +1333,7 @@ ;;;*** -;;;### (autoloads (Info-elisp-ref Info-emacs-key Info-goto-emacs-key-command-node Info-goto-emacs-command-node Info-emacs-command Info-search Info-visit-file Info-goto-node Info-batch-rebuild-dir Info-find-node Info-query info) "info" "lisp/info.el") +;;;### (autoloads (Info-search-index-in-xemacs-and-lispref Info-search-index-in-lispref Info-search-text-in-xemacs Info-search-text-in-lispref Info-elisp-ref Info-emacs-key Info-goto-emacs-key-command-node Info-goto-emacs-command-node Info-emacs-command Info-search Info-visit-file Info-goto-node Info-batch-rebuild-dir Info-find-node Info-query info) "info" "lisp/info.el") (defvar Info-directory-list nil "\ List of directories to search for Info documentation files. @@ -1406,6 +1412,19 @@ Look up an Emacs Lisp function in the Elisp manual in the Info system. This command is designed to be used whether you are already in Info or not." t nil) +(autoload 'Info-search-text-in-lispref "info" "\ +Search for REGEXP in Lispref text and select node it's found in." t nil) + +(autoload 'Info-search-text-in-xemacs "info" "\ +Search for REGEXP in User's Manual text and select node it's found in." t nil) + +(autoload 'Info-search-index-in-lispref "info" "\ +Search for REGEXP in Lispref index and select node it's found in." t nil) + +(autoload 'Info-search-index-in-xemacs-and-lispref "info" "\ +Search for REGEXP in both User's Manual and Lispref indices. +Select node it's found in." t nil) + ;;;*** ;;;### (autoloads nil "itimer-autosave" "lisp/itimer-autosave.el") @@ -1820,10 +1839,11 @@ You can only play sound files if you are running on display 0 of the console of a machine with native sound support or running a NetAudio -server and XEmacs has the necessary sound support compiled in. +or ESD server and XEmacs has the necessary sound support compiled in. -The sound file must be in the Sun/NeXT U-LAW format, except on Linux, -where .wav files are also supported by the sound card drivers." t nil) +The sound file must be in the Sun/NeXT U-LAW format, except on Linux +and MS Windows, where .wav files are also supported by the sound card +drivers." t nil) (autoload 'load-default-sounds "sound" "\ Load and install some sound files as beep-types, using
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/behavior-defs.el Fri May 04 22:42:35 2001 +0000 @@ -0,0 +1,299 @@ +;;; behavior-defs.el --- definitions of specific behaviors + +;; Copyright (C) 2000, 2001 Ben Wing. + +;; Author: Ben Wing +;; Maintainer: XEmacs Development Team +;; Keywords: 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, 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Synched up with: Not in FSF. + +;;; Authorship: + +;; Created July 2000 by Ben Wing. + +;;; Commentary: + +;; This file will be dumped with XEmacs. + +;;; Code: + +(require 'behavior) + +(define-behavior 'mouse-avoidance + "Mouse avoidance mode" + :title "Mouse Avoidance" + :enable #'(lambda () + (mouse-avoidance-mode 'animate)) + :disable #'(lambda () + (mouse-avoidance-mode 'none))) + +(define-behavior 'resize-minibuffer + "When this behavior is enabled, the minibuffer is dynamically resized to +contain the entire region of text put in it as you type. + +The maximum height to which the minibuffer can grow is controlled by the +variable `resize-minibuffer-window-max-height'. + +The variable `resize-minibuffer-window-exactly' determines whether the +minibuffer window should ever be shrunk to make it no larger than needed to +display its contents. + +When using a window system, it is possible for a minibuffer to be the sole +window in a frame. Since that window is already its maximum size, the only +way to make more text visible at once is to increase the size of the frame. +The variable `resize-minibuffer-frame' controls whether this should be +done. The variables `resize-minibuffer-frame-max-height' and +`resize-minibuffer-frame-exactly' are analogous to their window +counterparts." + :title "Resize Minibuffer Automatically" + :enable #'(lambda () + (resize-minibuffer-mode 1)) + :disable #'(lambda () + (resize-minibuffer-mode -1))) + +(define-behavior 'func-menu + "Suppose you have a file with a lot of functions in it. Well, this +package makes it easy to jump to any of those functions. The names of +the functions in the current buffer are automatically put into menubar +menu, you select one of the function-names and the point is moved to +that very function. The mark is pushed on the mark-ring, so you can +easily go back to where you were. Alternatively, you can use enter the +name of the desired function via the minibuffer which offers +completing read input. In addition, the name of the function before +point is optionally displayed in the modeline." + :title "Function Menu" + :require 'func-menu + :enable #'(lambda () + (add-hook 'find-file-hooks 'fume-add-menubar-entry) + (mapc #'(lambda (buffer) + (with-current-buffer buffer + (setq fume-display-in-modeline-p t) + (fume-add-menubar-entry))) + (buffer-list))) + :disable #'(lambda () + (remove-hook 'find-file-hooks 'fume-add-menubar-entry) + (fset 'widen (symbol-function 'fume-widen)) + (fset 'narrow-to-region (symbol-function 'narrow-to-region)) + (mapc #'(lambda (buffer) + (with-current-buffer buffer + (fume-remove-menubar-entry) + (setq fume-display-in-modeline-p nil) + (fume-remove-post-command-hook + 'fume-tickle-modeline) + (fume-remove-post-command-hook + 'fume-maybe-install-modeline-feature) + (fume-remove-post-command-hook + 'fume-rescan-buffer-trigger))) + (buffer-list)))) + +(define-behavior 'mwheel + "This code enables the use of the infamous 'wheel' on the new +crop of mice. Under XFree86 and the XSuSE X Servers, the wheel +events are sent as button4/button5 events, which are automatically +set up to do scrolling in the expected way. The actual way that the +scrolling works can be controlled by `mwheel-scroll-amount' and +`mwheel-follow-mouse'." + :title "Mouse Wheel Support" + :enable 'mwheel-install) + +(define-behavior 'recent-files +"Recent-files adds the menu \"Recent Files\" (or whatever name you +choose, see \"Customization:\" below) to Emacs's menubar. Its +entries are the files (and directories) that have recently been +opened by Emacs. You can open one of these files again by +selecting its entry in the \"Recent Files\" menu. The list of file +entries in this menu is preserved from one Emacs session to +another. You can prevent Emacs from saving this list by selecting +\"Don't save recent-files list on exit\" from the menu. If you have +disabled saving, you can re-enable it by selecting \"Save +recent-files list on exit\". + +The menu has permanent and non-permanent entries. Permanent +entries are marked with an asterisk in front of the filename. The +non-permanent entries are hidden in a submenu. + +Each time you open a file in Emacs, it is added as a non-permanent +entry to the menu. The value of `recent-files-number-of-entries' +determines how many non-permanent entries are held in the +menu. When the number of non-permanent entries reaches this value, +the least recently added non-permanent entry is removed from the +menu when another non-permanent entry is added. It is not removed +from the list, though; it may reappear when entries are deleted +from the list. The number of entries saved to disk is the value of +the variable `recent-files-number-of-saved-entries'. + +Permanent entries are not removed from the menu. You can make a +file entry permanent by selecting \"Make <buffer> permanent\" (where +<buffer> is the name of the current buffer) when the current +buffer holds this file. \"Make <buffer> non-permanent\" makes the +file entry of the current buffer non-permanent. + +The command \"Kill buffer <buffer> and delete entry\" is handy when +you have accidently opened a file but want to keep neither the +buffer nor the entry. + +You can erase the list of non-permanent entries by selecting +\"Erase non-permanent entries\" from the menu. + +Customization: + +There are lots of variables to control the behaviour of +recent-files. You do not have to change any of them if you like it +as it comes out of the box. However, you may want to look at these +options to make it behave different. + +`recent-files-number-of-entries' + Controls how many non-permanent entries are shown in the + recent-files list. The default is 15. + +`recent-files-number-of-saved-entries' + Controls how many non-permanent entries are saved to disk when + Emacs exits or recent-files-save-the-list is called. The + default is 50. + +`recent-files-save-file' + The name of the file where the recent-files list is saved + between Emacs session. You probably don't need to change this. + The default is \".recent-files.el\" in your home directory. + +`recent-files-dont-include' + A list of regular expressions for files that should not be + included into the recent-files list. This list is empty by + default. For instance, a list to exclude all .newsrc + files, all auto-save-files, and all files in the /tmp + directory (but not the /tmp directory itself) would look + like this: + (setq recent-files-dont-include + '(\"/\\.newsrc\" \"~$\" \"^/tmp/.\")) + The default is empty. + +`recent-files-use-full-names' + If the value of this variable is non-nil, the full pathnames of + the files are shown in the recent-files menu. Otherwise only + the filename part (or the last name component if it is a + directory) is shown in the menu. The default it t, i.e. show + full names. + +`recent-files-filename-replacements' + This is a list of pairs of regular expressions and replacement + strings. If a filename matches one of the regular expressions, + the matching part is replaced by the replacement string for + display in the recent-files menu. + Example: My home directory is \"/users/mmc/nickel/\". I want to + replace it with \"~/\". I also want to replace the directory + \"/imports/teleservices/mmc/avc2/\", where I work a lot, with + \".../avc2/\". The list then looks like + (setq recent-files-filename-replacements + '((\"/users/mmc/nickel/\" . \"~/\") + (\"/imports/teleservices/mmc/avc2/\" . \".../avc2/\"))) + Only the first match is replaced. So, if you have several + entries in this list that may match a filename simultaneously, + put the one you want to match (usually the most special) in + front of the others. The default is to replace the home + directory with \"~\". + +`recent-files-sort-function' + Contains a function symbol to sort the display of filenames in + the recent-files menu. Supplied are two functions, + 'recent-files-dont-sort and 'recent-files-sort-alphabetically. + The first, which is the default, preserves the order of \"most + recent on top\". + +`recent-files-permanent-submenu' + If this variable is non-nil, the permanent entries are put into + a separate submenu of the recent-files menu. The default is + nil. + +`recent-files-non-permanent-submenu' + If this variable is non-nil, the non-permanent entries are put + into a separate submenu of the recent-files menu. The default + is nil. (You can set both `recent-files-permanent-submenu' and + `recent-files-non-permanent-submenu' to t to have both lists in + separate submenus.) + +`recent-files-commands-submenu' + If this variable is non-nil, the commands if recent-files are + placed in a submenu of the recent-files menu. The default is + nil. + +`recent-files-commands-submenu-title' + If the commands are placed in a submenu, this string is used as + the title of the submenu. The default is \"Commands...\". + +`recent-files-actions-on-top' + If this variable is non-nil, the \"action\" menu entries (\"Make + <buffer> permanent\" etc.) are put on top of the menu. Otherwise + they appear below the file entries or submenus. The default is + nil. + +`recent-files-permanent-first' + If this variable is t, the permanent entries are put first in + the recent-files menu, i.e. above the non-permanent entries. If + the value is nil, non-permanent entries appear first. If the + value is neither t nor nil, the entries are sorted according to + recent-files-sort-function. The default is 'sort. + +`recent-files-find-file-command' + This variable contains to commandto execute when a file entry + is selected from the menu. Usually this will be `find-file', + which is the default. + +KNOWN BUG: + - recent-files overwrites the recent-files-save-file + unconditionally when Emacs exits. If you have two Emacs + processes running, the one exiting later will overwrite the + file without merging in the new entries from the other Emacs + process. This can be avoided by disabling the save on exit from + the menu." + :title "Recent Files Menu" + :enable 'recent-files-initialize) + +(define-behavior 'filladapt + "These functions enhance the default behavior of Emacs' Auto Fill +mode and the commands `fill-paragraph', `lisp-fill-paragraph', +`fill-region-as-paragraph' and `fill-region'. + +The chief improvement is that the beginning of a line to be +filled is examined and, based on information gathered, an +appropriate value for fill-prefix is constructed. Also the +boundaries of the current paragraph are located. This occurs +only if the fill prefix is not already non-nil. + +The net result of this is that blurbs of text that are offset +from left margin by asterisks, dashes, and/or spaces, numbered +examples, included text from USENET news articles, etc. are +generally filled correctly with no fuss." + :title "Adaptive Filling" + :require 'filladapt + :enable #'(lambda () + (setq-default filladapt-mode t) + (mapc #'(lambda (buffer) + (with-current-buffer buffer + (unless filladapt-mode + (filladapt-mode 1)))) + (buffer-list))) + :disable #'(lambda () + (setq-default filladapt-mode nil) + (mapc #'(lambda (buffer) + (with-current-buffer buffer + (when filladapt-mode + (filladapt-mode -1)))) + (buffer-list))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/behavior.el Fri May 04 22:42:35 2001 +0000 @@ -0,0 +1,140 @@ +;;; behavior.el --- consistent interface onto behaviors + +;; Copyright (C) 2000, 2001 Ben Wing. + +;; Author: Ben Wing +;; Maintainer: XEmacs Development Team +;; Keywords: 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, 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Synched up with: Not in FSF. + +;;; Authorship: + +;; Created July 2000 by Ben Wing. + +;;; Commentary: + +;; This file will be dumped with XEmacs. + +;;; Code: + +(defvar behavior-hash-table (make-hash-table)) + +(defvar behavior-history nil + "History of entered behaviors.") + +(defun define-behavior (name doc-string &rest cl-keys) + "Define a behavior named NAME. +DOC-STRING must be specified, a description of what the behavior does +when it's enabled and how to further control it (typically through +custom variables). Accepted keywords are + +:title A \"pretty\" version of the name, for use in menus. If omitted + a prettified name will be generated. +:require A single symbol or a list of such symbols, which need to be + present at enable time, or will be loaded using `require'. +:enable A function of no variables, which turns the behavior on. +:disable A function of no variables, which turns the behavior off. + +Behaviors are assumed to be global, and to take effect immediately; if +the underlying package is per-buffer, it may have to scan all existing +buffers and frob them. When a behavior is disabled, it should completely +go away *everywhere*, as if it were never invoked at all. + +The :disable keywords can be missing, although this is considered bad +practice. In such a case, attempting to disable the behavior will signal +an error unless you use the `force' option." + (cl-parsing-keywords + ((:title (capitalize-string-as-title (replace-in-string + (symbol-name name) "-" " "))) + :require + :enable + :disable) + () + (let ((entry (list :title cl-title :require cl-require + :enable cl-enable :disable cl-disable))) + (puthash name entry behavior-hash-table)))) + +(defun read-behavior (prompt &optional must-match initial-contents history + default-value) + "Return a behavior symbol from the minibuffer, prompting with string PROMPT. +If non-nil, optional second arg INITIAL-CONTENTS is a string to insert + in the minibuffer before reading. +Third arg HISTORY, if non-nil, specifies a history list. (It defaults to +`behavior-history'.) +Fourth arg DEFAULT-VALUE is the default value. If non-nil, it is used + for history command, and as the value to return if the user enters the + empty string." + (let ((result + (completing-read + prompt + (let ((table (let (lis) + (maphash #'(lambda (key val) + (push (cons key val) lis)) + behavior-hash-table) + (nreverse lis)))) + (mapc #'(lambda (aentry) + (setcar aentry (symbol-name + (car aentry)))) + table) + table) + nil must-match initial-contents + (or history 'behavior-history) + default-value))) + (if (and result (stringp result)) + (intern result) + result))) + +(defun behavior-enabled-p (name)) + +(defun enable-behavior (behavior &optional force) + "Enable the specified behavior." + (interactive (list (read-behavior "Enable Behavior: " t) current-prefix-arg)) + (let ((plist (gethash behavior behavior-hash-table))) + (or plist (error 'invalid-argument "Not a behavior" behavior)) + (let ((require (getf plist :require)) + (enable (getf plist :enable))) + (cond ((listp require) + (mapc #'(lambda (sym) (require sym)) require)) + ((symbolp require) + (require require)) + ((null require)) + (t (error 'invalid-argument "Invalid :require spec" require))) + (if enable (funcall enable))))) + +(defun disable-behavior (behavior &optional force) + "Disable the specified behavior." + (interactive (list (read-behavior "Disable Behavior: " t) + current-prefix-arg)) + (let ((plist (gethash behavior behavior-hash-table))) + (or plist (error 'invalid-argument "Not a behavior" behavior)) + (let ((require (getf plist :require)) + (disable (getf plist :disable))) + (cond ((listp require) + (mapc #'(lambda (sym) (require sym)) require)) + ((symbolp require) + (require require)) + ((null require)) + (t (error 'invalid-argument "Invalid :require spec" require))) + (if disable (funcall disable))))) + +(provide 'behavior) + +;;; finder-inf.el ends here
--- a/lisp/bytecomp-runtime.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/bytecomp-runtime.el Fri May 04 22:42:35 2001 +0000 @@ -183,7 +183,253 @@ (funcall bodythunk) (setq after-load-alist (cons '(,file . (list 'lambda '() bodythunk)) after-load-alist)))))) - + + + +;;; Functions to cleanly eliminate warnings about undefined functions +;;; or variables when the code knows what it's doing. These macros DO +;;; NOT rely on any byte-compiler changes, and thus can be copied into +;;; a package and used within it. + +;; NOTE: As a result of the above requirement, the macros rely on +;; "tricks" to get the warnings suppressed. A cleaner way, of course, +;; would be to extend the byte compiler to provide a proper interface. + +;; #### Should we require an unquoted symbol rather than a quoted one, +;; as we currently do? The quoting gets no generality, as `eval' is +;; called at compile time. But most functions and macros want quoted +;; arguments, and I find it extremely confusing to deal with cases +;; such as `throw' requiring a quoted argument but `block' an unquoted +;; one. + +(put 'with-boundp 'lisp-indent-function 1) +(defmacro with-boundp (symbols &rest body) + "Evaluate BODY, but do not issue bytecomp warnings about SYMBOLS undefined. +SYMBOLS can be a symbol or a list of symbols and must be quoted. When +compiling this file, the warning `reference to free variable SYMBOL' +will not occur. This is a clean way to avoid such warnings. See also +`declare-boundp' and `if-boundp'." + (setq symbols (eval symbols)) + (unless (consp symbols) + (setq symbols (list symbols))) + `(progn + (declare (special ,@symbols)) + ,@body)) + +(put 'if-boundp 'lisp-indent-function 2) +(defmacro if-boundp (symbol then &rest else) + "Equivalent to (if (boundp SYMBOL) THEN ELSE) but handles bytecomp warnings. +When compiling this file, the warning `reference to free variable SYMBOL' +will not occur. This is a clean way to avoid such warnings. See also +`with-boundp' and `declare-boundp'." + `(with-boundp ,symbol + (if (boundp ,symbol) ,then ,@else))) + +(defmacro declare-boundp (symbol) + "Evaluate SYMBOL without bytecomp warnings about the symbol. +Sample usage is + + (declare-boundp gpm-minor-mode) + +which is equivalent to + + (with-fboundp 'gpm-minor-mode + gpm-minor-mode)" + `(with-boundp ',symbol ,symbol)) + +(defmacro globally-declare-boundp (symbol) + "Declare that all free uses of SYMBOL in this file are valid. +SYMBOL can also be a list of symbols. SYMBOL must be quoted. + +When compiling this file, the warning `reference to free variable +SYMBOL' will not occur regardless of where calls to SYMBOL occur in +the file. + +In general, you should *NOT* use this; use `declare-boundp', +`if-boundp', or `with-boundp' to wrap individual uses, as necessary. +That way, you're more likely to remember to put in the explicit checks +for the variable's existence that are usually necessary. However, +`globally-declare-boundp' is better in some circumstances, such as +when writing an ELisp package that makes integral use of +optionally-compiled-in functionality (typically, an interface onto a +system library) and checks for the existence of the functionality at +some entry point to the package. See `globally-declare-fboundp' for +more information." + (setq symbol (eval symbol)) + (if (not (consp symbol)) + (setq symbol (list symbol))) + `(progn + ;; (defvar FOO) has no side effects. + ,@(mapcar #'(lambda (sym) `(defvar ,sym)) symbol))) + +(defun byte-compile-with-fboundp (form) + (byte-compile-form (cons 'progn (cdr (cdr form)))) + ;; Unfortunately, byte-compile-unresolved-functions is used not only + ;; for unresolved-function warnings, but also in connection with the + ;; following warnings: + + ;; "defsubst %s was used before it was defined" + ;; "%s being defined to take %s%s, but was previously called with %s" + + ;; By hacking byte-compile-unresolved-functions like this, we + ;; effectively disable these warnings. But code should not be using + ;; `with-fboundp' with a function defined later on in the same + ;; file, so this is not a big deal. + + (let ((symbols (eval (car (cdr form))))) + (unless (consp symbols) + (setq symbols (list symbols))) + (setq symbols (mapcar #'(lambda (sym) (cons sym nil)) symbols)) + (setq byte-compile-unresolved-functions + (set-difference byte-compile-unresolved-functions symbols + :key #'car)) + )) + +;; EEEEEEEEVIL hack. We need to create our own byte-compilation +;; method so that the proper variables are bound while compilation +;; takes place (which is when the warnings get noticed and batched +;; up). What we really want to do is make `with-fboundp' a macro +;; that simply `progn's its BODY; but GOD DAMN IT, macros can't have +;; their own byte-compilation methods! So we make `with-fboundp' a +;; macro calling `with-fboundp-1', which is cleverly aliased to +;; progn. This way we can put a byte-compilation method on +;; `with-fboundp-1', and when interpreting, progn will duly skip +;; the first, quoted argument, i.e. the symbol name. (We could make +;; `with-fboundp-1' a regular function, but then we'd have to thunk +;; BODY and eval it at runtime. We could probably just do this using +;; (apply 'progn BODY), but the existing method is more obviously +;; guaranteed to work.) +;; +;; In defense, cl-macs.el does a very similar thing with +;; `cl-block-wrapper'. + +(put 'with-fboundp-1 'byte-compile 'byte-compile-with-fboundp) +(defalias 'with-fboundp-1 'progn) + +(put 'with-fboundp 'lisp-indent-function 1) +(defmacro with-fboundp (symbol &rest body) + "Evaluate BODY, but do not issue bytecomp warnings about SYMBOL. +SYMBOL must be quoted. When compiling this file, the warning `the +function SYMBOL is not known to be defined' will not occur. This is a +clean way to avoid such warnings. See also `declare-fboundp', +`if-fboundp', and `globally-declare-fboundp'." + `(with-fboundp-1 ,symbol ,@body)) + +(put 'if-fboundp 'lisp-indent-function 2) +(defmacro if-fboundp (symbol then &rest else) + "Equivalent to (if (fboundp SYMBOL) THEN ELSE) but handles bytecomp warnings. +When compiling this file, the warning `the function SYMBOL is not +known to be defined' will not occur. This is a clean way to avoid +such warnings. See also `declare-fboundp', `with-fboundp', and +`globally-declare-fboundp'." + `(with-fboundp ,symbol + (if (fboundp ,symbol) ,then ,@else))) + +(defmacro declare-fboundp (form) + "Execute FORM (a function call) without bytecomp warnings about the call. +Sample usage is + + (declare-fboundp (x-keysym-on-keyboard-sans-modifiers-p 'backspace)) + +which is equivalent to + + (with-fboundp 'x-keysym-on-keyboard-sans-modifiers-p + (x-keysym-on-keyboard-sans-modifiers-p 'backspace))" + `(with-fboundp ',(car form) ,form)) + +(defmacro globally-declare-fboundp (symbol) + "Declare that all calls to function SYMBOL in this file are valid. +SYMBOL can also be a list of symbols. SYMBOL must be quoted. + +When compiling this file, the warning `the function SYMBOL is not +known to be defined' will not occur regardless of where calls to +SYMBOL occur in the file. + +In general, you should *NOT* use this; use `declare-fboundp', +`if-fboundp', or `with-fboundp' to wrap individual uses, as necessary. +That way, you're more likely to remember to put in the explicit checks +for the function's existence that are usually necessary. However, +`globally-declare-fboundp' is better in some circumstances, such as +when writing an ELisp package that makes integral use of +optionally-compiled-in functionality (typically, an interface onto a +system library) and checks for the existence of the functionality at +some entry point to the package. The file `ldap.el' is a good +example: It provides a layer on top of the optional LDAP ELisp +primitives, makes calls to them throughout its code, and verifies the +presence of LDAP support at load time. Putting calls to +`declare-fboundp' throughout the code would be a major annoyance." + (when (cl-compiling-file) + (setq symbol (eval symbol)) + (if (not (consp symbol)) + (setq symbol (list symbol))) + ;; Another hack. This works because the autoload environment is + ;; currently used ONLY to suppress warnings, and the actual + ;; autoload definition is not used. (NOTE: With this definition, + ;; we will get spurious "multiple autoloads for %s" warnings if we + ;; have an autoload later in the file for any functions in SYMBOL. + ;; This is not something that code should ever do, though.) + (setq byte-compile-autoload-environment + (append (mapcar #'(lambda (sym) (cons sym nil)) symbol) + byte-compile-autoload-environment))) + nil) + +(defun byte-compile-with-byte-compiler-warnings-suppressed (form) + (let ((byte-compile-warnings byte-compile-warnings) + (types (car (cdr form)))) + (unless (consp types) + (setq types (list types))) + (if (eq byte-compile-warnings t) + (setq byte-compile-warnings byte-compile-default-warnings)) + (setq byte-compile-warnings (set-difference byte-compile-warnings types)) + (byte-compile-form (cons 'progn (cdr (cdr form)))))) + +;; Same hack here as with `with-fboundp'. +(put 'with-byte-compiler-warnings-suppressed-1 'byte-compile + 'byte-compile-with-byte-compiler-warnings-suppressed) +(defalias 'with-byte-compiler-warnings-suppressed-1 'progn) + +(put 'with-byte-compiler-warnings-suppressed 'lisp-indent-function 1) +(defmacro with-byte-compiler-warnings-suppressed (type &rest body) + "Evaluate BODY, but do not issue bytecomp warnings TYPE. +TYPE should be one of `redefine', `callargs', `subr-callargs', +`free-vars', `unresolved', `unused-vars', `obsolete', or `pedantic', +or a list of one or more of these symbols. (See `byte-compile-warnings'.) +TYPE must be quoted. + +NOTE: You should *NOT* under normal circumstances be using this! +There are better ways of avoiding most of these warnings. In particular: + +-- use (declare (special ...)) if you are making use of + dynamically-scoped variables. +-- use `with-fboundp', `declare-fboundp', `if-fboundp', or + `globally-declare-fboundp' to avoid warnings about undefined + functions when you know the function actually exists. +-- use `with-boundp', `declare-boundp', or `if-boundp' to avoid + warnings about undefined variables when you know the variable + actually exists. +-- use `with-obsolete-variable' or `with-obsolete-function' if you + are purposely using such a variable or function." + `(with-byte-compiler-warnings-suppressed-1 ,type ,@body)) + +;; #### These should be more clever. You could (e.g.) try fletting +;; `byte-compile-obsolete' or temporarily removing the obsolete info +;; from the symbol and putting it back with an unwind-protect. (Or +;; better, modify the byte-compiler to provide a proper solution, and +;; fix these macros to use it if available, or fall back on the way +;; below. Remember, these definitions need to work with an unchanged +;; byte compiler so that they can be copied and used in packages.) + +(put 'with-obsolete-variable 'lisp-indent-function 1) +(defmacro with-obsolete-variable (symbol &rest body) + "Evaluate BODY but do not warn about usage of obsolete variable SYMBOL. +SYMBOL must be quoted. See also `with-obsolete-function'." + `(with-byte-compiler-warnings-suppressed 'obsolete ,@body)) + +(put 'with-obsolete-function 'lisp-indent-function 1) +(defmacro with-obsolete-function (symbol &rest body) + "Evaluate BODY but do not warn about usage of obsolete function SYMBOL. +SYMBOL must be quoted. See also `with-obsolete-variable'." + `(with-byte-compiler-warnings-suppressed 'obsolete ,@body)) ;;; Interface to file-local byte-compiler parameters. @@ -222,8 +468,11 @@ unused-vars references to non-global variables bound but not referenced. unresolved calls to unknown functions. callargs lambda calls with args that don't match the definition. + subr-callargs calls to subrs with args that don't match the definition. redefine function cell redefined from a macro to a lambda or vice versa, or redefined to take a different number of arguments. + obsolete use of an obsolete function or variable. + pedantic warn of use of compatible symbols. If the first element if the list is `+' or `-' then the specified elements are added to or removed from the current set of warnings, instead of the
--- a/lisp/bytecomp.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/bytecomp.el Fri May 04 22:42:35 2001 +0000 @@ -421,6 +421,12 @@ when an error occurs in a file. This is bound to t by `batch-byte-recompile-directory'.") +(defvar byte-recompile-ignore-uncompilable-mule-files t + "If non-nil, `byte-recompile-*' ignores non-ASCII .el files in a non-Mule +XEmacs. This assumes that such files have a -*- coding: ??? -*- magic +cookie in their first line or a ;;;###coding system: magic cookie +early in the file.") + (defvar byte-recompile-directory-recursively t "*If true, then `byte-recompile-directory' will recurse on subdirectories.") @@ -943,11 +949,63 @@ " at " (current-time-string) "\n") (setq byte-compile-current-file nil)))) +(defvar byte-compile-inbuffer) +(defvar byte-compile-outbuffer) + (defun byte-compile-warn (format &rest args) (setq format (apply 'format format args)) (if byte-compile-error-on-warn (error "%s" format) ; byte-compile-file catches and logs it (byte-compile-log-1 (concat "** " format) t) + + ;; This was a first attempt to add line numbers to the + ;; byte-compilation output. Unfortunately, it doesn't work + ;; perfectly: it reports the line number at the end of the form + ;; (which may be an entire function), rather than the line number + ;; of the actual problem. Doing this right is hard because we + ;; currently use the built-in Lisp parser to parse the entire form + ;; at once. What we basically need is a whole separate parser + ;; that annotates its output with line numbers. For example, we + ;; might modify the parser in lread.c so that, with the right + ;; option set, it replaces every Lisp object contained in the + ;; structure it returns with a cons of that object and the line + ;; number it was found on (determined by counting newlines, + ;; starting from some arbitrary point). You then have two + ;; options: (a) Modify the byte compiler so that everything that + ;; compiles a form deals with the new annotated form rather than + ;; the old one, or (b) The byte compiler saves this structure + ;; while converting it into a normal structure that's given to the + ;; various form handlers, which need no (or less) modification. + ;; In the former case, finding the line number is trivial because + ;; it's in the form. In the latter case, finding the line number + ;; depends on having a unique Lisp object that can be looked up in + ;; the annotated structure -- i.e. a list, vector, or string. + ;; You'd have to look at the various places where errors are spit + ;; out (not very many, really), and make sure that such a unique + ;; object is available. Then you do a depth-first search through + ;; the annotated structure to find the object. + ;; + ;; An alternative way of doing (b) that's probably much more + ;; efficient (and easier to implement) is simply to have the + ;; parser in lread.c annotate every unique object using a separate + ;; hash table. This also eliminates the need for a search to find + ;; the line number. In order to be fine-grained enough to get at + ;; every symbol in a form -- e.g. if we want to pinpoint a + ;; particular undefined variable in a function call -- we need to + ;; annotate every cons, not just each list. We still have + ;; (probably unimportant) problems with vectors, since all we have + ;; is the start of the vector. If we cared about this, we could + ;; store in the hash table a list of the line numbers for each + ;; item in the vector, not just its start. + ;; + ;; --ben + +; (byte-compile-log-1 (concat "** line: " +; (save-excursion +; (set-buffer byte-compile-inbuffer) +; (int-to-string (line-number))) +; " " +; format) t) ;;; RMS says: ;;; It is useless to flash warnings too fast to be read. ;;; Besides, they will all be shown at the end. @@ -1436,6 +1494,11 @@ ;; It is an ordinary file. Decide whether to compile it. (if (and (string-match emacs-lisp-file-regexp source) (not (auto-save-file-name-p source)) + ;; make sure not a mule file we can't handle. + (or (not byte-recompile-ignore-uncompilable-mule-files) + (featurep 'mule) + (not (find-coding-system-magic-cookie-in-file + source))) (setq dest (byte-compile-dest-file source)) (if (file-exists-p dest) ;; File was already compiled. @@ -1480,7 +1543,10 @@ (file-newer-than-file-p filename dest) (and force (or (eq 0 force) - (y-or-n-p (concat "Compile " filename "? ")))))) + (y-or-n-p (concat "Compile " filename "? "))))) + (or (not byte-recompile-ignore-uncompilable-mule-files) + (featurep 'mule) + (not (find-coding-system-magic-cookie-in-file filename)))) (byte-compile-file filename)))) ;;;###autoload @@ -1622,9 +1688,6 @@ (insert "\n")) ((message "%s" (prin1-to-string value))))))) -(defvar byte-compile-inbuffer) -(defvar byte-compile-outbuffer) - (defun byte-compile-from-buffer (byte-compile-inbuffer filename &optional eval) ;; buffer --> output-buffer, or buffer --> eval form, return nil (let (byte-compile-outbuffer
--- a/lisp/cl-extra.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/cl-extra.el Fri May 04 22:42:35 2001 +0000 @@ -307,44 +307,47 @@ (defun cl-map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg) (or cl-buffer (setq cl-buffer (current-buffer))) - (if (fboundp 'overlay-lists) - - ;; This is the preferred algorithm, though overlay-lists is undocumented. - (let (cl-ovl) - (save-excursion - (set-buffer cl-buffer) - (setq cl-ovl (overlay-lists)) - (if cl-start (setq cl-start (copy-marker cl-start))) - (if cl-end (setq cl-end (copy-marker cl-end)))) - (setq cl-ovl (nconc (car cl-ovl) (cdr cl-ovl))) - (while (and cl-ovl - (or (not (overlay-start (car cl-ovl))) - (and cl-end (>= (overlay-start (car cl-ovl)) cl-end)) - (and cl-start (<= (overlay-end (car cl-ovl)) cl-start)) - (not (funcall cl-func (car cl-ovl) cl-arg)))) - (setq cl-ovl (cdr cl-ovl))) - (if cl-start (set-marker cl-start nil)) - (if cl-end (set-marker cl-end nil))) + (with-fboundp '(overlay-start overlay-end overlays-at next-overlay-change) + (if-fboundp 'overlay-lists - ;; This alternate algorithm fails to find zero-length overlays. - (let ((cl-mark (save-excursion (set-buffer cl-buffer) - (copy-marker (or cl-start (point-min))))) - (cl-mark2 (and cl-end (save-excursion (set-buffer cl-buffer) - (copy-marker cl-end)))) - cl-pos cl-ovl) - (while (save-excursion - (and (setq cl-pos (marker-position cl-mark)) - (< cl-pos (or cl-mark2 (point-max))) - (progn - (set-buffer cl-buffer) - (setq cl-ovl (overlays-at cl-pos)) - (set-marker cl-mark (next-overlay-change cl-pos))))) - (while (and cl-ovl - (or (/= (overlay-start (car cl-ovl)) cl-pos) - (not (and (funcall cl-func (car cl-ovl) cl-arg) - (set-marker cl-mark nil))))) - (setq cl-ovl (cdr cl-ovl)))) - (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil))))) + ;; This is the preferred algorithm, though overlay-lists is + ;; undocumented. + (let (cl-ovl) + (save-excursion + (set-buffer cl-buffer) + (setq cl-ovl (overlay-lists)) + (if cl-start (setq cl-start (copy-marker cl-start))) + (if cl-end (setq cl-end (copy-marker cl-end)))) + (setq cl-ovl (nconc (car cl-ovl) (cdr cl-ovl))) + (while (and cl-ovl + (or (not (overlay-start (car cl-ovl))) + (and cl-end (>= (overlay-start (car cl-ovl)) cl-end)) + (and cl-start (<= (overlay-end (car cl-ovl)) + cl-start)) + (not (funcall cl-func (car cl-ovl) cl-arg)))) + (setq cl-ovl (cdr cl-ovl))) + (if cl-start (set-marker cl-start nil)) + (if cl-end (set-marker cl-end nil))) + + ;; This alternate algorithm fails to find zero-length overlays. + (let ((cl-mark (save-excursion (set-buffer cl-buffer) + (copy-marker (or cl-start (point-min))))) + (cl-mark2 (and cl-end (save-excursion (set-buffer cl-buffer) + (copy-marker cl-end)))) + cl-pos cl-ovl) + (while (save-excursion + (and (setq cl-pos (marker-position cl-mark)) + (< cl-pos (or cl-mark2 (point-max))) + (progn + (set-buffer cl-buffer) + (setq cl-ovl (overlays-at cl-pos)) + (set-marker cl-mark (next-overlay-change cl-pos))))) + (while (and cl-ovl + (or (/= (overlay-start (car cl-ovl)) cl-pos) + (not (and (funcall cl-func (car cl-ovl) cl-arg) + (set-marker cl-mark nil))))) + (setq cl-ovl (cdr cl-ovl)))) + (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil)))))) ;;; Support for `setf'. (defun cl-set-frame-visible-p (frame val)
--- a/lisp/code-files.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/code-files.el Fri May 04 22:42:35 2001 +0000 @@ -204,53 +204,6 @@ ;(defun convert-mbox-coding-system (filename visit start end) ;... -(defun find-coding-system-magic-cookie () - "Look for the coding-system magic cookie in the current buffer. -The coding-system magic cookie is the exact string -\";;;###coding system: \" followed by a valid coding system symbol, -somewhere within the first 3000 characters of the file. If found, -the coding system symbol is returned; otherwise nil is returned. -Note that it is extremely unlikely that such a string would occur -coincidentally as the result of encoding some characters in a non-ASCII -charset, and that the spaces make it even less likely since the space -character is not a valid octet in any ISO 2022 encoding of most non-ASCII -charsets." - (save-excursion - (goto-char (point-min)) - (or (and (looking-at - "^[^\n]*-\\*-[^\n]*coding: \\([^ \t\n;]+\\)[^\n]*-\\*-") - (let ((codesys (intern (buffer-substring - (match-beginning 1)(match-end 1))))) - (if (find-coding-system codesys) codesys))) - ;; (save-excursion - ;; (let (start end) - ;; (and (re-search-forward "^;+[ \t]*Local Variables:" nil t) - ;; (setq start (match-end 0)) - ;; (re-search-forward "\n;+[ \t]*End:") - ;; (setq end (match-beginning 0)) - ;; (save-restriction - ;; (narrow-to-region start end) - ;; (goto-char start) - ;; (re-search-forward "^;;; coding: \\([^\n]+\\)$" nil t) - ;; ) - ;; (let ((codesys - ;; (intern (buffer-substring - ;; (match-beginning 1)(match-end 1))))) - ;; (if (find-coding-system codesys) codesys)) - ;; ))) - (let ((case-fold-search nil)) - (if (search-forward - ";;;###coding system: " (+ (point-min) 3000) t) - (let ((start (point)) - (end (progn - (skip-chars-forward "^ \t\n\r") - (point)))) - (if (> end start) - (let ((codesys (intern (buffer-substring start end)))) - (if (find-coding-system codesys) codesys))) - ))) - ))) - (defun load (file &optional noerror nomessage nosuffix) "Execute a file of Lisp code named FILE. First tries FILE with .elc appended, then tries with .el, @@ -270,7 +223,8 @@ (if (or (<= (length filename) 0) (null (setq path (locate-file filename load-path - (and (not nosuffix) '(".elc" ".el" "")))))) + (and (not nosuffix) + '(".elc" ".el" "")))))) (and (null noerror) (signal 'file-error (list "Cannot open load file" filename))) ;; now use the internal load to actually load the file. @@ -280,12 +234,10 @@ (string= ".elc" (downcase (substring path -4))))) (or (and (not elc) coding-system-for-read) ; prefer for source file ;; find magic-cookie - (save-excursion - (set-buffer (get-buffer-create " *load*")) - (erase-buffer) - (let ((coding-system-for-read 'raw-text)) - (insert-file-contents path nil 1 3001)) - (find-coding-system-magic-cookie)) + (let ((codesys (find-coding-system-magic-cookie-in-file path))) + (when codesys + (setq codesys (intern codesys)) + (if (find-coding-system codesys) codesys))) (if elc ;; if reading a byte-compiled file and we didn't find ;; a coding-system magic cookie, then use `binary'.
--- a/lisp/coding.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/coding.el Fri May 04 22:42:35 2001 +0000 @@ -31,6 +31,10 @@ ;;; Code: +(globally-declare-fboundp + '(coding-system-lock-shift + coding-system-seven coding-system-charset charset-dimension)) + (defalias 'check-coding-system 'get-coding-system) (defconst modeline-multibyte-status '("%C") @@ -105,8 +109,8 @@ (get-coding-system coding-system) ; correctness check (setq keyboard-coding-system coding-system) (if (eq (device-type) 'tty) - (set-console-tty-input-coding-system - (device-console) keyboard-coding-system)) + (declare-fboundp (set-console-tty-input-coding-system + (device-console) keyboard-coding-system))) (redraw-modeline t)) (defsubst terminal-coding-system () @@ -120,8 +124,8 @@ (setq terminal-coding-system coding-system) ; #### should this affect all current tty consoles ? (if (eq (device-type) 'tty) - (set-console-tty-output-coding-system - (device-console) terminal-coding-system)) + (declare-fboundp (set-console-tty-output-coding-system + (device-console) terminal-coding-system))) (redraw-modeline t)) (defun set-pathname-coding-system (coding-system) @@ -193,6 +197,62 @@ 0 (string-match "-unix$\\|-dos$\\|-mac$" (symbol-name (coding-system-name coding-system)))))))) + + +;;; #### bleagh!!!!!!! + +(defun coding-system-get (coding-system prop) + "Extract a value from CODING-SYSTEM's property list for property PROP." + (or (plist-get + (get (coding-system-name coding-system) 'coding-system-property) + prop) + (condition-case nil + (coding-system-property coding-system prop) + (error nil)))) + +(defun coding-system-put (coding-system prop value) + "Change value in CODING-SYSTEM's property list PROP to VALUE." + (put (coding-system-name coding-system) + 'coding-system-property + (plist-put (get (coding-system-name coding-system) + 'coding-system-property) + prop value))) + +(defun coding-system-category (coding-system) + "Return the coding category of CODING-SYSTEM." + (or (coding-system-get coding-system 'category) + (let ((type (coding-system-type coding-system))) + (cond ((eq type 'no-conversion) + 'no-conversion) + ((eq type 'shift-jis) + 'shift-jis) + ((eq type 'ucs-4) + 'ucs-4) + ((eq type 'utf-8) + 'utf-8) + ((eq type 'big5) + 'big5) + ((eq type 'iso2022) + (cond ((coding-system-lock-shift coding-system) + 'iso-lock-shift) + ((coding-system-seven coding-system) + 'iso-7) + (t + (let ((dim 0) + ccs + (i 0)) + (while (< i 4) + (setq ccs (coding-system-charset coding-system i)) + (if (and ccs + (> (charset-dimension ccs) dim)) + (setq dim (charset-dimension ccs)) + ) + (setq i (1+ i))) + (cond ((= dim 1) 'iso-8-1) + ((= dim 2) 'iso-8-2) + (t 'iso-8-designate)) + )))))))) + ;;;; Definitions of predefined coding systems
--- a/lisp/console.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/console.el Fri May 04 22:42:35 2001 +0000 @@ -41,7 +41,8 @@ "Resume the consoles with a controlling process of PID." (mapc (lambda (c) (if (and (eq (console-type c) 'tty) - (eql pid (console-tty-controlling-process c))) + (eql pid + (declare-fboundp (console-tty-controlling-process c)))) (resume-console c))) (console-list)) nil)
--- a/lisp/custom-load.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/custom-load.el Fri May 04 22:42:35 2001 +0000 @@ -4,89 +4,89 @@ (autoload 'custom-add-loads "cus-load") -(custom-add-loads 'extensions '("auto-show" "wid-edit")) -(custom-add-loads 'info-faces '("info")) +(custom-add-loads 'menu '("menubar-items")) +(custom-add-loads 'printing '("printer")) +(custom-add-loads 'frames '("frame" "window-xemacs" "gui" "gnuserv")) +(custom-add-loads 'hypermedia '("wid-edit")) +(custom-add-loads 'programming '("cus-edit")) +(custom-add-loads 'widget-faces '("wid-edit")) +(custom-add-loads 'dired '("files")) +(custom-add-loads 'help '("help" "cus-edit" "hyper-apropos" "info")) +(custom-add-loads 'languages '("lisp-mode" "cus-edit" "font-lock")) +(custom-add-loads 'matching '("simple" "isearch-mode" "hyper-apropos")) +(custom-add-loads 'internal '("cus-edit")) +(custom-add-loads 'processes '("process" "gnuserv")) +(custom-add-loads 'font-lock '("font-lock")) +(custom-add-loads 'backup '("files")) (custom-add-loads 'custom-buffer '("cus-edit")) -(custom-add-loads 'custom-faces '("cus-edit")) -(custom-add-loads 'auto-show '("auto-show")) -(custom-add-loads 'drag-n-drop '("dragdrop")) -(custom-add-loads 'mouse '("mouse" "mwheel")) -(custom-add-loads 'etags '("etags")) -(custom-add-loads 'package-tools '("package-get" "package-ui")) -(custom-add-loads 'widgets '("wid-browse" "wid-edit")) -(custom-add-loads 'menu '("menubar-items")) -(custom-add-loads 'minibuffer '("simple" "minibuf")) +(custom-add-loads 'pui '("package-ui")) +(custom-add-loads 'fill-comments '("simple")) +(custom-add-loads 'build-report '("build-report")) +(custom-add-loads 'mail '("simple" "startup")) +(custom-add-loads 'development '("process" "lisp-mode" "cus-edit")) (custom-add-loads 'log-message '("simple")) -(custom-add-loads 'environment '("frame" "keydefs" "minibuf" "modeline" "window-xemacs" "menubar" "gutter" "toolbar-items" "cus-edit" "gnuserv" "sound" "x-init")) -(custom-add-loads 'sound '("sound")) -(custom-add-loads 'pui '("package-ui")) -(custom-add-loads 'terminals '("gnuserv")) (custom-add-loads 'auto-save '("files" "auto-save")) -(custom-add-loads 'mail '("simple" "startup")) +(custom-add-loads 'help-appearance '("help" "help-macro")) +(custom-add-loads 'find-file '("files")) +(custom-add-loads 'package-tools '("package-get" "package-ui")) +(custom-add-loads 'widget-documentation '("wid-edit")) +(custom-add-loads 'build '("build-report")) +(custom-add-loads 'font-lock-faces '("font-lock")) +(custom-add-loads 'i18n '("cus-edit")) (custom-add-loads 'custom-menu '("cus-edit")) -(custom-add-loads 'docs '("hyper-apropos" "info")) -(custom-add-loads 'tools '("etags" "hyper-apropos")) -(custom-add-loads 'editing-basics '("cmdloop" "simple" "files" "lisp")) -(custom-add-loads 'internal '("cus-edit")) -(custom-add-loads 'help-appearance '("help" "help-macro")) -(custom-add-loads 'build-report '("build-report")) -(custom-add-loads 'buffers-menu '("menubar-items")) -(custom-add-loads 'hypermedia '("wid-edit")) -(custom-add-loads 'lisp '("lisp" "lisp-mode" "hyper-apropos")) +(custom-add-loads 'fill '("simple" "fill")) +(custom-add-loads 'display '("modeline" "toolbar" "scrollbar" "auto-show")) +(custom-add-loads 'terminals '("gnuserv")) +(custom-add-loads 'mouse '("mouse" "mwheel")) +(custom-add-loads 'dnd-debug '("dragdrop")) (custom-add-loads 'applications '("cus-edit")) -(custom-add-loads 'help '("help" "cus-edit" "hyper-apropos" "info")) -(custom-add-loads 'keyboard '("cmdloop")) -(custom-add-loads 'hyper-apropos-faces '("hyper-apropos")) -(custom-add-loads 'ldap '("ldap")) -(custom-add-loads 'widget-browse '("wid-browse")) +(custom-add-loads 'emacs '("faces" "help" "files" "cus-edit" "package-get")) (custom-add-loads 'data '("auto-save")) -(custom-add-loads 'warnings '("simple")) -(custom-add-loads 'widget-documentation '("wid-edit")) (custom-add-loads 'comm '("ldap")) -(custom-add-loads 'backup '("files")) -(custom-add-loads 'frames '("frame" "window-xemacs" "gui" "gnuserv")) -(custom-add-loads 'customize '("wid-edit" "cus-edit")) -(custom-add-loads 'custom-browse '("cus-edit")) -(custom-add-loads 'abbrev '("abbrev" "files")) -(custom-add-loads 'programming '("cus-edit")) -(custom-add-loads 'printing '("printer")) -(custom-add-loads 'toolbar '("toolbar-items")) -(custom-add-loads 'dired '("files")) -(custom-add-loads 'dnd-debug '("dragdrop")) (custom-add-loads 'package-get '("package-get")) -(custom-add-loads 'killing '("simple")) -(custom-add-loads 'widget-button '("wid-edit")) +(custom-add-loads 'lisp '("lisp" "lisp-mode" "hyper-apropos")) (custom-add-loads 'paren-blinking '("simple")) -(custom-add-loads 'find-file '("files")) -(custom-add-loads 'font-menu '("font-menu")) -(custom-add-loads 'files '("files")) -(custom-add-loads 'build '("build-report")) -(custom-add-loads 'font-lock '("font-lock")) -(custom-add-loads 'external '("process" "cus-edit")) -(custom-add-loads 'development '("process" "lisp-mode" "cus-edit")) (custom-add-loads 'gnuserv '("gnuserv")) -(custom-add-loads 'gutter '("gutter" "gutter-items")) -(custom-add-loads 'fill-comments '("simple")) -(custom-add-loads 'windows '("window" "window-xemacs")) -(custom-add-loads 'widget-faces '("wid-edit")) -(custom-add-loads 'languages '("lisp-mode" "cus-edit" "font-lock")) -(custom-add-loads 'fill '("simple" "fill")) -(custom-add-loads 'custom-magic-faces '("cus-edit")) -(custom-add-loads 'display '("modeline" "toolbar" "scrollbar" "auto-show")) -(custom-add-loads 'faces '("faces" "cus-edit" "font-lock" "font" "hyper-apropos" "info" "wid-edit")) -(custom-add-loads 'emacs '("faces" "help" "files" "cus-edit" "package-get")) -(custom-add-loads 'processes '("process" "gnuserv")) +(custom-add-loads 'toolbar '("toolbar-items")) +(custom-add-loads 'modeline '("modeline")) +(custom-add-loads 'drag-n-drop '("dragdrop")) +(custom-add-loads 'customize '("wid-edit" "cus-edit")) +(custom-add-loads 'buffers-tab '("gutter-items")) +(custom-add-loads 'widget-browse '("wid-browse")) +(custom-add-loads 'custom-browse '("cus-edit")) (custom-add-loads 'hyper-apropos '("hyper-apropos")) +(custom-add-loads 'custom-faces '("cus-edit")) +(custom-add-loads 'minibuffer '("simple" "minibuf")) +(custom-add-loads 'info '("toolbar-items" "info")) (custom-add-loads 'wp '("printer" "cus-edit")) (custom-add-loads 'vc '("files")) +(custom-add-loads 'keyboard '("cmdloop")) +(custom-add-loads 'docs '("hyper-apropos" "info")) (custom-add-loads 'isearch '("isearch-mode")) -(custom-add-loads 'font-lock-faces '("font-lock")) -(custom-add-loads 'modeline '("modeline")) +(custom-add-loads 'gutter '("gutter" "gutter-items")) +(custom-add-loads 'custom-magic-faces '("cus-edit")) +(custom-add-loads 'etags '("etags")) +(custom-add-loads 'info-faces '("info")) +(custom-add-loads 'widgets '("wid-browse" "wid-edit")) +(custom-add-loads 'auto-show '("auto-show")) +(custom-add-loads 'sound '("sound")) (custom-add-loads 'editing '("simple" "abbrev" "fill" "mouse" "dragdrop" "cus-edit")) -(custom-add-loads 'matching '("simple" "isearch-mode" "hyper-apropos")) -(custom-add-loads 'i18n '("cus-edit")) -(custom-add-loads 'info '("toolbar-items" "info")) +(custom-add-loads 'abbrev '("abbrev" "files")) +(custom-add-loads 'files '("files")) +(custom-add-loads 'environment '("frame" "keydefs" "minibuf" "modeline" "window-xemacs" "menubar" "gutter" "toolbar-items" "cus-edit" "gnuserv" "sound" "x-init")) +(custom-add-loads 'buffers-menu '("menubar-items")) +(custom-add-loads 'external '("process" "cus-edit")) +(custom-add-loads 'killing '("simple")) +(custom-add-loads 'editing-basics '("cmdloop" "simple" "files" "lisp")) +(custom-add-loads 'ldap '("ldap")) +(custom-add-loads 'extensions '("auto-show" "wid-edit")) +(custom-add-loads 'faces '("faces" "cus-edit" "font-lock" "font" "hyper-apropos" "info" "wid-edit")) +(custom-add-loads 'font-menu '("font-menu")) +(custom-add-loads 'widget-button '("wid-edit")) +(custom-add-loads 'tools '("etags" "hyper-apropos")) +(custom-add-loads 'warnings '("simple")) +(custom-add-loads 'hyper-apropos-faces '("hyper-apropos")) +(custom-add-loads 'windows '("window" "window-xemacs")) (custom-add-loads 'x '("gtk-faces" "x-faces")) -(custom-add-loads 'buffers-tab '("gutter-items")) ;;; custom-load.el ends here
--- a/lisp/dialog-gtk.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/dialog-gtk.el Fri May 04 22:42:35 2001 +0000 @@ -32,6 +32,20 @@ (require 'gtk-password-dialog) (require 'gtk-file-dialog) +(globally-declare-fboundp +'(gtk-signal-connect + gtk-main-quit gtk-window-set-transient-for + gtk-widget-show-all gtk-main gtk-color-selection-dialog-new + gtk-color-selection-dialog-ok-button gtk-widget-hide-all + gtk-color-selection-get-color + gtk-color-selection-dialog-colorsel + gtk-color-selection-dialog-cancel-button gtk-widget-show-now + gtk-widget-grab-focus gtk-widget-destroy gtk-dialog-new + gtk-window-set-title gtk-container-set-border-width + gtk-box-set-spacing gtk-dialog-vbox gtk-container-add + gtk-label-new gtk-button-new-with-label + gtk-widget-set-sensitive gtk-widget-show gtk-dialog-action-area)) + (defun popup-builtin-open-dialog (keys) ;; Allowed keywords are: ;; @@ -48,7 +62,6 @@ ;; :no-read-only-return t/nil (let ((initial-filename (plist-get keys :initial-filename)) (clicked-ok nil) - (filename nil) (widget nil)) (setq widget (gtk-file-dialog-new :directory (plist-get keys :directory) @@ -76,7 +89,7 @@ (defun popup-builtin-color-dialog (keys) ;; Allowed keys: ;; :initial-color COLOR - (let ((initial-color (or (plist-get keys :initial-color) "white")) + (let (;(initial-color (or (plist-get keys :initial-color) "white")) (title (or (plist-get keys :title "Select color..."))) (dialog nil) (clicked-ok nil)
--- a/lisp/dialog.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/dialog.el Fri May 04 22:42:35 2001 +0000 @@ -613,45 +613,44 @@ (setq frame (make-frame (append cl-properties - `(popup ,cl-parent initially-unmapped t - menubar-visible-p nil - has-modeline-p nil - default-toolbar-visible-p nil - top-gutter-visible-p t - top-gutter-height , - (* dfheight fonth) - top-gutter ,gutter-spec - minibuffer none - name ,name - modeline-shadow-thickness 0 - vertical-scrollbar-visible-p nil - horizontal-scrollbar-visible-p nil - unsplittable t - left ,(+ fleft (- (/ fwidth 2) - (/ (* dfwidth - fontw) - 2))) - top ,(+ ftop (- (/ fheight 2) - (/ (* dfheight - fonth) - 2))))))) + `(popup + ,cl-parent initially-unmapped t + menubar-visible-p nil + has-modeline-p nil + default-toolbar-visible-p nil + top-gutter-visible-p t + top-gutter-height ,(* dfheight fonth) + top-gutter ,gutter-spec + minibuffer none + name ,name + modeline-shadow-thickness 0 + vertical-scrollbar-visible-p nil + horizontal-scrollbar-visible-p nil + unsplittable t + left ,(+ fleft (- (/ fwidth 2) + (/ (* dfwidth + fontw) + 2))) + top ,(+ ftop (- (/ fheight 2) + (/ (* dfheight + fonth) + 2))))))) (set-face-foreground 'modeline [default foreground] frame) (set-face-background 'modeline [default background] frame) (unless unmapped (make-frame-visible frame)) (let ((newbuf (generate-new-buffer " *dialog box*"))) (set-buffer-dedicated-frame newbuf frame) (set-frame-property frame 'dialog-box-buffer newbuf) + (set-window-buffer (frame-root-window frame) newbuf) (with-current-buffer newbuf - ;; Should be frame specific, so - ;; we don't do this for now. - ;; (setq frame-title-format cl-title) - (make-local-hook 'delete-frame-hook) - (add-hook 'delete-frame-hook - #'(lambda (frame) - (kill-buffer - (frame-property - frame - 'dialog-box-buffer)))))) + (set (make-local-variable 'frame-title-format) + cl-title) + (add-local-hook 'delete-frame-hook + #'(lambda (frame) + (kill-buffer + (frame-property + frame + 'dialog-box-buffer)))))) frame))) (if cl-modal (dialog-box-modal-loop '(create-dialog-box-frame))
--- a/lisp/dragdrop.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/dragdrop.el Fri May 04 22:42:35 2001 +0000 @@ -304,7 +304,7 @@ (erase-buffer) (insert data) (and (featurep 'tm-view) - (mime/viewer-mode buf))) + (declare-fboundp (mime/viewer-mode buf)))) ((and (listp data) (= (length data) 3)) ;; change the internal content-type representation to the @@ -318,7 +318,8 @@ (and (featurep 'tm-view) ;; this list of (car data) should be done before ;; enqueing the event - (mime/viewer-mode buf (car data) (cadr data)))) + (declare-fboundp + (mime/viewer-mode buf (car data) (cadr data))))) (t (display-message 'error "Wrong drop data"))))) (undo-boundary) @@ -423,13 +424,13 @@ (defun gtk-start-drag (event data &optional type) (interactive "esi") (if (featurep 'gtk) - (gtk-start-drag-internal event data type) + (declare-fboundp (gtk-start-drag-internal event data type)) (error "GTK functionality not compiled in."))) (defun gtk-start-drag-region (event begin end) (interactive "_er") (if (featurep 'gtk) - (gtk-start-drag-internal event (buffer-substring-no-properties begin end) "text/plain") + (declare-fboundp (gtk-start-drag-internal event (buffer-substring-no-properties begin end) "text/plain")) (error "GTK functionality not compiled in."))) ;;; dragdrop.el ends here
--- a/lisp/dumped-lisp.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/dumped-lisp.el Fri May 04 22:42:35 2001 +0000 @@ -30,6 +30,7 @@ "objects" "extents" "events" + "hash-table" "text-props" "process" ;; This is bad. network-streams may not be defined. (when-feature multicast "multicast") ; #+network-streams implicitly true
--- a/lisp/easymenu.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/easymenu.el Fri May 04 22:42:35 2001 +0000 @@ -159,7 +159,7 @@ ,doc (interactive "@e") (run-hooks 'activate-menubar-hook) - (setq zmacs-region-stays 't) + (setq zmacs-region-stays t) (popup-menu ,symbol))))) (defun easy-menu-change (&rest args)
--- a/lisp/etags.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/etags.el Fri May 04 22:42:35 2001 +0000 @@ -172,6 +172,11 @@ :type 'boolean :group 'etags) +(defcustom tags-check-parent-directories-for-tag-files t + "*If non-nil, look for TAGS files in all parent directories." + :type 'boolean + :group 'etags) + ;; Buffer tag tables. @@ -185,10 +190,13 @@ ;; Current directory (when (file-readable-p (concat default-directory "TAGS")) (push (concat default-directory "TAGS") result)) - ;; Parent directory - (let ((parent-tag-file (expand-file-name "../TAGS" default-directory))) - (when (file-readable-p parent-tag-file) - (push parent-tag-file result))) + ;; Parent directories + (when tags-check-parent-directories-for-tag-files + (let ((cur default-directory)) + (while (file-exists-p (setq cur (expand-file-name ".." cur))) + (let ((parent-tag-file (expand-file-name "TAGS" cur))) + (when (file-readable-p parent-tag-file) + (push parent-tag-file result)))))) ;; tag-table-alist (let* ((key (or buffer-file-name (concat default-directory (buffer-name))))
--- a/lisp/faces.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/faces.el Fri May 04 22:42:35 2001 +0000 @@ -1496,7 +1496,7 @@ ((framep locale) (frame-type locale)) (t nil)))) (cond ((or (and (not devtype) (featurep 'x)) (eq 'x devtype)) - (x-init-face-from-resources face locale)) + (declare-fboundp (x-init-face-from-resources face locale))) ((or (not devtype) (eq 'tty devtype)) ;; Nothing to do for TTYs? )))))) @@ -1508,11 +1508,11 @@ (init-face-from-resources face device)) ;; Then do any device-specific initialization. (cond ((eq 'x (device-type device)) - (x-init-device-faces device)) + (declare-fboundp (x-init-device-faces device))) ((eq 'gtk (device-type device)) - (gtk-init-device-faces device)) + (declare-fboundp (gtk-init-device-faces device))) ((eq 'mswindows (device-type device)) - (mswindows-init-device-faces device)) + (declare-fboundp (mswindows-init-device-faces device))) ;; Nothing to do for TTYs? ) (or (eq 'stream (device-type device)) @@ -1525,11 +1525,11 @@ (init-face-from-resources face frame)) ;; Then do any frame-specific initialization. (cond ((eq 'x (frame-type frame)) - (x-init-frame-faces frame)) + (declare-fboundp (x-init-frame-faces frame))) ((eq 'gtk (frame-type frame)) - (gtk-init-frame-faces frame)) + (declare-fboundp (gtk-init-frame-faces frame))) ((eq 'mswindows (frame-type frame)) - (mswindows-init-frame-faces frame)) + (declare-fboundp (mswindows-init-frame-faces frame))) ;; Is there anything which should be done for TTY's? ))) @@ -1544,8 +1544,8 @@ (loop for face in (face-list) do (init-face-from-resources face 'global)) ;; Further X frobbing. - (and (featurep 'x) (x-init-global-faces)) - (and (featurep 'gtk) (gtk-init-global-faces)) + (and (featurep 'x) (declare-fboundp (x-init-global-faces))) + (and (featurep 'gtk) (declare-fboundp (gtk-init-global-faces))) ;; for bold and the like, make the global specification be bold etc. ;; if the user didn't already specify a value. These will also be @@ -1701,9 +1701,10 @@ in that frame; otherwise change each frame." (while (not (find-face face)) (setq face (wrong-type-argument 'facep face))) - (let ((bitmap-path (ecase (console-type) - (x x-bitmap-file-path) - (mswindows mswindows-bitmap-file-path))) + (let ((bitmap-path + (ecase (console-type) + (x (declare-boundp x-bitmap-file-path)) + (mswindows (declare-boundp mswindows-bitmap-file-path)))) instantiator) (while (null
--- a/lisp/files.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/files.el Fri May 04 22:42:35 2001 +0000 @@ -1708,6 +1708,52 @@ ;; Ordinary variable, really set it. (t (make-local-variable var) (set var val)))) + +(defun find-coding-system-magic-cookie-in-file (file) + "Look for the coding-system magic cookie in FILE. +The coding-system magic cookie is either the local variable specification +-*- ... coding: ... -*- on the first line, or the exact string +\";;;###coding system: \" somewhere within the first 3000 characters +of the file. If found, the coding system name (as a string) is returned; +otherwise nil is returned. Note that it is extremely unlikely that +either such string would occur coincidentally as the result of encoding +some characters in a non-ASCII charset, and that the spaces make it +even less likely since the space character is not a valid octet in any +ISO 2022 encoding of most non-ASCII charsets." + (save-excursion + (with-temp-buffer + (let ((coding-system-for-read 'raw-text)) + (insert-file-contents file nil 1 3001)) + (goto-char (point-min)) + (or (and (looking-at + "^[^\n]*-\\*-[^\n]*coding: \\([^ \t\n;]+\\)[^\n]*-\\*-") + (buffer-substring (match-beginning 1) (match-end 1))) + ;; (save-excursion + ;; (let (start end) + ;; (and (re-search-forward "^;+[ \t]*Local Variables:" nil t) + ;; (setq start (match-end 0)) + ;; (re-search-forward "\n;+[ \t]*End:") + ;; (setq end (match-beginning 0)) + ;; (save-restriction + ;; (narrow-to-region start end) + ;; (goto-char start) + ;; (re-search-forward "^;;; coding: \\([^\n]+\\)$" nil t) + ;; ) + ;; (let ((codesys + ;; (intern (buffer-substring + ;; (match-beginning 1)(match-end 1))))) + ;; (if (find-coding-system codesys) codesys)) + ;; ))) + (let ((case-fold-search nil)) + (if (search-forward + ";;;###coding system: " (+ (point-min) 3000) t) + (let ((start (point)) + (end (progn + (skip-chars-forward "^ \t\n\r") + (point)))) + (if (> end start) (buffer-substring start end)) + ))) + )))) (defcustom change-major-mode-with-file-name t "*Non-nil means \\[write-file] should set the major mode from the file name. @@ -1789,10 +1835,11 @@ (kill-local-variable 'backup-inhibited) ;; If buffer was read-only because of version control, ;; that reason is gone now, so make it writable. - (when (boundp 'vc-mode) - (if vc-mode - (setq buffer-read-only nil)) - (kill-local-variable 'vc-mode)) + (if-boundp 'vc-mode + (progn + (if vc-mode + (setq buffer-read-only nil)) + (kill-local-variable 'vc-mode))) ;; Turn off backup files for certain file names. ;; Since this is a permanent local, the major mode won't eliminate it. (and buffer-file-name @@ -2290,8 +2337,8 @@ ;; delete it now. (delete-auto-save-file-if-necessary recent-save) ;; Support VC `implicit' locking. - (when (fboundp 'vc-after-save) - (vc-after-save)) + (if-fboundp 'vc-after-save + (vc-after-save)) (run-hooks 'after-save-hook)) (display-message 'no-log "(No changes need to be saved)")))) @@ -2477,9 +2524,10 @@ ;; #### FSF has an EXIT-ACTION argument ;; to `view-buffer'. (view-buffer buf) - (setq view-exit-action - (lambda (ignore) - (exit-recursive-edit))) + (with-boundp 'view-exit-action + (setq view-exit-action + (lambda (ignore) + (exit-recursive-edit)))) (recursive-edit) ;; Return nil to ask about BUF again. nil) @@ -3223,8 +3271,10 @@ (defun file-remote-p (file-name) "Test whether FILE-NAME is looked for on a remote system." (cond ((not allow-remote-paths) nil) - ((featurep 'ange-ftp) (ange-ftp-ftp-path file-name)) - ((fboundp 'efs-ftp-path) (efs-ftp-path file-name)) + ((fboundp 'ange-ftp-ftp-path) + (declare-fboundp (ange-ftp-ftp-path file-name))) + ((fboundp 'efs-ftp-path) + (declare-fboundp (efs-ftp-path file-name))) (t nil))) ;; #### FSF has file-name-non-special here.
--- a/lisp/fill.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/fill.el Fri May 04 22:42:35 2001 +0000 @@ -128,7 +128,7 @@ (forward-char -1) (if (< (point) opoint) (forward-char)))) - (if (featurep 'mule) (kinsoku-process-extend))) + (if (featurep 'mule) (declare-fboundp (kinsoku-process-extend)))) (defun fill-end-of-sentence-p () (save-excursion @@ -458,7 +458,7 @@ ;; 97/3/14 jhod: Kinsoku ;(skip-chars-backward "^ \n" linebeg))) (fill-move-backward-to-break-point re-break-point linebeg))) - (if (featurep 'mule) (kinsoku-process)) + (if (featurep 'mule) (declare-fboundp (kinsoku-process))) ;end patch ;; If the left margin and fill prefix by themselves @@ -662,14 +662,13 @@ (fill-region-as-paragraph (point) end justify nosqueeze) (goto-char end))))))) -;; XEmacs addition: from Tim Bradshaw <tfb@edinburgh.ac.uk> (defun fill-paragraph-or-region (arg) "Fill the current region, if it's active; otherwise, fill the paragraph. See `fill-paragraph' and `fill-region' for more information." (interactive "*P") (if (region-active-p) - (fill-region (point) (mark) arg) - (fill-paragraph arg))) + (call-interactively 'fill-region) + (call-interactively 'fill-paragraph))) (defconst default-justification 'left @@ -787,7 +786,7 @@ (defun find-space-insertable-point () "Search backward for a permissible point for inserting justification spaces." (if (boundp 'space-insertable) - (if (re-search-backward space-insertable nil t) + (if (re-search-backward (declare-boundp space-insertable) nil t) (progn (forward-char 1) t) nil)
--- a/lisp/font-lock.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/font-lock.el Fri May 04 22:42:35 2001 +0000 @@ -1237,40 +1237,38 @@ ;; syntactically-sectionize any more. Do we still ;; need the widen? (widen) - (let ((zmacs-region-stays - zmacs-region-stays)) ; protect from change! - (map-extents - #'(lambda (ex dummy-maparg) - ;; first expand the ranges to full lines, - ;; because that is what will be fontified; - ;; then use a range table to merge the - ;; ranges. (we could also do this simply using - ;; text properties. the range table code was - ;; here from a previous version of this code - ;; and works just as well.) - (let* ((beg (extent-start-position ex)) - (end (extent-end-position ex)) - (beg (progn (goto-char beg) - (beginning-of-line) - (point))) - (end (progn (goto-char end) - (forward-line 1) - (point)))) - (put-range-table beg end t - font-lock-range-table))) - nil nil nil nil nil 'font-lock-pending t) - ;; clear all pending extents first in case of error below. - (put-text-property (point-min) (point-max) - 'font-lock-pending nil) - (map-range-table - #'(lambda (beg end val) + (map-extents + #'(lambda (ex dummy-maparg) + ;; first expand the ranges to full lines, + ;; because that is what will be fontified; + ;; then use a range table to merge the + ;; ranges. (we could also do this simply using + ;; text properties. the range table code was + ;; here from a previous version of this code + ;; and works just as well.) + (let* ((beg (extent-start-position ex)) + (end (extent-end-position ex)) + (beg (progn (goto-char beg) + (beginning-of-line) + (point))) + (end (progn (goto-char end) + (forward-line 1) + (point)))) + (put-range-table beg end t + font-lock-range-table))) + nil nil nil nil nil 'font-lock-pending t) + ;; clear all pending extents first in case of error below. + (put-text-property (point-min) (point-max) + 'font-lock-pending nil) + (map-range-table + #'(lambda (beg end val) ;; This creates some unnecessary progress gauges. ;; (if (and (= beg (point-min)) ;; (= end (point-max))) ;; (font-lock-fontify-buffer) ;; (font-lock-fontify-region beg end))) - (font-lock-fontify-region beg end)) - font-lock-range-table))))))) + (font-lock-fontify-region beg end)) + font-lock-range-table)))))) font-lock-pending-buffer-table))) ;; Syntactic fontification functions. @@ -1664,12 +1662,12 @@ ((and (boundp 'lazy-shot-mode) lazy-shot-mode) (lazy-shot-mode -1)))) -;; Do something special for these packages after fontifying. I prefer a hook. +; Do something special for these packages after fontifying. I prefer a hook. (defun font-lock-after-fontify-buffer () (cond ((and (boundp 'fast-lock-mode) fast-lock-mode) - (fast-lock-after-fontify-buffer)) + (declare-fboundp (fast-lock-after-fontify-buffer))) ((and (boundp 'lazy-lock-mode) lazy-lock-mode) - (lazy-lock-after-fontify-buffer)))) + (declare-fboundp (lazy-lock-after-fontify-buffer))))) ;; Various functions.
--- a/lisp/font.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/font.el Fri May 04 22:42:35 2001 +0000 @@ -1,34 +1,44 @@ ;;; font.el --- New font model + +;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu) +;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. + ;; Author: wmperry +;; Maintainer: XEmacs Development Team ;; Created: 1997/09/05 15:44:37 +;; Keywords: faces ;; Version: 1.52 -;; Keywords: faces + +;; 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 1, 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is part of GNU Emacs. -;;; -;;; GNU Emacs 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. -;;; -;;; GNU Emacs is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to the -;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;;; Boston, MA 02111-1307, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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 in FSF + +;;; Commentary: -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The emacsen compatibility package - load it up before anything else -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Code: + +(globally-declare-fboundp + '(x-list-fonts + mswindows-list-fonts ns-list-fonts internal-facep fontsetp get-font-info + get-fontset-info mswindows-define-rgb-color cancel-function-timers)) + +(globally-declare-boundp + '(global-face-data + x-font-regexp x-font-regexp-foundry-and-family)) + (require 'cl) (eval-and-compile @@ -75,12 +85,6 @@ (require 'disp-table) -(if (not (fboundp '<<)) (fset '<< 'lsh)) -(if (not (fboundp '&)) (fset '& 'logand)) -(if (not (fboundp '|)) (fset '| 'logior)) -(if (not (fboundp '~)) (fset '~ 'lognot)) -(if (not (fboundp '>>)) (defun >> (value count) (<< value (- count)))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Lots of variables / keywords for use later in the program @@ -149,40 +153,40 @@ (defvar font-style-keywords nil) -(defsubst set-font-family (fontobj family) +(defun set-font-family (fontobj family) (aset fontobj 1 family)) -(defsubst set-font-weight (fontobj weight) +(defun set-font-weight (fontobj weight) (aset fontobj 3 weight)) -(defsubst set-font-style (fontobj style) +(defun set-font-style (fontobj style) (aset fontobj 5 style)) -(defsubst set-font-size (fontobj size) +(defun set-font-size (fontobj size) (aset fontobj 7 size)) -(defsubst set-font-registry (fontobj reg) +(defun set-font-registry (fontobj reg) (aset fontobj 9 reg)) -(defsubst set-font-encoding (fontobj enc) +(defun set-font-encoding (fontobj enc) (aset fontobj 11 enc)) -(defsubst font-family (fontobj) +(defun font-family (fontobj) (aref fontobj 1)) -(defsubst font-weight (fontobj) +(defun font-weight (fontobj) (aref fontobj 3)) -(defsubst font-style (fontobj) +(defun font-style (fontobj) (aref fontobj 5)) -(defsubst font-size (fontobj) +(defun font-size (fontobj) (aref fontobj 7)) -(defsubst font-registry (fontobj) +(defun font-registry (fontobj) (aref fontobj 9)) -(defsubst font-encoding (fontobj) +(defun font-encoding (fontobj) (aref fontobj 11)) (eval-when-compile @@ -194,13 +198,13 @@ (quote ,(intern (format "set-font-%s-p" attr))) (quote ,(intern (format "font-%s-p" attr))))) font-style-keywords)) - (defconst ,(intern (format "font-%s-mask" attr)) (<< 1 ,mask) + (defconst ,(intern (format "font-%s-mask" attr)) (lsh 1 ,mask) ,(format "Bitmask for whether a font is to be rendered in %s or not." attr)) (defun ,(intern (format "font-%s-p" attr)) (fontobj) ,(format "Whether FONTOBJ will be renderd in `%s' or not." attr) - (if (/= 0 (& (font-style fontobj) + (if (/= 0 (logand (font-style fontobj) ,(intern (format "font-%s-mask" attr)))) t nil)) @@ -209,9 +213,9 @@ attr) (cond (val - (set-font-style fontobj (| (font-style fontobj) - ,(intern - (format "font-%s-mask" attr))))) + (set-font-style fontobj (logior (font-style fontobj) + ,(intern + (format "font-%s-mask" attr))))) ((,(intern (format "font-%s-p" attr)) fontobj) (set-font-style fontobj (- (font-style fontobj) ,(intern @@ -254,7 +258,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Utility functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defsubst set-font-style-by-keywords (fontobj styles) +(defun set-font-style-by-keywords (fontobj styles) (make-local-variable 'font-func) (declare (special font-func)) (if (listp styles) @@ -265,9 +269,8 @@ (setq font-func (car-safe (cdr-safe (assq styles font-style-keywords)))) (and (fboundp font-func) (funcall font-func fontobj t)))) -(defsubst font-properties-from-style (fontobj) - (let ((style (font-style fontobj)) - (todo font-style-keywords) +(defun font-properties-from-style (fontobj) + (let ((todo font-style-keywords) type func retval) (while todo (setq func (cdr (cdr (car todo))) @@ -394,7 +397,8 @@ (font-weight fontobj-2))) (set-font-family retval (font-unique (append (font-family fontobj-1) (font-family fontobj-2)))) - (set-font-style retval (| (font-style fontobj-1) (font-style fontobj-2))) + (set-font-style retval (logior (font-style fontobj-1) + (font-style fontobj-2))) (set-font-registry retval (or (font-registry fontobj-1) (font-registry fontobj-2))) (set-font-encoding retval (or (font-encoding fontobj-1) @@ -454,9 +458,9 @@ ((- "[-?]") (foundry "[^-]*") (family "[^-]*") - (weight "\\(bold\\|demibold\\|medium\\|black\\)") + ;(weight "\\(bold\\|demibold\\|medium\\|black\\)") (weight\? "\\([^-]*\\)") - (slant "\\([ior]\\)") + ;(slant "\\([ior]\\)") (slant\? "\\([^-]?\\)") (swidth "\\([^-]*\\)") (adstyle "\\([^-]*\\)") @@ -523,7 +527,6 @@ (not (string-match font-x-font-regexp fontname))) (make-font) (let ((family nil) - (style nil) (size nil) (weight (match-string 1 fontname)) (slant (match-string 2 fontname)) @@ -634,7 +637,6 @@ (font-family default) (x-font-families-for-device device))) (weight (or (font-weight fontobj) :medium)) - (style (font-style fontobj)) (size (or (if font-running-xemacs (font-size fontobj)) (font-size default))) @@ -717,9 +719,7 @@ (ns-font-families-for-device device))) (weight (or (font-weight fontobj) :medium)) (style (or (font-style fontobj) (list :normal))) - (size (font-size fontobj)) - (registry (or (font-registry fontobj) "*")) - (encoding (or (font-encoding fontobj) "*"))) + (size (font-size fontobj))) ;; Create a font, wow! (if (stringp family) (setq family (list family))) @@ -863,7 +863,6 @@ (family (or (font-family fontobj) (font-family default))) (weight (or (font-weight fontobj) :regular)) - (style (font-style fontobj)) (size (or (if font-running-xemacs (font-size fontobj)) (font-size default))) @@ -996,7 +995,6 @@ ;; create-device-hook. This is XEmacs 19.12+ specific (let ((faces (face-list 2)) (cur nil) - (font nil) (font-spec nil)) (while faces (setq cur (car faces) @@ -1012,8 +1010,7 @@ (if (devicep device-list) (setq device-list (list device-list))) (let* ((cur-device nil) - (font-spec (face-property face 'font-specification)) - (font nil)) + (font-spec (face-property face 'font-specification))) (if (not font-spec) ;; Hey! Don't mess with fonts we didn't create in the ;; first place. @@ -1189,14 +1186,14 @@ b 0))) (list r g b) )) -(defsubst font-rgb-color-p (obj) +(defun font-rgb-color-p (obj) (or (and (vectorp obj) (= (length obj) 4) (eq (aref obj 0) 'rgb)))) -(defsubst font-rgb-color-red (obj) (aref obj 1)) -(defsubst font-rgb-color-green (obj) (aref obj 2)) -(defsubst font-rgb-color-blue (obj) (aref obj 3)) +(defun font-rgb-color-red (obj) (aref obj 1)) +(defun font-rgb-color-green (obj) (aref obj 2)) +(defun font-rgb-color-blue (obj) (aref obj 3)) (defun font-color-rgb-components (color) "Return the RGB components of COLOR as a list of integers (R G B). @@ -1237,7 +1234,7 @@ (t (font-lookup-rgb-components color))))) -(defsubst font-tty-compute-color-delta (col1 col2) +(defun font-tty-compute-color-delta (col1 col2) (+ (* (- (aref col1 0) (aref col2 0)) (- (aref col1 0) (aref col2 0))) @@ -1295,7 +1292,7 @@ (tty (apply 'font-tty-find-closest-color (font-color-rgb-components color))) (ns - (let ((vals (mapcar #'(lambda (x) (>> x 8)) + (let ((vals (mapcar #'(lambda (x) (lsh x -8)) (font-color-rgb-components color)))) (apply 'format "RGB%02x%02x%02xff" vals))) (otherwise
--- a/lisp/frame.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/frame.el Fri May 04 22:42:35 2001 +0000 @@ -782,7 +782,8 @@ (cond ((device-on-window-system-p) (iconify-emacs)) ((and (eq (device-type) 'tty) - (console-tty-controlling-process (selected-console))) + (declare-fboundp (console-tty-controlling-process + (selected-console)))) (suspend-console (selected-console))) (t (suspend-emacs)))) @@ -797,7 +798,8 @@ (cond ((device-on-window-system-p) (iconify-frame)) ((and (eq (frame-type) 'tty) - (console-tty-controlling-process (selected-console))) + (declare-fboundp (console-tty-controlling-process + (selected-console)))) (suspend-console (selected-console))) (t (suspend-emacs))))
--- a/lisp/gdk.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/gdk.el Fri May 04 22:42:35 2001 +0000 @@ -31,6 +31,9 @@ (eval-and-compile (require 'gtk-ffi)) +(globally-declare-fboundp + '(gtk-import-function-internal gtk-call-function)) + (gtk-import-function nil gdk_set_show_events (gboolean . show_events)) (gtk-import-function nil gdk_set_use_xshm (gboolean . use_xshm)) (gtk-import-function GtkString gdk_get_display)
--- a/lisp/generic-widgets.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/generic-widgets.el Fri May 04 22:42:35 2001 +0000 @@ -28,6 +28,21 @@ ;; This file is dumped with XEmacs. +(globally-declare-fboundp + '(gtk-label-new + gtk-widget-show-all gtk-signal-connect + gtk-window-new gtk-container-add gtk-vbox-new gtk-hbox-new + gtk-box-pack-start gtk-notebook-new + gtk-notebook-set-homogeneous-tabs gtk-notebook-set-scrollable + gtk-notebook-set-show-tabs gtk-notebook-set-tab-pos + gtk-notebook-append-page gtk-text-new gtk-text-set-editable + gtk-text-set-word-wrap gtk-text-set-line-wrap + gtk-widget-set-style gtk-text-insert gtk-label-set-line-wrap + gtk-label-set-justify gtk-radio-button-new + gtk-radio-button-group gtk-check-button-new + gtk-toggle-button-new gtk-button-new gtk-progress-bar-new + gtk-progress-bar-set-orientation gtk-progress-bar-set-bar-style)) + (defun build-ui (ui) (if (null ui) (gtk-label-new "[empty]") @@ -222,6 +237,7 @@ (defun build-ui::radio-group (spec) "A convenience when specifying a group of radio buttons." + (declare (special build-ui::radio-group)) (let ((build-ui::radio-group nil)) (mapcar 'build-ui (plist-get (cdr spec) :items)))) @@ -236,10 +252,10 @@ NOTE: Radio buttons must be in a radio-group object for them to work. " - (let ((plist (cdr spec)) - (button nil) - (button-type (plist-get plist :type 'normal)) - (label nil)) + (declare (special build-ui::radio-group)) + (let* ((plist (cdr spec)) + (button nil) + (button-type (plist-get plist :type 'normal))) (case button-type (radio (if (not (boundp 'build-ui::radio-group))
--- a/lisp/glade.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/glade.el Fri May 04 22:42:35 2001 +0000 @@ -31,6 +31,9 @@ (eval-and-compile (require 'gtk-ffi)) +(globally-declare-fboundp + '(gtk-import-function-internal gtk-call-function)) + (gtk-import-function none glade_init) (gtk-import-function none glade_gnome_init) (gtk-import-function none glade_bonobo_init)
--- a/lisp/gnome-widgets.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/gnome-widgets.el Fri May 04 22:42:35 2001 +0000 @@ -31,6 +31,11 @@ (eval-and-compile (require 'gtk-ffi)) +(globally-declare-fboundp + '(gtk-import-function-internal + gtk-call-function + gtk-button-new-with-label)) + (gtk-import-function GtkType gnome_about_get_type) (gtk-import-function GtkWidget gnome_about_new (GtkString . title)
--- a/lisp/gnome.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/gnome.el Fri May 04 22:42:35 2001 +0000 @@ -1,3 +1,8 @@ +(globally-declare-fboundp + '(gtk-type-from-name + gtk-import-function-internal + gtk-call-function)) + (defvar gnome-init-called nil) (defun gnome-init (app-id app-version argv)
--- a/lisp/gpm.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/gpm.el Fri May 04 22:42:35 2001 +0000 @@ -26,25 +26,26 @@ :size 13 :weakness 'key) "A hash table of devices with GPM currently turned on.") - + (defun gpm-mode (&optional arg device) "Toggle GPM mouse mode. With prefix arg, turn GPM mouse mode on if and only if arg is positive." (interactive (list current-prefix-arg (selected-device))) - (cond - ((null arg) ; Toggle - (if (gethash device gpm-enabled-devices) - (progn - (gpm-enable device nil) - (remhash device gpm-enabled-devices)) + (with-fboundp 'gpm-enable + (cond + ((null arg) ; Toggle + (if (gethash device gpm-enabled-devices) + (progn + (gpm-enable device nil) + (remhash device gpm-enabled-devices)) + (gpm-enable device t) + (puthash device t gpm-enabled-devices))) + ((> arg 0) ; Turn on (gpm-enable device t) - (puthash device t gpm-enabled-devices))) - ((> arg 0) ; Turn on - (gpm-enable device t) - (puthash device t gpm-enabled-devices)) - ((gethash device gpm-enabled-devices) ; Turn off - (gpm-enable device nil) - (remhash device gpm-enabled-devices)))) + (puthash device t gpm-enabled-devices)) + ((gethash device gpm-enabled-devices) ; Turn off + (gpm-enable device nil) + (remhash device gpm-enabled-devices))))) (defun turn-on-gpm-mouse-tracking (&optional device) ;; Enable mouse tracking on linux console @@ -54,22 +55,24 @@ ;; Disable mouse tracking on linux console (gpm-mode -5 device)) +(defun gpm-is-supported-p (device) + "Returns non-nil if GPM is usable right now on DEVICE in this XEmacs session. +This checks whether GPM support was compiled in, TTY support was +compiled in, XEmacs is running on Linux, the current console/device is +TTY, and its terminal type has been set to `linux'." + (and (not noninteractive) ; Don't want to do this in batch mode + (fboundp 'gpm-enable) ; Must have C-level GPM support + (eq system-type 'linux) ; Must be running linux + (eq (device-type device) 'tty) ; on a tty + (equal "linux" (declare-fboundp ; an a linux terminal type + (console-tty-terminal-type (device-console device)))))) + (defun gpm-create-device-hook (device) - (if (and (not noninteractive) ; Don't want to do this in batch mode - (fboundp 'gpm-enable) ; Must have C-level GPM support - (eq system-type 'linux) ; Must be running linux - (eq (device-type device) 'tty) ; on a tty - (equal "linux" (console-tty-terminal-type ; an a linux terminal type - (device-console device)))) + (if (gpm-is-supported-p device) (turn-on-gpm-mouse-tracking device))) (defun gpm-delete-device-hook (device) - (if (and (not noninteractive) ; Don't want to do this in batch mode - (fboundp 'gpm-enable) ; Must have C-level GPM support - (eq system-type 'linux) ; Must be running linux - (eq (device-type device) 'tty) ; on a tty - (equal "linux" (console-tty-terminal-type ; an a linux terminal type - (device-console device)))) + (if (gpm-is-supported-p device) (turn-off-gpm-mouse-tracking device))) ;; Restore normal mouse behavior outside Emacs
--- a/lisp/gtk-extra.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/gtk-extra.el Fri May 04 22:42:35 2001 +0000 @@ -31,6 +31,9 @@ (eval-and-compile (require 'gtk-ffi)) +(globally-declare-fboundp + '(gtk-import-function-internal gtk-call-function)) + ;;; gtkbordercombo.h (gtk-import-function GtkType gtk_border_combo_get_type) (gtk-import-function GtkWidget gtk_border_combo_new)
--- a/lisp/gtk-faces.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/gtk-faces.el Fri May 04 22:42:35 2001 +0000 @@ -31,6 +31,16 @@ ;; This file is dumped with XEmacs (when GTK support is compiled in). +(globally-declare-fboundp + '(gtk-init-pointers + gtk-font-selection-dialog-new + gtk-widget-set-sensitive gtk-font-selection-dialog-apply-button + gtk-signal-connect gtk-main-quit + gtk-font-selection-dialog-ok-button + gtk-font-selection-dialog-get-font-name gtk-widget-destroy + font-menu-set-font font-family font-size + gtk-font-selection-dialog-cancel-button gtk-widget-show-all + gtk-main)) (defun gtk-init-find-device () (let ((dev nil) @@ -282,7 +292,6 @@ 'clicked (lambda (button data) (let* ((dialog (car data)) - (locale (cdr data)) (font (font-create-object (gtk-font-selection-dialog-get-font-name dialog)))) (gtk-widget-destroy dialog)
--- a/lisp/gtk-file-dialog.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/gtk-file-dialog.el Fri May 04 22:42:35 2001 +0000 @@ -38,6 +38,21 @@ ;; ;; This attempts to rectify the situation. +(globally-declare-fboundp + '(gtk-clist-clear + gtk-clist-freeze gtk-clist-append + gtk-clist-thaw gtk-combo-set-popdown-strings gtk-dialog-new + gtk-dialog-vbox gtk-dialog-action-area gtk-window-set-title + gtk-button-new-with-label gtk-container-add gtk-signal-connect + gtk-entry-get-text gtk-widget-destroy gtk-combo-new + gtk-combo-disable-activate gtk-box-pack-start gtk-combo-entry + gtk-hbox-new gtk-clist-new-with-titles gtk-scrolled-window-new + gtk-widget-set-usize gtk-clist-get-text gtk-entry-set-text + gtk-button-clicked gtk-option-menu-new gtk-menu-new + gtk-label-new gtk-menu-item-new-with-label gtk-menu-append + gtk-widget-show gtk-option-menu-set-menu gtk-box-pack-end + gtk-entry-new gtk-widget-set-sensitive gtk-widget-realize)) + (defun gtk-file-dialog-fill-file-list (dialog dir) (if (not dir) (setq dir (get dialog 'x-file-dialog-current-dir nil))) @@ -45,7 +60,8 @@ (put dialog 'x-file-dialog-current-dir dir) (let ((list (get dialog 'x-file-dialog-files-list nil)) - (remotep (file-remote-p dir))) + ;(remotep (file-remote-p dir)) + ) (if (not list) nil (gtk-clist-clear list) @@ -53,11 +69,12 @@ ;; NOTE: Current versions of efs / ange-ftp do not honor the ;; files-only flag to directory-files, but actually DOING these ;; checks is hideously expensive. Leave it turned off for now. - (mapc (lambda (f) - (if (or t ; Lets just wait for EFS to - (not remotep) ; fix itself, shall we? - (not (file-directory-p (expand-file-name f dir)))) - (gtk-clist-append list (list f)))) + (mapc #'(lambda (f) + (if (or t ; Lets just wait for EFS to + ;(not remotep) ; fix itself, shall we? + ;(not (file-directory-p (expand-file-name f dir))) + ) + (gtk-clist-append list (list f)))) (directory-files dir nil (get dialog 'x-file-dialog-active-filter nil) nil t)) @@ -65,8 +82,8 @@ (defun gtk-file-dialog-fill-directory-list (dialog dir) (let ((subdirs (directory-files dir nil nil nil 5)) - (remotep (file-remote-p dir)) - (selected-dir (get dialog 'x-file-dialog-current-dir "/")) + ;(remotep (file-remote-p dir)) + ;(selected-dir (get dialog 'x-file-dialog-current-dir "/")) (directory-list (get dialog 'x-file-dialog-directory-list))) (gtk-clist-freeze directory-list) @@ -79,8 +96,9 @@ ;; files-only flag to directory-files, but actually DOING these ;; checks is hideously expensive. Leave it turned off for now. (if (or t ; Lets just wait for EFS to - (not remotep) ; fix itself, shall we? - (file-directory-p (expand-file-name (car subdirs) dir))) + ;(not remotep) ; fix itself, shall we? + ;(file-directory-p (expand-file-name (car subdirs) dir)) + ) (gtk-clist-append directory-list (list (car subdirs))))) (pop subdirs)) (gtk-clist-thaw directory-list))) @@ -121,7 +139,7 @@ (vbox (gtk-dialog-vbox dialog)) (dir (plist-get keywords :initial-directory default-directory)) (button-area (gtk-dialog-action-area dialog)) - (initializing-gtk-file-dialog t) + ;(initializing-gtk-file-dialog t) (select-box nil) button hbox) @@ -171,8 +189,7 @@ ;; Directory listing (let ((directories (gtk-clist-new-with-titles 1 '("Directories"))) - (scrolled (gtk-scrolled-window-new nil nil)) - (item nil)) + (scrolled (gtk-scrolled-window-new nil nil))) (gtk-container-add scrolled directories) (gtk-widget-set-usize scrolled 200 300) (gtk-box-pack-start hbox scrolled t t 0)
--- a/lisp/gtk-font-menu.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/gtk-font-menu.el Fri May 04 22:42:35 2001 +0000 @@ -35,6 +35,10 @@ (require 'font-menu) +(globally-declare-boundp + '(gtk-font-regexp + gtk-font-regexp-foundry-and-family gtk-font-regexp-spacing)) + (defvar gtk-font-menu-registry-encoding nil "Registry and encoding to use with font menu fonts.") @@ -82,7 +86,8 @@ ;; recalculate the menus from the cache w/o having to do list-fonts again. (unless gtk-font-regexp-ascii (setq gtk-font-regexp-ascii (if (featurep 'mule) - (charset-registry 'ascii) + (declare-fboundp + (charset-registry 'ascii)) "iso8859-1"))) (setq gtk-font-menu-registry-encoding (if (featurep 'mule) "*-*" "iso8859-1"))
--- a/lisp/gtk-init.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/gtk-init.el Fri May 04 22:42:35 2001 +0000 @@ -23,6 +23,11 @@ ;; Free Software Foundation, 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +(globally-declare-boundp + '(gtk-initial-argv-list + gtk-initial-geometry + gtk-keysym-on-keyboard-p)) + (defvar gtk-win-initted nil) (defvar gtk-pre-win-initted nil) (defvar gtk-post-win-initted nil)
--- a/lisp/gtk-package.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/gtk-package.el Fri May 04 22:42:35 2001 +0000 @@ -1,5 +1,9 @@ ;; A GTK version of package-ui.el +(globally-declare-fboundp + '(gtk-window-new + gtk-hbox-new gtk-container-add gtk-widget-show-all)) + (require 'package-get) (require 'package-ui)
--- a/lisp/gtk-password-dialog.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/gtk-password-dialog.el Fri May 04 22:42:35 2001 +0000 @@ -24,6 +24,15 @@ ;;; Synched up with: Not in FSF. +(globally-declare-fboundp + '(gtk-dialog-new + gtk-dialog-vbox gtk-dialog-action-area + gtk-window-set-title gtk-button-new-with-label + gtk-container-add gtk-signal-connect gtk-entry-get-text + gtk-widget-destroy gtk-container-set-border-width gtk-label-new + gtk-misc-set-alignment gtk-entry-new gtk-widget-set-sensitive + gtk-entry-set-text gtk-entry-select-region)) + (defun gtk-password-dialog-ok-button (dlg) (get dlg 'x-ok-button))
--- a/lisp/gtk-widget-accessors.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/gtk-widget-accessors.el Fri May 04 22:42:35 2001 +0000 @@ -1,3 +1,6 @@ +(globally-declare-fboundp + '(gtk-fundamental-type)) + (require 'gtk-ffi) (defconst GTK_TYPE_INVALID 0)
--- a/lisp/gtk-widgets.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/gtk-widgets.el Fri May 04 22:42:35 2001 +0000 @@ -31,6 +31,10 @@ (eval-and-compile (require 'gtk-ffi)) +(globally-declare-fboundp + '(gtk-import-function-internal + gtk-call-function gtk-import-variable-internal gtk-ctree-recurse)) + (gtk-import-function GtkType gtk_accel_label_get_type) (gtk-import-function GtkWidget gtk_accel_label_new GtkString) (gtk-import-function guint gtk_accel_label_get_accel_width GtkAccelLabel)
--- a/lisp/gtk.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/gtk.el Fri May 04 22:42:35 2001 +0000 @@ -1,3 +1,9 @@ +(globally-declare-fboundp + '(gtk-import-function-internal gtk-call-function gtk-type-name)) + +(globally-declare-boundp + '(gtk-enumeration-info)) + (gtk-import-function nil "gdk_flush") (defun gtk-describe-enumerations ()
--- a/lisp/gutter-items.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/gutter-items.el Fri May 04 22:42:35 2001 +0000 @@ -488,8 +488,7 @@ (clear-message label frame nil no-restore) (or frame (setq frame (selected-frame))) (remove-progress-feedback label frame) - (let ((inhibit-read-only t) - (zmacs-region-stays zmacs-region-stays)) ; preserve from change + (let ((inhibit-read-only t)) (erase-buffer (get-buffer-create " *Gutter Area*"))) (if no-restore nil ; just preparing to put another msg up @@ -558,8 +557,7 @@ (or frame (setq frame (selected-frame))) ;; Add a new entry to the message-stack, or modify an existing one (let* ((top (car progress-stack)) - (inhibit-read-only t) - (zmacs-region-stays zmacs-region-stays)) + (inhibit-read-only t)) (if (eq label (car top)) (setcdr top message) (push (cons label message) progress-stack)) @@ -589,7 +587,6 @@ (defun raw-append-progress-feedback (message &optional value frame) (unless (equal message "") (let* ((inhibit-read-only t) - (zmacs-region-stays zmacs-region-stays) (val (or value 0)) (gutter-string (copy-sequence "\n")) (ext (make-extent 0 1 gutter-string)))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/hash-table.el Fri May 04 22:42:35 2001 +0000 @@ -0,0 +1,70 @@ +;;; hash-table.el --- hash-table utility functions + +;; Copyright (C) 2000 Ben Wing. + +;; Author: Ben Wing +;; Maintainer: XEmacs Development Team +;; Keywords: 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, 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Synched up with: Not in FSF. + +;;; Authorship: + +;; Created July 2000 by Ben Wing. + +;;; Commentary: + +;; This file is dumped with XEmacs. + +;;; Code: + +(defun hash-table-key-list (hash-table) + "Return a list of all keys in HASH-TABLE." + (let (lis) + (maphash #'(lambda (key val) + (push key lis)) + hash-table) + (nreverse lis))) + +(defun hash-table-value-list (hash-table) + "Return a list of all values in HASH-TABLE." + (let (lis) + (maphash #'(lambda (key val) + (push val lis)) + hash-table) + (nreverse lis))) + +(defun hash-table-key-value-alist (hash-table) + "Return an alist of (KEY . VALUE) for all keys and values in HASH-TABLE." + (let (lis) + (maphash #'(lambda (key val) + (push (cons key val) lis)) + hash-table) + (nreverse lis))) + +(defun hash-table-key-value-plist (hash-table) + "Return a plist for all keys and values in HASH-TABLE. +A plist is a simple list containing alternating keys and values." + (let (lis) + (maphash #'(lambda (key val) + (push key lis) + (push val lis)) + hash-table) + (nreverse lis)))
--- a/lisp/help-macro.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/help-macro.el Fri May 04 22:42:35 2001 +0000 @@ -78,13 +78,15 @@ (defmacro make-help-screen (fname help-line help-text helped-map) "Construct help-menu function name FNAME. -When invoked, FNAME shows HELP-LINE and reads a command using HELPED-MAP. -If the command is the help character, FNAME displays HELP-TEXT -and continues trying to read a command using HELPED-MAP. -When FNAME finally does get a command, it executes that command -and then returns." +When invoked, FNAME shows HELP-LINE and reads a command using +HELPED-MAP. If the command is the help character, FNAME displays +HELP-TEXT and continues trying to read a command using HELPED-MAP. +When FNAME finally does get a command, it executes that command and +then returns. As of 21.5 (or 21.4?), HELP-LINE and HELP-TEXT are +`eval'd, just like for a function call. This allows you to place +Lisp expressions in those arguments." `(defun ,fname () - ,help-text + ,(eval help-text) (interactive) (flet ((help-read-key (prompt) ;; This is in `flet' to avoid problems with autoloading. @@ -105,7 +107,7 @@ (car key) key))))) (let ((line-prompt - (substitute-command-keys ,help-line))) + (substitute-command-keys ,(eval help-line)))) (when three-step-help (message "%s" line-prompt)) (let* ((help-screen (documentation (quote ,fname)))
--- a/lisp/help.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/help.el Fri May 04 22:42:35 2001 +0000 @@ -64,118 +64,77 @@ (define-key help-map 'help 'help-for-help) (define-key help-map '(f1) 'help-for-help) -(define-key help-map "\C-l" 'describe-copying) ; on \C-c in FSFmacs -(define-key help-map "\C-d" 'describe-distribution) -(define-key help-map "\C-w" 'describe-no-warranty) (define-key help-map "a" 'hyper-apropos) ; 'command-apropos in FSFmacs -(define-key help-map "A" 'command-apropos) +(define-key help-map "A" 'command-hyper-apropos) +;; #### should be hyper-apropos-documentation, once that's written. +(define-key help-map "\C-a" 'apropos-documentation) (define-key help-map "b" 'describe-bindings) (define-key help-map "B" 'describe-beta) -(define-key help-map "\C-p" 'describe-pointer) +(define-key help-map "c" 'describe-key-briefly) (define-key help-map "C" 'customize) -(define-key help-map "c" 'describe-key-briefly) -(define-key help-map "k" 'describe-key) +;; FSFmacs has Info-goto-emacs-command-node on C-f, no binding +;; for Info-elisp-ref +(define-key help-map "\C-c" 'Info-goto-emacs-command-node) (define-key help-map "d" 'describe-function) -(define-key help-map "e" 'describe-last-error) +(define-key help-map "\C-d" 'describe-distribution) + +(define-key help-map "e" (if (fboundp 'view-last-error) 'view-last-error + 'describe-last-error)) + (define-key help-map "f" 'describe-function) - +;; #### not a good interface. no way to specify that C-h is preferred +;; as a prefix and not BS. should instead be specified as part of +;; `define-key'. +;; (put 'describe-function 'preferred-key-sequence "\C-hf") (define-key help-map "F" 'xemacs-local-faq) +(define-key help-map "\C-f" 'Info-elisp-ref) (define-key help-map "i" 'info) -(define-key help-map '(control i) 'Info-query) -;; FSFmacs has Info-goto-emacs-command-node on C-f, no binding -;; for Info-elisp-ref -(define-key help-map '(control c) 'Info-goto-emacs-command-node) -(define-key help-map '(control k) 'Info-goto-emacs-key-command-node) -(define-key help-map '(control f) 'Info-elisp-ref) +(define-key help-map "I" 'Info-search-index-in-xemacs-and-lispref) +(define-key help-map "\C-i" 'Info-query) + +(define-key help-map "k" 'describe-key) +(define-key help-map "\C-k" 'Info-goto-emacs-key-command-node) (define-key help-map "l" 'view-lossage) +(define-key help-map "\C-l" 'describe-copying) ; on \C-c in FSFmacs (define-key help-map "m" 'describe-mode) +(define-key help-map "n" 'view-emacs-news) (define-key help-map "\C-n" 'view-emacs-news) -(define-key help-map "n" 'view-emacs-news) (define-key help-map "p" 'finder-by-keyword) +(define-key help-map "\C-p" 'describe-pointer) + +(define-key help-map "q" 'help-quit) ;; Do this right with an autoload cookie in finder.el. ;;(autoload 'finder-by-keyword "finder" ;; "Find packages matching a given keyword." t) (define-key help-map "s" 'describe-syntax) +(define-key help-map "S" 'view-sample-init-el) (define-key help-map "t" 'help-with-tutorial) -(define-key help-map "w" 'where-is) - (define-key help-map "v" 'describe-variable) -(if (fboundp 'view-last-error) - (define-key help-map "e" 'view-last-error)) - - -(define-key help-map "q" 'help-quit) - -;#### This stuff was an attempt to have font locking and hyperlinks in the -;help buffer, but it doesn't really work. Some of this stuff comes from -;FSF Emacs; but the FSF Emacs implementation is rather broken, as usual. -;What needs to happen is this: -; -; -- we probably need a "hyperlink mode" from which help-mode is derived. -; -- this means we probably need multiple inheritance of modes! -; Thankfully this is not hard to implement; we already have the -; ability for a keymap to have multiple parents. However, we'd -; have to define any multiply-inherited-from modes using a standard -; `define-mode' construction instead of manually doing it, because -; we don't want each guy calling `kill-all-local-variables' and -; messing up the previous one. -; -- we need to scan the buffer ourselves (not from font-lock, because -; the user might not have font-lock enabled) and highlight only -; those words that are *documented* functions and variables (and -; probably excluding words without dashes in them unless enclosed -; in quotes, so that common words like "list" and "point" don't -; become hyperlinks. -; -- we should *not* use font-lock keywords like below. Instead we -; should add the font-lock stuff ourselves during the scanning phase, -; if font-lock is enabled in this buffer. +(define-key help-map "w" 'where-is) +(define-key help-map "\C-w" 'describe-no-warranty) -;(defun help-follow-reference (event extent user-data) -; (let ((symbol (intern-soft (extent-string extent)))) -; (cond ((and symbol (fboundp symbol)) -; (describe-function symbol)) -; ((and symbol (boundp symbol)) -; (describe-variable symbol)) -; (t nil)))) - -;(defvar help-font-lock-keywords -; (let ((name-char "[-+a-zA-Z0-9_*]") (sym-char "[-+a-zA-Z0-9_:*]")) -; (list -; ;; -; ;; The symbol itself. -; (list (concat "\\`\\(" name-char "+\\)\\(:\\)?") -; '(1 (if (match-beginning 2) -; 'font-lock-function-name-face -; 'font-lock-variable-name-face) -; nil t)) -; ;; -; ;; Words inside `' which tend to be symbol names. -; (list (concat "`\\(" sym-char sym-char "+\\)'") -; 1 '(prog1 -; 'font-lock-reference-face -; (add-list-mode-item (match-beginning 1) -; (match-end 1) -; nil -; 'help-follow-reference)) -; t) -; ;; -; ;; CLisp `:' keywords as references. -; (list (concat "\\<:" sym-char "+\\>") 0 'font-lock-reference-face t))) -; "Default expressions to highlight in Help mode.") - -;(put 'help-mode 'font-lock-defaults '(help-font-lock-keywords)) +;; #### It would be nice if the code below to add hyperlinks was +;; generalized. We would probably need a "hyperlink mode" from which +;; help-mode is derived. This means we probably need multiple +;; inheritance of modes! Thankfully this is not hard to implement; we +;; already have the ability for a keymap to have multiple parents. +;; However, we'd have to define any multiply-inherited-from modes using +;; a standard `define-mode' construction instead of manually doing it, +;; because we don't want each guy calling `kill-all-local-variables' and +;; messing up the previous one. (define-derived-mode help-mode view-major-mode "Help" "Major mode for viewing help text. @@ -819,41 +778,68 @@ (make-help-screen help-for-help "A B C F I K L M N P S T V W C-c C-d C-f C-i C-k C-n C-w; ? for more help:" - "Type a Help option: + (concat + "Type a Help option: \(Use SPC or DEL to scroll through this text. Type \\<help-map>\\[help-quit] to exit the Help command.) +Help on key bindings: + +\\[describe-bindings] Table of all key bindings. +\\[describe-key-briefly] Type a key sequence or select a menu item; + it displays the corresponding command name. +\\[describe-key] Type a key sequence or select a menu item; + it displays the documentation for the command bound to that key. + (Terser but more up-to-date than what's in the manual.) +\\[Info-goto-emacs-key-command-node] Type a key sequence or select a menu item; + it jumps to the full documentation in the XEmacs User's Manual + for the corresponding command. +\\[view-lossage] Recent input keystrokes and minibuffer messages. +\\[describe-mode] Documentation of current major and minor modes. +\\[describe-pointer] Table of all mouse-button bindings. +\\[where-is] Type a command name; it displays which keystrokes invoke that command. + +Help on functions and variables: + \\[hyper-apropos] Type a substring; it shows a hypertext list of functions and variables that contain that substring. - See also the `apropos' command. -\\[command-apropos] Type a substring; it shows a list of commands - (interactively callable functions) that contain that substring. -\\[describe-bindings] Table of all key bindings. -\\[describe-key-briefly] Type a command key sequence; - it displays the function name that sequence runs. +\\[command-apropos] Older version of apropos; superseded by previous command. +\\[apropos-documentation] Type a substring; it shows a hypertext list of + functions and variables containing that substring anywhere + in their documentation. +\\[Info-goto-emacs-command-node] Type a command name; it jumps to the full documentation + in the XEmacs User's Manual. +\\[describe-function] Type a command or function name; it shows its documentation. + (Terser but more up-to-date than what's in the manual.) +\\[Info-elisp-ref] Type a function name; it jumps to the full documentation + in the XEmacs Lisp Reference Manual. +\\[Info-search-index-in-xemacs-and-lispref] Type a substring; it looks it up in the indices of both + the XEmacs User's Manual and the XEmacs Lisp Reference Manual. + It jumps to the first match (preferring an exact match); you + can use `\\<Info-mode-map>\\[Info-index-next]\\<help-map>' to successively visit other matches. +\\[describe-variable] Type a variable name; it displays its documentation and value. + +Miscellaneous: + +" + (if (string-match "beta" emacs-version) +"\\[describe-beta] Special considerations about running a beta version of XEmacs. +" +"") +" \\[customize] Customize Emacs options. -\\[Info-goto-emacs-command-node] Type a function name; it displays the Info node for that command. -\\[describe-function] Type a function name; it shows its documentation. -\\[Info-elisp-ref] Type a function name; it jumps to the full documentation - in the XEmacs Lisp Programmer's Manual. +\\[describe-distribution] How to obtain XEmacs. +\\[describe-last-error] Information about the most recent error. \\[xemacs-local-faq] Local copy of the XEmacs FAQ. \\[info] Info documentation reader. \\[Info-query] Type an Info file name; it displays it in Info reader. -\\[describe-key] Type a command key sequence; - it displays the documentation for the command bound to that key. -\\[Info-goto-emacs-key-command-node] Type a command key sequence; - it displays the Info node for the command bound to that key. -\\[view-lossage] Recent input keystrokes and minibuffer messages. -\\[describe-mode] Documentation of current major and minor modes. +\\[describe-copying] XEmacs copying permission (General Public License). \\[view-emacs-news] News of recent XEmacs changes. \\[finder-by-keyword] Type a topic keyword; it finds matching packages. -\\[describe-pointer] Table of all mouse-button bindings. \\[describe-syntax] Contents of syntax table with explanations. +\\[view-sample-init-el] View the sample init.el that comes with XEmacs. \\[help-with-tutorial] XEmacs learn-by-doing tutorial. -\\[describe-variable] Type a variable name; it displays its documentation and value. -\\[where-is] Type a command name; it displays which keystrokes invoke that command. -\\[describe-distribution] XEmacs ordering information. -\\[describe-no-warranty] Information on absence of warranty for XEmacs. -\\[describe-copying] XEmacs copying permission (General Public License)." +\\[describe-no-warranty] Information on absence of warranty for XEmacs." +) help-map) (defmacro with-syntax-table (syntab &rest body) @@ -1222,12 +1208,13 @@ (setq def (symbol-function def))) (if (and (fboundp 'compiled-function-annotation) (compiled-function-p def)) - (setq file-name (compiled-function-annotation def))) + (setq file-name (declare-fboundp (compiled-function-annotation def)))) (if (eq 'macro (car-safe def)) (setq fndef (cdr def) file-name (and (compiled-function-p (cdr def)) (fboundp 'compiled-function-annotation) - (compiled-function-annotation (cdr def))) + (declare-fboundp + (compiled-function-annotation (cdr def)))) macrop t) (setq fndef def)) (if aliases (princ aliases)) @@ -1413,7 +1400,7 @@ (let ((print-escape-newlines t)) (princ "`") ;; (Help-princ-face (symbol-name variable) - ;; 'font-lock-variable-name-face) overkill + ;; 'font-lock-variable-name-face) overkill (princ (symbol-name variable)) (princ "' is ") (while (variable-alias variable)
--- a/lisp/hyper-apropos.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/hyper-apropos.el Fri May 04 22:42:35 2001 +0000 @@ -1,11 +1,12 @@ ;;; hyper-apropos.el --- Hypertext emacs lisp documentation interface. -;; Copyright (C) 1997 Free Software Foundation, Inc. +;; Copyright (C) 1997 Free Software Foundation, Inc. ;; Copyright (C) 1994, 1995 Tinker Systems and INS Engineering Corp. ;; Copyright (C) 1995 Sun Microsystems. ;; Copyright (C) 1996 Ben Wing. -;; Maintainer: Jonathan Stigelman <Stig@hackvan.com> +;; Author: Jonathan Stigelman <stig@xemacs.org> +;; Maintainer: XEmacs Development Team ;; Keywords: lisp, tools, help, docs, matching ;; This file is part of XEmacs. @@ -79,13 +80,19 @@ :group 'hyper-apropos) (define-obsolete-variable-alias 'hypropos-show-brief-docs 'hyper-apropos-show-brief-docs) -;; I changed this to true because I think it's more useful this way. --ben + +;; I changed the following to true because it's obviously more useful +;; that way, and is a very good example of following the principle of +;; least surprise. --ben (defcustom hyper-apropos-programming-apropos t "*If non-nil, list all the functions and variables. This will cause more output to be generated, and take a longer time. +Otherwise, only the interactive functions and user variables will be listed. -Otherwise, only the interactive functions and user variables will be listed." +If you're thinking of setting it to nil, consider that you can get the +equivalent just by using the command \\[command-hyper-apropos]. (And if you do set it to nil, +you can get the full output by using \\[universal-argument] \\[hyper-apropos].)" :type 'boolean :group 'hyper-apropos) (define-obsolete-variable-alias @@ -231,13 +238,26 @@ (defconst hyper-apropos-help-buf "*Hyper Help*") ;;;###autoload +(defun command-hyper-apropos (regexp) + "Display lists of commands and user options matching REGEXP +in buffer \"*Hyper Apropos*\". See `hyper-apropos-mode' for a +description of the available commands in a Hyper-Apropos buffer." + (interactive (list (read-from-minibuffer + "List symbols matching regexp: " + nil nil nil 'hyper-apropos-regexp-history))) + (let ((hyper-apropos-programming-apropos nil)) + (hyper-apropos regexp nil))) + +;;;###autoload (defun hyper-apropos (regexp toggle-apropos) "Display lists of functions and variables matching REGEXP in buffer \"*Hyper Apropos*\". If optional prefix arg is given, then the value of `hyper-apropos-programming-apropos' is toggled for this search. -See also `hyper-apropos-mode'." - (interactive (list (read-from-minibuffer "List symbols matching regexp: " - nil nil nil 'hyper-apropos-regexp-history) +See `hyper-apropos-mode' for a description of the available commands in +a Hyper-Apropos buffer." + (interactive (list (read-from-minibuffer + "List symbols matching regexp: " + nil nil nil 'hyper-apropos-regexp-history) current-prefix-arg)) (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode)) (setq hyper-apropos-prev-wconfig (current-window-configuration)))
--- a/lisp/info.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/info.el Fri May 04 22:42:35 2001 +0000 @@ -6,7 +6,7 @@ ;; Author: Dave Gillespie <daveg@synaptics.com> ;; Richard Stallman <rms@gnu.ai.mit.edu> ;; Maintainer: Dave Gillespie <daveg@synaptics.com> -;; Version: 1.07 of 7/22/93 +;; Version: diverged at version 1.07 of 7/22/93 ;; Keywords: docs, help ;; This file is part of XEmacs. @@ -26,7 +26,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;;; Synched up with: Not synched with FSF. +;;; Synched up with: Not synched with FSF. Highly divergent, and with +;;; many new features added for XEmacs. ;; Commentary: @@ -37,7 +38,8 @@ ;; Also, Info tries adding ".info" to a file name if the name itself ;; is not found. ;; -;; See the change log below for further details. +;; See the partial change log below for further details, and look into +;; ChangeLog for the rest. ;; LCD Archive Entry: @@ -1795,7 +1797,16 @@ (Info-select-node) (or (and (equal onode Info-current-node) (equal ofile Info-current-file)) - (Info-history-add ofile onode opoint))))) + (Info-history-add ofile onode opoint)))) + (message "Found \"%s\" in %s. Press `z' to continue search." + regexp Info-current-node) + ) + +(defun Info-search-next () + "Repeat search starting from point with last regexp used in `Info-search'." + (interactive) + (Info-search Info-last-search)) + ;; Extract the value of the node-pointer named NAME. ;; If there is none, use ERRORNAME in the error message; @@ -2255,17 +2266,9 @@ (Info-page-prev) (setq this-command 'Info)) (scroll-down arg))) + -(defun Info-index (topic) - "Look up a string in the index for this file. -The index is defined as the first node in the top-level menu whose -name contains the word \"Index\", plus any immediately following -nodes whose names also contain the word \"Index\". -If there are no exact matches to the specified topic, this chooses -the first match which is a case-insensitive substring of a topic. -Use the `,' command to see the other matches. -Give a blank topic name to go to the Index node itself." - (interactive "sIndex topic: ") +(defun Info-find-index-alternatives (topic) (let ((pattern (format "\n\\* \\([^\n:]*%s[^\n:]*\\):[ \t]*%s" (regexp-quote topic) "\\(.*\\)\\.[ t]*\\([0-9]*\\)$")) @@ -2283,9 +2286,7 @@ (Info-goto-node (Info-extract-menu-node-name))) (or (equal topic "") (let ((matches nil) - (exact nil) - (Info-keeping-history nil) - found) + (Info-keeping-history nil)) (while (progn (goto-char (point-min)) @@ -2305,17 +2306,41 @@ (string-match "\\<Index\\>" node))) (let ((Info-fontify nil)) (Info-goto-node node))) - (or matches - (progn - (Info-last) - (error "No \"%s\" in index" topic))) - ;; Here it is a feature that assoc is case-sensitive. - (while (setq found (assoc topic matches)) - (setq exact (cons found exact) - matches (delq found matches))) - (setq Info-index-alternatives (nconc exact (nreverse matches)) - Info-index-first-alternative (car Info-index-alternatives)) - (Info-index-next 0))))) + (nreverse matches))))) + +(defun Info-index (topic &optional starting-nodes) + "Look up a string in the index for this file. +The index is defined as the first node in the top-level menu whose +name contains the word \"Index\", plus any immediately following +nodes whose names also contain the word \"Index\". +If there are no exact matches to the specified topic, this chooses +the first match which is a case-insensitive substring of a topic. +Use the `,' command to see the other matches. +Give a blank topic name to go to the Index node itself. + +If STARTING-NODES is given, it should be a list of nodes specifying +files in which the indices will be searched. The results will be +combined together." + (interactive "sIndex topic: ") + (let ((matches (if starting-nodes + (mapcan #'(lambda (node) + (Info-goto-node node) + (Info-find-index-alternatives topic)) + starting-nodes) + (Info-find-index-alternatives topic))) + exact found) + (or matches + (progn + (if (or (not starting-nodes) (< (length starting-nodes) 2)) + (Info-last)) + (error "No \"%s\" in index" topic))) + ;; Here it is a feature that assoc is case-sensitive. + (while (setq found (assoc topic matches)) + (setq exact (cons found exact) + matches (delq found matches))) + (setq Info-index-alternatives (nconc exact matches) + Info-index-first-alternative (car Info-index-alternatives)) + (Info-index-next 0))) (defun Info-index-next (num) "Go to the next matching index item from the last `i' command." @@ -2441,6 +2466,43 @@ (error (Info-find-node "elisp" "Top"))) (Info-index (symbol-name func))) (pop-to-buffer "*info*")) + +(defun Info-read-search-text-regexp () + (read-from-minibuffer + (if (and (boundp 'Info-last-search) Info-last-search) + (format "Search (regexp, default %s): " + Info-last-search) + "Search (regexp): ") + nil nil nil nil nil (and (boundp 'Info-last-search) Info-last-search))) + +;;;###autoload +(defun Info-search-text-in-lispref (regexp) + "Search for REGEXP in Lispref text and select node it's found in." + (interactive (list (Info-read-search-text-regexp))) + (Info-goto-node "(Lispref)") + (Info-search regexp)) + +;;;###autoload +(defun Info-search-text-in-xemacs (regexp) + "Search for REGEXP in User's Manual text and select node it's found in." + (interactive (list (Info-read-search-text-regexp))) + (Info-goto-node "(XEmacs)") + (Info-search regexp)) + +;;;###autoload +(defun Info-search-index-in-lispref (regexp) + "Search for REGEXP in Lispref index and select node it's found in." + (interactive "sIndex topic: ") + (Info-goto-node "(Lispref)") + (Info-index regexp)) + +;;;###autoload +(defun Info-search-index-in-xemacs-and-lispref (regexp) + "Search for REGEXP in both User's Manual and Lispref indices. +Select node it's found in." + (interactive "sIndex topic: ") + (Info-index regexp '("(XEmacs)" "(Lispref)"))) + (defun Info-reannotate-node () (let ((bufs (delq nil (mapcar 'get-file-buffer Info-annotations-path)))) @@ -2852,6 +2914,7 @@ (define-key Info-mode-map "u" 'Info-up) (define-key Info-mode-map "v" 'Info-visit-file) (define-key Info-mode-map "x" 'Info-bookmark) + (define-key Info-mode-map "z" 'Info-search-next) (define-key Info-mode-map "<" 'Info-top) (define-key Info-mode-map ">" 'Info-end) (define-key Info-mode-map "[" 'Info-global-prev)
--- a/lisp/isearch-mode.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/isearch-mode.el Fri May 04 22:42:35 2001 +0000 @@ -969,8 +969,9 @@ (interactive) (if (and delete-key-deletes-forward (case (device-type) - ('tty (eq tty-erase-char ?\C-h)) - ('x (not (x-keysym-on-keyboard-sans-modifiers-p 'backspace))))) + ('tty (eq (declare-boundp tty-erase-char) ?\C-h)) + ('x (not (declare-fboundp + (x-keysym-on-keyboard-sans-modifiers-p 'backspace)))))) (isearch-delete-char) (isearch-mode-help)))
--- a/lisp/keymap.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/keymap.el Fri May 04 22:42:35 2001 +0000 @@ -374,28 +374,35 @@ (defun key-sequence-list-description (keys) "Convert a key sequence KEYS to the full [(modifiers... key)...] form. -Argument KEYS can be in any form accepted by `define-key' function." +Argument KEYS can be in any form accepted by `define-key' function. +The output is always in a canonical form, meaning you can use this +function to determine if two key sequence specifications are equivalent +by comparing the respective outputs of this function using `equal'." (let ((vec - (cond ((vectorp keys) - keys) - ((stringp keys) - (vconcat keys)) - (t - (vector keys)))) - (event-to-list - #'(lambda (ev) - (append (event-modifiers ev) (list (event-key ev)))))) - (mapvector - #'(lambda (key) - (cond ((key-press-event-p key) - (funcall event-to-list key)) - ((characterp key) - (funcall event-to-list (character-to-event key))) - ((listp key) - key) - (t - (list key)))) - vec))) + (cond ((vectorp keys) + keys) + ((stringp keys) + (vconcat keys)) + (t + (vector keys))))) + (flet ((event-to-list (ev) + (append (event-modifiers ev) (list (event-key ev))))) + (mapvector + #'(lambda (key) + (let* ((full-key + (cond ((key-press-event-p key) + (event-to-list key)) + ((characterp key) + (event-to-list (character-to-event key))) + ((listp key) + (copy-sequence key)) + (t + (list key)))) + (keysym (car (last full-key)))) + (if (characterp keysym) + (setcar (last full-key) (intern (char-to-string keysym)))) + full-key)) + vec)))) ;;; Support keyboard commands to turn on various modifiers.
--- a/lisp/ldap.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/ldap.el Fri May 04 22:42:35 2001 +0000 @@ -5,7 +5,7 @@ ;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> ;; Created: Jan 1998 -;; Version: $Revision: 1.11 $ +;; Version: $Revision: 1.12 $ ;; Keywords: help comm ;; This file is part of XEmacs @@ -35,6 +35,9 @@ ;;; Code: +(globally-declare-fboundp '(ldapp ldap-open ldap-close ldap-add ldap-modify + ldap-delete)) + (eval-when '(load) (if (not (fboundp 'ldap-open)) (error "No LDAP support compiled in this XEmacs")))
--- a/lisp/lib-complete.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/lib-complete.el Fri May 04 22:42:35 2001 +0000 @@ -221,6 +221,7 @@ (defun read-library-internal (FILE FILTER FLAG) "Don't call this." ;; Relies on read-library-internal-search-path being let-bound + (declare (special read-library-internal-search-path)) (let ((completion-table (lib-complete:get-completion-table FILE read-library-internal-search-path FILTER))) @@ -248,6 +249,7 @@ filter the completions. This function is passed the filename, and should return a transformed filename (possibly a null transformation) or nil, indicating that the filename should not be included in the completions." + (declare (special read-library-internal-search-path)) (let* ((read-library-internal-search-path SEARCH-PATH) (library (completing-read PROMPT 'read-library-internal FILTER (or MUST-MATCH FULL) nil))) @@ -258,8 +260,10 @@ (t library)))) (defun read-library-name (prompt) - "PROMPTs for and returns an existing Elisp library name (without any suffix) or the empty string." + "PROMPTs for and returns an existing Elisp library name (without any suffix) +or the empty string." (interactive) + (declare (special read-library-internal-search-path)) (let ((read-library-internal-search-path load-path)) (completing-read prompt 'read-library-internal
--- a/lisp/lisp-mnt.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/lisp-mnt.el Fri May 04 22:42:35 2001 +0000 @@ -561,7 +561,7 @@ (if addr (concat (car addr) " <" (cdr addr) ">") (or (and (boundp 'report-emacs-bug-beta-address) - report-emacs-bug-beta-address) + (declare-boundp report-emacs-bug-beta-address)) "<xemacs-beta@xemacs.org>")) topic) (goto-char (point-max))
--- a/lisp/lisp-mode.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/lisp-mode.el Fri May 04 22:42:35 2001 +0000 @@ -101,6 +101,9 @@ :active (fboundp 'untrace-all)] "---" ["%_Comment Out Region" comment-region :active (region-exists-p)] + ["Unc%_omment Region" (comment-region (region-beginning) + (region-end) '(4)) + :active (region-exists-p)] "---" ["%_Indent Region or Balanced Expression" ,(popup-wrap '(if (region-exists-p)
--- a/lisp/menubar-items.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/menubar-items.el Fri May 04 22:42:35 2001 +0000 @@ -190,6 +190,8 @@ "----" ["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] @@ -335,14 +337,7 @@ ["%_Save Abbrevs As..." write-abbrev-file] ["L%_oad Abbrevs..." read-abbrev-file] ) - ("%_Register" - ["%_Copy to Register..." copy-to-register :active (region-exists-p)] - ["%_Paste Register..." insert-register] - "---" - ["%_Save Point to Register" point-to-register] - ["%_Jump to Register" register-to-point] - ) - ("R%_ectangles" + ("%_Rectangles" ["%_Kill Rectangle" kill-rectangle] ["%_Yank Rectangle" yank-rectangle] ["Rectangle %_to Register" copy-rectangle-to-register] @@ -355,6 +350,13 @@ (not mouse-track-rectangle-p)) :style toggle :selected mouse-track-rectangle-p] ) + ("Re%_gister" + ["%_Copy to Register..." copy-to-register :active (region-exists-p)] + ["%_Paste 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)] ["%_Paragraphs in Region" sort-paragraphs :active (region-exists-p)] @@ -382,6 +384,16 @@ ["%_Balanced Expression" indent-sexp] ["%_C Expression" indent-c-exp] ) + ("%_Tabs" + ["%_Convert Tabs to Spaces" untabify :active (and (region-exists-p) + (fboundp 'untabify))] + ["Convert %_Spaces to Tabs" tabify :active (and (region-exists-p) + (fboundp 'tabify))] + "---" + ["%_Tab to Tab Stop" tab-to-tab-stop] + ["%_Move to Tab Stop" move-to-tab-stop] + ["%_Edit Tab Stops" edit-tab-stops] + ) ("S%_pell-Check" ["%_Buffer" ispell-buffer :active (fboundp 'ispell-buffer)] @@ -1403,9 +1415,13 @@ ["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. - (progn (find-file (or user-init-file "~/.xemacs/init.el")) - (or (eq major-mode 'emacs-lisp-mode) - (emacs-lisp-mode)))] + (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 Init File" customize-save-customized] ) @@ -1424,54 +1440,67 @@ ("%_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] ["%_Obtaining XEmacs" describe-distribution] "-----" ("%_Info (Online Docs)" - ["%_Info Contents" info] - ["Lookup %_Key Binding..." Info-goto-emacs-key-command-node] - ["Lookup %_Command..." Info-goto-emacs-command-node] - ["Lookup %_Function..." Info-elisp-ref] - ["Lookup %_Topic..." Info-query]) + ["Info Con%_tents" (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 In%_ternals 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] + "-----" + ["Search %_Index 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)] - ["%_Home Page" xemacs-www-page :active (fboundp 'browse-url)]) ("%_Tutorials" :filter tutorials-menu-filter) ("%_Samples" - ["Sample %_init.el" - (find-file (locate-data-file "sample.init.el")) + ["View Sample %_init.el" view-sample-init-el :active (locate-data-file "sample.init.el")] - ["Sample .%_gtkrc" - (find-file (locate-data-file "sample.gtkrc")) + ["View Sample .%_gtkrc" + (Help-find-file (locate-data-file "sample.gtkrc")) :included (featurep 'gtk) :active (locate-data-file "sample.gtkrc")] - ["Sample .%_Xdefaults" - (find-file (locate-data-file "sample.Xdefaults")) + ["View Sample .%_Xdefaults" + (Help-find-file (locate-data-file "sample.Xdefaults")) :included (featurep 'x) :active (locate-data-file "sample.Xdefaults")] - ["Sample %_enriched" - (find-file (locate-data-file "enriched.doc")) + ["View Sample %_enriched.doc" + (Help-find-file (locate-data-file "enriched.doc")) :active (locate-data-file "enriched.doc")]) - ("%_Commands & Keys" - ["%_Mode" describe-mode] + ("%_Commands, Variables, Keys" + ["Describe %_Mode" describe-mode] ["%_Apropos..." hyper-apropos] + ["%_Command-Only Apropos..." command-hyper-apropos] ["Apropos %_Docs..." apropos-documentation] "-----" - ["%_Key..." describe-key] - ["%_Bindings" describe-bindings] - ["%_Mouse Bindings" describe-pointer] + ["Describe %_Key..." describe-key] + ["Show %_Bindings" describe-bindings] + ["Show M%_ouse Bindings" describe-pointer] ["%_Recent Keys" view-lossage] "-----" - ["%_Function..." describe-function] - ["%_Variable..." describe-variable] - ["%_Locate Command..." where-is]) - "-----" - ["%_Recent Messages" view-lossage] + ["Describe %_Function..." describe-function] + ["Describe %_Variable..." describe-variable] + ["%_Locate Command in Keymap..." where-is]) ("%_Misc" ["%_Current Installation Info" describe-installation :active (boundp 'Installation-string)] @@ -1480,6 +1509,8 @@ ["Find %_Packages" finder-by-keyword] ["View %_Splash Screen" xemacs-splash-buffer] ["%_Unix Manual..." manual-entry]) + "-----" + ["%_Recent Messages" view-lossage] ["Send %_Bug Report..." report-emacs-bug :active (fboundp 'report-emacs-bug)]))) @@ -1924,24 +1955,12 @@ (defconst default-popup-menu '("XEmacs Commands" - ["%_Undo" advertised-undo - :active (and (not (eq buffer-undo-list t)) - (or buffer-undo-list pending-undo-list)) - :suffix (if (or (eq last-command 'undo) - (eq last-command 'advertised-undo)) - "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 %_Block" mark-paragraph] - ["Sp%_lit Window" split-window-vertically] - ["U%_nsplit Window" delete-other-windows] + ["%_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))] )) ;; In an effort to avoid massive menu clutter, this mostly worthless menu is
--- a/lisp/menubar.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/menubar.el Fri May 04 22:42:35 2001 +0000 @@ -564,7 +564,7 @@ )) (defun popup-buffer-menu (event) - "Pop up a copy of the Buffers menu (from the menubar) where the mouse is clicked." + "Pop up a copy of the menubar Buffers menu where the mouse is clicked." (interactive "e") (let ((window (and (event-over-text-area-p event) (event-window event))) (bmenu nil)) @@ -717,11 +717,11 @@ (define-key menu-accelerator-map [up] 'menu-up) (define-key menu-accelerator-map [down] 'menu-down) (define-key menu-accelerator-map [return] 'menu-select) - (define-key menu-accelerator-map [kp_down] 'menu-down) - (define-key menu-accelerator-map [kp_up] 'menu-down) - (define-key menu-accelerator-map [kp_left] 'menu-left) - (define-key menu-accelerator-map [kp_right] 'menu-right) - (define-key menu-accelerator-map [kp_enter] 'menu-select) + (define-key menu-accelerator-map [kp-down] 'menu-down) + (define-key menu-accelerator-map [kp-up] 'menu-down) + (define-key menu-accelerator-map [kp-left] 'menu-left) + (define-key menu-accelerator-map [kp-right] 'menu-right) + (define-key menu-accelerator-map [kp-enter] 'menu-select) (define-key menu-accelerator-map "\C-g" 'menu-quit)))
--- a/lisp/minibuf.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/minibuf.el Fri May 04 22:42:35 2001 +0000 @@ -1099,9 +1099,11 @@ (if (and filename-kludge-p ;; #### evil evil evil evil (or (and (fboundp 'ange-ftp-ftp-path) - (ange-ftp-ftp-path string)) + (declare-fboundp + (ange-ftp-ftp-path string))) (and (fboundp 'efs-ftp-path) - (efs-ftp-path string)))) + (declare-fboundp + (efs-ftp-path string))))) (setq comp t) (setq comp (try-completion string @@ -1126,11 +1128,12 @@ (set-buffer mouse-grabbed-buffer) ; the minibuf (let ((kludge-string (concat (buffer-string) string))) (if (or (and (fboundp 'ange-ftp-ftp-path) - (ange-ftp-ftp-path kludge-string)) - (and (fboundp 'efs-ftp-path) (efs-ftp-path kludge-string))) - ;; #### evil evil evil, but more so. - string - (append-expand-filename (buffer-string) string))))) + (declare-fboundp (ange-ftp-ftp-path kludge-string))) + (and (fboundp 'efs-ftp-path) + (declare-fboundp (efs-ftp-path kludge-string)))) + ;; #### evil evil evil, but more so. + string + (append-expand-filename (buffer-string) string))))) (defun minibuffer-smart-select-highlighted-completion (event) "Select the highlighted text under the mouse as a minibuffer response. @@ -1787,10 +1790,12 @@ ((eq action 't) ;; all completions (mapcar #'(lambda (p) (concat "~" p)) - (user-name-all-completions user))) + (declare-fboundp + (user-name-all-completions user)))) (t;; 'nil ;; complete - (let* ((val+uniq (user-name-completion-1 user)) + (let* ((val+uniq (declare-fboundp + (user-name-completion-1 user))) (val (car val+uniq)) (uniq (cdr val+uniq))) (cond ((stringp val) @@ -2239,9 +2244,9 @@ (setq x-read-color-completion-table clist) x-read-color-completion-table))) (mswindows - (mapcar #'list (mswindows-color-list))) + (mapcar #'list (declare-fboundp (mswindows-color-list)))) (tty - (mapcar #'list (tty-color-list))))) + (mapcar #'list (declare-fboundp (tty-color-list)))))) (defun read-color (prompt &optional must-match initial-contents) "Read the name of a color from the minibuffer.
--- a/lisp/modeline.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/modeline.el Fri May 04 22:42:35 2001 +0000 @@ -672,7 +672,7 @@ modeline is clicked. It will call `vc-toggle-read-only' if available, otherwise it will call the usual `toggle-read-only'." (interactive) - (if (fboundp 'vc-toggle-read-only) + (if-fboundp 'vc-toggle-read-only (vc-toggle-read-only) (toggle-read-only)))
--- a/lisp/mouse.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/mouse.el Fri May 04 22:42:35 2001 +0000 @@ -90,7 +90,7 @@ (interactive) (if (and (not (console-on-window-system-p)) (and (featurep 'gpm) - (not gpm-minor-mode))) + (not (declare-boundp gpm-minor-mode)))) (yank) (push-mark) (if (region-active-p) @@ -1052,7 +1052,7 @@ (not (= start end))) ;; I guess cutbuffers should do something with rectangles too. ;; does anybody use them? - (x-store-cutbuffer (buffer-substring start end))))) + (declare-fboundp (x-store-cutbuffer (buffer-substring start end)))))) (defun mouse-track-activate-rectangular-selection () (if (consp default-mouse-track-extent)
--- a/lisp/msw-font-menu.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/msw-font-menu.el Fri May 04 22:42:35 2001 +0000 @@ -64,9 +64,11 @@ or if you change your font path, you can call this to re-initialize the menus." (unless mswindows-font-regexp-ascii (setq mswindows-font-regexp-ascii (if (featurep 'mule) - (charset-registry 'ascii) + (declare-fboundp + (charset-registry 'ascii)) "Western"))) - (setq mswindows-font-menu-registry-encoding (if (featurep 'mule) "" "Western")) + (setq mswindows-font-menu-registry-encoding (if (featurep 'mule) "" + "Western")) (let ((case-fold-search t) family size weight entry dev-cache cache families sizes weights)
--- a/lisp/mule/arabic.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/mule/arabic.el Fri May 04 22:42:35 2001 +0000 @@ -1,4 +1,4 @@ -;;; arabic.el --- pre-loaded support for Arabic. +;;; arabic.el --- pre-loaded support for Arabic. -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc. ;; Copyright (C) 1995 Amdahl Corporation.
--- a/lisp/mule/canna-leim.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/mule/canna-leim.el Fri May 04 22:42:35 2001 +0000 @@ -1,4 +1,4 @@ -;;; canna-leim.el --- Canna-related code for LEIM +;;; canna-leim.el --- Canna-related code for LEIM -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1997 Stephen Turnbull <turnbull@sk.tsukuba.ac.jp> ;; Copyright (C) 1997 Free Software Foundation, Inc. ;;
--- a/lisp/mule/english.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/mule/english.el Fri May 04 22:42:35 2001 +0000 @@ -1,4 +1,4 @@ -;;; english.el --- English support +;;; english.el --- English support -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1997,1999 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation.
--- a/lisp/mule/greek.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/mule/greek.el Fri May 04 22:42:35 2001 +0000 @@ -1,4 +1,4 @@ -;;; greek.el --- Support for Greek +;;; greek.el --- Support for Greek -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation.
--- a/lisp/mule/kinsoku.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/mule/kinsoku.el Fri May 04 22:42:35 2001 +0000 @@ -1,4 +1,4 @@ -;; kinsoku.el -- Kinsoku (line wrap) processing for XEmacs/Mule +;; kinsoku.el -- Kinsoku (line wrap) processing for XEmacs/Mule -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1997 Free Software Foundation, Inc. ;; This file is part of Mule (MULtilingual Enhancement of XEmacs).
--- a/lisp/mule/latin.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/mule/latin.el Fri May 04 22:42:35 2001 +0000 @@ -1,4 +1,4 @@ -;;; latin.el --- Support for Latin charsets. +;;; latin.el --- Support for Latin charsets. -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 2001 Free Software Foundation, Inc.
--- a/lisp/mule/misc-lang.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/mule/misc-lang.el Fri May 04 22:42:35 2001 +0000 @@ -1,4 +1,4 @@ -;;; misc-lang.el --- support for miscellaneous languages (characters) +;;; misc-lang.el --- support for miscellaneous languages (characters) -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1995,1999 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation.
--- a/lisp/mule/mule-category.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/mule/mule-category.el Fri May 04 22:42:35 2001 +0000 @@ -1,4 +1,4 @@ -;;; mule-category.el --- category functions for XEmacs/Mule. +;;; mule-category.el --- category functions for XEmacs/Mule. -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc. ;; Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN.
--- a/lisp/mule/mule-ccl.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/mule/mule-ccl.el Fri May 04 22:42:35 2001 +0000 @@ -1,4 +1,4 @@ -;;; mule-ccl.el --- CCL (Code Conversion Language) compiler +;;; mule-ccl.el --- CCL (Code Conversion Language) compiler -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation.
--- a/lisp/mule/mule-charset.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/mule/mule-charset.el Fri May 04 22:42:35 2001 +0000 @@ -1,4 +1,4 @@ -;;; mule-charset.el --- Charset functions for Mule. +;;; mule-charset.el --- Charset functions for Mule. -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Copyright (C) 1995 Amdahl Corporation.
--- a/lisp/mule/mule-cmds.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/mule/mule-cmds.el Fri May 04 22:42:35 2001 +0000 @@ -1,4 +1,4 @@ -;;; mule-cmds.el --- Commands for multilingual environment +;;; mule-cmds.el --- Commands for multilingual environment -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1995,1999 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation.
--- a/lisp/mule/mule-coding.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/mule/mule-coding.el Fri May 04 22:42:35 2001 +0000 @@ -1,4 +1,4 @@ -;;; mule-coding.el --- Coding-system functions for Mule. +;;; mule-coding.el --- Coding-system functions for Mule. -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation.
--- a/lisp/mule/mule-help.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/mule/mule-help.el Fri May 04 22:42:35 2001 +0000 @@ -1,4 +1,4 @@ -;;; mule-help.el --- Mule-ized Help functions +;;; mule-help.el --- Mule-ized Help functions -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1997 by Free Software Foundation, Inc.
--- a/lisp/mule/mule-init.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/mule/mule-init.el Fri May 04 22:42:35 2001 +0000 @@ -1,4 +1,4 @@ -;; Mule default configuration file +;; Mule default configuration file -*- coding: iso-2022-7bit; -*- ;; This file is part of XEmacs.
--- a/lisp/mule/mule-misc.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/mule/mule-misc.el Fri May 04 22:42:35 2001 +0000 @@ -1,4 +1,4 @@ -;; mule-misc.el --- Miscellaneous Mule functions. +;; mule-misc.el --- Miscellaneous Mule functions. -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1995,1999 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. @@ -286,56 +286,4 @@ ;;; @ coding-system category ;;; -(defun coding-system-get (coding-system prop) - "Extract a value from CODING-SYSTEM's property list for property PROP." - (or (plist-get - (get (coding-system-name coding-system) 'coding-system-property) - prop) - (condition-case nil - (coding-system-property coding-system prop) - (error nil)))) - -(defun coding-system-put (coding-system prop value) - "Change value in CODING-SYSTEM's property list PROP to VALUE." - (put (coding-system-name coding-system) - 'coding-system-property - (plist-put (get (coding-system-name coding-system) - 'coding-system-property) - prop value))) - -(defun coding-system-category (coding-system) - "Return the coding category of CODING-SYSTEM." - (or (coding-system-get coding-system 'category) - (let ((type (coding-system-type coding-system))) - (cond ((eq type 'no-conversion) - 'no-conversion) - ((eq type 'shift-jis) - 'shift-jis) - ((eq type 'ucs-4) - 'ucs-4) - ((eq type 'utf-8) - 'utf-8) - ((eq type 'big5) - 'big5) - ((eq type 'iso2022) - (cond ((coding-system-lock-shift coding-system) - 'iso-lock-shift) - ((coding-system-seven coding-system) - 'iso-7) - (t - (let ((dim 0) - ccs - (i 0)) - (while (< i 4) - (setq ccs (coding-system-charset coding-system i)) - (if (and ccs - (> (charset-dimension ccs) dim)) - (setq dim (charset-dimension ccs)) - ) - (setq i (1+ i))) - (cond ((= dim 1) 'iso-8-1) - ((= dim 2) 'iso-8-2) - (t 'iso-8-designate)) - )))))))) - ;;; mule-misc.el ends here
--- a/lisp/mule/mule-tty-init.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/mule/mule-tty-init.el Fri May 04 22:42:35 2001 +0000 @@ -1,4 +1,4 @@ -;;; mule-tty-init.el --- Initialization code for console tty under MULE +;;; mule-tty-init.el --- Initialization code for console tty under MULE -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1998 Free Software Foundation, Inc. ;; Copyright (C) 1998 Kazuyuki IENAGA <kazz@imasy.or.jp>
--- a/lisp/mule/mule-x-init.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/mule/mule-x-init.el Fri May 04 22:42:35 2001 +0000 @@ -1,4 +1,4 @@ -;;; mule-x-init.el --- initialization code for X Windows under MULE +;;; mule-x-init.el --- initialization code for X Windows under MULE -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1994 Free Software Foundation, Inc. ;; Copyright (C) 1996 Ben Wing <ben@xemacs.org>
--- a/lisp/mule/thai-xtis-chars.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/mule/thai-xtis-chars.el Fri May 04 22:42:35 2001 +0000 @@ -1,4 +1,4 @@ -;;; thai-xtis-chars.el --- definition of the Thai XTIS charset. +;;; thai-xtis-chars.el --- definition of the Thai XTIS charset. -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation.
--- a/lisp/mule/viet-chars.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/mule/viet-chars.el Fri May 04 22:42:35 2001 +0000 @@ -1,4 +1,4 @@ -;;; vietnamese-chars.el --- pre-loaded support for Vietnamese, part 1. +;;; vietnamese-chars.el --- pre-loaded support for Vietnamese, part 1. -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc. ;; Copyright (C) 1995 Amdahl Corporation.
--- a/lisp/multicast.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/multicast.el Fri May 04 22:42:35 2001 +0000 @@ -75,7 +75,7 @@ (error "invalid port specification.")) (and (= 0 (setq ttl (string-to-int (match-string 3 address)))) (error "invalid ttl specification.")) - (open-multicast-group-internal name buffer dest port ttl) + (declare-fboundp (open-multicast-group-internal name buffer dest port ttl)) )) ;;; multicast.el ends here
--- a/lisp/mwheel.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/mwheel.el Fri May 04 22:42:35 2001 +0000 @@ -45,6 +45,10 @@ (require 'custom) (require 'cl) +(globally-declare-fboundp + '(event-basic-type + posn-window event-start mwheel-event-window mwheel-event-button)) + (defcustom mwheel-scroll-amount '(5 . 1) "Amount to scroll windows by when spinning the mouse wheel. This is actually a cons cell, where the first item is the amount to scroll
--- a/lisp/package-get.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/package-get.el Fri May 04 22:42:35 2001 +0000 @@ -445,7 +445,7 @@ (fboundp 'mc-pgp-verify-region) (or (not (condition-case err - (mc-pgp-verify-region beg end) + (declare-fboundp (mc-pgp-verify-region beg end)) (file-error (and (string-match "No such file" (nth 2 err)) (or (not package-get-require-signed-base-updates)
--- a/lisp/scrollbar.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/scrollbar.el Fri May 04 22:42:35 2001 +0000 @@ -45,11 +45,11 @@ (when (and (featurep 'x) (or (eq locale 'global) (eq 'x (device-or-frame-type locale)))) - (x-init-scrollbar-from-resources locale)) + (declare-fboundp (x-init-scrollbar-from-resources locale))) (when (and (featurep 'mswindows) (or (eq locale 'global) (eq 'mswindows (device-or-frame-type locale)))) - (mswindows-init-scrollbar-metrics locale))) + (declare-fboundp (mswindows-init-scrollbar-metrics locale)))) ;; ;; vertical scrollbar functions
--- a/lisp/simple.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/simple.el Fri May 04 22:42:35 2001 +0000 @@ -58,10 +58,10 @@ ;; this isn't a user-visible change. These functions have also been altered ;; to use (mark t) for the same reason. -;; 97/3/14 Jareth Hein (jhod@po.iijnet.or.jp) added kinsoku processing (support -;; for filling of Asian text) into the fill code. This was ripped bleeding from -;; Mule-2.3, and could probably use some feature additions (like additional wrap -;; styles, etc) +;; 97/3/14 Jareth Hein (jhod@po.iijnet.or.jp) added kinsoku processing +;; (support for filling of Asian text) into the fill code. This was +;; ripped bleeding from Mule-2.3, and could probably use some feature +;; additions (like additional wrap styles, etc) ;; 97/06/11 Steve Baur (steve@xemacs.org) Convert use of ;; (preceding|following)-char to char-(after|before). @@ -453,7 +453,8 @@ (defsubst delete-forward-p () (and delete-key-deletes-forward (or (not (eq (device-type) 'x)) - (x-keysym-on-keyboard-sans-modifiers-p 'backspace)))) + (declare-fboundp + (x-keysym-on-keyboard-sans-modifiers-p 'backspace))))) (defun backward-or-forward-delete-char (arg) "Delete either one character backwards or one character forwards. @@ -2791,6 +2792,15 @@ (if arg (forward-line 1)) (setq count (1- count))))) +;; This variable: Synched up with 20.7. +(defvar comment-padding 1 + "Number of spaces `comment-region' puts between comment chars and text. + +Extra spacing between the comment characters and the comment text +makes the comment easier to read. Default is 1. Nil means 0 and is +more efficient.") + +;; This function: Synched up with 20.7. (defun comment-region (start end &optional arg) "Comment or uncomment each line in the region. With just C-u prefix arg, uncomment each line in region. @@ -2808,6 +2818,8 @@ (save-excursion (save-restriction (let ((cs comment-start) (ce comment-end) + (cp (when comment-padding + (make-string comment-padding ? ))) numarg) (if (consp arg) (setq numarg t) (setq numarg (prefix-numeric-value arg)) @@ -2820,17 +2832,40 @@ ;; Loop over all lines from START to END. (narrow-to-region start end) (goto-char start) - (while (not (eobp)) - (if (or (eq numarg t) (< numarg 0)) - (progn + ;; if user didn't specify how many comments to remove, be smart + ;; and remove the minimal number that all lines have. that way, + ;; comments in a region of Elisp code that gets commented out will + ;; get put back correctly. + (if (eq numarg t) + (let ((min-comments 999999)) + (while (not (eobp)) + (let ((this-comments 0)) + (while (looking-at (regexp-quote cs)) + (incf this-comments) + (forward-char (length cs))) + (if (and (> this-comments 0) (< this-comments min-comments)) + (setq min-comments this-comments)) + (forward-line 1))) + (if (< min-comments 999999) + (setq numarg (- min-comments))) + (goto-char start))) + (if (or (eq numarg t) (< numarg 0)) + (while (not (eobp)) + (let (found-comment) ;; Delete comment start from beginning of line. (if (eq numarg t) (while (looking-at (regexp-quote cs)) + (setq found-comment t) (delete-char (length cs))) (let ((count numarg)) (while (and (> 1 (setq count (1+ count))) (looking-at (regexp-quote cs))) + (setq found-comment t) (delete-char (length cs))))) + ;; Delete comment padding from beginning of line + (when (and found-comment comment-padding + (looking-at (regexp-quote cp))) + (delete-char comment-padding)) ;; Delete comment end from end of line. (if (string= "" ce) nil @@ -2840,23 +2875,29 @@ ;; This is questionable if comment-end ends in ;; whitespace. That is pretty brain-damaged, ;; though. - (skip-chars-backward " \t") - (if (and (>= (- (point) (point-min)) (length ce)) - (save-excursion - (backward-char (length ce)) - (looking-at (regexp-quote ce)))) - (delete-char (- (length ce))))) + (while (progn (skip-chars-backward " \t") + (and (>= (- (point) (point-min)) + (length ce)) + (save-excursion + (backward-char (length ce)) + (looking-at (regexp-quote ce))))) + (delete-char (- (length ce))))) (let ((count numarg)) (while (> 1 (setq count (1+ count))) (end-of-line) ;; This is questionable if comment-end ends in ;; whitespace. That is pretty brain-damaged though (skip-chars-backward " \t") - (save-excursion - (backward-char (length ce)) - (if (looking-at (regexp-quote ce)) - (delete-char (length ce)))))))) - (forward-line 1)) + (if (>= (- (point) (point-min)) (length ce)) + (save-excursion + (backward-char (length ce)) + (if (looking-at (regexp-quote ce)) + (delete-char (length ce))))))))) + (forward-line 1))) + + (when comment-padding + (setq cs (concat cs cp))) + (while (not (eobp)) ;; Insert at beginning and at end. (if (looking-at "[ \t]*$") () (insert cs) @@ -2989,12 +3030,11 @@ (fill-point (let ((opoint (point)) bounce - ;; 97/3/14 jhod: Kinsoku - (re-break-point (if (featurep 'mule) - (concat "[ \t\n]\\|" word-across-newline - ".\\|." word-across-newline) - "[ \t\n]")) - ;; end patch + (re-break-point ;; Kinsoku processing + (if (featurep 'mule) + (concat "[ \t\n]\\|" word-across-newline + ".\\|." word-across-newline) + "[ \t\n]")) (first t)) (save-excursion (move-to-column (1+ fill-column)) @@ -3011,24 +3051,21 @@ (and (looking-at "\\. ") (not (looking-at "\\. ")))))) (setq first nil) - ;; 97/3/14 jhod: Kinsoku - ; (skip-chars-backward "^ \t\n")) + ;; XEmacs: change for Kinsoku processing (fill-move-backward-to-break-point re-break-point) - ;; end patch ;; If we find nowhere on the line to break it, ;; break after one word. Set bounce to t ;; so we will not keep going in this while loop. (if (bolp) (progn - ;; 97/3/14 jhod: Kinsoku - ; (re-search-forward "[ \t]" opoint t) + ;; XEmacs: change for Kinsoku processing (fill-move-forward-to-break-point re-break-point opoint) - ;; end patch (setq bounce t))) (skip-chars-backward " \t")) (if (and (featurep 'mule) - (or bounce (bolp))) (kinsoku-process)) ;; 97/3/14 jhod: Kinsoku + (or bounce (bolp))) + (declare-fboundp (kinsoku-process))) ;; Let fill-point be set to the place where we end up. (point))))) @@ -3047,7 +3084,8 @@ ;; break the line there. (if (save-excursion (goto-char fill-point) - (not (or (bolp) (eolp)))) ; 97/3/14 jhod: during kinsoku processing it is possible to move beyond + ;; during kinsoku processing it is possible to move beyond + (not (or (bolp) (eolp)))) (let ((prev-column (current-column))) ;; If point is at the fill-point, do not `save-excursion'. ;; Otherwise, if a comment prefix or fill-prefix is inserted, @@ -3058,7 +3096,7 @@ ;; 1999-09-17 hniksic: turn off Kinsoku until ;; it's debugged. (funcall comment-line-break-function) - ;; 97/3/14 jhod: Kinsoku processing + ;; XEmacs: Kinsoku processing ; ;(indent-new-comment-line) ; (let ((spacep (memq (char-before (point)) '(?\ ?\t)))) ; (funcall comment-line-break-function) @@ -3248,9 +3286,8 @@ (interactive) (let (comcol comstart) (skip-chars-backward " \t") - ;; 97/3/14 jhod: Kinsoku processing (if (featurep 'mule) - (kinsoku-process)) + (declare-fboundp (kinsoku-process))) (delete-region (point) (progn (skip-chars-forward " \t") (point))) @@ -3868,14 +3905,28 @@ the region is active. Otherwise, this means that the user has pushed a mark in this buffer at some point in the past. The functions `region-beginning' and `region-end' can be used to find the - limits of the region." + limits of the region. + +You should use this, *NOT* `region-active-p', in a menu item +specification that you want grayed out when the region is not active: + + [ ... ... :active (region-exists-p)] + +This correctly caters to the user's setting of `zmacs-regions'." (not (null (mark)))) ;; XEmacs (defun region-active-p () "Return non-nil if the region is active. If `zmacs-regions' is true, this is equivalent to `region-exists-p'. -Otherwise, this function always returns false." +Otherwise, this function always returns false. + +You should generally *NOT* use this in a menu item specification that you +want grayed out when the region is not active. Instead, use this: + + [ ... ... :active (region-exists-p)] + +Which correctly caters to the user's setting of `zmacs-regions'." (and zmacs-regions zmacs-region-extent)) (defvar zmacs-activate-region-hook nil @@ -4216,8 +4267,7 @@ (or frame (setq frame (selected-frame))) (let ((clear-stream (and message-stack (eq 'stream (frame-type frame))))) (remove-message label frame) - (let ((inhibit-read-only t) - (zmacs-region-stays zmacs-region-stays)) ; preserve from change + (let ((inhibit-read-only t)) (erase-buffer " *Echo Area*")) (if clear-stream (send-string-to-terminal ?\n stdout-p)) @@ -4275,8 +4325,7 @@ ;; message-stack. (defun raw-append-message (message &optional frame stdout-p) (unless (equal message "") - (let ((inhibit-read-only t) - (zmacs-region-stays zmacs-region-stays)) ; preserve from change + (let ((inhibit-read-only t)) (insert-string message " *Echo Area*") ;; Conditionalizing on the device type in this way is not that clean, ;; but neither is having a device method, as I originally implemented
--- a/lisp/sound.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/sound.el Fri May 04 22:42:35 2001 +0000 @@ -140,10 +140,11 @@ You can only play sound files if you are running on display 0 of the console of a machine with native sound support or running a NetAudio -server and XEmacs has the necessary sound support compiled in. +or ESD server and XEmacs has the necessary sound support compiled in. -The sound file must be in the Sun/NeXT U-LAW format, except on Linux, -where .wav files are also supported by the sound card drivers." +The sound file must be in the Sun/NeXT U-LAW format, except on Linux +and MS Windows, where .wav files are also supported by the sound card +drivers." (interactive "fSound file name: \n\ SSymbol to name this sound: \n\ nVolume (0 for default): ") @@ -151,17 +152,14 @@ (error "sound-name not a symbol")) (unless (or (null volume) (integerp volume)) (error "volume not an integer or nil")) - (let ((file (if (file-name-absolute-p filename) - ;; For absolute file names, we don't have on choice on the - ;; location, but sound extensions however can still be tried - (setq file (locate-file filename - (list (file-name-directory filename)) - (split-string sound-extension-list - ":"))) - (setq file (locate-file filename - default-sound-directory-list - (split-string sound-extension-list - ":"))))) + (let ((file + ;; For absolute file names, we don't have on choice on the + ;; location, but sound extensions however can still be tried + (locate-file filename + (if (file-name-absolute-p filename) + (list (file-name-directory filename)) + default-sound-directory-list) + (split-string sound-extension-list ":"))) buf data) (unless file (error "Couldn't load sound file %s" filename))
--- a/lisp/startup.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/startup.el Fri May 04 22:42:35 2001 +0000 @@ -30,11 +30,39 @@ ;; This file is dumped with XEmacs. -;; -batch, -t, and -nw are processed by main() in emacs.c and are -;; never seen by lisp code. - -;; -version and -help are special-cased as well: they imply -batch, -;; but are left on the list for lisp code to process. +;; It handles the all aspects of startup once the C code has finished +;; initializing itself. Entry from C is through the function set in +;; the `top-level' variable, which is normally `normal-top-level'. At +;; the point that `normal-top-level' has been invoked: +;; +;; (1) the dumped Elisp files are available. Either they were loaded +;; during this invocation of temacs and it was then converted to +;; XEmacs using the run-temacs mechanism, or (more likely) the +;; loadup and dumping occurred at some point in the past and we +;; just read in the dumped data. +;; +;; (2) All C subsystems have been initialized. +;; +;; (3) A "stream" device has been created, which does I/O over stdin +;; and stdout. This is the only device we have available and our +;; only means of communication, other than disk files. +;; +;; (4) The command-line arguments have been sorted according to +;; priority specs (this implies that the names of all arguments +;; must be hard-coded into emacs.c), and certain low-level +;; arguments such as -sd, -t, -nd, -nw, -batch, etc. have been +;; processed by main_1() and removed. (NOTE: main_1() is the name +;; in the source code, but in the object file it has some other +;; name, such as xemacs_21_2_34_mips_sgi_irix6().) Certain other +;; arguments such as -version and -help are partially-processed, +;; triggering some special behavior but being left on the list for +;; further processing by the Lisp code. +;; +;; The job of the code here is to process the remaining command-line +;; args, set up the various paths, locate where all the packages are +;; and set things up for them (initialize the load path, read in the +;; autoloads, etc.), read in the init files, display the splash +;; screen, and set up any remaining environment-dependent variables. ;;; Code: @@ -565,14 +593,19 @@ (push (pop args) new-args))) (t (push arg new-args)))) - (setq init-file-user (and load-user-init-file-p "")) + (with-obsolete-variable 'init-file-user + (setq init-file-user (and load-user-init-file-p ""))) (nreverse new-args))) (defconst initial-scratch-message "\ ;; This buffer is for notes you don't want to save, and for Lisp evaluation. ;; If you want to create a file, first visit that file with C-x C-f, -;; then enter the text in that file's own buffer. +;; then enter the text in that file's own buffer. (C-x is the standard +;; XEmacs abbreviation for `Control+X', i.e. hold down the Control key +;; while hitting the X key.) +;; +;; For Lisp evaluation, type an expression, move to the end and hit C-j. " "Initial message displayed in *scratch* buffer at startup.
--- a/lisp/symbols.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/symbols.el Fri May 04 22:42:35 2001 +0000 @@ -83,6 +83,9 @@ ;; perhaps there should be something that combines ;; `define-magic-variable-handlers' with `defvaralias'. +(globally-declare-fboundp + '(set-magic-variable-handler)) + (defun define-magic-variable-handlers (variable handler-class harg) "Set the magic variable handles for VARIABLE to those in HANDLER-CLASS. HANDLER-CLASS should be a symbol. The handlers are constructed by adding
--- a/lisp/syntax.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/syntax.el Fri May 04 22:42:35 2001 +0000 @@ -248,8 +248,8 @@ (if (equal first last) (cond ((vectorp first) (princ (format "%s, row %d\t" - (charset-name - (aref first 0)) + (declare-fboundp (charset-name + (aref first 0))) (aref first 1)) stream)) ((symbolp first) @@ -260,8 +260,8 @@ (princ "\t" stream))) (cond ((vectorp first) (princ (format "%s, rows %d .. %d\t" - (charset-name - (aref first 0)) + (declare-fboundp (charset-name + (aref first 0))) (aref first 1) (aref last 1)) stream)) @@ -303,8 +303,8 @@ (and (characterp range) (characterp first-char) (or (not (featurep 'mule)) - (eq (char-charset range) - (char-charset first-char))) + (eq (declare-fboundp (char-charset range)) + (declare-fboundp (char-charset first-char)))) (= (char-int last-char) (1- (char-int range)))) (and (vectorp range) (vectorp first-char)
--- a/lisp/toolbar-items.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/toolbar-items.el Fri May 04 22:42:35 2001 +0000 @@ -37,13 +37,6 @@ ;;; Code: -;; Suppress warning message from bytecompiler -(eval-when-compile - (defvar pending-delete-mode) - ;; #### The compiler still warns about missing - ;; `pending-delete-pre-hook'. Any way to get rid of the warning? - ) - (defgroup toolbar nil "Configure XEmacs Toolbar functions and properties" :group 'environment) @@ -132,9 +125,9 @@ (interactive) ;; This horrible kludge is for pending-delete to work correctly. (and (boundp 'pending-delete-mode) - pending-delete-mode + (declare-boundp pending-delete-mode) (let ((this-command toolbar-paste-function)) - (pending-delete-pre-hook))) + (declare-fboundp (pending-delete-pre-hook)))) (call-interactively toolbar-paste-function)) (defcustom toolbar-undo-function 'undo
--- a/lisp/toolbar.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/toolbar.el Fri May 04 22:42:35 2001 +0000 @@ -107,7 +107,7 @@ (not (featurep 'infodock)) (or (eq locale 'global) (eq 'x (device-or-frame-type locale)))) - (x-init-toolbar-from-resources locale))) + (declare-fboundp (x-init-toolbar-from-resources locale)))) ;; #### Is this actually needed or will the code in
--- a/lisp/tty-init.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/tty-init.el Fri May 04 22:42:35 2001 +0000 @@ -36,27 +36,28 @@ ;; called both from init-tty-win and from the C code. (defun init-pre-tty-win () "Initialize TTY at startup (pre). Don't call this." - (unless pre-tty-win-initted - (register-tty-color "black" "\e[30m" "\e[40m") - (register-tty-color "red" "\e[31m" "\e[41m") - (register-tty-color "green" "\e[32m" "\e[42m") - (register-tty-color "yellow" "\e[33m" "\e[43m") - (register-tty-color "blue" "\e[34m" "\e[44m") - (register-tty-color "magenta" "\e[35m" "\e[45m") - (register-tty-color "cyan" "\e[36m" "\e[46m") - (register-tty-color "white" "\e[37m" "\e[47m") + (with-fboundp 'register-tty-color + (unless pre-tty-win-initted + (register-tty-color "black" "\e[30m" "\e[40m") + (register-tty-color "red" "\e[31m" "\e[41m") + (register-tty-color "green" "\e[32m" "\e[42m") + (register-tty-color "yellow" "\e[33m" "\e[43m") + (register-tty-color "blue" "\e[34m" "\e[44m") + (register-tty-color "magenta" "\e[35m" "\e[45m") + (register-tty-color "cyan" "\e[36m" "\e[46m") + (register-tty-color "white" "\e[37m" "\e[47m") - ;; Define `highlighted' tty colors - (register-tty-color "darkgrey" "\e[1;30m" "\e[1;40m") - (register-tty-color "brightred" "\e[1;31m" "\e[1;41m") - (register-tty-color "brightgreen" "\e[1;32m" "\e[1;42m") - (register-tty-color "brightyellow" "\e[1;33m" "\e[1;43m") - (register-tty-color "brightblue" "\e[1;34m" "\e[1;44m") - (register-tty-color "brightmagenta" "\e[1;35m" "\e[1;45m") - (register-tty-color "brightcyan" "\e[1;36m" "\e[1;46m") - (register-tty-color "brightwhite" "\e[1;37m" "\e[1;47m") + ;; Define `highlighted' tty colors + (register-tty-color "darkgrey" "\e[1;30m" "\e[1;40m") + (register-tty-color "brightred" "\e[1;31m" "\e[1;41m") + (register-tty-color "brightgreen" "\e[1;32m" "\e[1;42m") + (register-tty-color "brightyellow" "\e[1;33m" "\e[1;43m") + (register-tty-color "brightblue" "\e[1;34m" "\e[1;44m") + (register-tty-color "brightmagenta" "\e[1;35m" "\e[1;45m") + (register-tty-color "brightcyan" "\e[1;36m" "\e[1;46m") + (register-tty-color "brightwhite" "\e[1;37m" "\e[1;47m") - (setq pre-tty-win-initted t))) + (setq pre-tty-win-initted t)))) ;; called both from init-tty-win and from the C code. ;; we have to do this for every created TTY console. @@ -67,7 +68,7 @@ ;; override term-file-prefix. (startup.el does it after ;; loading the init file.) (if (featurep 'mule) - (init-mule-tty-win)) + (declare-fboundp (init-mule-tty-win))) (when init-file-loaded ;; temporarily select the console so that the changes ;; to function-key-map are made for the right console.
--- a/lisp/wid-browse.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/wid-browse.el Fri May 04 22:42:35 2001 +0000 @@ -226,7 +226,7 @@ "Insert description of WIDGET's KEY VALUE. Nothing is assumed about value." (let ((pp (condition-case signal - (pp-to-string value) + (declare-fboundp (pp-to-string value)) (error (prin1-to-string signal))))) (when (string-match "\n\\'" pp) (setq pp (substring pp 0 (1- (length pp)))))
--- a/lisp/widgets-gtk.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/widgets-gtk.el Fri May 04 22:42:35 2001 +0000 @@ -28,6 +28,17 @@ ;; This file is dumped with XEmacs (when embedded widgets are compiled in). +(globally-declare-fboundp + '(gtk-button-new-with-label + gtk-signal-connect + gtk-radio-button-new-with-label gtk-radio-button-group + gtk-toggle-button-set-active gtk-check-button-new-with-label + gtk-widget-show-all gtk-notebook-new gtk-notebook-append-page + gtk-vbox-new gtk-label-new gtk-adjustment-new + gtk-progress-bar-new-with-adjustment gtk-adjustment-set-value + gtk-entry-new gtk-entry-set-text gtk-widget-set-style + gtk-widget-get-style)) + (defvar foo) (defun gtk-widget-instantiate-button-internal (plist callback)
--- a/lisp/x-faces.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/x-faces.el Fri May 04 22:42:35 2001 +0000 @@ -62,6 +62,10 @@ ;;; Code: +(globally-declare-fboundp + '(x-get-resource-and-maybe-bogosity-check + x-get-resource x-init-pointer-shape)) + (defconst x-font-regexp nil) (defconst x-font-regexp-head nil) (defconst x-font-regexp-head-2 nil)
--- a/lisp/x-font-menu.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/x-font-menu.el Fri May 04 22:42:35 2001 +0000 @@ -34,6 +34,13 @@ (require 'font-menu) +(globally-declare-boundp + '(x-font-regexp + x-font-regexp-foundry-and-family x-font-regexp-spacing)) + +(globally-declare-fboundp + '(charset-registry)) + (defvar x-font-menu-registry-encoding nil "Registry and encoding to use with font menu fonts.") @@ -184,8 +191,6 @@ ;; get the truename and use the possibly suboptimal data from that. ;;;###autoload (defun* x-font-menu-font-data (face dcache) - (defvar x-font-regexp) - (defvar x-font-regexp-foundry-and-family) (let* ((case-fold-search t) (domain (if font-menu-this-frame-only-p (selected-frame)
--- a/lisp/x-init.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/x-init.el Fri May 04 22:42:35 2001 +0000 @@ -32,6 +32,13 @@ ;;; Code: +(globally-declare-fboundp + '(x-keysym-on-keyboard-p + x-server-vendor x-init-specifier-from-resources init-mule-x-win)) + +(globally-declare-boundp + '(x-initial-argv-list)) + ;; If you want to change this variable, this is the place you must do it. ;; Do not set it to a string containing periods. X doesn't like that. ;(setq x-emacs-application-class "Emacs")
--- a/lisp/x-misc.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/x-misc.el Fri May 04 22:42:35 2001 +0000 @@ -31,6 +31,9 @@ ;;; Code: +(globally-declare-fboundp + '(x-get-resource)) + (defun x-bogosity-check-resource (name class type) "Check for a bogus resource specification." (let ((bogus (x-get-resource
--- a/lisp/x-mouse.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/x-mouse.el Fri May 04 22:42:35 2001 +0000 @@ -31,6 +31,9 @@ ;;; Code: +(globally-declare-fboundp + '(x-store-cutbuffer x-get-resource)) + ;;(define-key global-map 'button2 'x-set-point-and-insert-selection) ;; This is reserved for use by Hyperbole. ;;(define-key global-map '(shift button2) 'x-mouse-kill)
--- a/lisp/x-scrollbar.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/x-scrollbar.el Fri May 04 22:42:35 2001 +0000 @@ -33,6 +33,9 @@ ;;; Code: +(globally-declare-fboundp + '(x-init-specifier-from-resources x-get-resource)) + (defun x-init-scrollbar-from-resources (locale) (x-init-specifier-from-resources (specifier-fallback scrollbar-width) 'natnum locale
--- a/lisp/x-select.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/x-select.el Fri May 04 22:42:35 2001 +0000 @@ -35,6 +35,10 @@ ;;; Code: +(globally-declare-fboundp + '(x-get-cutbuffer-internal + x-rotate-cutbuffers-internal x-store-cutbuffer-internal)) + (define-obsolete-function-alias 'x-selection-exists-p 'selection-exists-p) (define-obsolete-function-alias 'x-selection-owner-p 'selection-owner-p) (define-obsolete-variable-alias 'x-selection-converter-alist 'selection-converter-alist)
--- a/lisp/x-win-sun.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/x-win-sun.el Fri May 04 22:42:35 2001 +0000 @@ -64,6 +64,9 @@ ;;; Code: +(globally-declare-fboundp + '(x-keysym-on-keyboard-sans-modifiers-p)) + ;;;###autoload (defun x-win-init-sun ()
--- a/lisp/x-win-xfree86.el Thu May 03 21:08:39 2001 +0000 +++ b/lisp/x-win-xfree86.el Fri May 04 22:42:35 2001 +0000 @@ -39,6 +39,11 @@ ;; For no obvious reason, shift-F1 is called F13, although Meta-F1 and ;; Control-F1 have normal names. +;;; Code: + +(globally-declare-fboundp + '(x-keysym-on-keyboard-p x-keysym-on-keyboard-sans-modifiers-p)) + ;;;###autoload (defun x-win-init-xfree86 () (loop for (key sane-key) in
--- a/src/ChangeLog Thu May 03 21:08:39 2001 +0000 +++ b/src/ChangeLog Fri May 04 22:42:35 2001 +0000 @@ -1,3 +1,129 @@ +2001-04-23 Ben Wing <ben@xemacs.org> + + ------------ notable bug fix: Windows event code -------------- + + * event-msw.c (FAKE_MOD_QUIT): + * event-msw.c (mswindows_dequeue_dispatch_event): + * event-msw.c (mswindows_wnd_proc): + * event-msw.c (emacs_mswindows_quit_p): + Get critical quit working. + + ------------ notable bug fix and new feature: regex code -------------- + + * lisp.h: + * regex.c: + * regex.c (enum): + * regex.c (print_compiled_pattern): + * regex.c (INIT_REG_TRANSLATE_SIZE): + * regex.c (regex_compile): + * regex.c (re_match_2_internal): + * regex.h: + * regex.h (RE_SYNTAX_AWK): + * regex.h (RE_SYNTAX_GREP): + * regex.h (RE_SYNTAX_EGREP): + * regex.h (RE_SYNTAX_POSIX_EGREP): + * regex.h (_RE_SYNTAX_POSIX_COMMON): + * regex.h (struct re_pattern_buffer): + * search.c: + * search.c (vars_of_search): + Shy groups were implemented in a horrible, half-assed way that + would cause them to screw up regex searching in most cases. + Fixed to work correctly. + + Also extended back-reference syntax past 9. Only is recognized + as such if there are at least that many non-shy groups; and + optionally will warn about such uses, to catch old code that + might be using them differently. (Added variable to control + this in search.c -- `warn-about-possibly-incompatible-back- + references', on by default for the moment. Declared in lisp.h. + + ---------------- process/SIGIO improvements ------------------- + + * process-unix.c: + * process-unix.c (get_internet_address): + * process-unix.c (unix_canonicalize_host_name): + * process-unix.c (unix_open_network_stream): + * process-unix.c (unix_open_multicast_group): + define USE_GETADDRINFO to replace more complex conditional, + and use it. the code conditionalized on this in + unix_open_network_stream had *serious* problems handling errors. + it's now fixed, and major amounts of duplicate code between + the two versions were combined. + + don't disable SIGIO and other interrupts unless + CONNECT_NEEDS_SLOWED_INTERRUPTS is defined -- don't penalize OS's + without bugs. similarly for a freebsd bug that was affecting all + OS's. + + * s\ultrix.h: + define CONNECT_NEEDS_SLOWED_INTERRUPTS, since that's the OS + mentioned as having a kernel bug. + + * sysdep.c (request_sigio_on_device): + * sysdep.c (unrequest_sigio_on_device): + fix SIGIO problems on Linux. add check for O_ASYNC in case it's + defined and FASYNC isn't. add comment about other ways to do + SIGIO on Linux. + + * callproc.c (Fold_call_process_internal): + * process.c (Fstart_process_internal): + Deal with the possibility that `default-directory' doesn't + have terminating slash. Correct comments about vfork. + + ---------------- Miscellaneous bug fixes/cleanup ------------------- + + * callint.c (Finteractive): + Add lots of documentation -- exactly what the Lisp equivalents of + all the interactive specs are. + + * console.h (struct console): change type of quit_char to Emchar. + + * event-msw.c (lstream_type_create_mswindows_selectable): spacing + change. + + * event-Xt.c: + * event-msw.c: + * event-stream.c: + * events-mod.h: + * events.c: + * events.h: + * frame-x.c: + * gpmevent.c: + * keymap.c: + Eliminate events-mod.h and combine into events.h. + + * emacs.c: + * emacs.c (make_arg_list_1): + * emacs.c (main_1): + A couple of char->Extbyte changes, add a comment. + + * glyphs-msw.c (mswindows_resource_instantiate): + * glyphs-msw.c (mswindows_xface_instantiate): + * glyphs-msw.c (mswindows_subwindow_instantiate): + * glyphs-msw.c (mswindows_widget_instantiate): + * glyphs-msw.c (mswindows_native_layout_instantiate): + * glyphs-msw.c (mswindows_button_instantiate): + * glyphs-msw.c (mswindows_edit_field_instantiate): + * glyphs-msw.c (mswindows_progress_gauge_instantiate): + * glyphs-msw.c (mswindows_tree_view_instantiate): + * glyphs-msw.c (mswindows_tab_control_instantiate): + * glyphs-msw.c (mswindows_label_instantiate): + * glyphs-msw.c (mswindows_scrollbar_instantiate): + * glyphs-msw.c (mswindows_combo_box_instantiate): + Correct indentation of function defns to not exceed 80 cols. + Try (sort of) to fix some code that sets the colors of the + progress gauge. (Commented out) + + * keymap.c (syms_of_keymap): + use DEFSYMBOL. + + * process.c (read_process_output): + No need to fiddle with zmacs_region_stays, now that bogus + clearing of it (see below) is removed. + + * search.c (Freplace_match): warning fix. + + 2001-05-03 Martin Buchholz <martin@xemacs.org> * s/aix4.h: Fix crash with xlc -O3.
--- a/src/callint.c Thu May 03 21:08:39 2001 +0000 +++ b/src/callint.c Fri May 04 22:42:35 2001 +0000 @@ -139,6 +139,74 @@ set to t when the command exits successfully. You may use any of `@', `*' and `_' at the beginning of the string; they are processed in the order that they appear. + + +When writing your own interactive spec, it can be useful to know the +equivalent Lisp expressions for the various code letters. They are: + +a -- (read-function "PROMPT") +b -- (let ((def (current-buffer))) + (if (eq (selected-window) (active-minibuffer-window)) + (setq def (other-buffer def)) + (read-buffer "PROMPT" def t))) +B -- (read-buffer "PROMPT" (other-buffer (current-buffer))) +c -- (prog1 + (let ((cursor-in-echo-area t)) + (message "%s" "PROMPT") + (read-char)) + (message nil)) +C -- (read-command "PROMPT") +d -- (point) +D -- (read-directory-name "PROMPT" nil default-directory t) +e -- current-mouse-event ;; #### not quite right. needs access to the KEYS + ;; argument of `call-interactively', but that's + ;; currently impossible. +f -- (read-file-name "PROMPT" nil nil 0) +F -- (read-file-name "PROMPT") +i -- nil +k -- (read-key-sequence "PROMPT") +K -- (read-key-sequence "PROMPT" nil t) +m -- (mark) +n -- (read-number "PROMPT") +N -- (if current-prefix-arg + (prefix-numeric-value current-prefix-arg) + (read-number "PROMPT")) +p -- (prefix-numeric-value current-prefix-arg) +P -- current-prefix-arg +r -- (if (and zmacs-regions (not zmacs-region-active-p)) + (error "The region is not active now")) + (let ((tem (marker-buffer (mark-marker t)))) + (unless (and tem (eq tem (current-buffer))) + (error "The mark is now set now"))) + (region-beginning) + + (region-end) +s -- (read-string "PROMPT") +S -- (let (tem prev-tem) + (while (not tem) + (setq tem (completing-read "PROMPT" obarray nil nil prev-tem)) + (setq prev-tem tem) + (setq tem (intern tem)) + (if (= (length tem) 0) + (setq tem nil)))) +v -- (read-variable "PROMPT") +x -- (read-expression "PROMPT") +X -- (eval (read-expression "PROMPT")) +z -- (and (fboundp 'read-coding-system) (read-coding-system "PROMPT")) +Z -- (and current-prefix-arg (fboundp 'read-coding-system) + (read-coding-system "PROMPT")) + +`*' (barf-if-buffer-read-only) +`@' (let ((event current-mouse-event)) ;; #### not quite right; needs the + (when event ;; value from the `e' spec above. + (let ((window event-window event)) + (when window + (if (and (window-minibuffer-p window) + (not (and (> (minibuffer-depth) 0) + (eq window (active-minibuffer-window))))) + (error "Attempt to select inactive minibuffer window")) + (select window))))) +`_' (setq zmacs-region-stays t) + */ (args)) {
--- a/src/callproc.c Thu May 03 21:08:39 2001 +0000 +++ b/src/callproc.c Fri May 04 22:42:35 2001 +0000 @@ -205,26 +205,30 @@ error ("Operating system cannot handle asynchronous subprocesses"); #endif /* NO_SUBPROCESSES */ - /* Do this before building new_argv because GC in Lisp code - * called by various filename-hacking routines might relocate strings */ + /* Do all filename munging before building new_argv because GC in + * Lisp code called by various filename-hacking routines might + * relocate strings */ locate_file (Vexec_path, args[0], Vlisp_EXEC_SUFFIXES, &path, X_OK); /* Make sure that the child will be able to chdir to the current - buffer's current directory, or its unhandled equivalent. We + buffer's current directory, or its unhandled equivalent. [[ We can't just have the child check for an error when it does the - chdir, since it's in a vfork. */ + chdir, since it's in a vfork. ]] -- not any more, we don't use + vfork. -ben + + Note: These calls are spread out to insure that the return values + of the calls (which may be newly-created strings) are properly + GC-protected. */ { struct gcpro ngcpro1, ngcpro2; - /* Do this test before building new_argv because GC in Lisp code - * called by various filename-hacking routines might relocate strings */ - /* Make sure that the child will be able to chdir to the current - buffer's current directory. We can't just have the child check - for an error when it does the chdir, since it's in a vfork. */ - + NGCPRO2 (current_dir, path); /* Caller gcprotects args[] */ current_dir = current_buffer->directory; - NGCPRO2 (current_dir, path); /* Caller gcprotects args[] */ + /* If the current dir has no terminating slash, we'll get undesirable + results, so put the slash back. */ + current_dir = Ffile_name_as_directory (current_dir); current_dir = Funhandled_file_name_directory (current_dir); current_dir = expand_and_dir_to_file (current_dir, Qnil); + #if 0 /* This is in FSF, but it breaks everything in the presence of ange-ftp-visited files, so away with it. */
--- a/src/console.h Thu May 03 21:08:39 2001 +0000 +++ b/src/console.h Fri May 04 22:42:35 2001 +0000 @@ -420,8 +420,9 @@ void *console_data; /* Character that causes a quit. Normally C-g. - #### Should be possible for this not to be ASCII. */ - int quit_char; + #### Should be possible for this not to be ASCII. (Currently works + under Windows.) */ + Emchar quit_char; /* ----- begin partially-completed console localization of event loop ---- */
--- a/src/emacs.c Thu May 03 21:08:39 2001 +0000 +++ b/src/emacs.c Fri May 04 22:42:35 2001 +0000 @@ -461,8 +461,8 @@ static JMP_BUF run_temacs_catch; static int run_temacs_argc; -static char **run_temacs_argv; -static char *run_temacs_args; +static Extbyte **run_temacs_argv; +static Extbyte *run_temacs_args; static size_t run_temacs_argv_size; static size_t run_temacs_args_size; @@ -657,7 +657,7 @@ if (i == 0) { /* Do not trust to what crt0 has stuffed into argv[0] */ - char full_exe_path[MAX_PATH]; + Extbyte full_exe_path[MAX_PATH]; Lisp_Object fullpath; GetModuleFileName (NULL, full_exe_path, MAX_PATH); @@ -668,7 +668,7 @@ Extbyte *fullpathext; LISP_STRING_TO_EXTERNAL (fullpath, fullpathext, - Qdll_filename_encoding); + Qdll_filename_encoding); (void) dll_init (fullpathext); } #endif @@ -994,6 +994,8 @@ noninteractive = 1; } + /* #### is it correct that -debug-paths is handled here (and presumably + removed), and then checked again below? */ if (argmatch (argv, argc, "-debug-paths", "--debug-paths", 11, NULL, &skip_args)) debug_paths = 1;
--- a/src/event-Xt.c Thu May 03 21:08:39 2001 +0000 +++ b/src/event-Xt.c Fri May 04 22:42:35 2001 +0000 @@ -65,8 +65,6 @@ #include "offix.h" #endif -#include "events-mod.h" - static void handle_focus_event_1 (struct frame *f, int in_p); static struct event_stream *Xt_event_stream;
--- a/src/event-msw.c Thu May 03 21:08:39 2001 +0000 +++ b/src/event-msw.c Fri May 04 22:42:35 2001 +0000 @@ -65,7 +65,6 @@ #include "sysdep.h" #include "objects-msw.h" -#include "events-mod.h" #ifdef HAVE_MSG_SELECT #include "sysfile.h" #include "console-tty.h" @@ -87,7 +86,8 @@ /* Fake key modifier which is attached to a quit char event. Removed upon dequeueing an event */ -#define FAKE_MOD_QUIT 0x80 +#define FAKE_MOD_QUIT (1 << 20) +#define FAKE_MOD_QUIT_CRITICAL (1 << 21) /* Timer ID used for button2 emulation */ #define BUTTON_2_TIMER_ID 1 @@ -1048,7 +1048,8 @@ if (sevt->event_type == key_press_event && (sevt->event.key.modifiers & FAKE_MOD_QUIT)) { - sevt->event.key.modifiers &= ~FAKE_MOD_QUIT; + sevt->event.key.modifiers &= + ~(FAKE_MOD_QUIT | FAKE_MOD_QUIT_CRITICAL); --mswindows_quit_chars_count; } @@ -2147,7 +2148,7 @@ BYTE keymap_orig[256]; BYTE keymap_sticky[256]; int has_AltGr = mswindows_current_layout_has_AltGr (); - int mods = 0; + int mods = 0, mods_with_shift = 0; int extendedp = lParam & 0x1000000; Lisp_Object keysym; int sticky_changed; @@ -2182,6 +2183,7 @@ memcpy (keymap_sticky, keymap_orig, 256); mods = mswindows_modifier_state (keymap_sticky, (DWORD) -1, has_AltGr); + mods_with_shift = mods; /* Handle non-printables */ if (!NILP (keysym = mswindows_key_to_emacs_keysym (wParam, mods, @@ -2250,22 +2252,27 @@ || PeekMessage (&tranmsg, hwnd, WM_SYSCHAR, WM_SYSCHAR, PM_REMOVE)) { - int mods1 = mods; + int mods_with_quit = mods; WPARAM ch = tranmsg.wParam; /* If a quit char with no modifiers other than control and shift, then mark it with a fake modifier, which is removed upon dequeueing the event */ - /* #### This might also not withstand localization, if - quit character is not a latin-1 symbol */ + /* !!#### Fix this in my mule ws -- replace current_buffer + with 0 */ if (((quit_ch < ' ' && (mods & XEMACS_MOD_CONTROL) - && quit_ch + 'a' - 1 == ch) + && DOWNCASE (current_buffer, quit_ch + 'a' - 1) == + DOWNCASE (current_buffer, ch)) || (quit_ch >= ' ' && !(mods & XEMACS_MOD_CONTROL) - && quit_ch == ch)) - && ((mods & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_SHIFT)) + && DOWNCASE (current_buffer, quit_ch) == + DOWNCASE (current_buffer, ch))) + && ((mods_with_shift & + ~(XEMACS_MOD_CONTROL | XEMACS_MOD_SHIFT)) == 0)) { - mods1 |= FAKE_MOD_QUIT; + mods_with_quit |= FAKE_MOD_QUIT; + if (mods_with_shift & XEMACS_MOD_SHIFT) + mods_with_quit |= FAKE_MOD_QUIT_CRITICAL; ++mswindows_quit_chars_count; } else if (potential_accelerator && !got_accelerator && @@ -2274,7 +2281,8 @@ got_accelerator = 1; break; } - mswindows_enqueue_keypress_event (hwnd, make_char (ch), mods1); + mswindows_enqueue_keypress_event (hwnd, make_char (ch), + mods_with_quit); } /* while */ /* This generates WM_SYSCHAR messages, which are interpreted @@ -3464,8 +3472,8 @@ if (mswindows_in_modal_loop) return; - /* Drain windows queue. This sets up number of quit characters in - the queue */ + /* Drain windows queue. This sets up number of quit characters in + the queue. */ mswindows_drain_windows_queue (); if (mswindows_quit_chars_count > 0) @@ -3483,10 +3491,11 @@ emacs_event = mswindows_cancel_dispatch_event (&match_against); assert (!NILP (emacs_event)); - if (XEVENT(emacs_event)->event.key.modifiers & XEMACS_MOD_SHIFT) + if (XEVENT (emacs_event)->event.key.modifiers & + FAKE_MOD_QUIT_CRITICAL) critical_p = 1; - Fdeallocate_event(emacs_event); + Fdeallocate_event (emacs_event); } Vquit_flag = critical_p ? Qcritical : Qt; @@ -3759,7 +3768,7 @@ { init_slurp_stream (); init_shove_stream (); -#if defined (HAVE_SOCKETS) && !defined(HAVE_MSG_SELECT) +#if defined (HAVE_SOCKETS) && !defined (HAVE_MSG_SELECT) init_winsock_stream (); #endif }
--- a/src/event-stream.c Thu May 03 21:08:39 2001 +0000 +++ b/src/event-stream.c Fri May 04 22:42:35 2001 +0000 @@ -92,7 +92,6 @@ #include "sysfile.h" #include "systime.h" /* to set Vlast_input_time */ -#include "events-mod.h" #ifdef FILE_CODING #include "file-coding.h" #endif
--- a/src/events-mod.h Thu May 03 21:08:39 2001 +0000 +++ b/src/events-mod.h Fri May 04 22:42:35 2001 +0000 @@ -1,13 +0,0 @@ -/* The modifiers XEmacs knows about; these appear in key and button events. */ - -#define XEMACS_MOD_CONTROL (1<<0) -#define XEMACS_MOD_META (1<<1) -#define XEMACS_MOD_SUPER (1<<2) -#define XEMACS_MOD_HYPER (1<<3) -#define XEMACS_MOD_ALT (1<<4) -#define XEMACS_MOD_SHIFT (1<<5) /* not used for dual-case characters */ -#define XEMACS_MOD_BUTTON1 (1<<6) -#define XEMACS_MOD_BUTTON2 (1<<7) -#define XEMACS_MOD_BUTTON3 (1<<8) -#define XEMACS_MOD_BUTTON4 (1<<9) -#define XEMACS_MOD_BUTTON5 (1<<10)
--- a/src/events.c Thu May 03 21:08:39 2001 +0000 +++ b/src/events.c Fri May 04 22:42:35 2001 +0000 @@ -38,7 +38,6 @@ #include "keymap.h" /* for key_desc_list_to_event() */ #include "redisplay.h" #include "window.h" -#include "events-mod.h" /* Where old events go when they are explicitly deallocated. The event chain here is cut loose before GC, so these will be freed
--- a/src/events.h Thu May 03 21:08:39 2001 +0000 +++ b/src/events.h Fri May 04 22:42:35 2001 +0000 @@ -542,9 +542,23 @@ extern Lisp_Object Qcancel_mode_internal; extern Lisp_Object Vmodifier_keys_sticky_time; -/* Note: under X Windows, XEMACS_MOD_ALT is generated by the Alt key if there are - both Alt and Meta keys. If there are no Meta keys, then Alt generates - XEMACS_MOD_META instead. +/* The modifiers XEmacs knows about; these appear in key and button events. */ + +#define XEMACS_MOD_CONTROL (1<<0) +#define XEMACS_MOD_META (1<<1) +#define XEMACS_MOD_SUPER (1<<2) +#define XEMACS_MOD_HYPER (1<<3) +#define XEMACS_MOD_ALT (1<<4) +#define XEMACS_MOD_SHIFT (1<<5) /* not used for dual-case characters */ +#define XEMACS_MOD_BUTTON1 (1<<6) +#define XEMACS_MOD_BUTTON2 (1<<7) +#define XEMACS_MOD_BUTTON3 (1<<8) +#define XEMACS_MOD_BUTTON4 (1<<9) +#define XEMACS_MOD_BUTTON5 (1<<10) + +/* Note: under X Windows, XEMACS_MOD_ALT is generated by the Alt key + if there are both Alt and Meta keys. If there are no Meta keys, + then Alt generates XEMACS_MOD_META instead. */ #ifdef emacs
--- a/src/frame-x.c Thu May 03 21:08:39 2001 +0000 +++ b/src/frame-x.c Fri May 04 22:42:35 2001 +0000 @@ -61,9 +61,6 @@ #ifdef HAVE_OFFIX_DND #include "offix.h" #endif -#if defined (HAVE_OFFIX_DND) || defined (HAVE_CDE) -#include "events-mod.h" -#endif /* Default properties to use when creating frames. */ Lisp_Object Vdefault_x_frame_plist;
--- a/src/glyphs-msw.c Thu May 03 21:08:39 2001 +0000 +++ b/src/glyphs-msw.c Fri May 04 22:42:35 2001 +0000 @@ -1250,9 +1250,10 @@ } static void -mswindows_resource_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) +mswindows_resource_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); unsigned int type = 0; @@ -1988,7 +1989,8 @@ #undef SYSV32 static void -mswindows_xface_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, +mswindows_xface_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { @@ -2376,8 +2378,10 @@ } static void -mswindows_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, +mswindows_subwindow_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, + Lisp_Object pointer_fg, + Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); @@ -2496,7 +2500,8 @@ /* widgets */ /************************************************************************/ static void -mswindows_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, +mswindows_widget_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain, const char* class, int flags, int exflags) @@ -2587,7 +2592,8 @@ static void mswindows_native_layout_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, + Lisp_Object pointer_fg, + Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); @@ -2612,7 +2618,8 @@ many-to-one relationship with things you see, whereas widgets can only be one-to-one (i.e. per frame) */ static void -mswindows_button_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, +mswindows_button_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { @@ -2697,9 +2704,11 @@ /* instantiate an edit control */ static void -mswindows_edit_field_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) +mswindows_edit_field_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, + Lisp_Object pointer_fg, + Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) { mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, pointer_bg, dest_mask, domain, "EDIT", @@ -2709,9 +2718,11 @@ /* instantiate a progress gauge */ static void -mswindows_progress_gauge_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) +mswindows_progress_gauge_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, + Lisp_Object pointer_fg, + Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) { HWND wnd; Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); @@ -2721,17 +2732,15 @@ WS_BORDER | PBS_SMOOTH, WS_EX_CLIENTEDGE); wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); /* set the colors */ -#ifdef PBS_SETBKCOLOR - SendMessage (wnd, PBS_SETBKCOLOR, 0, +#if 0 /* #### fix this */ + SendMessage (wnd, PBM_SETBKCOLOR, 0, (LPARAM) (COLOR_INSTANCE_MSWINDOWS_COLOR (XCOLOR_INSTANCE (FACE_BACKGROUND (XIMAGE_INSTANCE_WIDGET_FACE (ii), XIMAGE_INSTANCE_FRAME (ii)))))); -#endif -#ifdef PBS_SETBARCOLOR - SendMessage (wnd, PBS_SETBARCOLOR, 0, - (L:PARAM) (COLOR_INSTANCE_MSWINDOWS_COLOR + SendMessage (wnd, PBM_SETBARCOLOR, 0, + (LPARAM) (COLOR_INSTANCE_MSWINDOWS_COLOR (XCOLOR_INSTANCE (FACE_FOREGROUND (XIMAGE_INSTANCE_WIDGET_FACE (ii), @@ -2798,9 +2807,11 @@ } static void -mswindows_tree_view_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) +mswindows_tree_view_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, + Lisp_Object pointer_fg, + Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) { Lisp_Object rest; HWND wnd; @@ -2901,9 +2912,11 @@ } static void -mswindows_tab_control_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) +mswindows_tab_control_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, + Lisp_Object pointer_fg, + Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) { /* This function can call lisp */ Lisp_Object rest; @@ -3016,7 +3029,8 @@ /* instantiate a static control possible for putting other things in */ static void -mswindows_label_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, +mswindows_label_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { @@ -3027,8 +3041,10 @@ /* instantiate a scrollbar control */ static void -mswindows_scrollbar_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, +mswindows_scrollbar_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, + Lisp_Object pointer_fg, + Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, @@ -3038,9 +3054,11 @@ /* instantiate a combo control */ static void -mswindows_combo_box_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) +mswindows_combo_box_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, + Lisp_Object pointer_fg, + Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); HWND wnd;
--- a/src/gpmevent.c Thu May 03 21:08:39 2001 +0000 +++ b/src/gpmevent.c Fri May 04 22:42:35 2001 +0000 @@ -29,7 +29,6 @@ #include "console-tty.h" #include "device.h" #include "events.h" -#include "events-mod.h" #include "sysdep.h" #include "commands.h" #include "lstream.h"
--- a/src/keymap.c Thu May 03 21:08:39 2001 +0000 +++ b/src/keymap.c Fri May 04 22:42:35 2001 +0000 @@ -37,7 +37,6 @@ #include "insdel.h" #include "keymap.h" #include "window.h" -#include "events-mod.h" /* A keymap contains six slots: @@ -4223,14 +4222,14 @@ { INIT_LRECORD_IMPLEMENTATION (keymap); - defsymbol (&Qminor_mode_map_alist, "minor-mode-map-alist"); - - defsymbol (&Qkeymapp, "keymapp"); - - defsymbol (&Qsuppress_keymap, "suppress-keymap"); - - defsymbol (&Qmodeline_map, "modeline-map"); - defsymbol (&Qtoolbar_map, "toolbar-map"); + DEFSYMBOL (Qminor_mode_map_alist); + + DEFSYMBOL (Qkeymapp); + + DEFSYMBOL (Qsuppress_keymap); + + DEFSYMBOL (Qmodeline_map); + DEFSYMBOL (Qtoolbar_map); DEFSUBR (Fkeymap_parents); DEFSUBR (Fset_keymap_parents); @@ -4265,51 +4264,51 @@ DEFSUBR (Ftext_char_description); - defsymbol (&Qcontrol, "control"); - defsymbol (&Qctrl, "ctrl"); - defsymbol (&Qmeta, "meta"); - defsymbol (&Qsuper, "super"); - defsymbol (&Qhyper, "hyper"); - defsymbol (&Qalt, "alt"); - defsymbol (&Qshift, "shift"); - defsymbol (&Qbutton0, "button0"); - defsymbol (&Qbutton1, "button1"); - defsymbol (&Qbutton2, "button2"); - defsymbol (&Qbutton3, "button3"); - defsymbol (&Qbutton4, "button4"); - defsymbol (&Qbutton5, "button5"); - defsymbol (&Qbutton6, "button6"); - defsymbol (&Qbutton7, "button7"); - defsymbol (&Qbutton0up, "button0up"); - defsymbol (&Qbutton1up, "button1up"); - defsymbol (&Qbutton2up, "button2up"); - defsymbol (&Qbutton3up, "button3up"); - defsymbol (&Qbutton4up, "button4up"); - defsymbol (&Qbutton5up, "button5up"); - defsymbol (&Qbutton6up, "button6up"); - defsymbol (&Qbutton7up, "button7up"); - defsymbol (&Qmouse_1, "mouse-1"); - defsymbol (&Qmouse_2, "mouse-2"); - defsymbol (&Qmouse_3, "mouse-3"); - defsymbol (&Qmouse_4, "mouse-4"); - defsymbol (&Qmouse_5, "mouse-5"); - defsymbol (&Qmouse_6, "mouse-6"); - defsymbol (&Qmouse_7, "mouse-7"); - defsymbol (&Qdown_mouse_1, "down-mouse-1"); - defsymbol (&Qdown_mouse_2, "down-mouse-2"); - defsymbol (&Qdown_mouse_3, "down-mouse-3"); - defsymbol (&Qdown_mouse_4, "down-mouse-4"); - defsymbol (&Qdown_mouse_5, "down-mouse-5"); - defsymbol (&Qdown_mouse_6, "down-mouse-6"); - defsymbol (&Qdown_mouse_7, "down-mouse-7"); - defsymbol (&Qmenu_selection, "menu-selection"); - defsymbol (&QLFD, "LFD"); - defsymbol (&QTAB, "TAB"); - defsymbol (&QRET, "RET"); - defsymbol (&QESC, "ESC"); - defsymbol (&QDEL, "DEL"); - defsymbol (&QSPC, "SPC"); - defsymbol (&QBS, "BS"); + DEFSYMBOL (Qcontrol); + DEFSYMBOL (Qctrl); + DEFSYMBOL (Qmeta); + DEFSYMBOL (Qsuper); + DEFSYMBOL (Qhyper); + DEFSYMBOL (Qalt); + DEFSYMBOL (Qshift); + DEFSYMBOL (Qbutton0); + DEFSYMBOL (Qbutton1); + DEFSYMBOL (Qbutton2); + DEFSYMBOL (Qbutton3); + DEFSYMBOL (Qbutton4); + DEFSYMBOL (Qbutton5); + DEFSYMBOL (Qbutton6); + DEFSYMBOL (Qbutton7); + DEFSYMBOL (Qbutton0up); + DEFSYMBOL (Qbutton1up); + DEFSYMBOL (Qbutton2up); + DEFSYMBOL (Qbutton3up); + DEFSYMBOL (Qbutton4up); + DEFSYMBOL (Qbutton5up); + DEFSYMBOL (Qbutton6up); + DEFSYMBOL (Qbutton7up); + DEFSYMBOL (Qmouse_1); + DEFSYMBOL (Qmouse_2); + DEFSYMBOL (Qmouse_3); + DEFSYMBOL (Qmouse_4); + DEFSYMBOL (Qmouse_5); + DEFSYMBOL (Qmouse_6); + DEFSYMBOL (Qmouse_7); + DEFSYMBOL (Qdown_mouse_1); + DEFSYMBOL (Qdown_mouse_2); + DEFSYMBOL (Qdown_mouse_3); + DEFSYMBOL (Qdown_mouse_4); + DEFSYMBOL (Qdown_mouse_5); + DEFSYMBOL (Qdown_mouse_6); + DEFSYMBOL (Qdown_mouse_7); + DEFSYMBOL (Qmenu_selection); + DEFSYMBOL (QLFD); + DEFSYMBOL (QTAB); + DEFSYMBOL (QRET); + DEFSYMBOL (QESC); + DEFSYMBOL (QDEL); + DEFSYMBOL (QSPC); + DEFSYMBOL (QBS); } void
--- a/src/lisp.h Thu May 03 21:08:39 2001 +0000 +++ b/src/lisp.h Fri May 04 22:42:35 2001 +0000 @@ -2859,6 +2859,8 @@ Bytecount, int, Error_behavior, int); Bytecount fast_lisp_string_match (Lisp_Object, Lisp_Object); void restore_match_data (void); +extern int warn_about_possibly_incompatible_back_references; + /* Defined in signal.c */ void init_interrupts_late (void);
--- a/src/process-unix.c Thu May 03 21:08:39 2001 +0000 +++ b/src/process-unix.c Fri May 04 22:42:35 2001 +0000 @@ -65,6 +65,11 @@ #include <grp.h> /* See grantpt fixups for HPUX below. */ #endif +#if defined (HAVE_GETADDRINFO) && defined (HAVE_GETNAMEINFO) +#define USE_GETADDRINFO +#endif + + /* * Implementation-specific data. Pointed to by Lisp_Process->process_data */ @@ -435,7 +440,7 @@ #ifdef HAVE_SOCKETS -#if !(defined(HAVE_GETADDRINFO) && defined(HAVE_GETNAMEINFO)) +#ifndef USE_GETADDRINFO static int get_internet_address (Lisp_Object host, struct sockaddr_in *address, Error_behavior errb) @@ -468,7 +473,8 @@ if (host_info_ptr) { address->sin_family = host_info_ptr->h_addrtype; - memcpy (&address->sin_addr, host_info_ptr->h_addr, host_info_ptr->h_length); + memcpy (&address->sin_addr, host_info_ptr->h_addr, + host_info_ptr->h_length); } else { @@ -491,7 +497,7 @@ return 1; } -#endif /* !(HAVE_GETADDRINFO && HAVE_GETNAMEINFO) */ +#endif /* !USE_GETADDRINFO */ static void set_socket_nonblocking_maybe (int fd, int port, const char* proto) @@ -1578,7 +1584,7 @@ static Lisp_Object unix_canonicalize_host_name (Lisp_Object host) { -#if defined(HAVE_GETADDRINFO) && defined(HAVE_GETNAMEINFO) +#ifdef USE_GETADDRINFO struct addrinfo hints, *res; static char addrbuf[NI_MAXHOST]; Lisp_Object canonname; @@ -1612,7 +1618,7 @@ } return canonname; -#else /* ! HAVE_GETADDRINFO */ +#else /* ! USE_GETADDRINFO */ struct sockaddr_in address; if (!get_internet_address (host, &address, ERROR_ME_NOT)) @@ -1623,7 +1629,7 @@ else /* #### any clue what to do here? */ return host; -#endif /* ! HAVE_GETADDRINFO */ +#endif /* ! USE_GETADDRINFO */ } /* Open a TCP network connection to a given HOST/SERVICE. @@ -1633,14 +1639,17 @@ do is deactivate and close it via delete-process. */ static void -unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service, - Lisp_Object protocol, void** vinfd, void** voutfd) +unix_open_network_stream (Lisp_Object name, Lisp_Object host, + Lisp_Object service, Lisp_Object protocol, + void **vinfd, void **voutfd) { int inch; int outch; - volatile int s; + volatile int s = -1; volatile int port; volatile int retry = 0; + volatile int xerrno = 0; + volatile int failed_connect = 0; int retval; CHECK_STRING (host); @@ -1649,12 +1658,11 @@ invalid_argument ("Unsupported protocol", protocol); { -#if defined(HAVE_GETADDRINFO) && defined(HAVE_GETNAMEINFO) +#ifdef USE_GETADDRINFO + struct addrinfo hints, *res; struct addrinfo * volatile lres; char *portstring; - volatile int xerrno = 0; - volatile int failed_connect = 0; char *ext_host; /* * Caution: service can either be a string or int. @@ -1694,118 +1702,11 @@ /* address loop */ for (lres = res; lres ; lres = lres->ai_next) - { - if (EQ (protocol, Qtcp)) - s = socket (lres->ai_family, SOCK_STREAM, 0); - else /* EQ (protocol, Qudp) */ - s = socket (lres->ai_family, SOCK_DGRAM, 0); - if (s < 0) - continue; - - /* Turn off interrupts here -- see comments below. There used to - be code which called bind_polling_period() to slow the polling - period down rather than turn it off, but that seems rather - bogus to me. Best thing here is to use a non-blocking connect - or something, to check for QUIT. */ - - /* Comments that are not quite valid: */ - - /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR) - when connect is interrupted. So let's not let it get interrupted. - Note we do not turn off polling, because polling is only used - when not interrupt_input, and thus not normally used on the systems - which have this bug. On systems which use polling, there's no way - to quit if polling is turned off. */ - - /* Slow down polling. Some kernels have a bug which causes retrying - connect to fail after a connect. */ - - slow_down_interrupts (); - - loop: - - /* A system call interrupted with a SIGALRM or SIGIO comes back - here, with can_break_system_calls reset to 0. */ - SETJMP (break_system_call_jump); - if (QUITP) - { - speed_up_interrupts (); - REALLY_QUIT; - /* In case something really weird happens ... */ - slow_down_interrupts (); - } +#else /* !USE_GETADDRINFO */ - /* Break out of connect with a signal (it isn't otherwise possible). - Thus you don't get screwed with a hung network. */ - can_break_system_calls = 1; - retval = connect (s, lres->ai_addr, lres->ai_addrlen); - can_break_system_calls = 0; - if (retval == -1) - { - xerrno = errno; - if (errno != EISCONN) - { - if (errno == EINTR) - goto loop; - if (errno == EADDRINUSE && retry < 20) - { - /* A delay here is needed on some FreeBSD systems, - and it is harmless, since this retrying takes time anyway - and should be infrequent. - `sleep-for' allowed for quitting this loop with interrupts - slowed down so it can't be used here. Async timers should - already be disabled at this point so we can use `sleep'. */ - sleep (1); - retry++; - goto loop; - } - } - - failed_connect = 1; - close (s); - s = -1; - - speed_up_interrupts (); - - continue; - } - - if (port == 0) - { - int gni; - char servbuf[NI_MAXSERV]; - - if (EQ (protocol, Qtcp)) - gni = getnameinfo (lres->ai_addr, lres->ai_addrlen, - NULL, 0, servbuf, sizeof(servbuf), - NI_NUMERICSERV); - else /* EQ (protocol, Qudp) */ - gni = getnameinfo (lres->ai_addr, lres->ai_addrlen, - NULL, 0, servbuf, sizeof(servbuf), - NI_NUMERICSERV | NI_DGRAM); - - if (gni == 0) - port = strtol (servbuf, NULL, 10); - } - - break; - } /* address loop */ - - speed_up_interrupts (); - - freeaddrinfo (res); - if (s < 0) - { - errno = xerrno; - - if (failed_connect) - report_file_error ("connection failed", list2 (host, name)); - else - report_file_error ("error creating socket", list1 (name)); - } -#else /* ! HAVE_GETADDRINFO */ struct sockaddr_in address; + volatile int i; if (INTP (service)) port = htons ((unsigned short) XINT (service)); @@ -1827,80 +1728,144 @@ get_internet_address (host, &address, ERROR_ME); address.sin_port = port; - if (EQ (protocol, Qtcp)) - s = socket (address.sin_family, SOCK_STREAM, 0); - else /* EQ (protocol, Qudp) */ - s = socket (address.sin_family, SOCK_DGRAM, 0); + /* use a trivial address loop */ + for (i = 0; i < 1; i++) + +#endif /* !USE_GETADDRINFO */ + { +#ifdef USE_GETADDRINFO + int family = lres->ai_family; +#else + int family = address.sin_family; +#endif + + if (EQ (protocol, Qtcp)) + s = socket (family, SOCK_STREAM, 0); + else /* EQ (protocol, Qudp) */ + s = socket (family, SOCK_DGRAM, 0); + + if (s < 0) + { + xerrno = errno; + failed_connect = 0; + continue; + } + +#ifdef CONNECT_NEEDS_SLOWED_INTERRUPTS + /* Slow down polling. Some kernels have a bug which causes retrying + connect to fail after a connect. (Note that the entire purpose + for this code is a very old comment concerning an Ultrix bug that + requires this code. We used to do this ALWAYS despite this! + This messes up C-g out of connect() in a big way. So instead we + just assume that anyone who sees such a kernel bug will define + this constant, which for now is only defined under Ultrix.) --ben + */ + slow_down_interrupts (); +#endif + + loop: + + /* A system call interrupted with a SIGALRM or SIGIO comes back + here, with can_break_system_calls reset to 0. */ + SETJMP (break_system_call_jump); + if (QUITP) + { +#ifdef CONNECT_NEEDS_SLOWED_INTERRUPTS + speed_up_interrupts (); +#endif + REALLY_QUIT; + /* In case something really weird happens ... */ +#ifdef CONNECT_NEEDS_SLOWED_INTERRUPTS + slow_down_interrupts (); +#endif + } + + /* Break out of connect with a signal (it isn't otherwise possible). + Thus you don't get screwed with a hung network. */ + can_break_system_calls = 1; + +#ifdef USE_GETADDRINFO + retval = connect (s, lres->ai_addr, lres->ai_addrlen); +#else + retval = connect (s, (struct sockaddr *) &address, sizeof (address)); +#endif + can_break_system_calls = 0; + if (retval == -1 && errno != EISCONN) + { + xerrno = errno; + if (errno == EINTR) + goto loop; + if (errno == EADDRINUSE && retry < 20) + { +#ifdef __FreeBSD__ + /* A delay here is needed on some FreeBSD systems, + and it is harmless, since this retrying takes + time anyway and should be infrequent. + `sleep-for' allowed for quitting this loop with + interrupts slowed down so it can't be used + here. Async timers should already be disabled + at this point so we can use `sleep'. + + (Again, this was not conditionalized on FreeBSD. + Let's not mess up systems without the problem. --ben) + */ + sleep (1); +#endif + retry++; + goto loop; + } + + failed_connect = 1; + close (s); + s = -1; + +#ifdef CONNECT_NEEDS_SLOWED_INTERRUPTS + speed_up_interrupts (); +#endif + + continue; + } + +#ifdef USE_GETADDRINFO + if (port == 0) + { + int gni; + char servbuf[NI_MAXSERV]; + + if (EQ (protocol, Qtcp)) + gni = getnameinfo (lres->ai_addr, lres->ai_addrlen, + NULL, 0, servbuf, sizeof(servbuf), + NI_NUMERICSERV); + else /* EQ (protocol, Qudp) */ + gni = getnameinfo (lres->ai_addr, lres->ai_addrlen, + NULL, 0, servbuf, sizeof(servbuf), + NI_NUMERICSERV | NI_DGRAM); + + if (gni == 0) + port = strtol (servbuf, NULL, 10); + } + + break; +#endif /* USE_GETADDRINFO */ + } /* address loop */ + +#ifdef CONNECT_NEEDS_SLOWED_INTERRUPTS + speed_up_interrupts (); +#endif + +#ifdef USE_GETADDRINFO + freeaddrinfo (res); +#endif if (s < 0) - report_file_error ("error creating socket", list1 (name)); - - /* Turn off interrupts here -- see comments below. There used to - be code which called bind_polling_period() to slow the polling - period down rather than turn it off, but that seems rather - bogus to me. Best thing here is to use a non-blocking connect - or something, to check for QUIT. */ - - /* Comments that are not quite valid: */ - - /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR) - when connect is interrupted. So let's not let it get interrupted. - Note we do not turn off polling, because polling is only used - when not interrupt_input, and thus not normally used on the systems - which have this bug. On systems which use polling, there's no way - to quit if polling is turned off. */ + { + errno = xerrno; - /* Slow down polling. Some kernels have a bug which causes retrying - connect to fail after a connect. */ - - slow_down_interrupts (); - - loop: - - /* A system call interrupted with a SIGALRM or SIGIO comes back - here, with can_break_system_calls reset to 0. */ - SETJMP (break_system_call_jump); - if (QUITP) - { - speed_up_interrupts (); - REALLY_QUIT; - /* In case something really weird happens ... */ - slow_down_interrupts (); + if (failed_connect) + report_file_error ("connection failed", list2 (host, name)); + else + report_file_error ("error creating socket", list1 (name)); } - - /* Break out of connect with a signal (it isn't otherwise possible). - Thus you don't get screwed with a hung network. */ - can_break_system_calls = 1; - retval = connect (s, (struct sockaddr *) &address, sizeof (address)); - can_break_system_calls = 0; - if (retval == -1 && errno != EISCONN) - { - int xerrno = errno; - if (errno == EINTR) - goto loop; - if (errno == EADDRINUSE && retry < 20) - { - /* A delay here is needed on some FreeBSD systems, - and it is harmless, since this retrying takes time anyway - and should be infrequent. - `sleep-for' allowed for quitting this loop with interrupts - slowed down so it can't be used here. Async timers should - already be disabled at this point so we can use `sleep'. */ - sleep (1); - retry++; - goto loop; - } - - close (s); - - speed_up_interrupts (); - - errno = xerrno; - report_file_error ("connection failed", list2 (host, name)); - } - - speed_up_interrupts (); -#endif /* ! HAVE_GETADDRINFO */ } inch = s; @@ -1913,8 +1878,8 @@ set_socket_nonblocking_maybe (inch, port, "tcp"); - *vinfd = (void*)inch; - *voutfd = (void*)outch; + *vinfd = (void *) inch; + *voutfd = (void *) outch; } @@ -2015,7 +1980,9 @@ instead of 'sendto'. Consequently, we 'connect' this socket. */ /* See open-network-stream-internal for comments on this part of the code */ +#ifdef CONNECT_NEEDS_SLOWED_INTERRUPTS slow_down_interrupts (); +#endif loop: @@ -2024,10 +1991,14 @@ SETJMP (break_system_call_jump); if (QUITP) { +#ifdef CONNECT_NEEDS_SLOWED_INTERRUPTS speed_up_interrupts (); +#endif REALLY_QUIT; /* In case something really weird happens ... */ +#ifdef CONNECT_NEEDS_SLOWED_INTERRUPTS slow_down_interrupts (); +#endif } /* Break out of connect with a signal (it isn't otherwise possible). @@ -2056,13 +2027,17 @@ close (rs); close (ws); +#ifdef CONNECT_NEEDS_SLOWED_INTERRUPTS speed_up_interrupts (); +#endif errno = xerrno; report_file_error ("error connecting socket", list2(name, port)); } +#ifdef CONNECT_NEEDS_SLOWED_INTERRUPTS speed_up_interrupts (); +#endif /* scope */ if (setsockopt (ws, IPPROTO_IP, IP_MULTICAST_TTL,
--- a/src/process.c Thu May 03 21:08:39 2001 +0000 +++ b/src/process.c Fri May 04 22:42:35 2001 +0000 @@ -568,13 +568,18 @@ CHECK_STRING (program); /* Make sure that the child will be able to chdir to the current - buffer's current directory, or its unhandled equivalent. We + buffer's current directory, or its unhandled equivalent. [[ We can't just have the child check for an error when it does the - chdir, since it's in a vfork. + chdir, since it's in a vfork. ]] -- not any more, we don't use + vfork. -ben - Note: these assignments and calls are like this in order to insure - "caller protects args" GC semantics. */ + Note: These calls are spread out to insure that the return values + of the calls (which may be newly-created strings) are properly + GC-protected. */ current_dir = current_buffer->directory; + /* If the current dir has no terminating slash, we'll get undesirable + results, so put the slash back. */ + current_dir = Ffile_name_as_directory (current_dir); current_dir = Funhandled_file_name_directory (current_dir); current_dir = expand_and_dir_to_file (current_dir, Qnil); @@ -884,7 +889,6 @@ Bufpos old_point; Bufpos old_begv; Bufpos old_zv; - int old_zmacs_region_stays = zmacs_region_stays; struct gcpro gcpro1, gcpro2; struct buffer *buf = XBUFFER (p->buffer); @@ -952,8 +956,6 @@ p->buffer); } - /* Handling the process output should not deactivate the mark. */ - zmacs_region_stays = old_zmacs_region_stays; buf->read_only = old_read_only; old_point = bufpos_clip_to_bounds (BUF_BEGV (buf), old_point,
--- a/src/regex.c Thu May 03 21:08:39 2001 +0000 +++ b/src/regex.c Fri May 04 22:42:35 2001 +0000 @@ -415,7 +415,7 @@ /* Start remembering the text that is matched, for storing in a register. Followed by one byte with the register number, in - the range 0 to one less than the pattern buffer's re_nsub + the range 1 to the pattern buffer's re_ngroups field. Then followed by one byte with the number of groups inner to this one. (This last has to be part of the start_memory only because we need it in the on_failure_jump @@ -424,7 +424,7 @@ /* Stop remembering the text that is matched and store it in a memory register. Followed by one byte with the register - number, in the range 0 to one less than `re_nsub' in the + number, in the range 1 to `re_ngroups' in the pattern buffer, and one byte with the number of inner groups, just like `start_memory'. (We need the number of inner groups here because we don't have any easy way of finding the @@ -971,6 +971,7 @@ } printf ("re_nsub: %ld\t", (long)bufp->re_nsub); + printf ("re_ngroups: %ld\t", (long)bufp->re_ngroups); printf ("regs_alloc: %d\t", bufp->regs_allocated); printf ("can_be_null: %d\t", bufp->can_be_null); printf ("newline_anchor: %d\n", bufp->newline_anchor); @@ -980,6 +981,20 @@ printf ("syntax: %d\n", bufp->syntax); /* Perhaps we should print the translate table? */ /* and maybe the category table? */ + + if (bufp->external_to_internal_register) + { + int i; + + printf ("external_to_internal_register:\n"); + for (i = 0; i <= bufp->re_nsub; i++) + { + if (i > 0) + printf (", "); + printf ("%d -> %d", i, bufp->external_to_internal_register[i]); + } + printf ("\n"); + } } @@ -1694,9 +1709,13 @@ #define MAX_REGNUM 255 /* But patterns can have more than `MAX_REGNUM' registers. We just - ignore the excess. */ + ignore the excess. + #### not true! groups past this will fail in lots of ways, if we + ever have to backtrack. + */ typedef unsigned regnum_t; +#define INIT_REG_TRANSLATE_SIZE 5 /* Macros for the compile stack. */ @@ -1880,7 +1899,9 @@ `syntax' is set to SYNTAX; `used' is set to the length of the compiled pattern; `fastmap_accurate' is zero; - `re_nsub' is the number of subexpressions in PATTERN; + `re_ngroups' is the number of groups/subexpressions (including shy + groups) in PATTERN; + `re_nsub' is the number of non-shy groups in PATTERN; `not_bol' and `not_eol' are zero; The `fastmap' and `newline_anchor' fields are neither @@ -1978,6 +1999,25 @@ /* Always count groups, whether or not bufp->no_sub is set. */ bufp->re_nsub = 0; + bufp->re_ngroups = 0; + + bufp->warned_about_incompatible_back_references = 0; + + if (bufp->external_to_internal_register == 0) + { + bufp->external_to_internal_register_size = INIT_REG_TRANSLATE_SIZE; + RETALLOC (bufp->external_to_internal_register, + bufp->external_to_internal_register_size, + int); + } + + { + int i; + + bufp->external_to_internal_register[0] = 0; + for (i = 1; i < bufp->external_to_internal_register_size; i++) + bufp->external_to_internal_register[i] = (int) 0xDEADBEEF; + } #if !defined (emacs) && !defined (SYNTAX_TABLE) /* Initialize the syntax table. */ @@ -2560,6 +2600,7 @@ handle_open: { regnum_t r; + int shy = 0; if (!(syntax & RE_NO_SHY_GROUPS) && p != pend @@ -2570,7 +2611,7 @@ switch (c) { case ':': /* shy groups */ - r = MAX_REGNUM + 1; + shy = 1; break; /* All others are reserved for future constructs. */ @@ -2578,11 +2619,32 @@ FREE_STACK_RETURN (REG_BADPAT); } } - else - { - bufp->re_nsub++; - r = ++regnum; - } + + r = ++regnum; + bufp->re_ngroups++; + if (!shy) + { + bufp->re_nsub++; + while (bufp->external_to_internal_register_size <= + bufp->re_nsub) + { + int i; + int old_size = + bufp->external_to_internal_register_size; + bufp->external_to_internal_register_size += 5; + RETALLOC (bufp->external_to_internal_register, + bufp->external_to_internal_register_size, + int); + /* debugging */ + for (i = old_size; + i < bufp->external_to_internal_register_size; i++) + bufp->external_to_internal_register[i] = + (int) 0xDEADBEEF; + } + + bufp->external_to_internal_register[bufp->re_nsub] = + bufp->re_ngroups; + } if (COMPILE_STACK_FULL) { @@ -2606,7 +2668,10 @@ /* We will eventually replace the 0 with the number of groups inner to this one. But do not push a start_memory for groups beyond the last one we can - represent in the compiled pattern. */ + represent in the compiled pattern. + #### bad bad bad. this will fail in lots of ways, if we + ever have to backtrack for these groups. + */ if (r <= MAX_REGNUM) { COMPILE_STACK_TOP.inner_group_offset @@ -2996,21 +3061,59 @@ case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': { - regnum_t reg; + regnum_t reg, regint; + int may_need_to_unfetch = 0; if (syntax & RE_NO_BK_REFS) goto normal_char; + /* This only goes up to 99. It could be extended to work + up to 255 (the maximum number of registers that can be + handled by the current regexp engine, because it stores + its register numbers in the compiled pattern as one byte, + ugh). Doing that's a bit trickier, because you might + have the case where \25 a back-ref but \255 is not, ... */ reg = c - '0'; - - if (reg > regnum) + if (p < pend) + { + PATFETCH (c); + if (c >= '0' && c <= '9') + { + regnum_t new_reg = reg * 10 + c - '0'; + if (new_reg <= bufp->re_nsub) + { + reg = new_reg; + may_need_to_unfetch = 1; + } + else + PATUNFETCH; + } + } + + if (reg > bufp->re_nsub) FREE_STACK_RETURN (REG_ESUBREG); + regint = bufp->external_to_internal_register[reg]; /* Can't back reference to a subexpression if inside of it. */ - if (group_in_compile_stack (compile_stack, reg)) - goto normal_char; + if (group_in_compile_stack (compile_stack, regint)) + { + if (may_need_to_unfetch) + PATUNFETCH; + goto normal_char; + } + +#ifdef emacs + if (reg > 9 && + bufp->warned_about_incompatible_back_references == 0) + { + bufp->warned_about_incompatible_back_references = 1; + warn_when_safe (intern ("regex"), Qinfo, + "Back reference \\%d now has new " + "semantics in %s", reg, pattern); + } +#endif laststart = buf_end; - BUF_PUSH_2 (duplicate, reg); + BUF_PUSH_2 (duplicate, regint); } break; @@ -3125,7 +3228,7 @@ isn't necessary unless we're trying to avoid calling alloca in the search and match routines. */ { - int num_regs = bufp->re_nsub + 1; + int num_regs = bufp->re_ngroups + 1; /* Since DOUBLE_FAIL_STACK refuses to double only if the current size is strictly greater than re_max_failures, the largest possible stack @@ -4386,7 +4489,7 @@ /* We fill all the registers internally, independent of what we return, for use in backreferences. The number here includes an element for register zero. */ - unsigned num_regs = bufp->re_nsub + 1; + unsigned num_regs = bufp->re_ngroups + 1; /* The currently active registers. */ unsigned lowest_active_reg = NO_LOWEST_ACTIVE_REG; @@ -4472,7 +4575,7 @@ there are groups, we include space for register 0 (the whole pattern), even though we never use it, since it simplifies the array indexing. We should fix this. */ - if (bufp->re_nsub) + if (bufp->re_ngroups) { regstart = REGEX_TALLOC (num_regs, re_char *); regend = REGEX_TALLOC (num_regs, re_char *); @@ -4650,12 +4753,13 @@ /* If caller wants register contents data back, do it. */ if (regs && !bufp->no_sub) { + int num_nonshy_regs = bufp->re_nsub + 1; /* Have the register data arrays been allocated? */ if (bufp->regs_allocated == REGS_UNALLOCATED) { /* No. So allocate them with malloc. We need one extra element beyond `num_regs' for the `-1' marker GNU code uses. */ - regs->num_regs = MAX (RE_NREGS, num_regs + 1); + regs->num_regs = MAX (RE_NREGS, num_nonshy_regs + 1); regs->start = TALLOC (regs->num_regs, regoff_t); regs->end = TALLOC (regs->num_regs, regoff_t); if (regs->start == NULL || regs->end == NULL) @@ -4669,9 +4773,9 @@ { /* Yes. If we need more elements than were already allocated, reallocate them. If we need fewer, just leave it alone. */ - if (regs->num_regs < num_regs + 1) + if (regs->num_regs < num_nonshy_regs + 1) { - regs->num_regs = num_regs + 1; + regs->num_regs = num_nonshy_regs + 1; RETALLOC (regs->start, regs->num_regs, regoff_t); RETALLOC (regs->end, regs->num_regs, regoff_t); if (regs->start == NULL || regs->end == NULL) @@ -4701,16 +4805,19 @@ /* Go through the first `min (num_regs, regs->num_regs)' registers, since that is all we initialized. */ - for (mcnt = 1; mcnt < MIN (num_regs, regs->num_regs); mcnt++) + for (mcnt = 1; mcnt < MIN (num_nonshy_regs, regs->num_regs); + mcnt++) { - if (REG_UNSET (regstart[mcnt]) || REG_UNSET (regend[mcnt])) + int internal_reg = bufp->external_to_internal_register[mcnt]; + if (REG_UNSET (regstart[internal_reg]) || + REG_UNSET (regend[internal_reg])) regs->start[mcnt] = regs->end[mcnt] = -1; else { - regs->start[mcnt] - = (regoff_t) POINTER_TO_OFFSET (regstart[mcnt]); - regs->end[mcnt] - = (regoff_t) POINTER_TO_OFFSET (regend[mcnt]); + regs->start[mcnt] = + (regoff_t) POINTER_TO_OFFSET (regstart[internal_reg]); + regs->end[mcnt] = + (regoff_t) POINTER_TO_OFFSET (regend[internal_reg]); } } @@ -4719,7 +4826,7 @@ we (re)allocated the registers, this is the case, because we always allocate enough to have at least one -1 at the end. */ - for (mcnt = num_regs; mcnt < regs->num_regs; mcnt++) + for (mcnt = num_nonshy_regs; mcnt < regs->num_regs; mcnt++) regs->start[mcnt] = regs->end[mcnt] = -1; } /* regs && !bufp->no_sub */ @@ -5065,11 +5172,15 @@ /* \<digit> has been turned into a `duplicate' command which is - followed by the numeric value of <digit> as the register number. */ + followed by the numeric value of <digit> as the register number. + (Already passed through external-to-internal-register mapping, + so it refers to the actual group number, not the non-shy-only + numbering used in the external world.) */ case duplicate: { REGISTER re_char *d2, *dend2; - int regno = *p++; /* Get which register to match against. */ + /* Get which register to match against. */ + int regno = *p++; DEBUG_PRINT2 ("EXECUTING duplicate %d.\n", regno); /* Can't back reference a group which we've never matched. */ @@ -6222,6 +6333,8 @@ `newline_anchor' to REG_NEWLINE being set in CFLAGS; `fastmap' and `fastmap_accurate' to zero; `re_nsub' to the number of subexpressions in PATTERN. + (non-shy of course. POSIX probably doesn't know about + shy ones, and in any case they should be invisible.) PATTERN is the address of the pattern string.
--- a/src/regex.h Thu May 03 21:08:39 2001 +0000 +++ b/src/regex.h Fri May 04 22:42:35 2001 +0000 @@ -153,6 +153,12 @@ If not set, then an unmatched ) is invalid. */ #define RE_UNMATCHED_RIGHT_PAREN_ORD (RE_NO_SHY_GROUPS << 1) +/* If this bit is set, then \22 will read as a back reference, + provided at least 22 non-shy groups have been seen so far. In all + other cases (bit not set, not 22 non-shy groups seen so far), it + reads as a back reference \2 followed by a digit 2. */ +#define RE_NO_MULTI_DIGIT_BK_REFS (RE_UNMATCHED_RIGHT_PAREN_ORD << 1) + /* This global variable defines the particular regexp syntax to use (for some interfaces). When a regexp is compiled, the syntax used is stored in the pattern buffer, so changing this does not affect @@ -170,7 +176,7 @@ | RE_NO_BK_PARENS | RE_NO_BK_REFS \ | RE_NO_BK_VBAR | RE_NO_EMPTY_RANGES \ | RE_UNMATCHED_RIGHT_PAREN_ORD | RE_NO_SHY_GROUPS \ - | RE_NO_MINIMAL_MATCHING) + | RE_NO_MINIMAL_MATCHING | RE_NO_MULTI_DIGIT_BK_REFS) #define RE_SYNTAX_POSIX_AWK \ (RE_SYNTAX_POSIX_EXTENDED | RE_BACKSLASH_ESCAPE_IN_LISTS) @@ -179,17 +185,18 @@ (RE_BK_PLUS_QM | RE_CHAR_CLASSES \ | RE_HAT_LISTS_NOT_NEWLINE | RE_INTERVALS \ | RE_NEWLINE_ALT | RE_NO_SHY_GROUPS \ - | RE_NO_MINIMAL_MATCHING) + | RE_NO_MINIMAL_MATCHING | RE_NO_MULTI_DIGIT_BK_REFS) #define RE_SYNTAX_EGREP \ (RE_CHAR_CLASSES | RE_CONTEXT_INDEP_ANCHORS \ | RE_CONTEXT_INDEP_OPS | RE_HAT_LISTS_NOT_NEWLINE \ | RE_NEWLINE_ALT | RE_NO_BK_PARENS \ | RE_NO_BK_VBAR | RE_NO_SHY_GROUPS \ - | RE_NO_MINIMAL_MATCHING) + | RE_NO_MINIMAL_MATCHING | RE_NO_MULTI_DIGIT_BK_REFS) #define RE_SYNTAX_POSIX_EGREP \ - (RE_SYNTAX_EGREP | RE_INTERVALS | RE_NO_BK_BRACES) + (RE_SYNTAX_EGREP | RE_INTERVALS | RE_NO_BK_BRACES | \ + RE_NO_MULTI_DIGIT_BK_REFS) /* P1003.2/D11.2, section 4.20.7.1, lines 5078ff. */ #define RE_SYNTAX_ED RE_SYNTAX_POSIX_BASIC @@ -200,7 +207,7 @@ #define _RE_SYNTAX_POSIX_COMMON \ (RE_CHAR_CLASSES | RE_DOT_NEWLINE | RE_DOT_NOT_NULL \ | RE_INTERVALS | RE_NO_EMPTY_RANGES | RE_NO_SHY_GROUPS \ - | RE_NO_MINIMAL_MATCHING) + | RE_NO_MINIMAL_MATCHING | RE_NO_MULTI_DIGIT_BK_REFS) #define RE_SYNTAX_POSIX_BASIC \ (_RE_SYNTAX_POSIX_COMMON | RE_BK_PLUS_QM) @@ -337,9 +344,14 @@ when it is matched. */ RE_TRANSLATE_TYPE translate; - /* Number of subexpressions found by the compiler. */ + /* Number of returnable groups found by the compiler. (This does + not count shy groups.) */ size_t re_nsub; + /* Total number of groups found by the compiler. (Including + shy ones.) */ + int re_ngroups; + /* Zero if this pattern cannot match the empty string, one else. Well, in truth it's used only in `re_search_2', to see whether or not we should use the fastmap, so we don't set @@ -374,6 +386,14 @@ /* If true, an anchor at a newline matches. */ unsigned newline_anchor : 1; + unsigned warned_about_incompatible_back_references : 1; + + /* Mapping between back references and groups (may not be + equivalent with shy groups). */ + int *external_to_internal_register; + + int external_to_internal_register_size; + /* [[[end pattern_buffer]]] */ };
--- a/src/s/ultrix.h Thu May 03 21:08:39 2001 +0000 +++ b/src/s/ultrix.h Fri May 04 22:42:35 2001 +0000 @@ -28,5 +28,15 @@ #undef SYSTEM_TYPE #define SYSTEM_TYPE "ultrix" +/* #### A very old comment in unix_open_network_stream() said this: + + Kernel bugs (on Ultrix at least) cause lossage (not just EINTR) + when connect is interrupted. So let's not let it get interrupted. + + Someone using Ultrix (anyone still out there?) should verify this. +*/ + +#define CONNECT_NEEDS_SLOWED_INTERRUPTS + /* We don't have a built-in strdup() function */ #define NEED_STRDUP
--- a/src/search.c Thu May 03 21:08:39 2001 +0000 +++ b/src/search.c Fri May 04 22:42:35 2001 +0000 @@ -104,6 +104,8 @@ /* Regular expressions used in forward/backward-word */ Lisp_Object Vforward_word_regexp, Vbackward_word_regexp; +int warn_about_possibly_incompatible_back_references; + /* range table for use with skip_chars. Only needed for Mule. */ Lisp_Object Vskip_chars_range_table; @@ -2269,7 +2271,7 @@ Lisp_Object buffer; int_dynarr *ul_action_dynarr = 0; int_dynarr *ul_pos_dynarr = 0; - int sub; + int sub = 0; int speccount; CHECK_STRING (replacement); @@ -3042,6 +3044,15 @@ #### Not yet implemented. */ ); Vbackward_word_regexp = Qnil; + + DEFVAR_INT ("warn-about-possibly-incompatible-back-references", + &warn_about_possibly_incompatible_back_references /* +If true, issue warnings when new-semantics back references occur. +This is to catch places where old code might inadvertently have changed +semantics. This will occur in old code only where more than nine groups +occur and a back reference to one of them is directly followed by a digit. +*/ ); + warn_about_possibly_incompatible_back_references = 1; } void
--- a/src/sysdep.c Thu May 03 21:08:39 2001 +0000 +++ b/src/sysdep.c Fri May 04 22:42:35 2001 +0000 @@ -1063,12 +1063,38 @@ { int filedesc = DEVICE_INFD (d); -#if defined (I_SETSIG) && !defined(HPUX10) && !defined(LINUX) + /* NOTE: It appears that Linux has its own mechanism for requesting + SIGIO, using the F_GETSIG and F_SETSIG commands to fcntl(). + These let you pick which signal you want sent (not just SIGIO), + and if you do this, you get additional info which tells you which + file descriptor has input ready on it. The man page says: + + Using these mechanisms, a program can implement fully + asynchronous I/O without using select(2) or poll(2) most + of the time. + + The use of O_ASYNC, F_GETOWN, F_SETOWN is specific to BSD + and Linux. F_GETSIG and F_SETSIG are Linux-specific. + POSIX has asynchronous I/O and the aio_sigevent structure + to achieve similar things; these are also available in + Linux as part of the GNU C Library (Glibc). + + But it appears that Linux also supports O_ASYNC, so I see no + particular need to switch. --ben + */ + +#if defined (I_SETSIG) && !defined (HPUX10) && !defined (LINUX) { - int events=0; + int events = 0; ioctl (filedesc, I_GETSIG, &events); ioctl (filedesc, I_SETSIG, events | S_INPUT); } +#elif defined (O_ASYNC) + /* Generally FASYNC and O_ASYNC are both defined, and both equal; + but let's not depend on that. O_ASYNC appears to be more + standard (at least the Linux include files think so), so + check it first. */ + fcntl (filedesc, F_SETFL, fcntl (filedesc, F_GETFL, 0) | O_ASYNC); #elif defined (FASYNC) fcntl (filedesc, F_SETFL, fcntl (filedesc, F_GETFL, 0) | FASYNC); #elif defined (FIOSSAIOSTAT) @@ -1108,12 +1134,14 @@ { int filedesc = DEVICE_INFD (d); -#if defined (I_SETSIG) && !defined(HPUX10) +#if defined (I_SETSIG) && !defined (HPUX10) && !defined (LINUX) { - int events=0; + int events = 0; ioctl (filedesc, I_GETSIG, &events); ioctl (filedesc, I_SETSIG, events & ~S_INPUT); } +#elif defined (O_ASYNC) + fcntl (filedesc, F_SETFL, fcntl (filedesc, F_GETFL, 0) & ~O_ASYNC); #elif defined (FASYNC) fcntl (filedesc, F_SETFL, fcntl (filedesc, F_GETFL, 0) & ~FASYNC); #elif defined (FIOSSAIOSTAT)