# HG changeset patch # User Aidan Kehoe # Date 1304271843 -3600 # Node ID 1f0b1504045607e47e4839bed1cd9f55b8eaa44a # Parent 861f2601a38bbcfeecbbaf86a4c2d04e41a2fabb# Parent 8861440b1aa49429c455f3b8cf78690678b1d8de Merge. diff -r 861f2601a38b -r 1f0b15040456 .hgtags --- a/.hgtags Sat Feb 20 06:03:00 2010 -0600 +++ b/.hgtags Sun May 01 18:44:03 2011 +0100 @@ -235,5 +235,13 @@ 223736d75acb5265cfd9352497e8483d787d8eab r21-2-45 0784d089fdc93fb58040b6efbec55cd4fdf650c2 r21-2-46 5aa1854ad5374fa936e99e22e7b1242097292f16 r21-2-47 +aaf96f4ba61234a5331b280b774d357503cd7994 ben-lisp-object-bp 1af222c7586991f690ea06d1b8c75fb5a6a0a352 r21-5-28 5c427ece884b7023a244fba8cad8cf41b37dd5ca r21-5-29 +3742ea8250b5fd339d6d797835faf8761f61d0ae ben-lisp-object-final-ws-year-2005 +d185fa593d5fcf818ca0d27e53374348d936d7e8 last-version-with-netinstall +e7991690160358d5dd0a8adbf54e0bb8bfc56891 r21-5-30 +1c87bdc11d65e3bcbe23895b6f585bede5ba4160 last-gplv2 +384423af8fb5267509e2450f9eebc3dfaeda8472 r21-5-31 +384423af8fb5267509e2450f9eebc3dfaeda8472 r21-5-latest-beta +384423af8fb5267509e2450f9eebc3dfaeda8472 first-gplv3 diff -r 861f2601a38b -r 1f0b15040456 CHANGES-beta --- a/CHANGES-beta Sat Feb 20 06:03:00 2010 -0600 +++ b/CHANGES-beta Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,439 @@ +# DO NOT PUT A VERSION MARKER HERE, ADDED AT RELEASE + +Major Features and Backward Incompatible Changes +User-Visible Bug Fixes and Minor Improvements + +-- improve: Backward-compatible MATCHSPEC in face-property-matching-instance. -- Stephen Turnbull + +Build Infrastructure and Source Tree +Documentation +Lisp API +Internal API and Implementation +Testing and Debugging + + +to XEmacs 21.5.31 "ginger" + +Major Features and Backward Incompatible Changes + +-- improve: Verify copyright status and restrict license to GPL version 3 or later. -- Mats Lidell, Mike Sperber, Stephen Turnbull (see hg log) + +to XEmacs 21.5.30 "garlic" + +Major Features and Backward Incompatible Changes + +-- remove: Last release under GPL v2; future releases will be GPL v3 or later. -- Mats Lidell, Jerry James, Stephen Turnbull, Aidan Kehoe, Ben Wing, Mike Sperber +-- new: Functions may return multiple values as in Common Lisp (incompatible with cl.el implementation in some cases). + +User-Visible Bug Fixes and Minor Improvements + +-- fix: Crash by registering all CCL programs. -- Aidan Kehoe +-- fix: Crash in PNG handling (issue570). -- Stephen Turnbull +-- fix: Crash in _wgetdcwd(...) when linking against msvcrt8 -- Adrian Aichner +-- fix: Crash in printing if gc_in_progress and in_debug_print -- Ben Wing +-- fix: Crash when printing window with Qt as its buffer. -- Ben Wing +-- fix: Crash when reset_glyph_cachels() is called on the minibuffer window when creating a frame. -- Ben Wing +-- fix: #'gnuserv-edit-files goes to line only if linenumber non-nil. -- It's me FKtPp ;) +-- fix: Make winclient startup more reliable. -- Vin Shelton +-- fix: Remove dk.xemacs.org from list of package download sites. -- Adrian Aichner +-- fix: issue 546, use #'next-single-char-property-change in list-mode.el -- Aidan Kehoe +-- improve: Exclude the current buffer in switch-to-buffer completion. -- Didier Verna +-- improve: Font locking of Common Lisp source. -- Didier Verna +-- improve: GNU-compatible optional COLUMN in indent-region. -- Aidan Kehoe +-- improve: Handling of coding systems for new or zero-length files. -- Aidan Kehoe +-- improve: Support the precomposed characters with stroke. -- Aidan Kehoe +-- improve: Fallback to whole file in describe-char-unicode-data if database is unreadable. -- Aidan Kehoe +-- improve: Make iso-left-tab equivalent to shift-tab. -- Aidan Kehoe +-- improve: Indentation handling in Lisp modes. -- Ben Wing +-- improve: Name lock symlinks .#FN# for file FN to avoid confusing extensions. -- Ben Wing +-- improve: Set debug-xft to 0. -- Stephen Turnbull +-- improve: Recognize bitmaps/ directory as containing bitmap files. -- Didier Verna +-- new: Use `emacs-data-roots' instead of `emacs-roots' where appropriate. -- Mike Sperber +-- new: The `absolute' property for background pixmaps. -- Ben Wing +-- improve: Match X11 bgcolor fallback of default face to gui element face. -- Didier Verna +-- new: The background-placement face property. -- Didier Verna + +Build Infrastructure and Source Tree + +-- fix: Cygwin and MinGW need -export-all-symbols. -- Ben Wing +-- fix: Cygwin needs pdump -- Jerry James +-- fix: Windows link if --with-msw=no in modules. -- Ben Wing +-- improve: Use cygwin_conv_path() when available. -- Ben Wing +-- improve: make-mswin-unicode.pl Cygwin header compatibility, overridden prototypes, `review' command. -- Ben Wing, Vin Shelton +-- improve: Darwin needs system malloc, s&m moved into configure. -- Stephen Turnbull +-- fix: Turn warnings (disabled by accident) back on. -- Ben Wing +-- improve: C++/G++ detection and configuration. -- Ben Wing +-- fix: XE_COMPLEX_ARG registration of options in _AC_USER_OPTS (fixes "unknown option" warnings). -- Stephen Turnbull +-- improve: Clean more build and debug products. -- Stephen Turnbull +-- improve: Don't install silly symlinks when $(prefix) != $(exec_prefix). -- Mike Sperber +-- improve: Installation log refers to "Xft feature" for safer grepping. -- Ben Wing +-- improve: Paths configuration. -- Mike Sperber +-- improve: Use HAVE_CONFIG_H to find config.h and prototypes. -- Ben Wing +-- improve: `--with-error-checking' means `--with-error-checking=all'. -- Ben Wing +-- improve: make-src-depend. -- Ben Wing +-- improve: ndbm configuration -- Karl Kleinpaste, Stephen Turnbull, Ben Wing +-- refactor: New targets config-changed, fix-perms -- Ben Wing +-- refactor: Rename all enable-FOO variables to with-FOO. -- Ben Wing +-- remove: Support for InfoDock, NeXTstep, old Ultrix, SCO Unix, Bull DPX/2, Data General Unix, RTU, Unisoft Unix, OffiX DND, dynodump, idd, sparcworks, NEC EWS. -- Jerry James +-- remove: Wise installer subtree, netinstall subtree, many files: ppc.ldscript, make-msgfile.c, make-po.c, yow.c, rcs-checkin, gnudepend.pl, leditcfns.c, wakeup.c -- Jerry James, Mats Lidell + +Documentation + +-- fix: Comment, docstring, and string non-syntactic defects and formatting. -- Stephen Turnbull, Ben Wing, Aidan Kehoe, Didier Verna +-- improve: --quick-build, --with-debug, and --with-error-checking option help. -- Ben Wing +-- improve: Bignum and fixnum correctness in manual. -- Aidan Kehoe +-- improve: Change "special form" to "special operator". -- Aidan Kehoe +-- improve: Docstrings for #'cadr, #'caddr, #'cadddr, #'debug-on-error, #'eval-when-compile, #'eval-and-compile, #'interactive, #'lisp-indent-specform, #'range-table-type, defun movement, #'make-coding-system-internal, #'make-syntax-table, docstring/formal argument matching. -- Stephen Turnbull, Aidan Kehoe, Ben Wing +-- improve: FAQ describes repositories and VCS usage. -- Stephen Turnbull +-- improve: Internals nodes on magic symbols, hash tables, finalizer methods, the new allocator, the new garbage collector, old-style DFC conversion macros, the different types of character and their uses, frame handling, window-system support, allocation of Lisp objects, sequence/list functions and their keywords. -- Marcus Crestani, Ben Wing, Aidan Kehoe +-- improve: PROBLEMS describes crash on recent Cygwin 1.7. -- Ben Wing +-- improve: PROBLEMS describes duplicate symbol warnings on Mac OS X. -- Stephen Turnbull +-- improve: Show the double-quotes in the sample output correctly for function-arglist. -- Aidan Kehoe +-- improve: Startup paths, Lisp, Emacs.ad, xemacs.1 reflect the change from `lib' to `share' for the architecture-independent directories. -- Mike Sperber, Jerry James +-- improve: Treatment of hex and octal character escapes. -- Aidan Kehoe +-- refactor: Move term.texi to the eterm package. -- Jerry James +-- refactor: Remove custom.texi. -- Jerry James + +Lisp API + +-- fix: #'autoload-featurep-protect-autoloads always inserts a coding-system cookie. -- Ben Wing +-- fix: #'compare-strings coerces bounds to be within strings -- Stephen Turnbull +-- fix: #'insert-file-contents always sets the buffer coding system. -- Aidan Kehoe +-- fix: #'letf checks whether arguments to #'values are bound, and make them unbound after evaluating BODY. -- Aidan Kehoe +-- fix: #'next-list-mode-item, #'switch-to-completions pay attention to non-text-property extents. -- Aidan Kehoe +-- fix: #'pre-display-buffer-function is not set to `get-frame-for-buffer'. -- Michael Sperber +-- fix: Add argument information built-in special operators. -- Aidan Kehoe +-- fix: Allow deleting windows in `post-command-hook'. -- Michael Sperber +-- fix: Argument annotations of For, Fand, Fif, Fwhen, Fcond, Fprogn, Fprog1, Fprog2, FletX, Flet, Fwhile, Fdefvar, Fdefconst, Frun_hooks, Frun_hooks_with_args, Frun_hooks_with_args_until_success, Frun_hooks_with_args_until_failure -- Aidan Kehoe +-- fix: Argument handling in make-autoload. -- Mike Sperber +-- fix: Canonicalize spaces in argument lists for function-documentation-1. -- Ben Wing +-- fix: Correct error in specifier canonicalization -- Aidan Kehoe +-- fix: Disable specifier memory-usage stats due to circularities. -- Ben Wing +-- fix: Ffunctionp does not return t for special operators. -- Aidan Kehoe +-- fix: Fnbutlast, Fbutlast accept dotted lists. -- Aidan Kehoe +-- fix: Initialize ?\012 as whitespace -- Aidan Kehoe +-- fix: Issue145: Allow default-network-coding-system and default-process-coding-system to be nil. -- Stephen Turnbull +-- fix: Many bugs revealed by Paul Dietz's test suite. -- Aidan Kehoe +-- fix: Search for Control-1 chars in boyer_moore() -- Ben Wing +-- fix: Signal a read error upon encountering a ratio constant with a zero denominator. -- Jerry James +-- improve: #'beginning-of-defun, #'end-of-defun behavior customizable via beginning-of-defun-function, end-of-defun-function. -- Andreas Roehler +-- improve: #'cd use of cd-path and CDPATH. -- It's me FKtPp ;), Aidan Kehoe +-- improve: #'ceiling, #'floor, #'round, #'truncate, #'fceiling, #'ffloor, #'fround, #'ftruncate: support Common Lisp, including optional DIVISOR arguments, returning multiple values, obey contamination rules, round towards the even number in ambiguous cases. -- Aidan Kehoe +-- improve: #'coerce takes 'fixnum as a destination type. -- Aidan Kehoe +-- improve: #'list-length, #'remf, #'getf, #'tailp, #'cl-set-getf, #'cl-do-remf, #'ldiff, #'endp, #'subseq (new, Common Lisp compatible). -- Aidan Kehoe +-- improve: #'char<, #'char>=, #'char>, #'char<=, #'alpha-char-p, #'graphic-char-p, #'standard-char-p, #'char-name, #'name-char, #'upper-case-p, #'lower-case-p, #'both-case-p, #'char-upcase, #'char-downcase, #'integer-length (new, Common Lisp compatible). -- Aidan Kehoe +-- improve: #'mapvector, #'mapconcat, #'mapcar to support multiple SEQUENCES and error with circular lists -- Aidan Kehoe +-- improve: #'nreverse, #'reverse accept any sequence. -- Aidan Kehoe +-- improve: #'try-completion, #'suggest-key-bindings, #'float-time, #'substring-no-properties, #'turn-off-auto-fill, #'describe-char-unihan-field-descriptions (GNU compatibility). -- Aidan Kehoe, Malcolm Purvis, Mike Sperber +-- improve: #remove*, #cl-delete-duplicates, #delete-duplicates, #'symbol-file, #'find-function. -- Aidan Kehoe +-- improve: 'buffer-display-count, 'buffer-display-time (new, GNU-compatible) -- Jeff Sparkes, Aidan Kehoe +-- improve: 'discarded-consing, 'quoted-lambda new warning types. -- Aidan Kehoe +-- improve: Accept #B, #O, and #X like GNU Emacs. -- Mike Sperber +-- improve: Accept keywords in the hash table read syntax. -- Aidan Kehoe +-- improve: Handling of object plists, especially processes. -- Aidan Kehoe +-- improve: Keyword arguments handling. -- Aidan Kehoe +-- improve: Turn on load-ignore-out-of-date-elc-files by default -- Ben Wing +-- improve: Type spec handling in coerce, cl-make-type-test -- Aidan Kehoe +-- improve: Use keywords instead of ordinary symbols in some XEmacs-specific functions. -- Aidan Kehoe +-- improve: read-buffer gets new optional argument EXCLUDE. +-- new: #'bytecomp-load-hook. -- Aidan Kehoe +-- new: #'canoncase; use it with chars in internal_equalp. -- Aidan Kehoe +-- new: #'constantly from ANSI Common Lisp, with SBCL extension. -- Aidan Kehoe +-- improve: #device-color-cells (tty_device_system_metrics()) returns metrics for num-color-cells and num-bit-planes (issue757) on TTYs. -- Jeff Sparkes +-- new: #'error-unless-tests-match, #'byte-compile-file-being-compiled, #'compiled-if, #'compiled-when for supporting conditional compilation of different code depending on the presence or absence of features. -- Ben Wing +-- new: #'format-time-string implements Roman month numbers. -- Aidan Kehoe +-- new: #'get-properties. -- Didier Verna +-- new: #'process-get, #'process-put, #'process-plist, #'set-process-plist for GNU compatibility -- Aidan Kehoe +-- new: #'save-some-buffers-action-alist, #'diff-files-for-recover, #'diff-buffer-with-file, -- Mike Sperber +-- new: #'set-window-configuration gets optional `set-frame-size-p' argument. -- Mike Sperber +-- new: #'set-window-pixel-width, #'set-window-pixel-height. -- Mike Sperber +-- new: #'stable-union, #'stable-intersection. -- Ben Wing +-- new: 'debug-xemacs, 'debug-regexps, 'debug-soe, 'debug-xft (was 'xft-debug-level), 'debug-searches (was 'debug-xemacs-searches), 'byte-code-meter, 'byte-metering-on variables for debugging. -- Ben Wing +-- new: Common-Lisp-compatible #'the, #'array-dimension-limit, #array-total-size-limit, #'array-rank-limit, #'equalp (especially in hash tables). -- Aidan Kehoe +-- new: Errors 'invalid-keyword-argument, 'scan-error. -- Aidan Kehoe, Ben Wing +-- new: Implement multiple values a la Common Lisp. New bytecodes: Bbind_multiple_value_limits, Bmultiple_value_call, Bmultiple_value_list_internal, Bthrow. Modified bytecodes: BRgotoifnilelsepop, BRgotoifnonnilelsepop. Bcall, Bdup, Bgotoifnilelsepop, Bgotoifnonnilelsepop, Breturn. New macros: DISCARD_PRESERVING_MULTIPLE_VALUES, POP_WITH_MULTIPLE_VALUES, TOP_ADDRESS, TOP_LVALUE, TOP_WITH_MULTIPLE_VALUES. Modified macros: DISCARD, POP, TOP. New functions: Fand, Fcond, Fdefconst, Fdefvar, Feval, Ffuncall, Fif, Flet, FletX, Fmultiple_value_call, Fmultiple_value_list_internal, Fmultiple_value_prog1, For, Fprog2, Fsetq, Fsetq_default, Fsignal, Fthrow, Fvalues, Fvalues_list, Fwhile, Fwith_output_to_temp_buffer. Modified functions: Fcall_interactively, bind_multiple_value_limits, button_item_to_widget_value, check_if_suppressed, connector, dde_eval_string, evaluate_xpm_color_symbols, execute_help_form, flagged_a_squirmer, glyph_instantiator_to_glyph, gui_item_display_flush_left, gui_item_value, make_multiple_value, mark_multiple_value, menu_convert, menu_descriptor_to_widget_1, multiple-values-limit, multiple_value_aref, multiple_value_aset, multiple_value_call, multiple_value_list_internal, pop_kbd_macro_event, populate_menu_add_item, print_multiple_value, size_multiple_value, syms_of_eval, values2. wv_set_evalable_slot, x_IO_error_handler. Exported functions: throw_or_bomb_out. New variables: multiple-values-limit, multiple_value_current_limit. Exported symbols: Qobsolete_throw, Qthrow. New lrecord_type: multiple_value. -- Aidan Kehoe +-- new: macro -- Aidan Kehoe +-- refactor: #'bq-vector-contents, #'bq-list*, #'format-decode removed; #'purecopy aliased to #'identity and uses removed. -- Aidan Kehoe +-- refactor: #'byte-compile-compiled-obj-to-list, #'custom-declare-variable-list removed. -- Aidan Kehoe +-- refactor: #'car-less-than-car, #'cdr-less-than-cdr move to format.el, #'list* moved to subr.el. -- Aidan Kehoe +-- refactor: #'ceiling*, #'floor*, #'round*, #'truncate* obsoleted. -- Aidan Kehoe +-- refactor: #'cl-function-arglist takes exactly one arg. -- Ben Wing +-- refactor: #'init-file-user, #'pui-add-install-directory, #'user-original-login-name, #'isearch-yank-x-selection, #'isearch-yank-x-clipboard removed. -- Ben Wing. +-- refactor: #'paths-filter, #'paths-uniq-append removed. -- Aidan Kehoe +-- refactor: #'show-buffer, #'buffer-flush-undo, #'buffer-local-value, #'x-color-values, #'mswindows-color-list, #'Info-default-directory-list, #'line-beginning-position, #'line-end-position, #'obsolete-throw, #'cl-mapc, #'byte-code-function-p, #'interactive-form, #'assq-delete-all, #'makehash, #'display-column-mode obsoleted. -- Ben Wing + +Internal API and Implementation + +-- fix: #'canna-henkan-begin. -- Ben Wing +-- fix: #'condition-case gets correct syntax in #'progress-feedback-dispatch-non-command-events. -- Stephen Turnbull +-- fix: #'custom-variable-prompt checks explicitly for nil before for symbol. -- Aidan Kehoe +-- fix: #'delete-duplicates compiler macro and calls to it. -- Aidan Kehoe +-- fix: #'eql Byte-compilation -- Aidan Kehoe +-- fix: #'eql for extended number types and the hash implementation -- Aidan Kehoe +-- fix: #'fc-name-unparse memory leak. -- Jerry James +-- fix: #'fill is much more careful about resizing a string argument. -- Aidan Kehoe +-- fix: #'finish-set-language-environment generation of display-table entries for error octet characters. -- Ben Wing +-- fix: #'with-trapping-errors gets correct :operation arguments in #'font-lock-pre-idle-hook and #'find-tag-default. -- Stephen Turnbull +-- fix: #83, #8C mapping in koi8-c, #A6 mapping in viscii. -- Ben Wing, Aidan Kehoe +-- fix: Bignum initialization and finalization. -- Jerry James +-- fix: Buffer overrun (issue630). -- Stephen Turnbull, Aidan Kehoe +-- fix: Build failure, Apple's g++-4.0.1, Mac OS 10.4. -- Aidan Kehoe +-- fix: Call MODE-mode for -*-MODE-*- only if it has a function binding. -- Aidan Kehoe +-- fix: Call character_to_event() on characters received from XIM. -- Aidan Kehoe +-- fix: Check for Xft before using it, fixing openSUSE bug #558764. -- Stephen Turnbull +-- fix: Coding system initialization. -- Aidan Kehoe +-- fix: Compile errors under C++ and/or Visual Studio 6 in syswindows.h. -- Ben Wing +-- fix: Computation of fastmap in charset_mule_not() -- Ben Wing +-- fix: Conditionalize COM support on HAVE_MS_WINDOWS -- Ben Wing +-- fix: Don't use Boyer-Moore for case-insensitive search if the search pattern contains repeated Ibytes. -- Aidan Kehoe +-- fix: Fall back from GTK to X11 in gnuclient. -- Aidan Kehoe +-- fix: Frame geometry (especially pixelized) to make it a bit easier to understand and fix some bugs. -- Ben Wing +-- fix: Function prototype/definition mismatches. -- Ben Wing +-- fix: GCPROing. -- Ben Wing, Aidan Kehoe +-- fix: GNU coding standards in modules/base64. -- Ben Wing +-- fix: Handling of errors in bytecode.c and floatfns.c. -- Jerry James +-- fix: Handling of escape characters when splitting strings. -- Aidan Kehoe +-- fix: Handling of possible meta characters (?\x80-?\xFF) -- Aidan Kehoe +-- fix: I18N encapsulation commands for Windows. -- Ben Wing +-- fix: Initialize `result' before calling FcFontMatch in Ffc_font_match and xft_find_charset_font -- Jerry James +-- fix: Integer canonicalization. -- Aidan Kehoe +-- fix: Integer overflow when allocating image memory -- Jerry James +-- fix: JPEG macro FAR conflict in eimage code. -- Vin Shelton +-- fix: Match integer sizes in assignment in read_event_from_tty_or_stream_desc -- Ben Wing +-- fix: Missing includes to termcap.c. -- Aidan Kehoe +-- fix: Missing names and ISO 639 codes for Arabic, Russian, and Thai. -- Stephen Turnbull +-- fix: Move CYGWIN_HEADERS to s/cygwin32.h and s/mingw32.h, fixing some compile problems. -- Ben Wing +-- fix: Move HAVE_SCROLLBARS test so the code can compile under Visual Studio 6. -- Vin Shelton +-- fix: Notices in aclocal.m4, ad2c, build-msw-release.sh, compface.mak, cvtmail.c, easymenu.el, elhash.c, emacs.c, emodules.texi, europe-theme.el, example-theme.el, external-widget.texi, fakemail.c, font.el, fontconfig.el, frame.el, glade.c, glyph-test.el, gnome.el, gnuserv.c, gnuserv.h, gnuslib.c, gtk test files, gtk-compose.el, gtk-glue.c, gtk-marshal.el, gtk-package.el, gtk-widget-accessors.el, gtk-xemacs.c, gtk-xemacs.h, gtk.el, gutter-items.el, gutter-test.el, gutter.el, hyper-apropos.el, insert-data-in-exec.c, installexe.sh, lao.txt, lwlib-internal.h, m/alpha.h, make-path.c, menu-items.el, modules/sample/external/Makefile.in.in, modules/sample/external/configure.ac, modules/sample/external/sample.c, modules/sample/internal/sample.c, mule/canna-leim.el alist.el, mule/kinsoku.el, multicast.el, number*.[ch], profile.c, regressiontest.pl, reproduce-crashes.el, s/hpux11-shr.h, s/mach-bsd4-3.h, s/sco7.h, s/sco7.h, sigpipe.c, site-load.el, symsinit.h, tcp.c, term/bg-mouse.el, term/sup-mouse.el, term/vt100.el, test-ew-motif.c, test-ew-xlib.c, tests/external-widget/Makefile, tiff.mak, ui-byhand.c, ui-gtk.c, ui-gtk.h, view-less.el, xemacs.rc, and xpm.mak. -- Jerry James, Stephen Turnbull +-- fix: Parse UNUSED and USED_IF right in make-docfile.c -- Stephen Turnbull +-- fix: Prune correct number of entries from load-history. -- Aidan Kehoe +-- fix: Qlist, Qstring mistakenly declared twice. -- Ben Wing +-- fix: Simplify assertion in event_pixel_translation for Visual C 6. -- Vin Shelton +-- fix: Synchronization of window point with current point when switching buffers. -- Michael Sperber +-- fix: Syntax errors in Ffc_config_app_font_add_file and Ffc_config_app_font_add_dir -- Jerry James +-- fix: Type correctness in split_string_by_ichar_1. -- Aidan Kehoe +-- fix: Type correctness of char and Ichar types. -- Ben Wing +-- fix: UTF-8-ize mule-wnnfns.c. -- Ben Wing +-- fix: Upper and lowercase mappings were reversed for some old-Cyrillic chars. -- Ben Wing +-- fix: Use correct timestamp with XSetInputFocus. -- Mike Sperber +-- fix: Use of REGISTER in certain functions. -- Aidan Kehoe +-- fix: Use unencumbered texts in #'split-string-by-char -- Aidan Kehoe +-- fix: Warning elimination. -- Aidan Kehoe, Ben Wing, Jerry James, Stephen Turnbull +-- fix: `escape-quoted' handling of characters in the 0x80 - 0x9F range. -- Ben Wing +-- fix: const handling in fileio.c. -- Ben Wing, Vin Shelton +-- fix: count_with_tail(), FdeleteX(), FremoveX() handling of COUNT argument. -- Aidan Kehoe +-- fix: fontmgr may not use Fsignal() in C, as it may return. -- Ben Wing +-- fix: g++ 4.3 complaints about implicit conversions of const char * to char * -- Ben Wing +-- fix: gif_instantiate() tries harder to find an appropriate GIF colormap. -- Adam Sjøgren +-- fix: gnuserv found in `exec-directory'. -- Michael Sperber +-- fix: gtk_xpm_instantiate() hotspot coordinates are Lisp integers -- Stephen Turnbull +-- fix: integerp byte code gets fixnump semantics. -- Aidan Kehoe +-- fix: lpRemoteName is an XELPTSTR. -- Vin Shelton +-- fix: memmove() substituted for strcpy() in etags.c -- Sjoerd Mullender +-- fix: modeline face avoids using fallbacks. -- Aidan Kehoe +-- fix: module_load() gets one more dereference on f = dll_variable(. -- Stephen Turnbull +-- fix: off-by-one bug in mswindows_link -- Ron Isaacson +-- fix: query_string_font() uses proper domain for cachel updating. -- Didier Verna +-- fix: query_string_geometry() lookup domain. -- Didier Verna +-- fix: realpath() supplied by Darwin used to get the canonical case for filenames. -- Aidan Kehoe +-- fix: resize_string() must not free dumped data. -- Aidan Kehoe +-- fix: staticpro_names() stores actual names. -- Ben Wing +-- fix: ulong_to_bit_string() prints a zero, not the empty string. -- Aidan Kehoe +-- fix: undecided_canonicalize_after_coding() to retain CODESYS info -- Aidan Kehoe +-- fix: unicode_convert() handles very short input strings correctly. -- Aidan Kehoe +-- fix: unicode_query() initializes invalid_lower_limit. -- Ben Wing +-- fix: unicode_query() missing return type. -- Stephen Turnbull +-- fix: xface_normalize() to handle inline data properly. -- Didier Verna +-- improve: #'byte-compile-initial-macro-environment uses #'the and compilable lambda expressions -- Aidan Kehoe +-- improve: #'byte-compile-lambda issues warnings for interactive forms. -- Aidan Kehoe +-- improve: #'cl-prettyprint handles (function ...) specially. -- Aidan Kehoe +-- improve: #'documentation, #'function-documentation-1, #'describe-function-1, #'hyper-apropos-get-doc, #'describe-function, #'function-arglist, #'function-documentation. -- Aidan Kehoe, Didier Verna, Ben Wing +-- improve: #'frame-pixel-height and friends reflect what will happen as of the next redisplay. -- Ben Wing +-- improve: #'function now parallels #'quote. -- Aidan Kehoe +-- improve: #'handle-pre-motion-command-current-command-is-motion. -- Aidan Kehoe +-- improve: #'read-from-minibuffer uses buffer (format " *Minibuf-%d*" (minibuffer-depth)), regardless of depth. -- Aidan Kehoe +-- improve: #'show-memory-usage, #'show-object-memory-usage-stats. -- Ben Wing, Marcus Crestani +-- improve: #'some, #'every used in info.el, format.el, files.el -- Aidan Kehoe +-- improve: #'the may warn at byte-compile time. -- Aidan Kehoe +-- improve: Allocate lrecord arrays in own size class. -- Marcus Crestani +-- improve: Case map handling. -- Ben Wing +-- improve: Colormap handling on Windows. -- Aidan Kehoe +-- improve: Context-specific handling of system coding systems where we used to just use Qnative. -- Ben Wing +-- improve: Cygwin handling of pathname coding systems. -- Ben Wing +-- improve: Dynarr code. -- Aidan Kehoe, Ben Wing +-- improve: Error-checking in Fquote, Ffunction, -- Aidan Kehoe +-- improve: Fontconfig API more complete. -- Stephen Turnbull +-- improve: Hash table's rehash threshold default now based on size and test function. -- Aidan Kehoe +-- improve: Keymap handling. -- Ben Wing +-- improve: Make error messages better reflect the text that was encountered in read_escape. -- Aidan Kehoe +-- improve: Make sure distinct symbol macros with identical names expand distinctly. -- Aidan Kehoe +-- improve: Mule-ize database.c partially, modules/postgresql, mule-wnnfns.c. -- Ben Wing +-- improve: Optimizations: remove redundant lambdas and interning of symbols for temporary character sets, #'hash-table-key-list, #'hash-table-value-list, #'hash-table-key-value-alist, #'hash-table-key-value-plist, #'read-behavior, #'complement, #'regexp-quote, #'concatenate, #'mapc, #'do-autoload-commands, #'packages-find-package-library-path, #'frame-list, #'extent-descendants, #'buffer-tag-table-files, #'preloaded-file-list, #'device-list, #'proclaim-inline, #'proclaim-notinline, #'inx-available-font-sizes, #'let-specifier, #'pui-add-required-packages, #'mswindows-available-font-sizes, #'modeline-minor-mode-menu, #'minibuf-directory-files, #'handle-pre-motion-command-current-command-is-motion, #'finish-set-language-environment, #'mod*, #'rem*, #'xpm-color-symbols, #'=, #'<, #'>, #'<=, #'>= -- Aidan Kehoe +-- improve: Print the device in a frame structure. -- Aidan Kehoe +-- improve: Qunbound, not Qnil used as second arg to call to syntax_error() -- Ben Wing +-- improve: Remove the TYPE argument from xfree(). -- Ben Wing +-- improve: Replace "obscure" symbol names with uninterned symbols. -- Aidan Kehoe +-- improve: Track type of range tables. -- Ben Wing +-- improve: UTF-8-ize canna/canna_api.c, unicode.el. -- Ben Wing +-- improve: Use external giflib instead of internal GIF support. -- Jerry James +-- improve: Warn or error if (quote ...) or (function ...) quotes more than one object -- Aidan Kehoe +-- improve: emacs_rint() always used for bignum consistency -- Aidan Kehoe +-- improve: emodules_doc_sym() and emodules_doc_subr() take Ascbyte * pointers -- Ben Wing +-- improve: extern Lisp_Object declarations moved -- Ben Wing +-- improve: lrecord UID's get separate UID space for each type. Display UID's consistently when appropriate. -- Ben Wing +-- improve: print_symbol() escapes symbols that look like ratios. -- Aidan Kehoe +-- improve: put_range_table() becomes O(log n) for adding a localized range. -- Ben Wing +-- improve: specifier_instance_from_inst_list calls call_with_suspended_errors() with ERROR_ME_WARN. -- Aidan Kehoe +-- improve: stat() failure ignored in file_name_completion -- Henrique Martins +-- fix: Bignums handled correctly by NATNUMP, #'member*, #'eql, #'assoc*. -- Aidan Kehoe +-- new: DEFAULT_DIRECTORY_FALLBACK is a directory that should "always" be available; avoid fatal error if the current directory doesn't exist, chdir to DEFAULT_DIRECTORY_FALLBACK instead. -- Aidan Kehoe +-- new: ERROR_CHECK_DYNARR, dynarr_checking_assert(), ERROR_CHECK_ANY. -- Ben Wing +-- new: Macros for getting the size/edges of various rectangles surrounding the paned area. -- Ben Wing +-- new: Symbols for type checks in sequence functions. -- Aidan Kehoe +-- new: Typedefs for PCVOID and PDWORD_PTR for non-Cygwin. -- Ben Wing +-- new: USED_IF_SCROLLBARS, fix warnings. -- Ben Wing +-- new: UTF-8 support in Cygwin. -- Ben Wing +-- new: deadbeef_memory() exported. -- Ben Wing +-- new: pluralize_word(), pluralize_and_append(). -- Ben Wing +-- new: printing_unreadable_lcrecord(). -- Ben Wing +-- refactor: #'byte-compile-file-form so that #'symbol-value and #'load-time-value can be implemented directly. -- Aidan Kehoe +-- refactor: #'byte-compile-funarg-n (new) used to create the various byte-compile-funarg functions, which check for quoted lambdas in given positions. -- Aidan Kehoe +-- refactor: #'capitalize-string-as-title uses #'with-string-as-buffer-contents. -- Ben Wing +-- refactor: #'custom-quote is aliased to #'quote-maybe. -- Aidan Kehoe +-- refactor: #'list-length, #'default-file-system-ignore-case, #'equalp, #'fill, #'sort*, #'merge, #'mapcar*, #'map, #'maplist, #'mapc, #'mapl, #'mapcan, #'mapcon, #'query-coding-region, #'make-coding-system, #'reduce, #'replace, #'some, #'every moved to C. -- Aidan Kehoe +-- refactor: #'notany, #'notevery get compiler macros. -- Aidan Kehoe +-- refactor: #'substring aliased to #'subseq. -- Aidan Kehoe +-- refactor: #if 0 out some unused functions in malloc.c. -- Ben Wing +-- refactor: 'Qcoerce moved to general-slots.h -- Aidan Kehoe +-- refactor: 'default-file-system-ignore-case moved to fileio.c. -- Aidan Kehoe +-- refactor: ARRAYP(), SEQUENCEP(), CHECK_ARRAY(), CHECK_SEQUENCE(), Fbit_vector, Fstring, FmapcarX in lisp.h -- Aidan Kehoe +-- refactor: Always use platform Xmu. -- Jerry James +-- refactor: Bignums get: New macros ROUNDING_CONVERT, CONVERT_WITH_NUMBER_TYPES, CONVERT_WITHOUT_NUMBER_TYPES, MAYBE_TWO_ARGS_BIGNUM, MAYBE_ONE_ARG_BIGNUM, MAYBE_TWO_ARGS_RATIO, MAYBE_ONE_ARG_RATIO, MAYBE_TWO_ARGS_BIGFLOAT, MAYBE_ONE_ARG_BIGFLOAT, MAYBE_EFF, MAYBE_CHAR_OR_MARKER. New functions ceiling_two_fixnum, ceiling_two_bignum, ceiling_two_ratio, ceiling_two_bigfloat, ceiling_one_ratio, ceiling_one_bigfloat, ceiling_two_float, ceiling_one_float, ceiling_one_mundane_arg, floor_two_fixnum, floor_two_bignum, floor_two_ratio, floor_two_bigfloat, floor_one_ratio, floor_one_bigfloat, floor_two_float, floor_one_mundane_arg, round_two_fixnum, round_two_bignum_1, round_two_bignum, round_two_ratio, round_one_bigfloat_1, round_two_bigfloat, round_one_ratio, round_one_bigfloat, round_two_float, round_one_float, round_one_mundane_arg, truncate_two_fixnum, truncate_two_bignum, truncate_two_ratio, truncate_two_bigfloat, truncate_one_ratio, truncate_one_bigfloat, truncate_two_float, truncate_one_float, truncate_one_mundane_arg. Modified functions: emacs_doprnt_1, internal_coerce_number, Ffloat, BIGFLOAT_ARITH_RETURN, BIGFLOAT_ARITH_RETURN. New variable scratch_ratio2. -- Aidan Kehoe +-- refactor: Byte code #o117 is #'subseq, not #'substring. -- Aidan Kehoe +-- refactor: Call init_string_ascii_begin() in FsortX, Ffill. -- Aidan Kehoe +-- refactor: Case sensitivity of file paths via new variables default-file-system-ignore-case, file-system-case-alist, function file-system-ignore-case-p. -- Aidan Kehoe +-- refactor: Coding system initialization. Rename default-process-coding-system-read -> process-read, default-process-coding-system-write -> process-write, buffer-file-coding-system-for-read -> bfcs-for-read, default-buffer-file-coding-system -> default-bfcs, no-conversion-coding-system-mapping -> no-conv-cs, unix-no-mule-no-eol-detection -> no-mule-no-eol-detection, unix-no-mule-eol-detection -> no-mule-eol-detection, unix-mule -> mule. -- Ben Wing +-- refactor: Dynarr code. -- Ben Wing +-- refactor: Eliminate bogus special-casing of standard abbrev tables. -- Aidan Kehoe +-- refactor: Fquote_maybe moved from callint.c to eval.c. -- Aidan Kehoe +-- refactor: Fregexp_quote declared in lisp.h. -- Ben Wing +-- refactor: Gutter geometry code. -- Ben Wing +-- refactor: Link image code only when HAVE_WINDOW_SYSTEM. -- Ben Wing +-- refactor: Lisp objects allocation/declaration simplified; documented in lrecord.h. -- Ben Wing +-- refactor: Lisp objects get advertised API. Eliminate macros for copying, freeing, zeroing objects, getting their storage size. -- Ben Wing +-- refactor: Move code and comments from lisp.h to text.h. -- Ben Wing +-- refactor: Move creation of utf-8 coding system to unicode.c. -- Ben Wing +-- refactor: Move gap array from extents.c to array.c. Extract dynarr, gap array and stack-like malloc into new file array.h. Rewrite range table code to use gap arrays. -- Ben Wing +-- refactor: Move the Thai language environment and the TIS-620 coding system to mule/thai.el; add support for Microsoft's code page 874. -- Aidan Kehoe +-- refactor: NEED_TO_HANDLE_21_4_CODE replacing the previous NO_NEED_TO_HANDLE_21_4_CODE. -- Aidan Kehoe +-- refactor: Redo memory-usage mechanism. -- Ben Wing +-- refactor: Reduce the number of words in an lcrecord from 3 to 2. New macro NORMAL_LISP_OBJECT_UID() abstracts out the differences between NEWGC and old-GC in accessing the `uid' value from a "normal Lisp Object pointer". -- Ben Wing +-- refactor: Rename EXTERNAL_TO_C_STRING -> EXTERNAL_TO_ITEXT, EXTERNAL_TO_C_STRING_MALLOC -> EXTERNAL_TO_ITEXT_MALLOC, SIZED_EXTERNAL_TO_C_STRING -> SIZED_EXTERNAL_TO_ITEXT, SIZED_EXTERNAL_TO_C_STRING_MALLOC -> SIZED_EXTERNAL_TO_ITEXT_MALLOC, C_STRING_TO_EXTERNAL -> ITEXT_TO_EXTERNAL, C_STRING_TO_EXTERNAL_MALLOC -> ITEXT_TO_EXTERNAL_MALLOC, LISP_STRING_TO_EXTERNAL, LISP_STRING_TO_EXTERNAL_MALLOC, LISP_STRING_TO_TSTR, C_STRING_TO_TSTR -> ITEXT_TO_TSTR, TSTR_TO_C_STRING -> TSTR_TO_ITEXT and change to return result directly rather than as a "return parameter." Rename C_STRING_TO_SIZED_EXTERNAL -> ITEXT_TO_SIZED_EXTERNAL, LISP_STRING_TO_SIZED_EXTERNAL, C_STRING_TO_SIZED_EXTERNAL_MALLOC -> ITEXT_TO_SIZED_EXTERNAL_MALLOC, LISP_STRING_TO_SIZED_EXTERNAL_MALLOC. Eliminate SIZED_C_STRING macros in favor of TO_*TERNAL_FORMAT. -- Ben Wing +-- refactor: Rename pixel_to_char_size -> pixel_to_frame_unit_size, char_to_pixel_size -> frame_unit_to_pixel_size, pixel_to_real_char_size -> pixel_to_char_size, char_to_real_pixel_size -> char_to_pixel_size. Reverse second and third arguments of change_frame_size(). Eliminate old round_size_to_char, and rename round_size_to_real_char -> round_size_to_char. The set_frame_size() method is now passed sizes in "frame units". -- Ben Wing +-- refactor: Rename src/objects* -> src/fontcolor*. -- Ben Wing +-- refactor: Rename the specifier-font-matching stages -- Ben Wing +-- refactor: Rename write_c_string -> write_cistring, build_intstring -> build_istring, build_string -> build_cistring, build_ext_string -> build_extstring, make_ext_string -> make_extstring, buffer_insert_c_string -> buffer_insert_ascstring, intern_int -> intern_istring -- Ben Wing +-- refactor: Rename: LISP_TO_VOID -> STORE_LISP_IN_VOID, VOID_TO_LISP -> GET_LISP_FROM_VOID. New functions STORE_VOID_IN_LISP and GET_VOID_FROM_LISP. Eliminate the use of make_opaque_ptr() in unwind_protect code. -- Ben Wing +-- refactor: Rename: default_face_height_and_width -> default_face_width_and_height and reverse width/height arguments. -- Ben Wing +-- refactor: Separate out regular and disksave finalization, with a separate object method `disksaver'. -- Ben Wing +-- refactor: TTY mapper for faces gets 2 args. -- Stephen Turnbull +-- refactor: USE_XFT* -> HAVE_XFT*. -- Ben Wing +-- refactor: Unused or easily implemented functions Fsave_window_excursion, save_window_excursion_unwind removed. -- Aidan Kehoe +-- refactor: Use #'string-to-number with the BASE argument instead of #'font-hex-string-to-number, #'display-warning instead of #'font-warn in font.el. -- Aidan Kehoe +-- refactor: Use defcustom in cmdloop.el. -- Aidan Kehoe +-- refactor: Use of syswindows.h. -- Ben Wing +-- refactor: XLIKE contains code common to GTK and X -- Ben Wing +-- refactor: XLIKE_get_gc takes a frame instead of a device as first argument. -- Didier Verna +-- refactor: assert() improved to replace "if (...) ABORT()". -- Ben Wing +-- refactor: bignum_butlast(). -- Aidan Kehoe +-- refactor: change_frame_size_1(). Rename FRAME_BORDER_* to FRAME_INTERNAL_BORDER_*. Add FRAME_INTERNAL_BORDER_SIZE(). Add FRAME_REAL_TOOLBAR_BOUNDS() and top/left/bottom/right versions. Rewrite FRAME_*_BORDER_START and FRAME_*_BORDER_END. -- Ben Wing +-- refactor: check_int_range() is now check_integer_range(), taking Lisp_Objects (and thus bignums). -- Aidan Kehoe +-- refactor: cl-macs is loaded if cl-extra.el being loaded interpreted. -- Aidan Kehoe +-- refactor: enum edge_pos (new) with TOP_EDGE, BOTTOM_EDGE, LEFT_EDGE, RIGHT_EDGE; subsume TOP_BORDER, TOP_GUTTER, enum toolbar_pos, enum gutter_pos, etc. New macro EDGE_POS_LOOP. New parameter NUM_EDGES. -- Ben Wing +-- refactor: find-file-create-switch-thunk, new macro. -- Aidan Kehoe +-- refactor: find/get_ccl_program() moved functionality out of several functions where it was duplicated. -- Aidan Kehoe +-- refactor: iso-8859-2, windows-1250, iso-8859-3, iso-8859-4, iso-8859-14, iso-8859-15, iso-8859-16, iso-8859-9, macintosh, windows-1252, iso-8859-8, iso-8859-7, windows-1253, iso-8859-5, koi8-r, koi8-u, windows-1251, alternativnyj, koi8-ru, koi8-t, koi8-c, koi8-o, iso-8859-6, windows-1256 are of type fixed-width. -- Aidan Kehoe +-- refactor: shortest_length_among_sequences, new function. -- Aidan Kehoe +-- refactor: test-harness.el moved to lisp/. -- Ben Wing +-- refactor: text_width() method takes a window instead of a frame. -- Ben Wing +-- remove: #'cl-string-vector-equalp, #'cl-bit-vector-vector-equalp, #'cl-vector-array-equalp, #'cl-hash-table-contents-equalp, #'cl-mapcar-many. -- Ben Wing +-- remove: Creation of windows-874 in mule/mule-win32-init.el. -- Aidan Kehoe +-- remove: Deactivate obsolete code in X face initialization. -- Didier Verna +-- remove: Dead code in cl.el. -- Aidan Kehoe +-- remove: OffiX DND support -- Jerry James +-- remove: PDWORD_PTR typedef (unused) from syswindows.h. -- Aidan Kehoe +-- remove: Support for "old" GNU malloc. -- Jerry James +-- remove: Support for emacs versions where keywords are not self-quoting. -- Aidan Kehoe +-- remove: mule/thai-util.el, mule/thai-xtis.el. -- Aidan Kehoe + +Testing and Debugging + +-- refactor: Clean up KKCC code related to DEBUG_XEMACS. New macros IF_OLD_GC(), IF_NEW_GC(). -- Ben Wing +-- new: valgrind debugging of allocation gets support. -- Jerry James +-- improve: debug_can_access_memory. -- Ben Wing +-- improve: Print more variables upon --debug-paths. -- Mike Sperber +-- improve: Debug facilities. -- Ben Wing +-- improve: 'debug-xemacs allows exit-to-debugger/assertion failure upon Lisp error during loadup. -- Ben Wing +-- fix: Type consistency between debug and non-debug builds. -- Ben Wing +-- fix: Conditionalize DEBUG_FONTS* definitions on DEBUG_XEMACS, provide empty definitions otherwise. -- Didier Verna +-- improve: .gdbinit.in.in gets file argument to check-xemacs and check-temacs -- Ben Wing +-- fix: lrecord_type_popup_data, lrecord_type_window_configuration from .gdbinit. -- Aidan Kehoe +-- fix: Type detection in gdb pobj and friends. -- Aidan Kehoe +-- fix: @srcdir@ correctness in .gdbinit.in.in -- Ben Wing +-- improve: Generation of src/.gdbinit. -- Ben Wing +-- fix: #'Check-Message comma syntax error. -- Aidan Kehoe +-- fix: .dbxrc looks for test-harness.el in lisp directory. -- Ben Wing +-- fix: Bignum expected errors. -- Aidan Kehoe +-- fix: Check for fixed-width coding systems. -- Aidan Kehoe +-- fix: Correct line endings in tests. -- Ben Wing +-- fix: Don't check the fixed-width coding systems with odd line endings for ASCII-transparency. -- Aidan Kehoe +-- fix: List of character sets in HELLO. -- Aidan Kehoe, Ben Wing +-- fix: Operation of c-tests. -- Ben Wing, Stephen Turnbull +-- fix: Restore mapping for scaron after testing. -- Aidan Kehoe +-- fix: Results must not be written into source file. -- Ben Wing +-- fix: Revert to the original language environment in tests. -- Aidan Kehoe +-- fix: SXEmacs -> XEmacs in lisp-reader-tests.el. -- Stephen Turnbull +-- fix: Set buffer of new file to be non-modified here before killing it. -- Aidan Kehoe +-- fix: Syntax of tests for signaled errors. -- Ben Wing +-- fix: Use utf-8 as file-name-coding-system under Cygwin 1.7+. -- Ben Wing +-- fix: letf test passes. -- Aidan Kehoe +-- improve: #'Assert. -- Ben Wing, Stephen Turnbull, Aidan Kehoe +-- improve: #'test-harness-from-buffer reverses order of "got" and "expected" values. -- Ben Wing +-- improve: Case tests. -- Ben Wing +-- improve: Docs. -- Ben Wing, Aidan Kehoe, Stephen Turnbull +-- improve: Refactor search and regexp tests, file tests. -- Ben Wing +-- improve: Replace asserts in test-format-data-conversion. -- Stephen Turnbull +-- new: #'equalp hash table test, #'define-hash-table-test. -- Aidan Kehoe +-- new: #'equalp. -- Aidan Kehoe +-- new: #'functionp. -- Aidan Kehoe +-- new: #'generate-rounding-output (useful for generating data). -- Aidan Kehoe +-- new: #'mapcar, #'map and #'list-length throw malformed-list. -- Aidan Kehoe +-- new: #'nbutlast, #'butlast with dotted lists, #'ldiff, #'tailp with circular lists, dotted lists. -- Aidan Kehoe +-- new: #'reduce. -- Aidan Kehoe +-- new: (equal "hi there" [hi there]) => nil, not ==> error. -- Aidan Kehoe +-- new: Binding default-process-coding-system to nil. -- Stephen Turnbull +-- new: CODESYS in #'find-file is respected for files without content. -- Aidan Kehoe +-- new: Circularity checking with #'merge. -- Aidan Kehoe +-- new: Clearer error messages from image instantiation. -- Aidan Kehoe +-- new: Common Lisp-compatible multiple values. -- Aidan Kehoe +-- new: Common Lisp-compatible rounding functions. -- Aidan Kehoe +-- new: Control-1 search bug. -- Ben Wing, Aidan Kehoe +-- new: Discard of multiple values in #'mapcar. -- Aidan Kehoe +-- new: Format strings with %b. -- Aidan Kehoe +-- new: More tests of equalp. -- Stephen Turnbull +-- new: Printing symbols with names that look like ratios. -- Aidan Kehoe +-- new: Some multidimensional characters should not use boyer_moore(). -- Aidan Kehoe +-- new: Torture test for case mappings. -- Ben Wing +-- new: Unicode detection with very short inputs. -- Aidan Kehoe +-- new: Variables to control backtraces in tests. -- Ben Wing +-- new: Zero-length files get sane coding system. -- Aidan Kehoe +-- new: escape-quoted for the range U+0000 to U+00FF. -- Stephen Turnbull +-- new: reproduce-crashes.el #12, #13. -- Adam Sjogren, Stephen Turnbull, Jerry James +-- new: split-string-by-char. -- Aidan Kehoe +-- remove: DLL/dltest.c. -- Jerry James +-- remove: Unused binding. -- Ben Wing +-- remove: auc-tex-test. -- Jerry James + to XEmacs 21.5.29 "garbanzo" Major Features and Backward Incompatible Changes diff -r 861f2601a38b -r 1f0b15040456 COPYING --- a/COPYING Sat Feb 20 06:03:00 2010 -0600 +++ b/COPYING Sun May 01 18:44:03 2011 +0100 @@ -1,285 +1,626 @@ - GNU GENERAL PUBLIC LICENSE - Version 2, June 1991 + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 - Copyright (C) 1989, 1991 Free Software Foundation, Inc. - 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. - Preamble + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -License is intended to guarantee your freedom to share and change free -software--to make sure the software is free for all its users. This -General Public License applies to most of the Free Software -Foundation's software and to any other program whose authors commit to -using it. (Some other Free Software Foundation software is covered by -the GNU Library General Public License instead.) You can apply it to + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for -this service if you wish), that you receive source code or can get it -if you want it, that you can change the software or use pieces of it -in new free programs; and that you know you can do these things. +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. - To protect your rights, we need to make restrictions that forbid -anyone to deny you these rights or to ask you to surrender the rights. -These restrictions translate to certain responsibilities for you if you -distribute copies of the software, or if you modify it. + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. For example, if you distribute copies of such a program, whether -gratis or for a fee, you must give the recipients all the rights that -you have. You must make sure that they, too, receive or can get the -source code. And you must show them these terms so they know their -rights. +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. - We protect your rights with two steps: (1) copyright the software, and -(2) offer you this license which gives you legal permission to copy, -distribute and/or modify the software. + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. - Also, for each author's protection and ours, we want to make certain -that everyone understands that there is no warranty for this free -software. If the software is modified by someone else and passed on, we -want its recipients to know that what they have is not the original, so -that any problems introduced by others will not reflect on the original -authors' reputations. + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. - Finally, any free program is threatened constantly by software -patents. We wish to avoid the danger that redistributors of a free -program will individually obtain patent licenses, in effect making the -program proprietary. To prevent this, we have made it clear that any -patent must be licensed for everyone's free use or not licensed at all. + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. The precise terms and conditions for copying, distribution and modification follow. - - GNU GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. - 0. This License applies to any program or other work which contains -a notice placed by the copyright holder saying it may be distributed -under the terms of this General Public License. The "Program", below, -refers to any such program or work, and a "work based on the Program" -means either the Program or any derivative work under copyright law: -that is to say, a work containing the Program or a portion of it, -either verbatim or with modifications and/or translated into another -language. (Hereinafter, translation is included without limitation in -the term "modification".) Each licensee is addressed as "you". + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. -Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running the Program is not restricted, and the output from the Program -is covered only if its contents constitute a work based on the -Program (independent of having been made by running the Program). -Whether that is true depends on what the Program does. + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. - 1. You may copy and distribute verbatim copies of the Program's -source code as you receive it, in any medium, provided that you -conspicuously and appropriately publish on each copy an appropriate -copyright notice and disclaimer of warranty; keep intact all the -notices that refer to this License and to the absence of any warranty; -and give any other recipients of the Program a copy of this License -along with the Program. + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. -You may charge a fee for the physical act of transferring a copy, and -you may at your option offer warranty protection in exchange for a fee. + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. - 2. You may modify your copy or copies of the Program or any portion -of it, thus forming a work based on the Program, and copy and -distribute such modifications or work under the terms of Section 1 -above, provided that you also meet all of these conditions: + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. - a) You must cause the modified files to carry prominent notices - stating that you changed the files and the date of any change. + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. - b) You must cause any work that you distribute or publish, that in - whole or in part contains or is derived from the Program or any - part thereof, to be licensed as a whole at no charge to all third - parties under the terms of this License. + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. - c) If the modified program normally reads commands interactively - when run, you must cause it, when started running for such - interactive use in the most ordinary way, to print or display an - announcement including an appropriate copyright notice and a - notice that there is no warranty (or else, saying that you provide - a warranty) and that users may redistribute the program under - these conditions, and telling the user how to view a copy of this - License. (Exception: if the Program itself is interactive but - does not normally print such an announcement, your work based on - the Program is not required to print an announcement.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Program, -and can be reasonably considered independent and separate works in -themselves, then this License, and its terms, do not apply to those -sections when you distribute them as separate works. But when you -distribute the same sections as part of a whole which is a work based -on the Program, the distribution of the whole must be on the terms of -this License, whose permissions for other licensees extend to the -entire whole, and thus to each and every part regardless of who wrote it. + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. -Thus, it is not the intent of this section to claim rights or contest -your rights to work written entirely by you; rather, the intent is to -exercise the right to control the distribution of derivative or -collective works based on the Program. + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. -In addition, mere aggregation of another work not based on the Program -with the Program (or with a work based on the Program) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. - 3. You may copy and distribute the Program (or a work based on it, -under Section 2) in object code or executable form under the terms of -Sections 1 and 2 above provided that you also do one of the following: + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. - a) Accompany it with the complete corresponding machine-readable - source code, which must be distributed under the terms of Sections - 1 and 2 above on a medium customarily used for software interchange; or, + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. - b) Accompany it with a written offer, valid for at least three - years, to give any third party, for a charge no more than your - cost of physically performing source distribution, a complete - machine-readable copy of the corresponding source code, to be - distributed under the terms of Sections 1 and 2 above on a medium - customarily used for software interchange; or, + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. - c) Accompany it with the information you received as to the offer - to distribute corresponding source code. (This alternative is - allowed only for noncommercial distribution and only if you - received the program in object code or executable form with such - an offer, in accord with Subsection b above.) + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or -The source code for a work means the preferred form of the work for -making modifications to it. For an executable work, complete source -code means all the source code for all modules it contains, plus any -associated interface definition files, plus the scripts used to -control compilation and installation of the executable. However, as a -special exception, the source code distributed need not include -anything that is normally distributed (in either source or binary -form) with the major components (compiler, kernel, and so on) of the -operating system on which the executable runs, unless that component -itself accompanies the executable. + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. -If distribution of executable or object code is made by offering -access to copy from a designated place, then offering equivalent -access to copy the source code from the same place counts as -distribution of the source code, even though third parties are not -compelled to copy the source along with the object code. - - 4. You may not copy, modify, sublicense, or distribute the Program -except as expressly provided under this License. Any attempt -otherwise to copy, modify, sublicense or distribute the Program is -void, and will automatically terminate your rights under this License. -However, parties who have received copies, or rights, from you under -this License will not have their licenses terminated so long as such -parties remain in full compliance. + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. - 5. You are not required to accept this License, since you have not -signed it. However, nothing else grants you permission to modify or -distribute the Program or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Program (or any work based on the -Program), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Program or works based on it. + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. - 6. Each time you redistribute the Program (or any work based on the -Program), the recipient automatically receives a license from the -original licensor to copy, distribute or modify the Program subject to -these terms and conditions. You may not impose any further -restrictions on the recipients' exercise of the rights granted herein. -You are not responsible for enforcing compliance by third parties to + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of this License. - 7. If, as a consequence of a court judgment or allegation of patent -infringement or for any other reason (not limited to patent issues), -conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot -distribute so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you -may not distribute the Program at all. For example, if a patent -license would not permit royalty-free redistribution of the Program by -all those who receive copies directly or indirectly through you, then -the only way you could satisfy both it and this License would be to -refrain entirely from distribution of the Program. + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. -If any portion of this section is held invalid or unenforceable under -any particular circumstance, the balance of the section is intended to -apply and the section as a whole is intended to apply in other -circumstances. + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. -It is not the purpose of this section to induce you to infringe any -patents or other property right claims or to contest validity of any -such claims; this section has the sole purpose of protecting the -integrity of the free software distribution system, which is -implemented by public license practices. Many people have made -generous contributions to the wide range of software distributed -through that system in reliance on consistent application of that -system; it is up to the author/donor to decide if he or she is willing -to distribute software through any other system and a licensee cannot -impose that choice. + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. -This section is intended to make thoroughly clear what is believed to -be a consequence of the rest of this License. - - 8. If the distribution and/or use of the Program is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Program under this License -may add an explicit geographical distribution limitation excluding -those countries, so that distribution is permitted only in or among -countries not thus excluded. In such case, this License incorporates -the limitation as if written in the body of this License. + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. - 9. The Free Software Foundation may publish revised and/or new versions -of the General Public License from time to time. Such new versions will + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. -Each version is given a distinguishing version number. If the Program -specifies a version number of this License which applies to it and "any -later version", you have the option of following the terms and conditions -either of that version or of any later version published by the Free -Software Foundation. If the Program does not specify a version number of -this License, you may choose any version ever published by the Free Software -Foundation. + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. - 10. If you wish to incorporate parts of the Program into other free -programs whose distribution conditions are different, write to the author -to ask for permission. For software which is copyrighted by the Free -Software Foundation, write to the Free Software Foundation; we sometimes -make exceptions for this. Our decision will be guided by the two goals -of preserving the free status of all derivatives of our free software and -of promoting the sharing and reuse of software generally. + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. - NO WARRANTY + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. - 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY -FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN -OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES -PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED -OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS -TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE -PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, -REPAIR OR CORRECTION. + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. - 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR -REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, -INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING -OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED -TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY -YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER -PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE -POSSIBILITY OF SUCH DAMAGES. + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it @@ -287,15 +628,15 @@ To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively -convey the exclusion of warranty; and each file should have at least +state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) - This program is free software; you can redistribute it and/or modify + This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, @@ -304,37 +645,30 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - + along with this program. If not, see . Also add information on how to contact you by electronic and paper mail. -If the program is interactive, make it output a short notice like this -when it starts in an interactive mode: + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: - Gnomovision version 69, Copyright (C) year name of author - Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, the commands you use may -be called something other than `show w' and `show c'; they could even be -mouse-clicks or menu items--whatever suits your program. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the program, if -necessary. Here is a sample; alter the names: +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". - Yoyodyne, Inc., hereby disclaims all copyright interest in the program - `Gnomovision' (which makes passes at compilers) written by James Hacker. - - , 1 April 1989 - Ty Coon, President of Vice + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. -This General Public License does not permit incorporating your program into -proprietary programs. If your program is a subroutine library, you may -consider it more useful to permit linking proprietary applications with the -library. If this is what you want to do, use the GNU Library General -Public License instead of this License. + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff -r 861f2601a38b -r 1f0b15040456 ChangeLog --- a/ChangeLog Sat Feb 20 06:03:00 2010 -0600 +++ b/ChangeLog Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,62 @@ +2011-04-29 Stephen J. Turnbull + + * XEmacs 21.5.31 "ginger" is released. + +2011-04-26 Stephen J. Turnbull + + * XEmacs 21.5.30 "garlic" is released. + +2011-03-24 Jerry James + + * INSTALL: "youself" -> "yourself". + * aclocal.m4: "dependancy" -> "dependency". + * configure.ac: "priveleges" -> "privileges". + * configure: Regenerate. + +2010-11-02 Mats Lidell + + * netinstall: removed + +2010-06-14 Stephen J. Turnbull + + * aclocal.m4: Add standard permission boilerplate. + +2010-06-02 Aidan Kehoe + + * version.sh.in: + * configure.ac (XE_COMPLEX_ARG, XE_EXPAND_VARIABLE): + Remove conditionals and information for InfoDock. + +2010-04-09 Ben Wing + + * CHANGES-beta: + Update with my changes to the trunk since the release of 21.5.29 + in 2009 up through April 9, 2010. + +2010-04-02 Aidan Kehoe + + * CHANGES-beta: + Update with my changes to the trunk since 2009-09-20. + +2010-03-18 Ben Wing + + * CHANGES-beta: + Partially updated with last couple of months worth of changes. + +2010-03-18 Mike Sperber + + * INSTALL: Reflect change from `lib' to `share'; also, document + how to invoke configure to get the old setting. + + * configure.ac: Set LATE_PACKAGE_DIRECTORIES_USER_DEFINED if + `datadir' was changed; set `with_late_packages' to something + sensible for this case. + +2010-02-20 Ben Wing + + * configure.ac (XE_COMPLEX_ARG): + Correct doc of --quick-build: It also doesn't check for Lisp shadows. + 2010-02-20 Ben Wing * configure: @@ -6619,3 +6678,23 @@ Thu Dec 5 11:56:05 1996 Joseph J Nuspl * configure.in (LIBS): Fix typo in dialog box test. + + +ChangeLog entries synched from GNU Emacs are the property of the FSF. +Other ChangeLog entries are usually the property of the author of the +change. + +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 3 of the License, 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. If not, see . diff -r 861f2601a38b -r 1f0b15040456 INSTALL --- a/INSTALL Sat Feb 20 06:03:00 2010 -0600 +++ b/INSTALL Sun May 01 18:44:03 2011 +0100 @@ -257,7 +257,7 @@ should put XEmacs and its data files. This defaults to `/usr/local'. - XEmacs (and the other utilities users run) go in PREFIXDIR/bin (unless the `--exec-prefix' option says otherwise). -- The architecture-independent files go in PREFIXDIR/lib/xemacs-VERSION +- The architecture-independent files go in PREFIXDIR/share/xemacs-VERSION (where VERSION is the version number of XEmacs, like `21.0'). - The architecture-dependent files go in PREFIXDIR/lib/xemacs-VERSION/CONFIGURATION-NAME @@ -284,6 +284,12 @@ part of the generated executable; everything else will continue to work as usual. +Unlike previous versions of XEmacs (21.4 or earlier), +architecture-independent files (in particular, the Lisp files and +package hierarchies) by default get installed under `/usr/local/share' +rather than `/usr/local/lib'. To create a setup as in previous +versions, use the `--datadir=/usr/local/lib' option to configure. + Configuring Feature Support --------------------------- @@ -475,7 +481,7 @@ For most platforms, configure or the src/s file have the preferred method for locking mail spool files preconfigured. Otherwise you must -find out for youself. Do not choose a locking protocol "on the +find out for yourself. Do not choose a locking protocol "on the objective merits." XEmacs must use the same method as other mail utilities on your system, or you WILL lose mail. @@ -567,7 +573,7 @@ `xemacs', `etags', `ctags', `b2m', `emacsclient', `ellcc', `gnuclient', `gnudoit', and `gnuattach'. -`/usr/local/lib/xemacs-VERSION/lisp' holds the Emacs Lisp libraries; +`/usr/local/share/xemacs-VERSION/lisp' holds the Emacs Lisp libraries; `VERSION' stands for the number of the XEmacs version you are installing, like `18.59' or `19.14'. Since the lisp libraries change from one version of XEmacs to @@ -578,14 +584,14 @@ XEmacs searches for its lisp files in these directories, and then in - `/usr/local/lib/xemacs/site-lisp/*'. + `/usr/local/share/xemacs/site-lisp/*'. -`/usr/local/lib/xemacs-VERSION/etc' holds the XEmacs tutorial, the +`/usr/local/share/xemacs-VERSION/etc' holds the XEmacs tutorial, the Unicode database, and other architecture-independent files XEmacs might need while running. VERSION is as specified for `.../lisp'. -`/usr/local/lib/xemacs/lock' contains files indicating who is +`/usr/local/share/xemacs/lock' contains files indicating who is editing what, so XEmacs can detect editing clashes between users. @@ -614,7 +620,7 @@ sub-directory of it, and then in `/usr/local/lib/xemacs/site-modules/*'. -`/usr/local/lib/xemacs-VERSION/info' holds the on-line documentation +`/usr/local/share/xemacs-VERSION/info' holds the on-line documentation for XEmacs, known as "info files". `/usr/local/man/man1' holds the man pages for the programs installed @@ -642,7 +648,7 @@ `datadir' indicates where to put the architecture-independent read-only data files that XEmacs refers to while it runs; it - defaults to /usr/local/lib. We create the following + defaults to /usr/local/data. We create the following subdirectories under `datadir': - `xemacs-VERSION/lisp', containing the XEmacs lisp libraries, and @@ -655,6 +661,13 @@ same time; this means that you don't have to make XEmacs unavailable while installing a new version. +`datarootdir' indicates where to put the documentation. (Usually, + this is identical to `datadir'---in the default configuration + `datadir' is set to the value of `datarootdir'.) + Specifically, the man pages are put in the `man' subdirectory + of `datarootdir', and the info pages are put in the + `xemacs/info' subdirectory. + `statedir' indicates where to put architecture-independent data files that XEmacs modifies while it runs; it defaults to /usr/local/lib as well. We create the following @@ -680,7 +693,7 @@ XEmacs is installed on. `infodir' indicates where to put the info files distributed with - XEmacs; it defaults to `/usr/local/lib/xemacs-VERSION/info'. + XEmacs; it defaults to `/usr/local/share/xemacs-VERSION/info'. `mandir' indicates where to put the man pages for XEmacs and its utilities (like `etags'); it defaults to @@ -710,23 +723,23 @@ `lispdir' indicates where XEmacs installs and expects its lisp libraries. Its default value, based on `datadir' (see above), - is `/usr/local/lib/xemacs-VERSION/lisp' (where `VERSION' is as + is `/usr/local/share/xemacs-VERSION/lisp' (where `VERSION' is as described above). `sitelispdir' indicates where XEmacs should search for lisp libraries specific to your site. XEmacs checks them in order before checking `lispdir'. Its default value, based on `datadir' - (see above), is `/usr/local/lib/xemacs/site-lisp'. + (see above), is `/usr/local/share/xemacs/site-lisp'. `etcdir' indicates where XEmacs should install and expect the rest of its architecture-independent data, like the tutorial and yow database. Its default value, based on `datadir' - (see above), is `/usr/local/lib/xemacs-VERSION/etc' (where + (see above), is `/usr/local/share/xemacs-VERSION/etc' (where `VERSION' is as described above). `lockdir' indicates the directory where XEmacs keeps track of its locking information. Its default value, based on `statedir' - (see above), is `/usr/local/lib/xemacs/lock'. + (see above), is `/usr/local/share/xemacs/lock'. `archlibdir' indicates where XEmacs installs and expects the executable files and other architecture-dependent data it uses diff -r 861f2601a38b -r 1f0b15040456 Makefile.in.in --- a/Makefile.in.in Sat Feb 20 06:03:00 2010 -0600 +++ b/Makefile.in.in Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ ## This file is part of XEmacs. -## XEmacs is free software; you can redistribute it and/or modify it +## 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. +## Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ ## for more details. ## You should have received a copy of the GNU General Public License -## along with XEmacs; see the file COPYING. If not, write to -## the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -## Boston, MA 02111-1307, USA. +## along with XEmacs. If not, see . ## make all to compile and build XEmacs. ## make install to build and install it. diff -r 861f2601a38b -r 1f0b15040456 PROBLEMS --- a/PROBLEMS Sat Feb 20 06:03:00 2010 -0600 +++ b/PROBLEMS Sun May 01 18:44:03 2011 +0100 @@ -1,5 +1,37 @@ -*- mode:outline -*- +Copyright (C) 1997, 1998 Steven L Baur +Copyright (C) 1997 Tor Arntsen +Copyright (C) 1998, 1999 Gunnar Evermann +Copyright (C) 1998 Karl M. Hegbloom +Copyright (C) 1998, 2000 Marcus Thiessel +Copyright (C) 1998, 2001 Martin Buchholz +Copyright (C) 1998 Michael Sperber +Copyright (C) 1999 Andy Piper +Copyright (C) 2000 Darryl Okahata +Copyright (C) 2000-2002, 2006, 2007, 2009 Stephen J. Turnbull +Copyright (C) 2001, 2003, 2005, 2010 Ben Wing +Copyright (C) 2001 Robert Pluim +Copyright (C) 2003 Jerry James +Copyright (C) 2003 Rodney Sparapani +Copyright (C) 2005, 2006 Malcolm Purvis + +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 3 of the License, 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. If not, see . + + This file describes various problems that have been encountered in compiling, installing and running XEmacs. It has been updated for XEmacs 21.5. Note that the issues are by now mainly historic; XEmacs diff -r 861f2601a38b -r 1f0b15040456 README.GPLv3 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/README.GPLv3 Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,8 @@ +Here we have notes about the conversion to GPLv3. Things left to do, +things to check, etc... + +* File with copyright notices that ought to be checked + +"etc/gnuserv.1" and "etc/gnuserv.README". Copyright added with date +1998. If more accurate dates for the respective contributions can be +deduced it would be good. diff -r 861f2601a38b -r 1f0b15040456 aclocal.m4 --- a/aclocal.m4 Sat Feb 20 06:03:00 2010 -0600 +++ b/aclocal.m4 Sun May 01 18:44:03 2011 +0100 @@ -2,7 +2,19 @@ dnl Copyright (C) 1998, 1999 J. Kean Johnston. dnl Author: J. Kean Johnston , based on work in libtool. dnl This file is part of XEmacs. - +dnl +dnl XEmacs is free software: you can redistribute it and/or modify it +dnl under the terms of the GNU General Public License as published by the +dnl Free Software Foundation, either version 3 of the License, or (at your +dnl option) any later version. +dnl +dnl XEmacs is distributed in the hope that it will be useful, but WITHOUT +dnl ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +dnl FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +dnl for more details. +dnl +dnl You should have received a copy of the GNU General Public License +dnl along with XEmacs. If not, see . dnl dnl There are several things we care about here. First, we need to find dnl out how we create an executable that has its symbols exported, so @@ -203,7 +215,7 @@ dnl if the C compiler itself cannot create shared libraries do we try to dnl find the linker. dnl -dnl The other advantage to my scheme is that it removes the dependancy +dnl The other advantage to my scheme is that it removes the dependency dnl on a given compiler version remaining static with relation to the dnl version of XEmacs. With the libtool way, it picks up the linker that dnl gcc uses, which can be the internal collect2 that comes with gcc. diff -r 861f2601a38b -r 1f0b15040456 build-msw-release.sh --- a/build-msw-release.sh Sat Feb 20 06:03:00 2010 -0600 +++ b/build-msw-release.sh Sun May 01 18:44:03 2011 +0100 @@ -3,21 +3,19 @@ # Copyright (C) 2000 Andy Piper # 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 +# +# 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 3 of the License, 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. - +# +# XEmacs is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to the Free -# Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301, USA. +# along with XEmacs. If not, see . # This file builds the release kits for both cygwin and win32. You # must have both environments configured for it to work properly. In diff -r 861f2601a38b -r 1f0b15040456 configure --- a/configure Sat Feb 20 06:03:00 2010 -0600 +++ b/configure Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,13 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.65 for XEmacs 21.5. +# Generated by GNU Autoconf 2.68 for XEmacs 21.5. # # Report bugs to . # # # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, -# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, -# Inc. +# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software +# Foundation, Inc. # # # This configure script is free software; the Free Software Foundation @@ -34,20 +34,18 @@ # # 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 +# 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 3 of the License, 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. +# XEmacs is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. # # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to the Free -# Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301, USA. +# along with XEmacs. If not, see . # # For usage, run `./configure --help' # For more detailed information on building and installing XEmacs, @@ -137,6 +135,7 @@ IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. +as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -262,11 +261,18 @@ # We cannot yet assume a decent shell, so we have to provide a # neutralization value for shells without unset; and this also # works around shells that cannot unset nonexistent variables. + # Preserve -v and -x to the replacement shell. BASH_ENV=/dev/null ENV=/dev/null (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV export CONFIG_SHELL - exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} + case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; + esac + exec "$CONFIG_SHELL" $as_opts "$as_myself" ${1+"$@"} fi if test x$as_have_required = xno; then : @@ -365,7 +371,7 @@ test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" - } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" } # as_fn_mkdir_p @@ -405,19 +411,19 @@ fi # as_fn_arith -# as_fn_error ERROR [LINENO LOG_FD] -# --------------------------------- +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the -# script with status $?, using 1 if that was 0. +# script with STATUS, using 1 if that was 0. as_fn_error () { - as_status=$?; test $as_status -eq 0 && as_status=1 - if test "$3"; then - as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3 - fi - $as_echo "$as_me: error: $1" >&2 + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 as_fn_exit $as_status } # as_fn_error @@ -579,7 +585,7 @@ exec 6>&1 # Name of the host. -# hostname on some systems (SVR3.2, Linux) returns a bogus exit status, +# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` @@ -1005,8 +1011,6 @@ with_workshop enable_sparcworks with_sparcworks -enable_infodock -with_infodock enable_debug with_debug enable_error_checking @@ -1104,8 +1108,9 @@ fi case $ac_option in - *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; - *) ac_optarg=yes ;; + *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *=) ac_optarg= ;; + *) ac_optarg=yes ;; esac # Accept the important Cygnus configure options, so we can diagnose typos. @@ -1150,7 +1155,7 @@ ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error "invalid feature name: $ac_useropt" + as_fn_error $? "invalid feature name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in @@ -1176,7 +1181,7 @@ ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error "invalid feature name: $ac_useropt" + as_fn_error $? "invalid feature name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in @@ -1380,7 +1385,7 @@ ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error "invalid package name: $ac_useropt" + as_fn_error $? "invalid package name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in @@ -1396,7 +1401,7 @@ ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error "invalid package name: $ac_useropt" + as_fn_error $? "invalid package name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in @@ -1426,8 +1431,8 @@ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; - -*) as_fn_error "unrecognized option: \`$ac_option' -Try \`$0 --help' for more information." + -*) as_fn_error $? "unrecognized option: \`$ac_option' +Try \`$0 --help' for more information" ;; *=*) @@ -1435,7 +1440,7 @@ # Reject names that are not valid shell variable names. case $ac_envvar in #( '' | [0-9]* | *[!_$as_cr_alnum]* ) - as_fn_error "invalid variable name: \`$ac_envvar'" ;; + as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; esac eval $ac_envvar=\$ac_optarg export $ac_envvar ;; @@ -1445,7 +1450,7 @@ $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 - : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} + : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" ;; esac @@ -1453,13 +1458,13 @@ if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` - as_fn_error "missing argument to $ac_option" + as_fn_error $? "missing argument to $ac_option" fi if test -n "$ac_unrecognized_opts"; then case $enable_option_checking in no) ;; - fatal) as_fn_error "unrecognized options: $ac_unrecognized_opts" ;; + fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; esac fi @@ -1482,7 +1487,7 @@ [\\/$]* | ?:[\\/]* ) continue;; NONE | '' ) case $ac_var in *prefix ) continue;; esac;; esac - as_fn_error "expected an absolute directory name for --$ac_var: $ac_val" + as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" done # There might be people who depend on the old broken behavior: `$host' @@ -1496,8 +1501,8 @@ if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe - $as_echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. - If a cross compiler is detected then cross compile mode will be used." >&2 + $as_echo "$as_me: WARNING: if you wanted to set the --build type, don't use --host. + If a cross compiler is detected then cross compile mode will be used" >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi @@ -1512,9 +1517,9 @@ ac_pwd=`pwd` && test -n "$ac_pwd" && ac_ls_di=`ls -di .` && ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || - as_fn_error "working directory cannot be determined" + as_fn_error $? "working directory cannot be determined" test "X$ac_ls_di" = "X$ac_pwd_ls_di" || - as_fn_error "pwd does not report name of working directory" + as_fn_error $? "pwd does not report name of working directory" # Find the source files, if location was not specified. @@ -1553,11 +1558,11 @@ fi if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." - as_fn_error "cannot find sources ($ac_unique_file) in $srcdir" + as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" fi ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" ac_abs_confdir=`( - cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error "$ac_msg" + cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" pwd)` # When building in place, set srcdir=. if test "$ac_abs_confdir" = "$ac_pwd"; then @@ -1597,7 +1602,7 @@ --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit - -q, --quiet, --silent do not print \`checking...' messages + -q, --quiet, --silent do not print \`checking ...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files @@ -1952,8 +1957,6 @@ --with-workshop Support the Sun WorkShop (formerly Sparcworks) development environment. --with-sparcworks Alias for --with-workshop - --with-infodock Support the Infodock version of XEmacs. Infodock is - a SourceForge project). Debugging options ----------------- @@ -1995,13 +1998,14 @@ --with-quick-build Speed up the build cycle by leaving out steps where XEmacs will still work (more or less) without them. Potentially dangerous if you don't know what you're - doing. This (1) doesn't garbage-collect after - loading each file during dumping, (2) doesn't + doing. This (1) Doesn't garbage-collect after + loading each file during dumping, (2) Doesn't automatically rebuild the DOC file (remove it by hand to get it rebuilt), (3) Removes config.h, lisp.h and associated files from the dependency lists, so changes to these files don't automatically - cause all .c files to be rebuilt. + cause all .c files to be rebuilt, (4) Doesn't check + for Lisp shadows. --with-union-type Use union definition of Lisp_Object type. Known to trigger bugs in some compilers. --with-quantify Support performance debugging using Quantify. @@ -2022,8 +2026,9 @@ CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if you have headers in a nonstandard directory CPP C preprocessor - YACC The `Yet Another C Compiler' implementation to use. Defaults to - the first program found out of: `bison -y', `byacc', `yacc'. + YACC The `Yet Another Compiler Compiler' implementation to use. + Defaults to the first program found out of: `bison -y', `byacc', + `yacc'. YFLAGS The list of arguments that will be passed by default to $YACC. This script will default YFLAGS to the empty string to avoid a default value of `-d' given by some make applications. @@ -2098,9 +2103,9 @@ if $ac_init_version; then cat <<\_ACEOF XEmacs configure 21.5 -generated by GNU Autoconf 2.65 - -Copyright (C) 2009 Free Software Foundation, Inc. +generated by GNU Autoconf 2.68 + +Copyright (C) 2010 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. @@ -2125,20 +2130,18 @@ 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 +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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to the Free -Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -Boston, MA 02110-1301, USA. +along with XEmacs. If not, see . For usage, run `./configure --help' For more detailed information on building and installing XEmacs, @@ -2190,7 +2193,7 @@ ac_retval=1 fi - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_compile @@ -2216,7 +2219,7 @@ mv -f conftest.er1 conftest.err fi $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } >/dev/null && { + test $ac_status = 0; } > conftest.i && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err }; then : @@ -2227,7 +2230,7 @@ ac_retval=1 fi - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_cpp @@ -2240,10 +2243,10 @@ ac_fn_c_check_header_mongrel () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : + if eval \${$3+:} false; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; } -if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 fi eval ac_res=\$$3 @@ -2279,7 +2282,7 @@ else ac_header_preproc=no fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 $as_echo "$ac_header_preproc" >&6; } @@ -2302,17 +2305,15 @@ $as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;} { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 $as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} -( cat <<\_ASBOX -## ------------------------------------- ## +( $as_echo "## ------------------------------------- ## ## Report this to xemacs-beta@xemacs.org ## -## ------------------------------------- ## -_ASBOX +## ------------------------------------- ##" ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; } -if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else eval "$3=\$ac_header_compiler" @@ -2321,7 +2322,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } fi - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_header_mongrel @@ -2362,7 +2363,7 @@ ac_retval=$ac_status fi rm -rf conftest.dSYM conftest_ipa8_conftest.oo - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_run @@ -2376,7 +2377,7 @@ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; } -if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -2394,7 +2395,7 @@ eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_header_compile @@ -2439,7 +2440,7 @@ # interfere with the next link command; also delete a directory that is # left behind by Apple's compiler. We do this before executing the actions. rm -rf conftest.dSYM conftest_ipa8_conftest.oo - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_link @@ -2452,7 +2453,7 @@ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; } -if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -2507,19 +2508,22 @@ eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_func -# ac_fn_c_check_decl LINENO SYMBOL VAR -# ------------------------------------ -# Tests whether SYMBOL is declared, setting cache variable VAR accordingly. +# ac_fn_c_check_decl LINENO SYMBOL VAR INCLUDES +# --------------------------------------------- +# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR +# accordingly. ac_fn_c_check_decl () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $2 is declared" >&5 -$as_echo_n "checking whether $2 is declared... " >&6; } -if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : + as_decl_name=`echo $2|sed 's/ *(.*//'` + as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'` + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5 +$as_echo_n "checking whether $as_decl_name is declared... " >&6; } +if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -2528,8 +2532,12 @@ int main () { -#ifndef $2 - (void) $2; +#ifndef $as_decl_name +#ifdef __cplusplus + (void) $as_decl_use; +#else + (void) $as_decl_name; +#endif #endif ; @@ -2546,7 +2554,7 @@ eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_decl @@ -2559,7 +2567,7 @@ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; } -if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else eval "$3=no" @@ -2600,7 +2608,7 @@ eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_type @@ -2613,7 +2621,7 @@ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2.$3" >&5 $as_echo_n "checking for $2.$3... " >&6; } -if { as_var=$4; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${$4+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -2657,7 +2665,7 @@ eval ac_res=\$$4 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_member @@ -2834,7 +2842,7 @@ rm -f conftest.val fi - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_compute_int @@ -2872,7 +2880,7 @@ ac_retval=1 fi - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_cxx_try_compile @@ -2881,7 +2889,7 @@ running configure, to aid debugging if configure makes a mistake. It was created by XEmacs $as_me 21.5, which was -generated by GNU Autoconf 2.65. Invocation command line was +generated by GNU Autoconf 2.68. Invocation command line was $ $0 $@ @@ -2991,11 +2999,9 @@ { echo - cat <<\_ASBOX -## ---------------- ## + $as_echo "## ---------------- ## ## Cache variables. ## -## ---------------- ## -_ASBOX +## ---------------- ##" echo # The following way of writing the cache mishandles newlines in values, ( @@ -3029,11 +3035,9 @@ ) echo - cat <<\_ASBOX -## ----------------- ## + $as_echo "## ----------------- ## ## Output variables. ## -## ----------------- ## -_ASBOX +## ----------------- ##" echo for ac_var in $ac_subst_vars do @@ -3046,11 +3050,9 @@ echo if test -n "$ac_subst_files"; then - cat <<\_ASBOX -## ------------------- ## + $as_echo "## ------------------- ## ## File substitutions. ## -## ------------------- ## -_ASBOX +## ------------------- ##" echo for ac_var in $ac_subst_files do @@ -3064,11 +3066,9 @@ fi if test -s confdefs.h; then - cat <<\_ASBOX -## ----------- ## + $as_echo "## ----------- ## ## confdefs.h. ## -## ----------- ## -_ASBOX +## ----------- ##" echo cat confdefs.h echo @@ -3123,7 +3123,12 @@ ac_site_file1=NONE ac_site_file2=NONE if test -n "$CONFIG_SITE"; then - ac_site_file1=$CONFIG_SITE + # We do not want a PATH search for config.site. + case $CONFIG_SITE in #(( + -*) ac_site_file1=./$CONFIG_SITE;; + */*) ac_site_file1=$CONFIG_SITE;; + *) ac_site_file1=./$CONFIG_SITE;; + esac elif test "x$prefix" != xNONE; then ac_site_file1=$prefix/share/config.site ac_site_file2=$prefix/etc/config.site @@ -3138,7 +3143,11 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 $as_echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 - . "$ac_site_file" + . "$ac_site_file" \ + || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "failed to load site script $ac_site_file +See \`config.log' for more details" "$LINENO" 5; } fi done @@ -3214,7 +3223,7 @@ $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 $as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} - as_fn_error "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 + as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 fi ## -------------------- ## ## Main body of script. ## @@ -5189,22 +5198,6 @@ withval="$with_sparcworks" fi; -# If --with-infodock or --without-infodock were given then copy the value to the -# equivalent enable_infodock variable. -if test "${with_infodock+set}" = set; then - enable_infodock="$with_infodock" -fi; -# If -enable-infodock or --disable-infodock were given then copy the value to the -# equivalent with_infodock variable. -if test "${enable_infodock+set}" = set; then - with_infodock="$enable_infodock" -fi; -# Check whether --with-infodock or --without-infodock was given. -if test "${with_infodock+set}" = set; then - enableval="$with_infodock" - withval="$with_infodock" - -fi; # If --with-debug or --without-debug were given then copy the value to the # equivalent enable_debug variable. @@ -5509,6 +5502,8 @@ $as_echo "#define ETCDIR_USER_DEFINED 1" >>confdefs.h + $as_echo "#define LATE_PACKAGE_DIRECTORIES_USER_DEFINED 1" >>confdefs.h + fi if test "x$libdir" != "x\${exec_prefix}/lib" @@ -5533,6 +5528,7 @@ inststaticdir='${PROGNAME}' instvardir='${PROGNAME}-${version}' sitemoduledir='${libdir}/${inststaticdir}/site-modules' +with_late_packages='${datadir}/${PROGNAME}' statedir=$with_statedir @@ -5598,16 +5594,22 @@ ac_aux_dir= for ac_dir in "$srcdir" "$srcdir/.." "$srcdir/../.."; do - for ac_t in install-sh install.sh shtool; do - if test -f "$ac_dir/$ac_t"; then - ac_aux_dir=$ac_dir - ac_install_sh="$ac_aux_dir/$ac_t -c" - break 2 - fi - done + if test -f "$ac_dir/install-sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install-sh -c" + break + elif test -f "$ac_dir/install.sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install.sh -c" + break + elif test -f "$ac_dir/shtool"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/shtool install -c" + break + fi done if test -z "$ac_aux_dir"; then - as_fn_error "cannot find install-sh, install.sh, or shtool in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" "$LINENO" 5 + as_fn_error $? "cannot find install-sh, install.sh, or shtool in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" "$LINENO" 5 fi # These three variables are undocumented and unsupported, @@ -5621,27 +5623,27 @@ # Make sure we can run config.sub. $SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 || - as_fn_error "cannot run $SHELL $ac_aux_dir/config.sub" "$LINENO" 5 + as_fn_error $? "cannot run $SHELL $ac_aux_dir/config.sub" "$LINENO" 5 { $as_echo "$as_me:${as_lineno-$LINENO}: checking build system type" >&5 $as_echo_n "checking build system type... " >&6; } -if test "${ac_cv_build+set}" = set; then : +if ${ac_cv_build+:} false; then : $as_echo_n "(cached) " >&6 else ac_build_alias=$build_alias test "x$ac_build_alias" = x && ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"` test "x$ac_build_alias" = x && - as_fn_error "cannot guess build type; you must specify one" "$LINENO" 5 + as_fn_error $? "cannot guess build type; you must specify one" "$LINENO" 5 ac_cv_build=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` || - as_fn_error "$SHELL $ac_aux_dir/config.sub $ac_build_alias failed" "$LINENO" 5 + as_fn_error $? "$SHELL $ac_aux_dir/config.sub $ac_build_alias failed" "$LINENO" 5 fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_build" >&5 $as_echo "$ac_cv_build" >&6; } case $ac_cv_build in *-*-*) ;; -*) as_fn_error "invalid value of canonical build" "$LINENO" 5;; +*) as_fn_error $? "invalid value of canonical build" "$LINENO" 5;; esac build=$ac_cv_build ac_save_IFS=$IFS; IFS='-' @@ -5712,34 +5714,8 @@ _ACEOF -if test "$with_infodock" = "yes"; then - if test ! -f ../../ID-INSTALL; then - echo "Cannot build InfoDock without InfoDock sources" - with_infodock=no - fi -fi - -if test "$with_infodock" = "yes"; then - cat >>confdefs.h <<_ACEOF -#define INFODOCK_MAJOR_VERSION $infodock_major_version -_ACEOF - - cat >>confdefs.h <<_ACEOF -#define INFODOCK_MINOR_VERSION $infodock_minor_version -_ACEOF - - cat >>confdefs.h <<_ACEOF -#define INFODOCK_BUILD_VERSION $infodock_build_version -_ACEOF - - version=${infodock_major_version}.${infodock_minor_version}.${infodock_build_version} - PROGNAME=infodock - SHEBANG_PROGNAME=infodock-script - CPPFLAGS="$CPPFLAGS -DINFODOCK" -else - PROGNAME=xemacs - SHEBANG_PROGNAME=xemacs-script -fi +PROGNAME=xemacs +SHEBANG_PROGNAME=xemacs-script @@ -6044,7 +6020,7 @@ set dummy ${ac_tool_prefix}gcc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -6084,7 +6060,7 @@ set dummy gcc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_ac_ct_CC+set}" = set; then : +if ${ac_cv_prog_ac_ct_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then @@ -6137,7 +6113,7 @@ set dummy ${ac_tool_prefix}cc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -6177,7 +6153,7 @@ set dummy cc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -6236,7 +6212,7 @@ set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -6280,7 +6256,7 @@ set dummy $ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_ac_ct_CC+set}" = set; then : +if ${ac_cv_prog_ac_ct_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then @@ -6334,8 +6310,8 @@ test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "no acceptable C compiler found in \$PATH -See \`config.log' for more details." "$LINENO" 5; } +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } # Provide some information about the compiler. $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 @@ -6449,9 +6425,8 @@ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -{ as_fn_set_status 77 -as_fn_error "C compiler cannot create executables -See \`config.log' for more details." "$LINENO" 5; }; } +as_fn_error 77 "C compiler cannot create executables +See \`config.log' for more details" "$LINENO" 5; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } @@ -6493,8 +6468,8 @@ else { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "cannot compute suffix of executables: cannot compile and link -See \`config.log' for more details." "$LINENO" 5; } +as_fn_error $? "cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details" "$LINENO" 5; } fi rm -f conftest conftest$ac_cv_exeext { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 @@ -6551,9 +6526,9 @@ else { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "cannot run C compiled programs. +as_fn_error $? "cannot run C compiled programs. If you meant to cross compile, use \`--host'. -See \`config.log' for more details." "$LINENO" 5; } +See \`config.log' for more details" "$LINENO" 5; } fi fi fi @@ -6564,7 +6539,7 @@ ac_clean_files=$ac_clean_files_save { $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 $as_echo_n "checking for suffix of object files... " >&6; } -if test "${ac_cv_objext+set}" = set; then : +if ${ac_cv_objext+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6604,8 +6579,8 @@ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "cannot compute suffix of object files: cannot compile -See \`config.log' for more details." "$LINENO" 5; } +as_fn_error $? "cannot compute suffix of object files: cannot compile +See \`config.log' for more details" "$LINENO" 5; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi @@ -6615,7 +6590,7 @@ ac_objext=$OBJEXT { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 $as_echo_n "checking whether we are using the GNU C compiler... " >&6; } -if test "${ac_cv_c_compiler_gnu+set}" = set; then : +if ${ac_cv_c_compiler_gnu+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6652,7 +6627,7 @@ ac_save_CFLAGS=$CFLAGS { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 $as_echo_n "checking whether $CC accepts -g... " >&6; } -if test "${ac_cv_prog_cc_g+set}" = set; then : +if ${ac_cv_prog_cc_g+:} false; then : $as_echo_n "(cached) " >&6 else ac_save_c_werror_flag=$ac_c_werror_flag @@ -6730,7 +6705,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 $as_echo_n "checking for $CC option to accept ISO C89... " >&6; } -if test "${ac_cv_prog_cc_c89+set}" = set; then : +if ${ac_cv_prog_cc_c89+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_prog_cc_c89=no @@ -6844,7 +6819,7 @@ CPP= fi if test -z "$CPP"; then - if test "${ac_cv_prog_CPP+set}" = set; then : + if ${ac_cv_prog_CPP+:} false; then : $as_echo_n "(cached) " >&6 else # Double quotes because CPP needs to be expanded @@ -6874,7 +6849,7 @@ # Broken: fails on valid input. continue fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. @@ -6890,11 +6865,11 @@ ac_preproc_ok=: break fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.err conftest.$ac_ext +rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok; then : break fi @@ -6933,7 +6908,7 @@ # Broken: fails on valid input. continue fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. @@ -6949,18 +6924,18 @@ ac_preproc_ok=: break fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.err conftest.$ac_ext +rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "C preprocessor \"$CPP\" fails sanity check -See \`config.log' for more details." "$LINENO" 5; } +as_fn_error $? "C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5; } fi ac_ext=c @@ -6975,7 +6950,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 $as_echo_n "checking for grep that handles long lines and -e... " >&6; } -if test "${ac_cv_path_GREP+set}" = set; then : +if ${ac_cv_path_GREP+:} false; then : $as_echo_n "(cached) " >&6 else if test -z "$GREP"; then @@ -7024,7 +6999,7 @@ done IFS=$as_save_IFS if test -z "$ac_cv_path_GREP"; then - as_fn_error "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 fi else ac_cv_path_GREP=$GREP @@ -7038,7 +7013,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 $as_echo_n "checking for egrep... " >&6; } -if test "${ac_cv_path_EGREP+set}" = set; then : +if ${ac_cv_path_EGREP+:} false; then : $as_echo_n "(cached) " >&6 else if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 @@ -7090,7 +7065,7 @@ done IFS=$as_save_IFS if test -z "$ac_cv_path_EGREP"; then - as_fn_error "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 fi else ac_cv_path_EGREP=$EGREP @@ -7105,7 +7080,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 $as_echo_n "checking for ANSI C header files... " >&6; } -if test "${ac_cv_header_stdc+set}" = set; then : +if ${ac_cv_header_stdc+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -7222,8 +7197,7 @@ as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default " -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF @@ -7235,7 +7209,7 @@ ac_fn_c_check_header_mongrel "$LINENO" "minix/config.h" "ac_cv_header_minix_config_h" "$ac_includes_default" -if test "x$ac_cv_header_minix_config_h" = x""yes; then : +if test "x$ac_cv_header_minix_config_h" = xyes; then : MINIX=yes else MINIX= @@ -7257,7 +7231,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether it is safe to define __EXTENSIONS__" >&5 $as_echo_n "checking whether it is safe to define __EXTENSIONS__... " >&6; } -if test "${ac_cv_safe_to_define___extensions__+set}" = set; then : +if ${ac_cv_safe_to_define___extensions__+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -7308,7 +7282,7 @@ set dummy ${ac_tool_prefix}gcc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -7348,7 +7322,7 @@ set dummy gcc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_ac_ct_CC+set}" = set; then : +if ${ac_cv_prog_ac_ct_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then @@ -7401,7 +7375,7 @@ set dummy ${ac_tool_prefix}cc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -7441,7 +7415,7 @@ set dummy cc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -7500,7 +7474,7 @@ set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -7544,7 +7518,7 @@ set dummy $ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_ac_ct_CC+set}" = set; then : +if ${ac_cv_prog_ac_ct_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then @@ -7598,8 +7572,8 @@ test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "no acceptable C compiler found in \$PATH -See \`config.log' for more details." "$LINENO" 5; } +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } # Provide some information about the compiler. $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 @@ -7628,7 +7602,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 $as_echo_n "checking whether we are using the GNU C compiler... " >&6; } -if test "${ac_cv_c_compiler_gnu+set}" = set; then : +if ${ac_cv_c_compiler_gnu+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -7665,7 +7639,7 @@ ac_save_CFLAGS=$CFLAGS { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 $as_echo_n "checking whether $CC accepts -g... " >&6; } -if test "${ac_cv_prog_cc_g+set}" = set; then : +if ${ac_cv_prog_cc_g+:} false; then : $as_echo_n "(cached) " >&6 else ac_save_c_werror_flag=$ac_c_werror_flag @@ -7743,7 +7717,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 $as_echo_n "checking for $CC option to accept ISO C89... " >&6; } -if test "${ac_cv_prog_cc_c89+set}" = set; then : +if ${ac_cv_prog_cc_c89+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_prog_cc_c89=no @@ -7856,7 +7830,7 @@ set dummy ${ac_tool_prefix}gcc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -7896,7 +7870,7 @@ set dummy gcc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_ac_ct_CC+set}" = set; then : +if ${ac_cv_prog_ac_ct_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then @@ -7949,7 +7923,7 @@ set dummy ${ac_tool_prefix}cc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -7989,7 +7963,7 @@ set dummy cc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -8048,7 +8022,7 @@ set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -8092,7 +8066,7 @@ set dummy $ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_ac_ct_CC+set}" = set; then : +if ${ac_cv_prog_ac_ct_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then @@ -8146,8 +8120,8 @@ test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "no acceptable C compiler found in \$PATH -See \`config.log' for more details." "$LINENO" 5; } +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } # Provide some information about the compiler. $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 @@ -8176,7 +8150,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 $as_echo_n "checking whether we are using the GNU C compiler... " >&6; } -if test "${ac_cv_c_compiler_gnu+set}" = set; then : +if ${ac_cv_c_compiler_gnu+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -8213,7 +8187,7 @@ ac_save_CFLAGS=$CFLAGS { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 $as_echo_n "checking whether $CC accepts -g... " >&6; } -if test "${ac_cv_prog_cc_g+set}" = set; then : +if ${ac_cv_prog_cc_g+:} false; then : $as_echo_n "(cached) " >&6 else ac_save_c_werror_flag=$ac_c_werror_flag @@ -8291,7 +8265,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 $as_echo_n "checking for $CC option to accept ISO C89... " >&6; } -if test "${ac_cv_prog_cc_c89+set}" = set; then : +if ${ac_cv_prog_cc_c89+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_prog_cc_c89=no @@ -8404,7 +8378,7 @@ set dummy ${ac_tool_prefix}gcc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -8444,7 +8418,7 @@ set dummy gcc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_ac_ct_CC+set}" = set; then : +if ${ac_cv_prog_ac_ct_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then @@ -8497,7 +8471,7 @@ set dummy ${ac_tool_prefix}cc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -8537,7 +8511,7 @@ set dummy cc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -8596,7 +8570,7 @@ set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -8640,7 +8614,7 @@ set dummy $ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_ac_ct_CC+set}" = set; then : +if ${ac_cv_prog_ac_ct_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then @@ -8694,8 +8668,8 @@ test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "no acceptable C compiler found in \$PATH -See \`config.log' for more details." "$LINENO" 5; } +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } # Provide some information about the compiler. $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 @@ -8724,7 +8698,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 $as_echo_n "checking whether we are using the GNU C compiler... " >&6; } -if test "${ac_cv_c_compiler_gnu+set}" = set; then : +if ${ac_cv_c_compiler_gnu+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -8761,7 +8735,7 @@ ac_save_CFLAGS=$CFLAGS { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 $as_echo_n "checking whether $CC accepts -g... " >&6; } -if test "${ac_cv_prog_cc_g+set}" = set; then : +if ${ac_cv_prog_cc_g+:} false; then : $as_echo_n "(cached) " >&6 else ac_save_c_werror_flag=$ac_c_werror_flag @@ -8839,7 +8813,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 $as_echo_n "checking for $CC option to accept ISO C89... " >&6; } -if test "${ac_cv_prog_cc_c89+set}" = set; then : +if ${ac_cv_prog_cc_c89+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_prog_cc_c89=no @@ -8944,8 +8918,8 @@ if test "$cross_compiling" = yes; then : { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "cannot run test program while cross compiling -See \`config.log' for more details." "$LINENO" 5; } +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } else cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -8965,8 +8939,8 @@ if test "$cross_compiling" = yes; then : { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "cannot run test program while cross compiling -See \`config.log' for more details." "$LINENO" 5; } +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } else cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -9030,7 +9004,7 @@ CPP= fi if test -z "$CPP"; then - if test "${ac_cv_prog_CPP+set}" = set; then : + if ${ac_cv_prog_CPP+:} false; then : $as_echo_n "(cached) " >&6 else # Double quotes because CPP needs to be expanded @@ -9060,7 +9034,7 @@ # Broken: fails on valid input. continue fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. @@ -9076,11 +9050,11 @@ ac_preproc_ok=: break fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.err conftest.$ac_ext +rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok; then : break fi @@ -9119,7 +9093,7 @@ # Broken: fails on valid input. continue fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. @@ -9135,18 +9109,18 @@ ac_preproc_ok=: break fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.err conftest.$ac_ext +rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "C preprocessor \"$CPP\" fails sanity check -See \`config.log' for more details." "$LINENO" 5; } +as_fn_error $? "C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5; } fi ac_ext=c @@ -9219,8 +9193,8 @@ if test "$cross_compiling" = yes; then : { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "cannot run test program while cross compiling -See \`config.log' for more details." "$LINENO" 5; } +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } else cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -9708,7 +9682,7 @@ $as_echo "$as_me: WARNING: Don't use -O2 with gcc 2.8.1 and egcs 1.0 under SPARC architectures" >&2;} { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: without also using -fno-schedule-insns." >&5 $as_echo "$as_me: WARNING: without also using -fno-schedule-insns." >&2;} - as_fn_error "Aborting due to known problem" "$LINENO" 5 + as_fn_error $? "Aborting due to known problem" "$LINENO" 5 ;; esac ;; @@ -9721,7 +9695,7 @@ $as_echo "$as_me: WARNING: There have been reports of egcs-1.1 not compiling XEmacs correctly on" >&2;} { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Alpha Linux. There have also been reports that egcs-1.0.3a is O.K." >&5 $as_echo "$as_me: WARNING: Alpha Linux. There have also been reports that egcs-1.0.3a is O.K." >&2;} - as_fn_error "Aborting due to known problem" "$LINENO" 5 + as_fn_error $? "Aborting due to known problem" "$LINENO" 5 ;; *:i*86*:2.7.2*) case "$CFLAGS" in @@ -9737,7 +9711,7 @@ $as_echo "$as_me: WARNING: Don't use -O2 with gcc 2.7.2 under Intel/XXX without also using" >&2;} { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: -fno-strength-reduce." >&5 $as_echo "$as_me: WARNING: -fno-strength-reduce." >&2;} - as_fn_error "Aborting due to known problem" "$LINENO" 5 + as_fn_error $? "Aborting due to known problem" "$LINENO" 5 ;; esac ;; @@ -9751,7 +9725,7 @@ $as_echo "$as_me: WARNING: Don't use -O2 with gcc 2.7.2 under Intel/XXX without also using" >&2;} { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: -fno-caller-saves." >&5 $as_echo "$as_me: WARNING: -fno-caller-saves." >&2;} - as_fn_error "Aborting due to known problem" "$LINENO" 5 + as_fn_error $? "Aborting due to known problem" "$LINENO" 5 ;; esac ;; @@ -9876,7 +9850,7 @@ done { $as_echo "$as_me:${as_lineno-$LINENO}: checking for terminateAndUnload in -lc" >&5 $as_echo_n "checking for terminateAndUnload in -lc... " >&6; } -if test "${ac_cv_lib_c_terminateAndUnload+set}" = set; then : +if ${ac_cv_lib_c_terminateAndUnload+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -9910,7 +9884,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_terminateAndUnload" >&5 $as_echo "$ac_cv_lib_c_terminateAndUnload" >&6; } -if test "x$ac_cv_lib_c_terminateAndUnload" = x""yes; then : +if test "x$ac_cv_lib_c_terminateAndUnload" = xyes; then : libs_system="$libs_system -lC" && if test "$verbose" = "yes"; then echo " Appending \"-lC\" to \$libs_system"; fi fi @@ -10231,7 +10205,7 @@ fi after_morecore_hook_exists=yes ac_fn_c_check_func "$LINENO" "malloc_set_state" "ac_cv_func_malloc_set_state" -if test "x$ac_cv_func_malloc_set_state" = x""yes; then : +if test "x$ac_cv_func_malloc_set_state" = xyes; then : else doug_lea_malloc=no @@ -10294,7 +10268,7 @@ set dummy ar; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_AR+set}" = set; then : +if ${ac_cv_prog_AR+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$AR"; then @@ -10336,7 +10310,7 @@ set dummy ${ac_tool_prefix}ranlib; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_RANLIB+set}" = set; then : +if ${ac_cv_prog_RANLIB+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$RANLIB"; then @@ -10376,7 +10350,7 @@ set dummy ranlib; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then : +if ${ac_cv_prog_ac_ct_RANLIB+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_RANLIB"; then @@ -10440,7 +10414,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5 $as_echo_n "checking for a BSD-compatible install... " >&6; } if test -z "$INSTALL"; then -if test "${ac_cv_path_install+set}" = set; then : +if ${ac_cv_path_install+:} false; then : $as_echo_n "(cached) " >&6 else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -10522,7 +10496,7 @@ set dummy $ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_YACC+set}" = set; then : +if ${ac_cv_prog_YACC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$YACC"; then @@ -10564,8 +10538,7 @@ do : as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF @@ -10576,7 +10549,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sys/wait.h that is POSIX.1 compatible" >&5 $as_echo_n "checking for sys/wait.h that is POSIX.1 compatible... " >&6; } -if test "${ac_cv_header_sys_wait_h+set}" = set; then : +if ${ac_cv_header_sys_wait_h+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -10617,7 +10590,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 $as_echo_n "checking for ANSI C header files... " >&6; } -if test "${ac_cv_header_stdc+set}" = set; then : +if ${ac_cv_header_stdc+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -10729,7 +10702,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether time.h and sys/time.h may both be included" >&5 $as_echo_n "checking whether time.h and sys/time.h may both be included... " >&6; } -if test "${ac_cv_header_time+set}" = set; then : +if ${ac_cv_header_time+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -10769,7 +10742,7 @@ #endif " -if test "x$ac_cv_have_decl_sys_siglist" = x""yes; then : +if test "x$ac_cv_have_decl_sys_siglist" = xyes; then : ac_have_decl=1 else ac_have_decl=0 @@ -10806,7 +10779,7 @@ for ac_func in utimes do : ac_fn_c_check_func "$LINENO" "utimes" "ac_cv_func_utimes" -if test "x$ac_cv_func_utimes" = x""yes; then : +if test "x$ac_cv_func_utimes" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_UTIMES 1 _ACEOF @@ -10820,7 +10793,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking return type of signal handlers" >&5 $as_echo_n "checking return type of signal handlers... " >&6; } -if test "${ac_cv_type_signal+set}" = set; then : +if ${ac_cv_type_signal+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -10852,7 +10825,7 @@ ac_fn_c_check_type "$LINENO" "size_t" "ac_cv_type_size_t" "$ac_includes_default" -if test "x$ac_cv_type_size_t" = x""yes; then : +if test "x$ac_cv_type_size_t" = xyes; then : else @@ -10863,7 +10836,7 @@ fi ac_fn_c_check_type "$LINENO" "pid_t" "ac_cv_type_pid_t" "$ac_includes_default" -if test "x$ac_cv_type_pid_t" = x""yes; then : +if test "x$ac_cv_type_pid_t" = xyes; then : else @@ -10875,7 +10848,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for uid_t in sys/types.h" >&5 $as_echo_n "checking for uid_t in sys/types.h... " >&6; } -if test "${ac_cv_type_uid_t+set}" = set; then : +if ${ac_cv_type_uid_t+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -10904,7 +10877,7 @@ fi ac_fn_c_check_type "$LINENO" "mode_t" "ac_cv_type_mode_t" "$ac_includes_default" -if test "x$ac_cv_type_mode_t" = x""yes; then : +if test "x$ac_cv_type_mode_t" = xyes; then : else @@ -10915,7 +10888,7 @@ fi ac_fn_c_check_type "$LINENO" "off_t" "ac_cv_type_off_t" "$ac_includes_default" -if test "x$ac_cv_type_off_t" = x""yes; then : +if test "x$ac_cv_type_off_t" = xyes; then : else @@ -10926,7 +10899,7 @@ fi ac_fn_c_check_type "$LINENO" "ssize_t" "ac_cv_type_ssize_t" "$ac_includes_default" -if test "x$ac_cv_type_ssize_t" = x""yes; then : +if test "x$ac_cv_type_ssize_t" = xyes; then : else @@ -11033,7 +11006,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether struct tm is in sys/time.h or time.h" >&5 $as_echo_n "checking whether struct tm is in sys/time.h or time.h... " >&6; } -if test "${ac_cv_struct_tm+set}" = set; then : +if ${ac_cv_struct_tm+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -11070,7 +11043,7 @@ #include <$ac_cv_struct_tm> " -if test "x$ac_cv_member_struct_tm_tm_zone" = x""yes; then : +if test "x$ac_cv_member_struct_tm_tm_zone" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_TM_TM_ZONE 1 @@ -11086,7 +11059,7 @@ else ac_fn_c_check_decl "$LINENO" "tzname" "ac_cv_have_decl_tzname" "#include " -if test "x$ac_cv_have_decl_tzname" = x""yes; then : +if test "x$ac_cv_have_decl_tzname" = xyes; then : ac_have_decl=1 else ac_have_decl=0 @@ -11098,7 +11071,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tzname" >&5 $as_echo_n "checking for tzname... " >&6; } -if test "${ac_cv_var_tzname+set}" = set; then : +if ${ac_cv_var_tzname+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -11136,7 +11109,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for an ANSI C-conforming const" >&5 $as_echo_n "checking for an ANSI C-conforming const... " >&6; } -if test "${ac_cv_c_const+set}" = set; then : +if ${ac_cv_c_const+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -11219,7 +11192,7 @@ $as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } set x ${MAKE-make} ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` -if { as_var=ac_cv_prog_make_${ac_make}_set; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then : $as_echo_n "(cached) " >&6 else cat >conftest.make <<\_ACEOF @@ -11227,7 +11200,7 @@ all: @echo '@@@%%%=$(MAKE)=@@@%%%' _ACEOF -# GNU make sometimes prints "make[1]: Entering...", which would confuse us. +# GNU make sometimes prints "make[1]: Entering ...", which would confuse us. case `${MAKE-make} -f conftest.make 2>/dev/null` in *@@@%%%=?*=@@@%%%*) eval ac_cv_prog_make_${ac_make}_set=yes;; @@ -11249,7 +11222,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5 $as_echo_n "checking whether byte ordering is bigendian... " >&6; } -if test "${ac_cv_c_bigendian+set}" = set; then : +if ${ac_cv_c_bigendian+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_c_bigendian=unknown @@ -11467,7 +11440,7 @@ ;; #( *) - as_fn_error "unknown endianness + as_fn_error $? "unknown endianness presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;; esac @@ -11478,7 +11451,7 @@ # This bug is HP SR number 8606223364. { $as_echo "$as_me:${as_lineno-$LINENO}: checking size of short" >&5 $as_echo_n "checking size of short... " >&6; } -if test "${ac_cv_sizeof_short+set}" = set; then : +if ${ac_cv_sizeof_short+:} false; then : $as_echo_n "(cached) " >&6 else if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (short))" "ac_cv_sizeof_short" "$ac_includes_default"; then : @@ -11487,9 +11460,8 @@ if test "$ac_cv_type_short" = yes; then { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -{ as_fn_set_status 77 -as_fn_error "cannot compute sizeof (short) -See \`config.log' for more details." "$LINENO" 5; }; } +as_fn_error 77 "cannot compute sizeof (short) +See \`config.log' for more details" "$LINENO" 5; } else ac_cv_sizeof_short=0 fi @@ -11518,7 +11490,7 @@ # This bug is HP SR number 8606223364. { $as_echo "$as_me:${as_lineno-$LINENO}: checking size of int" >&5 $as_echo_n "checking size of int... " >&6; } -if test "${ac_cv_sizeof_int+set}" = set; then : +if ${ac_cv_sizeof_int+:} false; then : $as_echo_n "(cached) " >&6 else if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (int))" "ac_cv_sizeof_int" "$ac_includes_default"; then : @@ -11527,9 +11499,8 @@ if test "$ac_cv_type_int" = yes; then { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -{ as_fn_set_status 77 -as_fn_error "cannot compute sizeof (int) -See \`config.log' for more details." "$LINENO" 5; }; } +as_fn_error 77 "cannot compute sizeof (int) +See \`config.log' for more details" "$LINENO" 5; } else ac_cv_sizeof_int=0 fi @@ -11552,7 +11523,7 @@ # This bug is HP SR number 8606223364. { $as_echo "$as_me:${as_lineno-$LINENO}: checking size of long" >&5 $as_echo_n "checking size of long... " >&6; } -if test "${ac_cv_sizeof_long+set}" = set; then : +if ${ac_cv_sizeof_long+:} false; then : $as_echo_n "(cached) " >&6 else if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (long))" "ac_cv_sizeof_long" "$ac_includes_default"; then : @@ -11561,9 +11532,8 @@ if test "$ac_cv_type_long" = yes; then { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -{ as_fn_set_status 77 -as_fn_error "cannot compute sizeof (long) -See \`config.log' for more details." "$LINENO" 5; }; } +as_fn_error 77 "cannot compute sizeof (long) +See \`config.log' for more details" "$LINENO" 5; } else ac_cv_sizeof_long=0 fi @@ -11586,7 +11556,7 @@ # This bug is HP SR number 8606223364. { $as_echo "$as_me:${as_lineno-$LINENO}: checking size of long long" >&5 $as_echo_n "checking size of long long... " >&6; } -if test "${ac_cv_sizeof_long_long+set}" = set; then : +if ${ac_cv_sizeof_long_long+:} false; then : $as_echo_n "(cached) " >&6 else if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (long long))" "ac_cv_sizeof_long_long" "$ac_includes_default"; then : @@ -11595,9 +11565,8 @@ if test "$ac_cv_type_long_long" = yes; then { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -{ as_fn_set_status 77 -as_fn_error "cannot compute sizeof (long long) -See \`config.log' for more details." "$LINENO" 5; }; } +as_fn_error 77 "cannot compute sizeof (long long) +See \`config.log' for more details" "$LINENO" 5; } else ac_cv_sizeof_long_long=0 fi @@ -11620,7 +11589,7 @@ # This bug is HP SR number 8606223364. { $as_echo "$as_me:${as_lineno-$LINENO}: checking size of void *" >&5 $as_echo_n "checking size of void *... " >&6; } -if test "${ac_cv_sizeof_void_p+set}" = set; then : +if ${ac_cv_sizeof_void_p+:} false; then : $as_echo_n "(cached) " >&6 else if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (void *))" "ac_cv_sizeof_void_p" "$ac_includes_default"; then : @@ -11629,9 +11598,8 @@ if test "$ac_cv_type_void_p" = yes; then { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -{ as_fn_set_status 77 -as_fn_error "cannot compute sizeof (void *) -See \`config.log' for more details." "$LINENO" 5; }; } +as_fn_error 77 "cannot compute sizeof (void *) +See \`config.log' for more details" "$LINENO" 5; } else ac_cv_sizeof_void_p=0 fi @@ -11654,7 +11622,7 @@ # This bug is HP SR number 8606223364. { $as_echo "$as_me:${as_lineno-$LINENO}: checking size of double" >&5 $as_echo_n "checking size of double... " >&6; } -if test "${ac_cv_sizeof_double+set}" = set; then : +if ${ac_cv_sizeof_double+:} false; then : $as_echo_n "(cached) " >&6 else if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (double))" "ac_cv_sizeof_double" "$ac_includes_default"; then : @@ -11663,9 +11631,8 @@ if test "$ac_cv_type_double" = yes; then { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -{ as_fn_set_status 77 -as_fn_error "cannot compute sizeof (double) -See \`config.log' for more details." "$LINENO" 5; }; } +as_fn_error 77 "cannot compute sizeof (double) +See \`config.log' for more details" "$LINENO" 5; } else ac_cv_sizeof_double=0 fi @@ -11685,7 +11652,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for long file names" >&5 $as_echo_n "checking for long file names... " >&6; } -if test "${ac_cv_sys_long_file_names+set}" = set; then : +if ${ac_cv_sys_long_file_names+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_sys_long_file_names=yes @@ -11725,12 +11692,12 @@ ac_fn_c_check_func "$LINENO" "sin" "ac_cv_func_sin" -if test "x$ac_cv_func_sin" = x""yes; then : +if test "x$ac_cv_func_sin" = xyes; then : else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sin in -lm" >&5 $as_echo_n "checking for sin in -lm... " >&6; } -if test "${ac_cv_lib_m_sin+set}" = set; then : +if ${ac_cv_lib_m_sin+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11764,7 +11731,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_sin" >&5 $as_echo "$ac_cv_lib_m_sin" >&6; } -if test "x$ac_cv_lib_m_sin" = x""yes; then : +if test "x$ac_cv_lib_m_sin" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBM 1 _ACEOF @@ -11797,7 +11764,7 @@ for ac_func in mkstemp do : ac_fn_c_check_func "$LINENO" "mkstemp" "ac_cv_func_mkstemp" -if test "x$ac_cv_func_mkstemp" = x""yes; then : +if test "x$ac_cv_func_mkstemp" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_MKSTEMP 1 _ACEOF @@ -11814,8 +11781,7 @@ do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF @@ -11969,7 +11935,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lgdk_imlib" >&5 $as_echo_n "checking for main in -lgdk_imlib... " >&6; } -if test "${ac_cv_lib_gdk_imlib_main+set}" = set; then : +if ${ac_cv_lib_gdk_imlib_main+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11997,13 +11963,13 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gdk_imlib_main" >&5 $as_echo "$ac_cv_lib_gdk_imlib_main" >&6; } -if test "x$ac_cv_lib_gdk_imlib_main" = x""yes; then : +if test "x$ac_cv_lib_gdk_imlib_main" = xyes; then : libs_gtk="-lgdk_imlib $libs_gtk" && if test "$verbose" = "yes"; then echo " Prepending \"-lgdk_imlib\" to \$libs_gtk"; fi fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Imlib_init in -lImlib" >&5 $as_echo_n "checking for Imlib_init in -lImlib... " >&6; } -if test "${ac_cv_lib_Imlib_Imlib_init+set}" = set; then : +if ${ac_cv_lib_Imlib_Imlib_init+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12037,14 +12003,14 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Imlib_Imlib_init" >&5 $as_echo "$ac_cv_lib_Imlib_Imlib_init" >&6; } -if test "x$ac_cv_lib_Imlib_Imlib_init" = x""yes; then : +if test "x$ac_cv_lib_Imlib_Imlib_init" = xyes; then : libs_gtk="$libs_gtk -lImlib" && if test "$verbose" = "yes"; then echo " Appending \"-lImlib\" to \$libs_gtk"; fi fi for ac_func in gdk_imlib_init do : ac_fn_c_check_func "$LINENO" "gdk_imlib_init" "ac_cv_func_gdk_imlib_init" -if test "x$ac_cv_func_gdk_imlib_init" = x""yes; then : +if test "x$ac_cv_func_gdk_imlib_init" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GDK_IMLIB_INIT 1 _ACEOF @@ -12099,8 +12065,7 @@ do : as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF @@ -12111,7 +12076,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lxml" >&5 $as_echo_n "checking for main in -lxml... " >&6; } -if test "${ac_cv_lib_xml_main+set}" = set; then : +if ${ac_cv_lib_xml_main+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12139,13 +12104,13 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_xml_main" >&5 $as_echo "$ac_cv_lib_xml_main" >&6; } -if test "x$ac_cv_lib_xml_main" = x""yes; then : +if test "x$ac_cv_lib_xml_main" = xyes; then : libs_gtk="-lxml $libs_gtk" && if test "$verbose" = "yes"; then echo " Prepending \"-lxml\" to \$libs_gtk"; fi fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lglade" >&5 $as_echo_n "checking for main in -lglade... " >&6; } -if test "${ac_cv_lib_glade_main+set}" = set; then : +if ${ac_cv_lib_glade_main+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12173,13 +12138,13 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_glade_main" >&5 $as_echo "$ac_cv_lib_glade_main" >&6; } -if test "x$ac_cv_lib_glade_main" = x""yes; then : +if test "x$ac_cv_lib_glade_main" = xyes; then : libs_gtk="-lglade $libs_gtk" && if test "$verbose" = "yes"; then echo " Prepending \"-lglade\" to \$libs_gtk"; fi fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lglade-gnome" >&5 $as_echo_n "checking for main in -lglade-gnome... " >&6; } -if test "${ac_cv_lib_glade_gnome_main+set}" = set; then : +if ${ac_cv_lib_glade_gnome_main+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12207,7 +12172,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_glade_gnome_main" >&5 $as_echo "$ac_cv_lib_glade_gnome_main" >&6; } -if test "x$ac_cv_lib_glade_gnome_main" = x""yes; then : +if test "x$ac_cv_lib_glade_gnome_main" = xyes; then : libs_gtk="-lglade-gnome $libs_gtk" && if test "$verbose" = "yes"; then echo " Prepending \"-lglade-gnome\" to \$libs_gtk"; fi fi @@ -12275,8 +12240,8 @@ have_x=disabled else case $x_includes,$x_libraries in #( - *\'*) as_fn_error "cannot use X directory names containing '" "$LINENO" 5;; #( - *,NONE | NONE,*) if test "${ac_cv_have_x+set}" = set; then : + *\'*) as_fn_error $? "cannot use X directory names containing '" "$LINENO" 5;; #( + *,NONE | NONE,*) if ${ac_cv_have_x+:} false; then : $as_echo_n "(cached) " >&6 else # One or both of the vars are not set, and there is no cached value. @@ -12293,7 +12258,7 @@ @echo libdir='${LIBDIR}' _ACEOF if (export CC; ${XMKMF-xmkmf}) >/dev/null 2>/dev/null && test -f Makefile; then - # GNU make sometimes prints "make[1]: Entering...", which would confuse us. + # GNU make sometimes prints "make[1]: Entering ...", which would confuse us. for ac_var in incroot usrlibdir libdir; do eval "ac_im_$ac_var=\`\${MAKE-make} $ac_var 2>/dev/null | sed -n 's/^$ac_var=//p'\`" done @@ -12379,7 +12344,7 @@ fi done fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext fi # $ac_x_includes = no if test "$ac_x_libraries" = no; then @@ -12553,7 +12518,7 @@ else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dnet_ntoa in -ldnet" >&5 $as_echo_n "checking for dnet_ntoa in -ldnet... " >&6; } -if test "${ac_cv_lib_dnet_dnet_ntoa+set}" = set; then : +if ${ac_cv_lib_dnet_dnet_ntoa+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12587,14 +12552,14 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dnet_dnet_ntoa" >&5 $as_echo "$ac_cv_lib_dnet_dnet_ntoa" >&6; } -if test "x$ac_cv_lib_dnet_dnet_ntoa" = x""yes; then : +if test "x$ac_cv_lib_dnet_dnet_ntoa" = xyes; then : X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet" fi if test $ac_cv_lib_dnet_dnet_ntoa = no; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dnet_ntoa in -ldnet_stub" >&5 $as_echo_n "checking for dnet_ntoa in -ldnet_stub... " >&6; } -if test "${ac_cv_lib_dnet_stub_dnet_ntoa+set}" = set; then : +if ${ac_cv_lib_dnet_stub_dnet_ntoa+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12628,7 +12593,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dnet_stub_dnet_ntoa" >&5 $as_echo "$ac_cv_lib_dnet_stub_dnet_ntoa" >&6; } -if test "x$ac_cv_lib_dnet_stub_dnet_ntoa" = x""yes; then : +if test "x$ac_cv_lib_dnet_stub_dnet_ntoa" = xyes; then : X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet_stub" fi @@ -12647,14 +12612,14 @@ # The functions gethostbyname, getservbyname, and inet_addr are # in -lbsd on LynxOS 3.0.1/i386, according to Lars Hecking. ac_fn_c_check_func "$LINENO" "gethostbyname" "ac_cv_func_gethostbyname" -if test "x$ac_cv_func_gethostbyname" = x""yes; then : +if test "x$ac_cv_func_gethostbyname" = xyes; then : fi if test $ac_cv_func_gethostbyname = no; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname in -lnsl" >&5 $as_echo_n "checking for gethostbyname in -lnsl... " >&6; } -if test "${ac_cv_lib_nsl_gethostbyname+set}" = set; then : +if ${ac_cv_lib_nsl_gethostbyname+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12688,14 +12653,14 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_nsl_gethostbyname" >&5 $as_echo "$ac_cv_lib_nsl_gethostbyname" >&6; } -if test "x$ac_cv_lib_nsl_gethostbyname" = x""yes; then : +if test "x$ac_cv_lib_nsl_gethostbyname" = xyes; then : X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl" fi if test $ac_cv_lib_nsl_gethostbyname = no; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname in -lbsd" >&5 $as_echo_n "checking for gethostbyname in -lbsd... " >&6; } -if test "${ac_cv_lib_bsd_gethostbyname+set}" = set; then : +if ${ac_cv_lib_bsd_gethostbyname+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12729,7 +12694,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bsd_gethostbyname" >&5 $as_echo "$ac_cv_lib_bsd_gethostbyname" >&6; } -if test "x$ac_cv_lib_bsd_gethostbyname" = x""yes; then : +if test "x$ac_cv_lib_bsd_gethostbyname" = xyes; then : X_EXTRA_LIBS="$X_EXTRA_LIBS -lbsd" fi @@ -12744,14 +12709,14 @@ # must be given before -lnsl if both are needed. We assume that # if connect needs -lnsl, so does gethostbyname. ac_fn_c_check_func "$LINENO" "connect" "ac_cv_func_connect" -if test "x$ac_cv_func_connect" = x""yes; then : +if test "x$ac_cv_func_connect" = xyes; then : fi if test $ac_cv_func_connect = no; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for connect in -lsocket" >&5 $as_echo_n "checking for connect in -lsocket... " >&6; } -if test "${ac_cv_lib_socket_connect+set}" = set; then : +if ${ac_cv_lib_socket_connect+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12785,7 +12750,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_socket_connect" >&5 $as_echo "$ac_cv_lib_socket_connect" >&6; } -if test "x$ac_cv_lib_socket_connect" = x""yes; then : +if test "x$ac_cv_lib_socket_connect" = xyes; then : X_EXTRA_LIBS="-lsocket $X_EXTRA_LIBS" fi @@ -12793,14 +12758,14 @@ # Guillermo Gomez says -lposix is necessary on A/UX. ac_fn_c_check_func "$LINENO" "remove" "ac_cv_func_remove" -if test "x$ac_cv_func_remove" = x""yes; then : +if test "x$ac_cv_func_remove" = xyes; then : fi if test $ac_cv_func_remove = no; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for remove in -lposix" >&5 $as_echo_n "checking for remove in -lposix... " >&6; } -if test "${ac_cv_lib_posix_remove+set}" = set; then : +if ${ac_cv_lib_posix_remove+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12834,7 +12799,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_posix_remove" >&5 $as_echo "$ac_cv_lib_posix_remove" >&6; } -if test "x$ac_cv_lib_posix_remove" = x""yes; then : +if test "x$ac_cv_lib_posix_remove" = xyes; then : X_EXTRA_LIBS="$X_EXTRA_LIBS -lposix" fi @@ -12842,14 +12807,14 @@ # BSDI BSD/OS 2.1 needs -lipc for XOpenDisplay. ac_fn_c_check_func "$LINENO" "shmat" "ac_cv_func_shmat" -if test "x$ac_cv_func_shmat" = x""yes; then : +if test "x$ac_cv_func_shmat" = xyes; then : fi if test $ac_cv_func_shmat = no; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shmat in -lipc" >&5 $as_echo_n "checking for shmat in -lipc... " >&6; } -if test "${ac_cv_lib_ipc_shmat+set}" = set; then : +if ${ac_cv_lib_ipc_shmat+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12883,7 +12848,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ipc_shmat" >&5 $as_echo "$ac_cv_lib_ipc_shmat" >&6; } -if test "x$ac_cv_lib_ipc_shmat" = x""yes; then : +if test "x$ac_cv_lib_ipc_shmat" = xyes; then : X_EXTRA_LIBS="$X_EXTRA_LIBS -lipc" fi @@ -12901,7 +12866,7 @@ # John Interrante, Karl Berry { $as_echo "$as_me:${as_lineno-$LINENO}: checking for IceConnectionNumber in -lICE" >&5 $as_echo_n "checking for IceConnectionNumber in -lICE... " >&6; } -if test "${ac_cv_lib_ICE_IceConnectionNumber+set}" = set; then : +if ${ac_cv_lib_ICE_IceConnectionNumber+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12935,7 +12900,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ICE_IceConnectionNumber" >&5 $as_echo "$ac_cv_lib_ICE_IceConnectionNumber" >&6; } -if test "x$ac_cv_lib_ICE_IceConnectionNumber" = x""yes; then : +if test "x$ac_cv_lib_ICE_IceConnectionNumber" = xyes; then : X_PRE_LIBS="$X_PRE_LIBS -lSM -lICE" fi @@ -12957,10 +12922,10 @@ SRC_SUBDIR_DEPS="$SRC_SUBDIR_DEPS lwlib" && if test "$verbose" = "yes"; then echo " Appending \"lwlib\" to \$SRC_SUBDIR_DEPS"; fi ac_fn_c_check_header_mongrel "$LINENO" "Xm/Xm.h" "ac_cv_header_Xm_Xm_h" "$ac_includes_default" -if test "x$ac_cv_header_Xm_Xm_h" = x""yes; then : +if test "x$ac_cv_header_Xm_Xm_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmStringFree in -lXm" >&5 $as_echo_n "checking for XmStringFree in -lXm... " >&6; } -if test "${ac_cv_lib_Xm_XmStringFree+set}" = set; then : +if ${ac_cv_lib_Xm_XmStringFree+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12994,7 +12959,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xm_XmStringFree" >&5 $as_echo "$ac_cv_lib_Xm_XmStringFree" >&6; } -if test "x$ac_cv_lib_Xm_XmStringFree" = x""yes; then : +if test "x$ac_cv_lib_Xm_XmStringFree" = xyes; then : got_motif=yes fi @@ -13163,17 +13128,17 @@ fi ac_fn_c_check_header_mongrel "$LINENO" "X11/Intrinsic.h" "ac_cv_header_X11_Intrinsic_h" "$ac_includes_default" -if test "x$ac_cv_header_X11_Intrinsic_h" = x""yes; then : - -else - as_fn_error "Unable to find X11 header files." "$LINENO" 5 +if test "x$ac_cv_header_X11_Intrinsic_h" = xyes; then : + +else + as_fn_error $? "Unable to find X11 header files." "$LINENO" 5 fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XOpenDisplay in -lX11" >&5 $as_echo_n "checking for XOpenDisplay in -lX11... " >&6; } -if test "${ac_cv_lib_X11_XOpenDisplay+set}" = set; then : +if ${ac_cv_lib_X11_XOpenDisplay+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13207,14 +13172,14 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_X11_XOpenDisplay" >&5 $as_echo "$ac_cv_lib_X11_XOpenDisplay" >&6; } -if test "x$ac_cv_lib_X11_XOpenDisplay" = x""yes; then : +if test "x$ac_cv_lib_X11_XOpenDisplay" = xyes; then : have_lib_x11=yes fi if test "$have_lib_x11" != "yes"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XGetFontProperty in -lX11" >&5 $as_echo_n "checking for XGetFontProperty in -lX11... " >&6; } -if test "${ac_cv_lib_X11_XGetFontProperty+set}" = set; then : +if ${ac_cv_lib_X11_XGetFontProperty+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13248,10 +13213,10 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_X11_XGetFontProperty" >&5 $as_echo "$ac_cv_lib_X11_XGetFontProperty" >&6; } -if test "x$ac_cv_lib_X11_XGetFontProperty" = x""yes; then : +if test "x$ac_cv_lib_X11_XGetFontProperty" = xyes; then : ld_switch_x_site="-b i486-linuxaout $ld_switch_x_site" else - as_fn_error "Unable to find X11 libraries." "$LINENO" 5 + as_fn_error $? "Unable to find X11 libraries." "$LINENO" 5 fi fi @@ -13260,7 +13225,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XShapeSelectInput in -lXext" >&5 $as_echo_n "checking for XShapeSelectInput in -lXext... " >&6; } -if test "${ac_cv_lib_Xext_XShapeSelectInput+set}" = set; then : +if ${ac_cv_lib_Xext_XShapeSelectInput+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13294,14 +13259,14 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xext_XShapeSelectInput" >&5 $as_echo "$ac_cv_lib_Xext_XShapeSelectInput" >&6; } -if test "x$ac_cv_lib_Xext_XShapeSelectInput" = x""yes; then : +if test "x$ac_cv_lib_Xext_XShapeSelectInput" = xyes; then : libs_x="-lXext $libs_x" && if test "$verbose" = "yes"; then echo " Prepending \"-lXext\" to \$libs_x"; fi fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XtOpenDisplay in -lXt" >&5 $as_echo_n "checking for XtOpenDisplay in -lXt... " >&6; } -if test "${ac_cv_lib_Xt_XtOpenDisplay+set}" = set; then : +if ${ac_cv_lib_Xt_XtOpenDisplay+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13335,10 +13300,10 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xt_XtOpenDisplay" >&5 $as_echo "$ac_cv_lib_Xt_XtOpenDisplay" >&6; } -if test "x$ac_cv_lib_Xt_XtOpenDisplay" = x""yes; then : +if test "x$ac_cv_lib_Xt_XtOpenDisplay" = xyes; then : libs_x="-lXt $libs_x" && if test "$verbose" = "yes"; then echo " Prepending \"-lXt\" to \$libs_x"; fi else - as_fn_error "Unable to find X11 libraries." "$LINENO" 5 + as_fn_error $? "Unable to find X11 libraries." "$LINENO" 5 fi @@ -13379,8 +13344,7 @@ do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF @@ -13393,8 +13357,7 @@ do : as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF @@ -13407,7 +13370,7 @@ for ac_func in XRegisterIMInstantiateCallback do : ac_fn_c_check_func "$LINENO" "XRegisterIMInstantiateCallback" "ac_cv_func_XRegisterIMInstantiateCallback" -if test "x$ac_cv_func_XRegisterIMInstantiateCallback" = x""yes; then : +if test "x$ac_cv_func_XRegisterIMInstantiateCallback" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_XREGISTERIMINSTANTIATECALLBACK 1 _ACEOF @@ -13439,7 +13402,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmuReadBitmapDataFromFile in -lXmu" >&5 $as_echo_n "checking for XmuReadBitmapDataFromFile in -lXmu... " >&6; } -if test "${ac_cv_lib_Xmu_XmuReadBitmapDataFromFile+set}" = set; then : +if ${ac_cv_lib_Xmu_XmuReadBitmapDataFromFile+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13473,14 +13436,14 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xmu_XmuReadBitmapDataFromFile" >&5 $as_echo "$ac_cv_lib_Xmu_XmuReadBitmapDataFromFile" >&6; } -if test "x$ac_cv_lib_Xmu_XmuReadBitmapDataFromFile" = x""yes; then : +if test "x$ac_cv_lib_Xmu_XmuReadBitmapDataFromFile" = xyes; then : with_xmu=yes else with_xmu=no fi if test "$with_xmu" = "no"; then - as_fn_error "We're sorry, but we thought there were no systems without Xmu by now. + as_fn_error $? "We're sorry, but we thought there were no systems without Xmu by now. You cannot build this version of XEmacs for X11 without Xmu. Please report this to xemacs-beta@xemacs.org. As a workaround, revert to XEmacs 21.5.29." "$LINENO" 5 else @@ -13489,7 +13452,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lXbsd" >&5 $as_echo_n "checking for main in -lXbsd... " >&6; } -if test "${ac_cv_lib_Xbsd_main+set}" = set; then : +if ${ac_cv_lib_Xbsd_main+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13517,7 +13480,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xbsd_main" >&5 $as_echo "$ac_cv_lib_Xbsd_main" >&6; } -if test "x$ac_cv_lib_Xbsd_main" = x""yes; then : +if test "x$ac_cv_lib_Xbsd_main" = xyes; then : libs_x="-lXbsd $libs_x" && if test "$verbose" = "yes"; then echo " Prepending \"-lXbsd\" to \$libs_x"; fi fi @@ -13552,7 +13515,7 @@ for ac_header in freetype/config/ftheader.h do : ac_fn_c_check_header_mongrel "$LINENO" "freetype/config/ftheader.h" "ac_cv_header_freetype_config_ftheader_h" "$ac_includes_default" -if test "x$ac_cv_header_freetype_config_ftheader_h" = x""yes; then : +if test "x$ac_cv_header_freetype_config_ftheader_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_FREETYPE_CONFIG_FTHEADER_H 1 _ACEOF @@ -13572,7 +13535,7 @@ for ac_header in freetype/config/ftheader.h do : ac_fn_c_check_header_mongrel "$LINENO" "freetype/config/ftheader.h" "ac_cv_header_freetype_config_ftheader_h" "$ac_includes_default" -if test "x$ac_cv_header_freetype_config_ftheader_h" = x""yes; then : +if test "x$ac_cv_header_freetype_config_ftheader_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_FREETYPE_CONFIG_FTHEADER_H 1 _ACEOF @@ -13595,7 +13558,7 @@ else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XRenderQueryExtension in -lXrender" >&5 $as_echo_n "checking for XRenderQueryExtension in -lXrender... " >&6; } -if test "${ac_cv_lib_Xrender_XRenderQueryExtension+set}" = set; then : +if ${ac_cv_lib_Xrender_XRenderQueryExtension+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13629,7 +13592,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xrender_XRenderQueryExtension" >&5 $as_echo "$ac_cv_lib_Xrender_XRenderQueryExtension" >&6; } -if test "x$ac_cv_lib_Xrender_XRenderQueryExtension" = x""yes; then : +if test "x$ac_cv_lib_Xrender_XRenderQueryExtension" = xyes; then : libs_x="-lXrender $libs_x" && if test "$verbose" = "yes"; then echo " Prepending \"-lXrender\" to \$libs_x"; fi else { echo "Error:" "Unable to find libXrender for --with-xft" >&2; exit 1; } @@ -13637,7 +13600,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for FcPatternCreate in -lfontconfig" >&5 $as_echo_n "checking for FcPatternCreate in -lfontconfig... " >&6; } -if test "${ac_cv_lib_fontconfig_FcPatternCreate+set}" = set; then : +if ${ac_cv_lib_fontconfig_FcPatternCreate+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13671,7 +13634,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_fontconfig_FcPatternCreate" >&5 $as_echo "$ac_cv_lib_fontconfig_FcPatternCreate" >&6; } -if test "x$ac_cv_lib_fontconfig_FcPatternCreate" = x""yes; then : +if test "x$ac_cv_lib_fontconfig_FcPatternCreate" = xyes; then : libs_x="-lfontconfig $libs_x" && if test "$verbose" = "yes"; then echo " Prepending \"-lfontconfig\" to \$libs_x"; fi else { echo "Error:" "Unable to find libfontconfig for --with-xft" >&2; exit 1; } @@ -13679,7 +13642,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XftFontOpen in -lXft" >&5 $as_echo_n "checking for XftFontOpen in -lXft... " >&6; } -if test "${ac_cv_lib_Xft_XftFontOpen+set}" = set; then : +if ${ac_cv_lib_Xft_XftFontOpen+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13713,7 +13676,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xft_XftFontOpen" >&5 $as_echo "$ac_cv_lib_Xft_XftFontOpen" >&6; } -if test "x$ac_cv_lib_Xft_XftFontOpen" = x""yes; then : +if test "x$ac_cv_lib_Xft_XftFontOpen" = xyes; then : libs_x="-lXft $libs_x" && if test "$verbose" = "yes"; then echo " Prepending \"-lXft\" to \$libs_x"; fi else { echo "Error:" "Unable to find libXft for --with-xft" >&2; exit 1; } @@ -13723,7 +13686,7 @@ for ac_func in FcConfigGetRescanInterval do : ac_fn_c_check_func "$LINENO" "FcConfigGetRescanInterval" "ac_cv_func_FcConfigGetRescanInterval" -if test "x$ac_cv_func_FcConfigGetRescanInterval" = x""yes; then : +if test "x$ac_cv_func_FcConfigGetRescanInterval" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_FCCONFIGGETRESCANINTERVAL 1 _ACEOF @@ -13734,7 +13697,7 @@ for ac_func in FcConfigSetRescanInterval do : ac_fn_c_check_func "$LINENO" "FcConfigSetRescanInterval" "ac_cv_func_FcConfigSetRescanInterval" -if test "x$ac_cv_func_FcConfigSetRescanInterval" = x""yes; then : +if test "x$ac_cv_func_FcConfigSetRescanInterval" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_FCCONFIGSETRESCANINTERVAL 1 _ACEOF @@ -13759,7 +13722,7 @@ $as_echo "" >&6; } { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lgdi32" >&5 $as_echo_n "checking for main in -lgdi32... " >&6; } -if test "${ac_cv_lib_gdi32_main+set}" = set; then : +if ${ac_cv_lib_gdi32_main+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13787,7 +13750,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gdi32_main" >&5 $as_echo "$ac_cv_lib_gdi32_main" >&6; } -if test "x$ac_cv_lib_gdi32_main" = x""yes; then : +if test "x$ac_cv_lib_gdi32_main" = xyes; then : with_msw=yes fi @@ -13818,8 +13781,8 @@ if test "$cross_compiling" = yes; then : { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "cannot run test program while cross compiling -See \`config.log' for more details." "$LINENO" 5; } +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } else cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -13885,7 +13848,7 @@ #include " -if test "x$ac_cv_header_X11_extensions_shape_h" = x""yes; then : +if test "x$ac_cv_header_X11_extensions_shape_h" = xyes; then : $as_echo "#define HAVE_BALLOON_HELP 1" >>confdefs.h @@ -13922,7 +13885,7 @@ test -z "$with_xauth" && test "$window_system" = "none" && with_xauth=no test -z "$with_xauth" && { ac_fn_c_check_header_mongrel "$LINENO" "X11/Xauth.h" "ac_cv_header_X11_Xauth_h" "$ac_includes_default" -if test "x$ac_cv_header_X11_Xauth_h" = x""yes; then : +if test "x$ac_cv_header_X11_Xauth_h" = xyes; then : else with_xauth=no @@ -13931,7 +13894,7 @@ } test -z "$with_xauth" && { { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XauGetAuthByAddr in -lXau" >&5 $as_echo_n "checking for XauGetAuthByAddr in -lXau... " >&6; } -if test "${ac_cv_lib_Xau_XauGetAuthByAddr+set}" = set; then : +if ${ac_cv_lib_Xau_XauGetAuthByAddr+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13965,7 +13928,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xau_XauGetAuthByAddr" >&5 $as_echo "$ac_cv_lib_Xau_XauGetAuthByAddr" >&6; } -if test "x$ac_cv_lib_Xau_XauGetAuthByAddr" = x""yes; then : +if test "x$ac_cv_lib_Xau_XauGetAuthByAddr" = xyes; then : : else with_xauth=no @@ -14007,7 +13970,7 @@ ;; * ) ac_fn_c_check_header_mongrel "$LINENO" "dlfcn.h" "ac_cv_header_dlfcn_h" "$ac_includes_default" -if test "x$ac_cv_header_dlfcn_h" = x""yes; then : +if test "x$ac_cv_header_dlfcn_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -lc" >&5 $as_echo_n "checking for dlopen in -lc... " >&6; } @@ -14088,7 +14051,7 @@ else ac_fn_c_check_header_mongrel "$LINENO" "dl.h" "ac_cv_header_dl_h" "$ac_includes_default" -if test "x$ac_cv_header_dl_h" = x""yes; then : +if test "x$ac_cv_header_dl_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shl_load in -lc" >&5 $as_echo_n "checking for shl_load in -lc... " >&6; } @@ -14144,7 +14107,7 @@ else ac_fn_c_check_header_mongrel "$LINENO" "ltdl.h" "ac_cv_header_ltdl_h" "$ac_includes_default" -if test "x$ac_cv_header_ltdl_h" = x""yes; then : +if test "x$ac_cv_header_ltdl_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for lt_dlinit in -lltdl" >&5 $as_echo_n "checking for lt_dlinit in -lltdl... " >&6; } @@ -14509,7 +14472,7 @@ fi if test -z "$LTLD" -a "$cc_produces_so" = no; then - as_fn_error "no acceptable linker found in \$PATH" "$LINENO" 5 + as_fn_error $? "no acceptable linker found in \$PATH" "$LINENO" 5 exit 1 fi fi @@ -14748,8 +14711,7 @@ do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF @@ -14795,8 +14757,7 @@ for dir in "" "Tt/" "desktop/" ; do as_ac_Header=`$as_echo "ac_cv_header_${dir}tt_c.h" | $as_tr_sh` ac_fn_c_check_header_mongrel "$LINENO" "${dir}tt_c.h" "$as_ac_Header" "$ac_includes_default" -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : tt_c_h_file="${dir}tt_c.h"; break fi @@ -14815,7 +14776,7 @@ for extra_libs in "" "-lI18N -lce" "-lcxx"; do { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tt_message_create in -ltt" >&5 $as_echo_n "checking for tt_message_create in -ltt... " >&6; } -if test "${ac_cv_lib_tt_tt_message_create+set}" = set; then : +if ${ac_cv_lib_tt_tt_message_create+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -14849,7 +14810,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tt_tt_message_create" >&5 $as_echo "$ac_cv_lib_tt_tt_message_create" >&6; } -if test "x$ac_cv_lib_tt_tt_message_create" = x""yes; then : +if test "x$ac_cv_lib_tt_tt_message_create" = xyes; then : tt_libs="-ltt $extra_libs"; break else : @@ -14877,7 +14838,7 @@ fi test -z "$with_cde" && { ac_fn_c_check_header_mongrel "$LINENO" "Dt/Dt.h" "ac_cv_header_Dt_Dt_h" "$ac_includes_default" -if test "x$ac_cv_header_Dt_Dt_h" = x""yes; then : +if test "x$ac_cv_header_Dt_Dt_h" = xyes; then : else with_cde=no @@ -14886,7 +14847,7 @@ } test -z "$with_cde" && { { $as_echo "$as_me:${as_lineno-$LINENO}: checking for DtDndDragStart in -lDtSvc" >&5 $as_echo_n "checking for DtDndDragStart in -lDtSvc... " >&6; } -if test "${ac_cv_lib_DtSvc_DtDndDragStart+set}" = set; then : +if ${ac_cv_lib_DtSvc_DtDndDragStart+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -14920,7 +14881,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_DtSvc_DtDndDragStart" >&5 $as_echo "$ac_cv_lib_DtSvc_DtDndDragStart" >&6; } -if test "x$ac_cv_lib_DtSvc_DtDndDragStart" = x""yes; then : +if test "x$ac_cv_lib_DtSvc_DtDndDragStart" = xyes; then : : else with_cde=no @@ -14970,7 +14931,7 @@ $as_echo "" >&6; } ldap_libs= test -z "$with_ldap" && { ac_fn_c_check_header_mongrel "$LINENO" "ldap.h" "ac_cv_header_ldap_h" "$ac_includes_default" -if test "x$ac_cv_header_ldap_h" = x""yes; then : +if test "x$ac_cv_header_ldap_h" = xyes; then : else with_ldap=no @@ -14978,7 +14939,7 @@ } test -z "$with_ldap" && { ac_fn_c_check_header_mongrel "$LINENO" "lber.h" "ac_cv_header_lber_h" "$ac_includes_default" -if test "x$ac_cv_header_lber_h" = x""yes; then : +if test "x$ac_cv_header_lber_h" = xyes; then : else with_ldap=no @@ -14988,7 +14949,7 @@ if test "$with_ldap" != "no"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ldap_search in -lldap" >&5 $as_echo_n "checking for ldap_search in -lldap... " >&6; } -if test "${ac_cv_lib_ldap_ldap_search+set}" = set; then : +if ${ac_cv_lib_ldap_ldap_search+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15022,13 +14983,13 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ldap_ldap_search" >&5 $as_echo "$ac_cv_lib_ldap_ldap_search" >&6; } -if test "x$ac_cv_lib_ldap_ldap_search" = x""yes; then : +if test "x$ac_cv_lib_ldap_ldap_search" = xyes; then : with_ldap=yes fi test "$with_ldap" != "yes" && { { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ldap_open in -lldap" >&5 $as_echo_n "checking for ldap_open in -lldap... " >&6; } -if test "${ac_cv_lib_ldap_ldap_open+set}" = set; then : +if ${ac_cv_lib_ldap_ldap_open+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15062,13 +15023,13 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ldap_ldap_open" >&5 $as_echo "$ac_cv_lib_ldap_ldap_open" >&6; } -if test "x$ac_cv_lib_ldap_ldap_open" = x""yes; then : +if test "x$ac_cv_lib_ldap_ldap_open" = xyes; then : with_ldap=yes with_ldap_lber=yes fi } test "$with_ldap" != "yes" && { { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ldap_open in -lldap" >&5 $as_echo_n "checking for ldap_open in -lldap... " >&6; } -if test "${ac_cv_lib_ldap_ldap_open+set}" = set; then : +if ${ac_cv_lib_ldap_ldap_open+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15102,13 +15063,13 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ldap_ldap_open" >&5 $as_echo "$ac_cv_lib_ldap_ldap_open" >&6; } -if test "x$ac_cv_lib_ldap_ldap_open" = x""yes; then : +if test "x$ac_cv_lib_ldap_ldap_open" = xyes; then : with_ldap=yes with_ldap_lber=yes with_ldap_krb=yes fi } test "$with_ldap" != "yes" && { { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ldap_open in -lldap" >&5 $as_echo_n "checking for ldap_open in -lldap... " >&6; } -if test "${ac_cv_lib_ldap_ldap_open+set}" = set; then : +if ${ac_cv_lib_ldap_ldap_open+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15142,13 +15103,13 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ldap_ldap_open" >&5 $as_echo "$ac_cv_lib_ldap_ldap_open" >&6; } -if test "x$ac_cv_lib_ldap_ldap_open" = x""yes; then : +if test "x$ac_cv_lib_ldap_ldap_open" = xyes; then : with_ldap=yes with_ldap_lber=yes with_ldap_krb=yes with_ldap_des=yes fi } test "$with_ldap_lber" != "yes" && { { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ber_pvt_opt_on in -llber" >&5 $as_echo_n "checking for ber_pvt_opt_on in -llber... " >&6; } -if test "${ac_cv_lib_lber_ber_pvt_opt_on+set}" = set; then : +if ${ac_cv_lib_lber_ber_pvt_opt_on+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15182,7 +15143,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_lber_ber_pvt_opt_on" >&5 $as_echo "$ac_cv_lib_lber_ber_pvt_opt_on" >&6; } -if test "x$ac_cv_lib_lber_ber_pvt_opt_on" = x""yes; then : +if test "x$ac_cv_lib_lber_ber_pvt_opt_on" = xyes; then : with_ldap_lber=yes fi } @@ -15205,8 +15166,7 @@ do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF @@ -15233,8 +15193,7 @@ for header_dir in "" "pgsql/" "postgresql/"; do as_ac_Header=`$as_echo "ac_cv_header_${header_dir}libpq-fe.h" | $as_tr_sh` ac_fn_c_check_header_mongrel "$LINENO" "${header_dir}libpq-fe.h" "$as_ac_Header" "$ac_includes_default" -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : libpq_fe_h_file=${header_dir}libpq-fe.h; break fi @@ -15246,7 +15205,7 @@ if test -n "$libpq_fe_h_file"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for PQconnectdb in -lpq" >&5 $as_echo_n "checking for PQconnectdb in -lpq... " >&6; } -if test "${ac_cv_lib_pq_PQconnectdb+set}" = set; then : +if ${ac_cv_lib_pq_PQconnectdb+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15280,14 +15239,14 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pq_PQconnectdb" >&5 $as_echo "$ac_cv_lib_pq_PQconnectdb" >&6; } -if test "x$ac_cv_lib_pq_PQconnectdb" = x""yes; then : +if test "x$ac_cv_lib_pq_PQconnectdb" = xyes; then : pq_libs="-lpq" else unset ac_cv_lib_pq_PQconnectdb; { $as_echo "$as_me:${as_lineno-$LINENO}: checking for PQconnectdb in -lpq" >&5 $as_echo_n "checking for PQconnectdb in -lpq... " >&6; } -if test "${ac_cv_lib_pq_PQconnectdb+set}" = set; then : +if ${ac_cv_lib_pq_PQconnectdb+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15321,7 +15280,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pq_PQconnectdb" >&5 $as_echo "$ac_cv_lib_pq_PQconnectdb" >&6; } -if test "x$ac_cv_lib_pq_PQconnectdb" = x""yes; then : +if test "x$ac_cv_lib_pq_PQconnectdb" = xyes; then : pq_libs="-lpq -lcrypto -lssl" fi @@ -15340,7 +15299,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for PQconnectStart in -lpq" >&5 $as_echo_n "checking for PQconnectStart in -lpq... " >&6; } -if test "${ac_cv_lib_pq_PQconnectStart+set}" = set; then : +if ${ac_cv_lib_pq_PQconnectStart+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15374,7 +15333,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pq_PQconnectStart" >&5 $as_echo "$ac_cv_lib_pq_PQconnectStart" >&6; } -if test "x$ac_cv_lib_pq_PQconnectStart" = x""yes; then : +if test "x$ac_cv_lib_pq_PQconnectStart" = xyes; then : with_postgresqlv7=yes; $as_echo "#define HAVE_POSTGRESQLV7 1" >>confdefs.h @@ -15437,8 +15396,8 @@ if test "$cross_compiling" = yes; then : { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "cannot run test program while cross compiling -See \`config.log' for more details." "$LINENO" 5; } +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } else cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -15517,7 +15476,7 @@ fi test -z "$with_xface" && { ac_fn_c_check_header_mongrel "$LINENO" "compface.h" "ac_cv_header_compface_h" "$ac_includes_default" -if test "x$ac_cv_header_compface_h" = x""yes; then : +if test "x$ac_cv_header_compface_h" = xyes; then : else with_xface=no @@ -15526,7 +15485,7 @@ } test -z "$with_xface" && { { $as_echo "$as_me:${as_lineno-$LINENO}: checking for UnGenFace in -lcompface" >&5 $as_echo_n "checking for UnGenFace in -lcompface... " >&6; } -if test "${ac_cv_lib_compface_UnGenFace+set}" = set; then : +if ${ac_cv_lib_compface_UnGenFace+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15560,7 +15519,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_compface_UnGenFace" >&5 $as_echo "$ac_cv_lib_compface_UnGenFace" >&6; } -if test "x$ac_cv_lib_compface_UnGenFace" = x""yes; then : +if test "x$ac_cv_lib_compface_UnGenFace" = xyes; then : : else with_xface=no @@ -15574,7 +15533,7 @@ fi test -z "$with_gif" && { ac_fn_c_check_header_mongrel "$LINENO" "gif_lib.h" "ac_cv_header_gif_lib_h" "$ac_includes_default" -if test "x$ac_cv_header_gif_lib_h" = x""yes; then : +if test "x$ac_cv_header_gif_lib_h" = xyes; then : else with_gif=no @@ -15585,7 +15544,7 @@ with_gif="yes" { $as_echo "$as_me:${as_lineno-$LINENO}: checking for EGifPutExtensionLast in -lgif" >&5 $as_echo_n "checking for EGifPutExtensionLast in -lgif... " >&6; } -if test "${ac_cv_lib_gif_EGifPutExtensionLast+set}" = set; then : +if ${ac_cv_lib_gif_EGifPutExtensionLast+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15619,12 +15578,12 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gif_EGifPutExtensionLast" >&5 $as_echo "$ac_cv_lib_gif_EGifPutExtensionLast" >&6; } -if test "x$ac_cv_lib_gif_EGifPutExtensionLast" = x""yes; then : +if test "x$ac_cv_lib_gif_EGifPutExtensionLast" = xyes; then : libs_x="-lgif $libs_x" && if test "$verbose" = "yes"; then echo " Prepending \"-lgif\" to \$libs_x"; fi else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for EGifPutExtensionLast in -lungif" >&5 $as_echo_n "checking for EGifPutExtensionLast in -lungif... " >&6; } -if test "${ac_cv_lib_ungif_EGifPutExtensionLast+set}" = set; then : +if ${ac_cv_lib_ungif_EGifPutExtensionLast+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15658,7 +15617,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ungif_EGifPutExtensionLast" >&5 $as_echo "$ac_cv_lib_ungif_EGifPutExtensionLast" >&6; } -if test "x$ac_cv_lib_ungif_EGifPutExtensionLast" = x""yes; then : +if test "x$ac_cv_lib_ungif_EGifPutExtensionLast" = xyes; then : libs_x="-lungif $libs_x" && if test "$verbose" = "yes"; then echo " Prepending \"-lungif\" to \$libs_x"; fi else with_gif=no @@ -15675,7 +15634,7 @@ if test "$with_png $with_tiff" != "no no"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inflate in -lc" >&5 $as_echo_n "checking for inflate in -lc... " >&6; } -if test "${ac_cv_lib_c_inflate+set}" = set; then : +if ${ac_cv_lib_c_inflate+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15709,13 +15668,13 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_inflate" >&5 $as_echo "$ac_cv_lib_c_inflate" >&6; } -if test "x$ac_cv_lib_c_inflate" = x""yes; then : +if test "x$ac_cv_lib_c_inflate" = xyes; then : : else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inflate in -lz" >&5 $as_echo_n "checking for inflate in -lz... " >&6; } -if test "${ac_cv_lib_z_inflate+set}" = set; then : +if ${ac_cv_lib_z_inflate+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15749,13 +15708,13 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_z_inflate" >&5 $as_echo "$ac_cv_lib_z_inflate" >&6; } -if test "x$ac_cv_lib_z_inflate" = x""yes; then : +if test "x$ac_cv_lib_z_inflate" = xyes; then : libs_x="-lz $libs_x" && if test "$verbose" = "yes"; then echo " Prepending \"-lz\" to \$libs_x"; fi else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inflate in -lgz" >&5 $as_echo_n "checking for inflate in -lgz... " >&6; } -if test "${ac_cv_lib_gz_inflate+set}" = set; then : +if ${ac_cv_lib_gz_inflate+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15789,7 +15748,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gz_inflate" >&5 $as_echo "$ac_cv_lib_gz_inflate" >&6; } -if test "x$ac_cv_lib_gz_inflate" = x""yes; then : +if test "x$ac_cv_lib_gz_inflate" = xyes; then : libs_x="-lgz $libs_x" && if test "$verbose" = "yes"; then echo " Prepending \"-lgz\" to \$libs_x"; fi fi @@ -15800,7 +15759,7 @@ fi test -z "$with_jpeg" && { ac_fn_c_check_header_mongrel "$LINENO" "jpeglib.h" "ac_cv_header_jpeglib_h" "$ac_includes_default" -if test "x$ac_cv_header_jpeglib_h" = x""yes; then : +if test "x$ac_cv_header_jpeglib_h" = xyes; then : else with_jpeg=no @@ -15809,7 +15768,7 @@ } test -z "$with_jpeg" && { { $as_echo "$as_me:${as_lineno-$LINENO}: checking for jpeg_destroy_decompress in -ljpeg" >&5 $as_echo_n "checking for jpeg_destroy_decompress in -ljpeg... " >&6; } -if test "${ac_cv_lib_jpeg_jpeg_destroy_decompress+set}" = set; then : +if ${ac_cv_lib_jpeg_jpeg_destroy_decompress+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15843,7 +15802,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_jpeg_jpeg_destroy_decompress" >&5 $as_echo "$ac_cv_lib_jpeg_jpeg_destroy_decompress" >&6; } -if test "x$ac_cv_lib_jpeg_jpeg_destroy_decompress" = x""yes; then : +if test "x$ac_cv_lib_jpeg_jpeg_destroy_decompress" = xyes; then : : else with_jpeg=no @@ -15858,14 +15817,14 @@ png_problem="" test -z "$with_png" && { ac_fn_c_check_func "$LINENO" "pow" "ac_cv_func_pow" -if test "x$ac_cv_func_pow" = x""yes; then : +if test "x$ac_cv_func_pow" = xyes; then : else with_png=no fi } test -z "$with_png" && { ac_fn_c_check_header_mongrel "$LINENO" "png.h" "ac_cv_header_png_h" "$ac_includes_default" -if test "x$ac_cv_header_png_h" = x""yes; then : +if test "x$ac_cv_header_png_h" = xyes; then : else with_png=no @@ -15874,7 +15833,7 @@ } test -z "$with_png" && { { $as_echo "$as_me:${as_lineno-$LINENO}: checking for png_read_image in -lpng" >&5 $as_echo_n "checking for png_read_image in -lpng... " >&6; } -if test "${ac_cv_lib_png_png_read_image+set}" = set; then : +if ${ac_cv_lib_png_png_read_image+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15908,7 +15867,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_png_png_read_image" >&5 $as_echo "$ac_cv_lib_png_png_read_image" >&6; } -if test "x$ac_cv_lib_png_png_read_image" = x""yes; then : +if test "x$ac_cv_lib_png_png_read_image" = xyes; then : : else with_png=no @@ -15921,8 +15880,8 @@ if test "$cross_compiling" = yes; then : { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "cannot run test program while cross compiling -See \`config.log' for more details." "$LINENO" 5; } +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } else cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -15967,7 +15926,7 @@ fi test -z "$with_tiff" && { ac_fn_c_check_header_mongrel "$LINENO" "tiffio.h" "ac_cv_header_tiffio_h" "$ac_includes_default" -if test "x$ac_cv_header_tiffio_h" = x""yes; then : +if test "x$ac_cv_header_tiffio_h" = xyes; then : else with_tiff=no @@ -15976,7 +15935,7 @@ } test -z "$with_tiff" && { { $as_echo "$as_me:${as_lineno-$LINENO}: checking for TIFFClientOpen in -ltiff" >&5 $as_echo_n "checking for TIFFClientOpen in -ltiff... " >&6; } -if test "${ac_cv_lib_tiff_TIFFClientOpen+set}" = set; then : +if ${ac_cv_lib_tiff_TIFFClientOpen+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -16010,7 +15969,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tiff_TIFFClientOpen" >&5 $as_echo "$ac_cv_lib_tiff_TIFFClientOpen" >&6; } -if test "x$ac_cv_lib_tiff_TIFFClientOpen" = x""yes; then : +if test "x$ac_cv_lib_tiff_TIFFClientOpen" = xyes; then : : else with_tiff=no @@ -16027,7 +15986,7 @@ if test "$with_gtk" = "yes"; then test -z "$with_xface" && { ac_fn_c_check_header_mongrel "$LINENO" "compface.h" "ac_cv_header_compface_h" "$ac_includes_default" -if test "x$ac_cv_header_compface_h" = x""yes; then : +if test "x$ac_cv_header_compface_h" = xyes; then : else with_xface=no @@ -16036,7 +15995,7 @@ } test -z "$with_xface" && { { $as_echo "$as_me:${as_lineno-$LINENO}: checking for UnGenFace in -lcompface" >&5 $as_echo_n "checking for UnGenFace in -lcompface... " >&6; } -if test "${ac_cv_lib_compface_UnGenFace+set}" = set; then : +if ${ac_cv_lib_compface_UnGenFace+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -16070,7 +16029,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_compface_UnGenFace" >&5 $as_echo "$ac_cv_lib_compface_UnGenFace" >&6; } -if test "x$ac_cv_lib_compface_UnGenFace" = x""yes; then : +if test "x$ac_cv_lib_compface_UnGenFace" = xyes; then : : else with_xface=no @@ -16120,7 +16079,7 @@ as_ac_Lib=`$as_echo "ac_cv_lib_$athena_variant''_XawScrollbarSetThumb" | $as_tr_sh` { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XawScrollbarSetThumb in -l$athena_variant" >&5 $as_echo_n "checking for XawScrollbarSetThumb in -l$athena_variant... " >&6; } -if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${$as_ac_Lib+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -16155,13 +16114,12 @@ eval ac_res=\$$as_ac_Lib { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } -eval as_val=\$$as_ac_Lib - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then : as_ac_Lib=`$as_echo "ac_cv_lib_$athena_variant''_XawSme3dComputeTopShadowRGB" | $as_tr_sh` { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XawSme3dComputeTopShadowRGB in -l$athena_variant" >&5 $as_echo_n "checking for XawSme3dComputeTopShadowRGB in -l$athena_variant... " >&6; } -if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${$as_ac_Lib+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -16196,8 +16154,7 @@ eval ac_res=\$$as_ac_Lib { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } -eval as_val=\$$as_ac_Lib - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Could not find a non-3d Athena widget library." >&5 $as_echo "$as_me: WARNING: Could not find a non-3d Athena widget library." >&2;} else @@ -16214,7 +16171,7 @@ as_ac_Lib=`$as_echo "ac_cv_lib_$athena_variant''_XawSme3dComputeTopShadowRGB" | $as_tr_sh` { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XawSme3dComputeTopShadowRGB in -l$athena_variant" >&5 $as_echo_n "checking for XawSme3dComputeTopShadowRGB in -l$athena_variant... " >&6; } -if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${$as_ac_Lib+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -16249,13 +16206,12 @@ eval ac_res=\$$as_ac_Lib { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } -eval as_val=\$$as_ac_Lib - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then : athena_lib=$athena_variant else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XawSme3dComputeTopShadowRGB in -lXaw" >&5 $as_echo_n "checking for XawSme3dComputeTopShadowRGB in -lXaw... " >&6; } -if test "${ac_cv_lib_Xaw_XawSme3dComputeTopShadowRGB+set}" = set; then : +if ${ac_cv_lib_Xaw_XawSme3dComputeTopShadowRGB+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -16289,7 +16245,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xaw_XawSme3dComputeTopShadowRGB" >&5 $as_echo "$ac_cv_lib_Xaw_XawSme3dComputeTopShadowRGB" >&6; } -if test "x$ac_cv_lib_Xaw_XawSme3dComputeTopShadowRGB" = x""yes; then : +if test "x$ac_cv_lib_Xaw_XawSme3dComputeTopShadowRGB" = xyes; then : athena_lib=Xaw; { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Assuming that libXaw is actually $athena_variant." >&5 @@ -16306,7 +16262,7 @@ if test "$athena_3d" = "no"; then ac_fn_c_check_header_mongrel "$LINENO" "X11/Xaw/ThreeD.h" "ac_cv_header_X11_Xaw_ThreeD_h" "$ac_includes_default" -if test "x$ac_cv_header_X11_Xaw_ThreeD_h" = x""yes; then : +if test "x$ac_cv_header_X11_Xaw_ThreeD_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Could not find a non-3d Athena header set." >&5 $as_echo "$as_me: WARNING: Could not find a non-3d Athena header set." >&2;} else @@ -16314,7 +16270,7 @@ #include " -if test "x$ac_cv_header_X11_Xaw_XawInit_h" = x""yes; then : +if test "x$ac_cv_header_X11_Xaw_XawInit_h" = xyes; then : athena_h_path=X11/Xaw else { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Could not find a non-3d Athena header set." >&5 @@ -16334,12 +16290,10 @@ #include " -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : as_ac_Header=`$as_echo "ac_cv_header_X11/$athena_variant/ThreeD.h" | $as_tr_sh` ac_fn_c_check_header_mongrel "$LINENO" "X11/$athena_variant/ThreeD.h" "$as_ac_Header" "$ac_includes_default" -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : athena_h_path=X11/$athena_variant fi @@ -16357,12 +16311,10 @@ #include " -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : as_ac_Header=`$as_echo "ac_cv_header_$athena_variant/ThreeD.h" | $as_tr_sh` ac_fn_c_check_header_mongrel "$LINENO" "$athena_variant/ThreeD.h" "$as_ac_Header" "$ac_includes_default" -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : athena_h_path=$athena_variant fi @@ -16380,9 +16332,9 @@ #include " -if test "x$ac_cv_header_X11_Xaw3d_XawInit_h" = x""yes; then : +if test "x$ac_cv_header_X11_Xaw3d_XawInit_h" = xyes; then : ac_fn_c_check_header_mongrel "$LINENO" "X11/Xaw3d/ThreeD.h" "ac_cv_header_X11_Xaw3d_ThreeD_h" "$ac_includes_default" -if test "x$ac_cv_header_X11_Xaw3d_ThreeD_h" = x""yes; then : +if test "x$ac_cv_header_X11_Xaw3d_ThreeD_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Assuming that X11/Xaw3d headers are suitable for $athena_variant." >&5 $as_echo "$as_me: WARNING: Assuming that X11/Xaw3d headers are suitable for $athena_variant." >&2;} @@ -16404,9 +16356,9 @@ #include " -if test "x$ac_cv_header_Xaw3d_XawInit_h" = x""yes; then : +if test "x$ac_cv_header_Xaw3d_XawInit_h" = xyes; then : ac_fn_c_check_header_mongrel "$LINENO" "Xaw3d/ThreeD.h" "ac_cv_header_Xaw3d_ThreeD_h" "$ac_includes_default" -if test "x$ac_cv_header_Xaw3d_ThreeD_h" = x""yes; then : +if test "x$ac_cv_header_Xaw3d_ThreeD_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Assuming that Xaw3d headers are suitable for $athena_variant." >&5 $as_echo "$as_me: WARNING: Assuming that Xaw3d headers are suitable for $athena_variant." >&2;} @@ -16422,7 +16374,7 @@ if test -z "$athena_h_path"; then ac_fn_c_check_header_mongrel "$LINENO" "X11/Xaw/ThreeD.h" "ac_cv_header_X11_Xaw_ThreeD_h" "$ac_includes_default" -if test "x$ac_cv_header_X11_Xaw_ThreeD_h" = x""yes; then : +if test "x$ac_cv_header_X11_Xaw_ThreeD_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Assuming that X11/Xaw headers are suitable for $athena_variant." >&5 $as_echo "$as_me: WARNING: Assuming that X11/Xaw headers are suitable for $athena_variant." >&2;} @@ -16448,10 +16400,10 @@ fi if test "$with_x11" = "yes"; then ac_fn_c_check_header_mongrel "$LINENO" "Xm/Xm.h" "ac_cv_header_Xm_Xm_h" "$ac_includes_default" -if test "x$ac_cv_header_Xm_Xm_h" = x""yes; then : +if test "x$ac_cv_header_Xm_Xm_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmStringCreate in -lXm" >&5 $as_echo_n "checking for XmStringCreate in -lXm... " >&6; } -if test "${ac_cv_lib_Xm_XmStringCreate+set}" = set; then : +if ${ac_cv_lib_Xm_XmStringCreate+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -16485,7 +16437,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xm_XmStringCreate" >&5 $as_echo "$ac_cv_lib_Xm_XmStringCreate" >&6; } -if test "x$ac_cv_lib_Xm_XmStringCreate" = x""yes; then : +if test "x$ac_cv_lib_Xm_XmStringCreate" = xyes; then : have_motif=yes else have_motif=no @@ -16747,7 +16699,7 @@ for ac_header in libintl.h do : ac_fn_c_check_header_mongrel "$LINENO" "libintl.h" "ac_cv_header_libintl_h" "$ac_includes_default" -if test "x$ac_cv_header_libintl_h" = x""yes; then : +if test "x$ac_cv_header_libintl_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBINTL_H 1 _ACEOF @@ -16758,7 +16710,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for strerror in -lintl" >&5 $as_echo_n "checking for strerror in -lintl... " >&6; } -if test "${ac_cv_lib_intl_strerror+set}" = set; then : +if ${ac_cv_lib_intl_strerror+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -16792,7 +16744,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_intl_strerror" >&5 $as_echo "$ac_cv_lib_intl_strerror" >&6; } -if test "x$ac_cv_lib_intl_strerror" = x""yes; then : +if test "x$ac_cv_lib_intl_strerror" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBINTL 1 _ACEOF @@ -16809,7 +16761,7 @@ $as_echo_n "checking for XIM... " >&6; } { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XOpenIM in -lX11" >&5 $as_echo_n "checking for XOpenIM in -lX11... " >&6; } -if test "${ac_cv_lib_X11_XOpenIM+set}" = set; then : +if ${ac_cv_lib_X11_XOpenIM+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -16843,7 +16795,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_X11_XOpenIM" >&5 $as_echo "$ac_cv_lib_X11_XOpenIM" >&6; } -if test "x$ac_cv_lib_X11_XOpenIM" = x""yes; then : +if test "x$ac_cv_lib_X11_XOpenIM" = xyes; then : with_xim=xlib else with_xim=no @@ -16852,7 +16804,7 @@ if test "$need_motif $have_lesstif" = "yes no"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmImMbLookupString in -lXm" >&5 $as_echo_n "checking for XmImMbLookupString in -lXm... " >&6; } -if test "${ac_cv_lib_Xm_XmImMbLookupString+set}" = set; then : +if ${ac_cv_lib_Xm_XmImMbLookupString+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -16886,14 +16838,14 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xm_XmImMbLookupString" >&5 $as_echo "$ac_cv_lib_Xm_XmImMbLookupString" >&6; } -if test "x$ac_cv_lib_Xm_XmImMbLookupString" = x""yes; then : +if test "x$ac_cv_lib_Xm_XmImMbLookupString" = xyes; then : with_xim=motif fi elif test "$have_motif $have_lesstif $with_xim" = "yes no no"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmImMbLookupString in -lXm" >&5 $as_echo_n "checking for XmImMbLookupString in -lXm... " >&6; } -if test "${ac_cv_lib_Xm_XmImMbLookupString+set}" = set; then : +if ${ac_cv_lib_Xm_XmImMbLookupString+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -16927,7 +16879,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xm_XmImMbLookupString" >&5 $as_echo "$ac_cv_lib_Xm_XmImMbLookupString" >&6; } -if test "x$ac_cv_lib_Xm_XmImMbLookupString" = x""yes; then : +if test "x$ac_cv_lib_Xm_XmImMbLookupString" = xyes; then : with_xim=motif fi @@ -16961,7 +16913,7 @@ $as_echo_n "checking for XFontSet... " >&6; } { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmbDrawString in -lX11" >&5 $as_echo_n "checking for XmbDrawString in -lX11... " >&6; } -if test "${ac_cv_lib_X11_XmbDrawString+set}" = set; then : +if ${ac_cv_lib_X11_XmbDrawString+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -16995,7 +16947,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_X11_XmbDrawString" >&5 $as_echo "$ac_cv_lib_X11_XmbDrawString" >&6; } -if test "x$ac_cv_lib_X11_XmbDrawString" = x""yes; then : +if test "x$ac_cv_lib_X11_XmbDrawString" = xyes; then : : else with_xfs=no @@ -17013,7 +16965,7 @@ fi test "$with_wnn6" = "yes" && with_wnn=yes # wnn6 implies wnn support test -z "$with_wnn" && { ac_fn_c_check_header_mongrel "$LINENO" "wnn/jllib.h" "ac_cv_header_wnn_jllib_h" "$ac_includes_default" -if test "x$ac_cv_header_wnn_jllib_h" = x""yes; then : +if test "x$ac_cv_header_wnn_jllib_h" = xyes; then : else with_wnn=no @@ -17021,7 +16973,7 @@ } test -z "$with_wnn" && { ac_fn_c_check_header_mongrel "$LINENO" "wnn/commonhd.h" "ac_cv_header_wnn_commonhd_h" "$ac_includes_default" -if test "x$ac_cv_header_wnn_commonhd_h" = x""yes; then : +if test "x$ac_cv_header_wnn_commonhd_h" = xyes; then : else with_wnn=no @@ -17032,7 +16984,7 @@ for ac_func in crypt do : ac_fn_c_check_func "$LINENO" "crypt" "ac_cv_func_crypt" -if test "x$ac_cv_func_crypt" = x""yes; then : +if test "x$ac_cv_func_crypt" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_CRYPT 1 _ACEOF @@ -17042,7 +16994,7 @@ test "$ac_cv_func_crypt" != "yes" && { { $as_echo "$as_me:${as_lineno-$LINENO}: checking for crypt in -lcrypt" >&5 $as_echo_n "checking for crypt in -lcrypt... " >&6; } -if test "${ac_cv_lib_crypt_crypt+set}" = set; then : +if ${ac_cv_lib_crypt_crypt+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17076,7 +17028,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_crypt_crypt" >&5 $as_echo "$ac_cv_lib_crypt_crypt" >&6; } -if test "x$ac_cv_lib_crypt_crypt" = x""yes; then : +if test "x$ac_cv_lib_crypt_crypt" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBCRYPT 1 _ACEOF @@ -17089,7 +17041,7 @@ if test -z "$with_wnn" -o "$with_wnn" = "yes"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for jl_dic_list_e in -lwnn" >&5 $as_echo_n "checking for jl_dic_list_e in -lwnn... " >&6; } -if test "${ac_cv_lib_wnn_jl_dic_list_e+set}" = set; then : +if ${ac_cv_lib_wnn_jl_dic_list_e+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17123,12 +17075,12 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_wnn_jl_dic_list_e" >&5 $as_echo "$ac_cv_lib_wnn_jl_dic_list_e" >&6; } -if test "x$ac_cv_lib_wnn_jl_dic_list_e" = x""yes; then : +if test "x$ac_cv_lib_wnn_jl_dic_list_e" = xyes; then : libwnn=wnn else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for jl_dic_list_e in -lwnn4" >&5 $as_echo_n "checking for jl_dic_list_e in -lwnn4... " >&6; } -if test "${ac_cv_lib_wnn4_jl_dic_list_e+set}" = set; then : +if ${ac_cv_lib_wnn4_jl_dic_list_e+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17162,12 +17114,12 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_wnn4_jl_dic_list_e" >&5 $as_echo "$ac_cv_lib_wnn4_jl_dic_list_e" >&6; } -if test "x$ac_cv_lib_wnn4_jl_dic_list_e" = x""yes; then : +if test "x$ac_cv_lib_wnn4_jl_dic_list_e" = xyes; then : libwnn=wnn4 else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for jl_dic_list_e in -lwnn6" >&5 $as_echo_n "checking for jl_dic_list_e in -lwnn6... " >&6; } -if test "${ac_cv_lib_wnn6_jl_dic_list_e+set}" = set; then : +if ${ac_cv_lib_wnn6_jl_dic_list_e+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17201,12 +17153,12 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_wnn6_jl_dic_list_e" >&5 $as_echo "$ac_cv_lib_wnn6_jl_dic_list_e" >&6; } -if test "x$ac_cv_lib_wnn6_jl_dic_list_e" = x""yes; then : +if test "x$ac_cv_lib_wnn6_jl_dic_list_e" = xyes; then : libwnn=wnn6 else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dic_list_e in -lwnn6_fromsrc" >&5 $as_echo_n "checking for dic_list_e in -lwnn6_fromsrc... " >&6; } -if test "${ac_cv_lib_wnn6_fromsrc_dic_list_e+set}" = set; then : +if ${ac_cv_lib_wnn6_fromsrc_dic_list_e+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17240,7 +17192,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_wnn6_fromsrc_dic_list_e" >&5 $as_echo "$ac_cv_lib_wnn6_fromsrc_dic_list_e" >&6; } -if test "x$ac_cv_lib_wnn6_fromsrc_dic_list_e" = x""yes; then : +if test "x$ac_cv_lib_wnn6_fromsrc_dic_list_e" = xyes; then : libwnn=wnn6_fromsrc else with_wnn=no @@ -17262,7 +17214,7 @@ as_ac_Lib=`$as_echo "ac_cv_lib_$libwnn''_jl_fi_dic_list" | $as_tr_sh` { $as_echo "$as_me:${as_lineno-$LINENO}: checking for jl_fi_dic_list in -l$libwnn" >&5 $as_echo_n "checking for jl_fi_dic_list in -l$libwnn... " >&6; } -if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${$as_ac_Lib+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17297,8 +17249,7 @@ eval ac_res=\$$as_ac_Lib { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } -eval as_val=\$$as_ac_Lib - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then : with_wnn6=yes fi @@ -17319,9 +17270,9 @@ # using $ac_header_compiler is a hack, but autoconf doesn't let us # get at this information otherwise :-( ac_fn_c_check_header_mongrel "$LINENO" "canna/jrkanji.h" "ac_cv_header_canna_jrkanji_h" "$ac_includes_default" -if test "x$ac_cv_header_canna_jrkanji_h" = x""yes; then : +if test "x$ac_cv_header_canna_jrkanji_h" = xyes; then : ac_fn_c_check_header_mongrel "$LINENO" "canna/RK.h" "ac_cv_header_canna_RK_h" "$ac_includes_default" -if test "x$ac_cv_header_canna_RK_h" = x""yes; then : +if test "x$ac_cv_header_canna_RK_h" = xyes; then : have_canna=$ac_header_compiler fi @@ -17348,7 +17299,7 @@ test "$have_canna" = "yes" && { { $as_echo "$as_me:${as_lineno-$LINENO}: checking for RkBgnBun in -lRKC" >&5 $as_echo_n "checking for RkBgnBun in -lRKC... " >&6; } -if test "${ac_cv_lib_RKC_RkBgnBun+set}" = set; then : +if ${ac_cv_lib_RKC_RkBgnBun+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17382,7 +17333,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_RKC_RkBgnBun" >&5 $as_echo "$ac_cv_lib_RKC_RkBgnBun" >&6; } -if test "x$ac_cv_lib_RKC_RkBgnBun" = x""yes; then : +if test "x$ac_cv_lib_RKC_RkBgnBun" = xyes; then : : else have_canna=no @@ -17390,7 +17341,7 @@ } test "$have_canna" = "yes" && { { $as_echo "$as_me:${as_lineno-$LINENO}: checking for jrKanjiControl in -lcanna" >&5 $as_echo_n "checking for jrKanjiControl in -lcanna... " >&6; } -if test "${ac_cv_lib_canna_jrKanjiControl+set}" = set; then : +if ${ac_cv_lib_canna_jrKanjiControl+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17424,7 +17375,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_canna_jrKanjiControl" >&5 $as_echo "$ac_cv_lib_canna_jrKanjiControl" >&6; } -if test "x$ac_cv_lib_canna_jrKanjiControl" = x""yes; then : +if test "x$ac_cv_lib_canna_jrKanjiControl" = xyes; then : : else have_canna=no @@ -17462,7 +17413,7 @@ libs_x="-lXm $libs_x" && if test "$verbose" = "yes"; then echo " Prepending \"-lXm\" to \$libs_x"; fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for layout_object_getvalue in -li18n" >&5 $as_echo_n "checking for layout_object_getvalue in -li18n... " >&6; } -if test "${ac_cv_lib_i18n_layout_object_getvalue+set}" = set; then : +if ${ac_cv_lib_i18n_layout_object_getvalue+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17496,7 +17447,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_i18n_layout_object_getvalue" >&5 $as_echo "$ac_cv_lib_i18n_layout_object_getvalue" >&6; } -if test "x$ac_cv_lib_i18n_layout_object_getvalue" = x""yes; then : +if test "x$ac_cv_lib_i18n_layout_object_getvalue" = xyes; then : libs_x="-li18n $libs_x" && if test "$verbose" = "yes"; then echo " Prepending \"-li18n\" to \$libs_x"; fi fi @@ -17567,7 +17518,7 @@ *cygwin* ) for ac_func in cygwin_conv_path do : ac_fn_c_check_func "$LINENO" "cygwin_conv_path" "ac_cv_func_cygwin_conv_path" -if test "x$ac_cv_func_cygwin_conv_path" = x""yes; then : +if test "x$ac_cv_func_cygwin_conv_path" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_CYGWIN_CONV_PATH 1 _ACEOF @@ -17583,8 +17534,7 @@ do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF @@ -17605,14 +17555,14 @@ if test "$check_vdb_posix" = "yes" ; then ac_fn_c_check_func "$LINENO" "mprotect" "ac_cv_func_mprotect" -if test "x$ac_cv_func_mprotect" = x""yes; then : +if test "x$ac_cv_func_mprotect" = xyes; then : $as_echo "#define HAVE_MPROTECT 1" >>confdefs.h have_vdb_mprotect=yes fi ac_fn_c_check_func "$LINENO" "sigaction" "ac_cv_func_sigaction" -if test "x$ac_cv_func_sigaction" = x""yes; then : +if test "x$ac_cv_func_sigaction" = xyes; then : $as_echo "#define HAVE_SIGACTION 1" >>confdefs.h have_vdb_sigaction=yes else @@ -17621,14 +17571,14 @@ ac_fn_c_check_member "$LINENO" "struct siginfo" "si_addr" "ac_cv_member_struct_siginfo_si_addr" "#include " -if test "x$ac_cv_member_struct_siginfo_si_addr" = x""yes; then : +if test "x$ac_cv_member_struct_siginfo_si_addr" = xyes; then : $as_echo "#define HAVE_STRUCT_SIGINFO_SI_ADDR 1" >>confdefs.h have_si_addr=yes fi ac_fn_c_check_member "$LINENO" "siginfo_t" "si_addr" "ac_cv_member_siginfo_t_si_addr" "#include " -if test "x$ac_cv_member_siginfo_t_si_addr" = x""yes; then : +if test "x$ac_cv_member_siginfo_t_si_addr" = xyes; then : $as_echo "#define HAVE_SIGINFO_T_SI_ADDR 1" >>confdefs.h have_si_addr=yes fi @@ -17638,14 +17588,14 @@ fi ac_fn_c_check_func "$LINENO" "signal" "ac_cv_func_signal" -if test "x$ac_cv_func_signal" = x""yes; then : +if test "x$ac_cv_func_signal" = xyes; then : $as_echo "#define HAVE_SIGNAL 1" >>confdefs.h have_vdb_signal=yes fi ac_fn_c_check_member "$LINENO" "struct sigcontext" "cr2" "ac_cv_member_struct_sigcontext_cr2" "#include " -if test "x$ac_cv_member_struct_sigcontext_cr2" = x""yes; then : +if test "x$ac_cv_member_struct_sigcontext_cr2" = xyes; then : $as_echo "#define HAVE_STRUCT_SIGCONTEXT_CR2 1" >>confdefs.h have_cr2=yes fi @@ -17676,8 +17626,7 @@ do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF @@ -17687,13 +17636,13 @@ ac_fn_c_check_func "$LINENO" "openpty" "ac_cv_func_openpty" -if test "x$ac_cv_func_openpty" = x""yes; then : +if test "x$ac_cv_func_openpty" = xyes; then : have_openpty=yes else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for openpty in -lutil" >&5 $as_echo_n "checking for openpty in -lutil... " >&6; } -if test "${ac_cv_lib_util_openpty+set}" = set; then : +if ${ac_cv_lib_util_openpty+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17727,7 +17676,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_util_openpty" >&5 $as_echo "$ac_cv_lib_util_openpty" >&6; } -if test "x$ac_cv_lib_util_openpty" = x""yes; then : +if test "x$ac_cv_lib_util_openpty" = xyes; then : have_openpty=yes need_libutil=yes fi @@ -17740,8 +17689,7 @@ do : as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF @@ -17757,7 +17705,7 @@ hpux*) for ac_header in sys/ptyio.h do : ac_fn_c_check_header_mongrel "$LINENO" "sys/ptyio.h" "ac_cv_header_sys_ptyio_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_ptyio_h" = x""yes; then : +if test "x$ac_cv_header_sys_ptyio_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_SYS_PTYIO_H 1 _ACEOF @@ -17769,7 +17717,7 @@ *) for ac_header in pty.h do : ac_fn_c_check_header_mongrel "$LINENO" "pty.h" "ac_cv_header_pty_h" "$ac_includes_default" -if test "x$ac_cv_header_pty_h" = x""yes; then : +if test "x$ac_cv_header_pty_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_PTY_H 1 _ACEOF @@ -17781,7 +17729,7 @@ test "$ac_cv_header_pty_h" = "no" && for ac_header in sys/pty.h do : ac_fn_c_check_header_mongrel "$LINENO" "sys/pty.h" "ac_cv_header_sys_pty_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_pty_h" = x""yes; then : +if test "x$ac_cv_header_sys_pty_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_SYS_PTY_H 1 _ACEOF @@ -17796,7 +17744,7 @@ for ac_header in stropts.h do : ac_fn_c_check_header_mongrel "$LINENO" "stropts.h" "ac_cv_header_stropts_h" "$ac_includes_default" -if test "x$ac_cv_header_stropts_h" = x""yes; then : +if test "x$ac_cv_header_stropts_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STROPTS_H 1 _ACEOF @@ -17809,7 +17757,7 @@ for ac_func in isastream do : ac_fn_c_check_func "$LINENO" "isastream" "ac_cv_func_isastream" -if test "x$ac_cv_func_isastream" = x""yes; then : +if test "x$ac_cv_func_isastream" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_ISASTREAM 1 _ACEOF @@ -17820,7 +17768,7 @@ for ac_header in strtio.h do : ac_fn_c_check_header_mongrel "$LINENO" "strtio.h" "ac_cv_header_strtio_h" "$ac_includes_default" -if test "x$ac_cv_header_strtio_h" = x""yes; then : +if test "x$ac_cv_header_strtio_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRTIO_H 1 _ACEOF @@ -17833,7 +17781,7 @@ for ac_func in getloadavg do : ac_fn_c_check_func "$LINENO" "getloadavg" "ac_cv_func_getloadavg" -if test "x$ac_cv_func_getloadavg" = x""yes; then : +if test "x$ac_cv_func_getloadavg" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GETLOADAVG 1 _ACEOF @@ -17846,7 +17794,7 @@ for ac_header in sys/loadavg.h do : ac_fn_c_check_header_mongrel "$LINENO" "sys/loadavg.h" "ac_cv_header_sys_loadavg_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_loadavg_h" = x""yes; then : +if test "x$ac_cv_header_sys_loadavg_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_SYS_LOADAVG_H 1 _ACEOF @@ -17862,7 +17810,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for kstat_open in -lkstat" >&5 $as_echo_n "checking for kstat_open in -lkstat... " >&6; } -if test "${ac_cv_lib_kstat_kstat_open+set}" = set; then : +if ${ac_cv_lib_kstat_kstat_open+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17896,7 +17844,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_kstat_kstat_open" >&5 $as_echo "$ac_cv_lib_kstat_kstat_open" >&6; } -if test "x$ac_cv_lib_kstat_kstat_open" = x""yes; then : +if test "x$ac_cv_lib_kstat_kstat_open" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBKSTAT 1 _ACEOF @@ -17908,7 +17856,7 @@ for ac_header in kstat.h do : ac_fn_c_check_header_mongrel "$LINENO" "kstat.h" "ac_cv_header_kstat_h" "$ac_includes_default" -if test "x$ac_cv_header_kstat_h" = x""yes; then : +if test "x$ac_cv_header_kstat_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KSTAT_H 1 _ACEOF @@ -17920,7 +17868,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for kvm_read in -lkvm" >&5 $as_echo_n "checking for kvm_read in -lkvm... " >&6; } -if test "${ac_cv_lib_kvm_kvm_read+set}" = set; then : +if ${ac_cv_lib_kvm_kvm_read+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17954,7 +17902,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_kvm_kvm_read" >&5 $as_echo "$ac_cv_lib_kvm_kvm_read" >&6; } -if test "x$ac_cv_lib_kvm_kvm_read" = x""yes; then : +if test "x$ac_cv_lib_kvm_kvm_read" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBKVM 1 _ACEOF @@ -18016,7 +17964,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether localtime caches TZ" >&5 $as_echo_n "checking whether localtime caches TZ... " >&6; } -if test "${emacs_cv_localtime_cache+set}" = set; then : +if ${emacs_cv_localtime_cache+:} false; then : $as_echo_n "(cached) " >&6 else if test "$ac_cv_func_tzset" = "yes"; then @@ -18125,7 +18073,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inline" >&5 $as_echo_n "checking for inline... " >&6; } -if test "${ac_cv_c_inline+set}" = set; then : +if ${ac_cv_c_inline+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_c_inline=no @@ -18205,7 +18153,7 @@ # for constant arguments. Useless! { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working alloca.h" >&5 $as_echo_n "checking for working alloca.h... " >&6; } -if test "${ac_cv_working_alloca_h+set}" = set; then : +if ${ac_cv_working_alloca_h+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -18238,7 +18186,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for alloca" >&5 $as_echo_n "checking for alloca... " >&6; } -if test "${ac_cv_func_alloca_works+set}" = set; then : +if ${ac_cv_func_alloca_works+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -18257,7 +18205,7 @@ #pragma alloca # else # ifndef alloca /* predefined by HP cc +Olibcalls */ -char *alloca (); +void *alloca (size_t); # endif # endif # endif @@ -18301,7 +18249,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether \`alloca.c' needs Cray hooks" >&5 $as_echo_n "checking whether \`alloca.c' needs Cray hooks... " >&6; } -if test "${ac_cv_os_cray+set}" = set; then : +if ${ac_cv_os_cray+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -18328,8 +18276,7 @@ for ac_func in _getb67 GETB67 getb67; do as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define CRAY_STACKSEG_END $ac_func @@ -18343,7 +18290,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking stack direction for C alloca" >&5 $as_echo_n "checking stack direction for C alloca... " >&6; } -if test "${ac_cv_c_stack_direction+set}" = set; then : +if ${ac_cv_c_stack_direction+:} false; then : $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then : @@ -18401,8 +18348,8 @@ if test "$cross_compiling" = yes; then : { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "cannot run test program while cross compiling -See \`config.log' for more details." "$LINENO" 5; } +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } else cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -18477,8 +18424,8 @@ if test "$cross_compiling" = yes; then : { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "cannot run test program while cross compiling -See \`config.log' for more details." "$LINENO" 5; } +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } else cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -18512,7 +18459,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working strcoll" >&5 $as_echo_n "checking for working strcoll... " >&6; } -if test "${ac_cv_func_strcoll_works+set}" = set; then : +if ${ac_cv_func_strcoll_works+:} false; then : $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then : @@ -18553,7 +18500,7 @@ for ac_func in getpgrp do : ac_fn_c_check_func "$LINENO" "getpgrp" "ac_cv_func_getpgrp" -if test "x$ac_cv_func_getpgrp" = x""yes; then : +if test "x$ac_cv_func_getpgrp" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GETPGRP 1 _ACEOF @@ -18563,7 +18510,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether getpgrp requires zero arguments" >&5 $as_echo_n "checking whether getpgrp requires zero arguments... " >&6; } -if test "${ac_cv_func_getpgrp_void+set}" = set; then : +if ${ac_cv_func_getpgrp_void+:} false; then : $as_echo_n "(cached) " >&6 else # Use it with a single arg. @@ -18600,8 +18547,8 @@ if test "$cross_compiling" = yes; then : { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "cannot run test program while cross compiling -See \`config.log' for more details." "$LINENO" 5; } +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } else cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -18690,7 +18637,7 @@ ac_fn_c_check_header_mongrel "$LINENO" "termios.h" "ac_cv_header_termios_h" "$ac_includes_default" -if test "x$ac_cv_header_termios_h" = x""yes; then : +if test "x$ac_cv_header_termios_h" = xyes; then : $as_echo "#define HAVE_TERMIOS 1" >>confdefs.h $as_echo "#define SIGNALS_VIA_CHARACTERS 1" >>confdefs.h @@ -18699,7 +18646,7 @@ else ac_fn_c_check_header_mongrel "$LINENO" "termio.h" "ac_cv_header_termio_h" "$ac_includes_default" -if test "x$ac_cv_header_termio_h" = x""yes; then : +if test "x$ac_cv_header_termio_h" = xyes; then : $as_echo "#define HAVE_TERMIO 1" >>confdefs.h fi @@ -18711,11 +18658,11 @@ ac_fn_c_check_func "$LINENO" "socket" "ac_cv_func_socket" -if test "x$ac_cv_func_socket" = x""yes; then : +if test "x$ac_cv_func_socket" = xyes; then : ac_fn_c_check_header_mongrel "$LINENO" "netinet/in.h" "ac_cv_header_netinet_in_h" "$ac_includes_default" -if test "x$ac_cv_header_netinet_in_h" = x""yes; then : +if test "x$ac_cv_header_netinet_in_h" = xyes; then : ac_fn_c_check_header_mongrel "$LINENO" "arpa/inet.h" "ac_cv_header_arpa_inet_h" "$ac_includes_default" -if test "x$ac_cv_header_arpa_inet_h" = x""yes; then : +if test "x$ac_cv_header_arpa_inet_h" = xyes; then : $as_echo "#define HAVE_SOCKETS 1" >>confdefs.h @@ -18782,11 +18729,11 @@ ac_fn_c_check_func "$LINENO" "msgget" "ac_cv_func_msgget" -if test "x$ac_cv_func_msgget" = x""yes; then : +if test "x$ac_cv_func_msgget" = xyes; then : ac_fn_c_check_header_mongrel "$LINENO" "sys/ipc.h" "ac_cv_header_sys_ipc_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_ipc_h" = x""yes; then : +if test "x$ac_cv_header_sys_ipc_h" = xyes; then : ac_fn_c_check_header_mongrel "$LINENO" "sys/msg.h" "ac_cv_header_sys_msg_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_msg_h" = x""yes; then : +if test "x$ac_cv_header_sys_msg_h" = xyes; then : $as_echo "#define HAVE_SYSVIPC 1" >>confdefs.h fi @@ -18799,12 +18746,12 @@ ac_fn_c_check_header_mongrel "$LINENO" "dirent.h" "ac_cv_header_dirent_h" "$ac_includes_default" -if test "x$ac_cv_header_dirent_h" = x""yes; then : +if test "x$ac_cv_header_dirent_h" = xyes; then : $as_echo "#define SYSV_SYSTEM_DIR 1" >>confdefs.h else ac_fn_c_check_header_mongrel "$LINENO" "sys/dir.h" "ac_cv_header_sys_dir_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_dir_h" = x""yes; then : +if test "x$ac_cv_header_sys_dir_h" = xyes; then : else $as_echo "#define NONSYSTEM_DIR_LIBRARY 1" >>confdefs.h @@ -18817,7 +18764,7 @@ ac_fn_c_check_header_mongrel "$LINENO" "nlist.h" "ac_cv_header_nlist_h" "$ac_includes_default" -if test "x$ac_cv_header_nlist_h" = x""yes; then : +if test "x$ac_cv_header_nlist_h" = xyes; then : $as_echo "#define NLIST_STRUCT 1" >>confdefs.h fi @@ -18834,7 +18781,7 @@ if test "$with_sound_native" != "no"; then if test -n "$with_native_sound_lib"; then ac_fn_c_check_header_mongrel "$LINENO" "multimedia/audio_device.h" "ac_cv_header_multimedia_audio_device_h" "$ac_includes_default" -if test "x$ac_cv_header_multimedia_audio_device_h" = x""yes; then : +if test "x$ac_cv_header_multimedia_audio_device_h" = xyes; then : sound_found=yes sound_cflags="" extra_objs="$extra_objs sunplay.o" && if test "$verbose" = "yes"; then echo " xemacs will be linked with \"sunplay.o\"" @@ -18875,7 +18822,7 @@ if test -z "$with_native_sound_lib"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ALopenport in -laudio" >&5 $as_echo_n "checking for ALopenport in -laudio... " >&6; } -if test "${ac_cv_lib_audio_ALopenport+set}" = set; then : +if ${ac_cv_lib_audio_ALopenport+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -18909,7 +18856,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_audio_ALopenport" >&5 $as_echo "$ac_cv_lib_audio_ALopenport" >&6; } -if test "x$ac_cv_lib_audio_ALopenport" = x""yes; then : +if test "x$ac_cv_lib_audio_ALopenport" = xyes; then : with_native_sound_lib="-laudio" fi @@ -18924,7 +18871,7 @@ if test -z "$with_native_sound_lib"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for AOpenAudio in -lAlib" >&5 $as_echo_n "checking for AOpenAudio in -lAlib... " >&6; } -if test "${ac_cv_lib_Alib_AOpenAudio+set}" = set; then : +if ${ac_cv_lib_Alib_AOpenAudio+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -18958,7 +18905,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Alib_AOpenAudio" >&5 $as_echo "$ac_cv_lib_Alib_AOpenAudio" >&6; } -if test "x$ac_cv_lib_Alib_AOpenAudio" = x""yes; then : +if test "x$ac_cv_lib_Alib_AOpenAudio" = xyes; then : with_native_sound_lib="-lAlib" fi @@ -18991,8 +18938,7 @@ for dir in "machine" "sys" "linux"; do as_ac_Header=`$as_echo "ac_cv_header_${dir}/soundcard.h" | $as_tr_sh` ac_fn_c_check_header_mongrel "$LINENO" "${dir}/soundcard.h" "$as_ac_Header" "$ac_includes_default" -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : sound_found=yes case "${ac_cv_build}" in @@ -19003,7 +18949,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _oss_ioctl in -lossaudio" >&5 $as_echo_n "checking for _oss_ioctl in -lossaudio... " >&6; } -if test "${ac_cv_lib_ossaudio__oss_ioctl+set}" = set; then : +if ${ac_cv_lib_ossaudio__oss_ioctl+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -19037,7 +18983,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ossaudio__oss_ioctl" >&5 $as_echo "$ac_cv_lib_ossaudio__oss_ioctl" >&6; } -if test "x$ac_cv_lib_ossaudio__oss_ioctl" = x""yes; then : +if test "x$ac_cv_lib_ossaudio__oss_ioctl" = xyes; then : with_native_sound_lib=-lossaudio { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Using NetBSD-deprecated -lossaudio" >&5 $as_echo "$as_me: WARNING: Using NetBSD-deprecated -lossaudio" >&2;} @@ -19084,11 +19030,11 @@ if test "$with_sound_alsa" != "no"; then ac_fn_c_check_header_mongrel "$LINENO" "alsa/input.h" "ac_cv_header_alsa_input_h" "$ac_includes_default" -if test "x$ac_cv_header_alsa_input_h" = x""yes; then : +if test "x$ac_cv_header_alsa_input_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for snd_pcm_open in -lasound" >&5 $as_echo_n "checking for snd_pcm_open in -lasound... " >&6; } -if test "${ac_cv_lib_asound_snd_pcm_open+set}" = set; then : +if ${ac_cv_lib_asound_snd_pcm_open+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -19122,7 +19068,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_asound_snd_pcm_open" >&5 $as_echo "$ac_cv_lib_asound_snd_pcm_open" >&6; } -if test "x$ac_cv_lib_asound_snd_pcm_open" = x""yes; then : +if test "x$ac_cv_lib_asound_snd_pcm_open" = xyes; then : have_alsa_sound=yes fi @@ -19146,11 +19092,11 @@ if test "$with_sound_nas" != "no"; then ac_fn_c_check_header_mongrel "$LINENO" "audio/audiolib.h" "ac_cv_header_audio_audiolib_h" "$ac_includes_default" -if test "x$ac_cv_header_audio_audiolib_h" = x""yes; then : +if test "x$ac_cv_header_audio_audiolib_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for AuOpenServer in -laudio" >&5 $as_echo_n "checking for AuOpenServer in -laudio... " >&6; } -if test "${ac_cv_lib_audio_AuOpenServer+set}" = set; then : +if ${ac_cv_lib_audio_AuOpenServer+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -19184,7 +19130,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_audio_AuOpenServer" >&5 $as_echo "$ac_cv_lib_audio_AuOpenServer" >&6; } -if test "x$ac_cv_lib_audio_AuOpenServer" = x""yes; then : +if test "x$ac_cv_lib_audio_AuOpenServer" = xyes; then : have_nas_sound=yes fi @@ -19225,7 +19171,7 @@ set dummy esd-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_have_esd_config+set}" = set; then : +if ${ac_cv_prog_have_esd_config+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$have_esd_config"; then @@ -19264,7 +19210,7 @@ c_switch_site="$c_switch_site `esd-config --cflags`" && if test "$verbose" = "yes"; then echo " Appending \"`esd-config --cflags`\" to \$c_switch_site"; fi LIBS="`esd-config --libs` $LIBS" && if test "$verbose" = "yes"; then echo " Prepending \"`esd-config --libs`\" to \$LIBS"; fi ac_fn_c_check_func "$LINENO" "esd_play_stream" "ac_cv_func_esd_play_stream" -if test "x$ac_cv_func_esd_play_stream" = x""yes; then : +if test "x$ac_cv_func_esd_play_stream" = xyes; then : have_esd_sound=yes else c_switch_site="$save_c_switch_site" LIBS="$save_LIBS" @@ -19305,7 +19251,7 @@ if test -z "$with_ncurses"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tgetent in -lncurses" >&5 $as_echo_n "checking for tgetent in -lncurses... " >&6; } -if test "${ac_cv_lib_ncurses_tgetent+set}" = set; then : +if ${ac_cv_lib_ncurses_tgetent+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -19339,7 +19285,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ncurses_tgetent" >&5 $as_echo "$ac_cv_lib_ncurses_tgetent" >&6; } -if test "x$ac_cv_lib_ncurses_tgetent" = x""yes; then : +if test "x$ac_cv_lib_ncurses_tgetent" = xyes; then : with_ncurses=yes else with_ncurses=no @@ -19350,13 +19296,13 @@ $as_echo "#define HAVE_NCURSES 1" >>confdefs.h ac_fn_c_check_header_mongrel "$LINENO" "ncurses/curses.h" "ac_cv_header_ncurses_curses_h" "$ac_includes_default" -if test "x$ac_cv_header_ncurses_curses_h" = x""yes; then : +if test "x$ac_cv_header_ncurses_curses_h" = xyes; then : curses_h_file=ncurses/curses.h fi ac_fn_c_check_header_mongrel "$LINENO" "ncurses/term.h" "ac_cv_header_ncurses_term_h" "$ac_includes_default" -if test "x$ac_cv_header_ncurses_term_h" = x""yes; then : +if test "x$ac_cv_header_ncurses_term_h" = xyes; then : term_h_file=ncurses/term.h fi @@ -19370,7 +19316,7 @@ save_c_switch_site="$c_switch_site" c_switch_site="$c_switch_site -I/usr/include/ncurses" ac_fn_c_check_header_mongrel "$LINENO" "ncurses/curses.h" "ac_cv_header_ncurses_curses_h" "$ac_includes_default" -if test "x$ac_cv_header_ncurses_curses_h" = x""yes; then : +if test "x$ac_cv_header_ncurses_curses_h" = xyes; then : curses_h_file=ncurses/curses.h fi @@ -19392,7 +19338,7 @@ as_ac_Lib=`$as_echo "ac_cv_lib_$lib''_tgetent" | $as_tr_sh` { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tgetent in -l$lib" >&5 $as_echo_n "checking for tgetent in -l$lib... " >&6; } -if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${$as_ac_Lib+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -19427,8 +19373,7 @@ eval ac_res=\$$as_ac_Lib { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } -eval as_val=\$$as_ac_Lib - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then : LIBS="-l${lib} $LIBS" && if test "$verbose" = "yes"; then echo " Prepending \"-l${lib}\" to \$LIBS"; fi; break fi @@ -19443,7 +19388,7 @@ else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tgetent in -lcurses" >&5 $as_echo_n "checking for tgetent in -lcurses... " >&6; } -if test "${ac_cv_lib_curses_tgetent+set}" = set; then : +if ${ac_cv_lib_curses_tgetent+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -19477,12 +19422,12 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_curses_tgetent" >&5 $as_echo "$ac_cv_lib_curses_tgetent" >&6; } -if test "x$ac_cv_lib_curses_tgetent" = x""yes; then : +if test "x$ac_cv_lib_curses_tgetent" = xyes; then : LIBS="-lcurses $LIBS" && if test "$verbose" = "yes"; then echo " Prepending \"-lcurses\" to \$LIBS"; fi else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tgetent in -ltermcap" >&5 $as_echo_n "checking for tgetent in -ltermcap... " >&6; } -if test "${ac_cv_lib_termcap_tgetent+set}" = set; then : +if ${ac_cv_lib_termcap_tgetent+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -19516,7 +19461,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_termcap_tgetent" >&5 $as_echo "$ac_cv_lib_termcap_tgetent" >&6; } -if test "x$ac_cv_lib_termcap_tgetent" = x""yes; then : +if test "x$ac_cv_lib_termcap_tgetent" = xyes; then : LIBS="-ltermcap $LIBS" && if test "$verbose" = "yes"; then echo " Prepending \"-ltermcap\" to \$LIBS"; fi else extra_objs="$extra_objs termcap.o" && if test "$verbose" = "yes"; then @@ -19540,11 +19485,11 @@ if test "$with_gpm" != "no"; then ac_fn_c_check_header_mongrel "$LINENO" "gpm.h" "ac_cv_header_gpm_h" "$ac_includes_default" -if test "x$ac_cv_header_gpm_h" = x""yes; then : +if test "x$ac_cv_header_gpm_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Gpm_Open in -lgpm" >&5 $as_echo_n "checking for Gpm_Open in -lgpm... " >&6; } -if test "${ac_cv_lib_gpm_Gpm_Open+set}" = set; then : +if ${ac_cv_lib_gpm_Gpm_Open+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -19578,7 +19523,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gpm_Gpm_Open" >&5 $as_echo "$ac_cv_lib_gpm_Gpm_Open" >&6; } -if test "x$ac_cv_lib_gpm_Gpm_Open" = x""yes; then : +if test "x$ac_cv_lib_gpm_Gpm_Open" = xyes; then : have_gpm=yes fi @@ -19618,8 +19563,7 @@ do : as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF @@ -19639,7 +19583,7 @@ if test "$with_database_gdbm" != "no"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dbm_open in -lgdbm" >&5 $as_echo_n "checking for dbm_open in -lgdbm... " >&6; } -if test "${ac_cv_lib_gdbm_dbm_open+set}" = set; then : +if ${ac_cv_lib_gdbm_dbm_open+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -19673,14 +19617,14 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gdbm_dbm_open" >&5 $as_echo "$ac_cv_lib_gdbm_dbm_open" >&6; } -if test "x$ac_cv_lib_gdbm_dbm_open" = x""yes; then : +if test "x$ac_cv_lib_gdbm_dbm_open" = xyes; then : with_database_gdbm=yes with_database_dbm=no libdbm=-lgdbm else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dbm_open in -lgdbm_compat" >&5 $as_echo_n "checking for dbm_open in -lgdbm_compat... " >&6; } -if test "${ac_cv_lib_gdbm_compat_dbm_open+set}" = set; then : +if ${ac_cv_lib_gdbm_compat_dbm_open+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -19714,7 +19658,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gdbm_compat_dbm_open" >&5 $as_echo "$ac_cv_lib_gdbm_compat_dbm_open" >&6; } -if test "x$ac_cv_lib_gdbm_compat_dbm_open" = x""yes; then : +if test "x$ac_cv_lib_gdbm_compat_dbm_open" = xyes; then : with_database_gdbm=yes with_database_dbm=no libdbm="-lgdbm_compat -lgdbm" else @@ -19732,13 +19676,13 @@ if test "$with_database_dbm" != "no"; then ac_fn_c_check_func "$LINENO" "dbm_open" "ac_cv_func_dbm_open" -if test "x$ac_cv_func_dbm_open" = x""yes; then : +if test "x$ac_cv_func_dbm_open" = xyes; then : with_database_dbm=yes libdbm= else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dbm_open in -ldbm" >&5 $as_echo_n "checking for dbm_open in -ldbm... " >&6; } -if test "${ac_cv_lib_dbm_dbm_open+set}" = set; then : +if ${ac_cv_lib_dbm_dbm_open+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -19772,7 +19716,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dbm_dbm_open" >&5 $as_echo "$ac_cv_lib_dbm_dbm_open" >&6; } -if test "x$ac_cv_lib_dbm_dbm_open" = x""yes; then : +if test "x$ac_cv_lib_dbm_dbm_open" = xyes; then : with_database_dbm=yes libdbm=-ldbm else @@ -19825,7 +19769,7 @@ set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CXX+set}" = set; then : +if ${ac_cv_prog_CXX+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CXX"; then @@ -19869,7 +19813,7 @@ set dummy $ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_ac_ct_CXX+set}" = set; then : +if ${ac_cv_prog_ac_ct_CXX+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CXX"; then @@ -19947,7 +19891,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C++ compiler" >&5 $as_echo_n "checking whether we are using the GNU C++ compiler... " >&6; } -if test "${ac_cv_cxx_compiler_gnu+set}" = set; then : +if ${ac_cv_cxx_compiler_gnu+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -19984,7 +19928,7 @@ ac_save_CXXFLAGS=$CXXFLAGS { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CXX accepts -g" >&5 $as_echo_n "checking whether $CXX accepts -g... " >&6; } -if test "${ac_cv_prog_cxx_g+set}" = set; then : +if ${ac_cv_prog_cxx_g+:} false; then : $as_echo_n "(cached) " >&6 else ac_save_cxx_werror_flag=$ac_cxx_werror_flag @@ -20112,7 +20056,7 @@ fi ac_fn_c_check_type "$LINENO" "u_int8_t" "ac_cv_type_u_int8_t" "$ac_includes_default" -if test "x$ac_cv_type_u_int8_t" = x""yes; then : +if test "x$ac_cv_type_u_int8_t" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_U_INT8_T 1 @@ -20121,7 +20065,7 @@ fi ac_fn_c_check_type "$LINENO" "u_int16_t" "ac_cv_type_u_int16_t" "$ac_includes_default" -if test "x$ac_cv_type_u_int16_t" = x""yes; then : +if test "x$ac_cv_type_u_int16_t" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_U_INT16_T 1 @@ -20130,7 +20074,7 @@ fi ac_fn_c_check_type "$LINENO" "u_int32_t" "ac_cv_type_u_int32_t" "$ac_includes_default" -if test "x$ac_cv_type_u_int32_t" = x""yes; then : +if test "x$ac_cv_type_u_int32_t" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_U_INT32_T 1 @@ -20241,15 +20185,14 @@ as_ac_var=`$as_echo "ac_cv_func_$dbfunc" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$dbfunc" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : with_database_berkdb=yes need_libdb=no else as_ac_Lib=`$as_echo "ac_cv_lib_db_$dbfunc" | $as_tr_sh` { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $dbfunc in -ldb" >&5 $as_echo_n "checking for $dbfunc in -ldb... " >&6; } -if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${$as_ac_Lib+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -20284,8 +20227,7 @@ eval ac_res=\$$as_ac_Lib { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } -eval as_val=\$$as_ac_Lib - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then : with_database_berkdb=yes need_libdb=yes fi @@ -20305,7 +20247,7 @@ as_ac_Lib=`$as_echo "ac_cv_lib_db_$dbfunc" | $as_tr_sh` { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $dbfunc in -ldb" >&5 $as_echo_n "checking for $dbfunc in -ldb... " >&6; } -if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${$as_ac_Lib+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -20340,8 +20282,7 @@ eval ac_res=\$$as_ac_Lib { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } -eval as_val=\$$as_ac_Lib - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then : with_database_berkdb=yes need_libdb=yes fi @@ -20368,7 +20309,7 @@ if test "$with_socks" = "yes"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for SOCKSinit in -lsocks" >&5 $as_echo_n "checking for SOCKSinit in -lsocks... " >&6; } -if test "${ac_cv_lib_socks_SOCKSinit+set}" = set; then : +if ${ac_cv_lib_socks_SOCKSinit+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -20402,7 +20343,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_socks_SOCKSinit" >&5 $as_echo "$ac_cv_lib_socks_SOCKSinit" >&6; } -if test "x$ac_cv_lib_socks_SOCKSinit" = x""yes; then : +if test "x$ac_cv_lib_socks_SOCKSinit" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBSOCKS 1 _ACEOF @@ -20423,11 +20364,11 @@ if test "$with_bignum" = "gmp"; then ac_fn_c_check_header_mongrel "$LINENO" "gmp.h" "ac_cv_header_gmp_h" "$ac_includes_default" -if test "x$ac_cv_header_gmp_h" = x""yes; then : +if test "x$ac_cv_header_gmp_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __gmpz_init in -lgmp" >&5 $as_echo_n "checking for __gmpz_init in -lgmp... " >&6; } -if test "${ac_cv_lib_gmp___gmpz_init+set}" = set; then : +if ${ac_cv_lib_gmp___gmpz_init+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -20461,7 +20402,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gmp___gmpz_init" >&5 $as_echo "$ac_cv_lib_gmp___gmpz_init" >&6; } -if test "x$ac_cv_lib_gmp___gmpz_init" = x""yes; then : +if test "x$ac_cv_lib_gmp___gmpz_init" = xyes; then : have_mpz_init=yes fi @@ -20480,11 +20421,11 @@ elif test "$with_bignum" = "mp"; then for library in "" "-lcrypto"; do ac_fn_c_check_header_mongrel "$LINENO" "mp.h" "ac_cv_header_mp_h" "$ac_includes_default" -if test "x$ac_cv_header_mp_h" = x""yes; then : +if test "x$ac_cv_header_mp_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mp_mfree in -lmp" >&5 $as_echo_n "checking for mp_mfree in -lmp... " >&6; } -if test "${ac_cv_lib_mp_mp_mfree+set}" = set; then : +if ${ac_cv_lib_mp_mp_mfree+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -20518,13 +20459,13 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mp_mp_mfree" >&5 $as_echo "$ac_cv_lib_mp_mp_mfree" >&6; } -if test "x$ac_cv_lib_mp_mp_mfree" = x""yes; then : +if test "x$ac_cv_lib_mp_mp_mfree" = xyes; then : have_mp_mfree=yes; break else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mfree in -lmp" >&5 $as_echo_n "checking for mfree in -lmp... " >&6; } -if test "${ac_cv_lib_mp_mfree+set}" = set; then : +if ${ac_cv_lib_mp_mfree+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -20558,7 +20499,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mp_mfree" >&5 $as_echo "$ac_cv_lib_mp_mfree" >&6; } -if test "x$ac_cv_lib_mp_mfree" = x""yes; then : +if test "x$ac_cv_lib_mp_mfree" = xyes; then : have_mfree=yes; break fi @@ -20576,7 +20517,7 @@ LIBS="$LIBS $library" && if test "$verbose" = "yes"; then echo " Appending \"$library\" to \$LIBS"; fi fi ac_fn_c_check_func "$LINENO" "mp_move" "ac_cv_func_mp_move" -if test "x$ac_cv_func_mp_move" = x""yes; then : +if test "x$ac_cv_func_mp_move" = xyes; then : $as_echo "#define HAVE_MP_MOVE 1" >>confdefs.h fi @@ -20587,7 +20528,7 @@ LIBS="$LIBS $library" && if test "$verbose" = "yes"; then echo " Appending \"$library\" to \$LIBS"; fi fi ac_fn_c_check_func "$LINENO" "move" "ac_cv_func_move" -if test "x$ac_cv_func_move" = x""yes; then : +if test "x$ac_cv_func_move" = xyes; then : $as_echo "#define HAVE_MP_MOVE 1" >>confdefs.h fi @@ -20604,8 +20545,8 @@ if test "$cross_compiling" = yes; then : { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "cannot run test program while cross compiling -See \`config.log' for more details." "$LINENO" 5; } +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } else cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -21509,10 +21450,21 @@ :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then - test "x$cache_file" != "x/dev/null" && + if test "x$cache_file" != "x/dev/null"; then { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 $as_echo "$as_me: updating cache $cache_file" >&6;} - cat confcache >$cache_file + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi else { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 $as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} @@ -21528,6 +21480,7 @@ ac_libobjs= ac_ltlibobjs= +U= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' @@ -21544,7 +21497,7 @@ -: ${CONFIG_STATUS=./config.status} +: "${CONFIG_STATUS=./config.status}" ac_write_fail=0 ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" @@ -21645,6 +21598,7 @@ IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. +as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -21690,19 +21644,19 @@ (unset CDPATH) >/dev/null 2>&1 && unset CDPATH -# as_fn_error ERROR [LINENO LOG_FD] -# --------------------------------- +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the -# script with status $?, using 1 if that was 0. +# script with STATUS, using 1 if that was 0. as_fn_error () { - as_status=$?; test $as_status -eq 0 && as_status=1 - if test "$3"; then - as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3 - fi - $as_echo "$as_me: error: $1" >&2 + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 as_fn_exit $as_status } # as_fn_error @@ -21898,7 +21852,7 @@ test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" - } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" } # as_fn_mkdir_p @@ -21952,7 +21906,7 @@ # values after options handling. ac_log=" This file was extended by XEmacs $as_me 21.5, which was -generated by GNU Autoconf 2.65. Invocation command line was +generated by GNU Autoconf 2.68. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS @@ -22018,10 +21972,10 @@ ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ XEmacs config.status 21.5 -configured by $0, generated by GNU Autoconf 2.65, +configured by $0, generated by GNU Autoconf 2.68, with options \\"\$ac_cs_config\\" -Copyright (C) 2009 Free Software Foundation, Inc. +Copyright (C) 2010 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." @@ -22037,11 +21991,16 @@ while test $# != 0 do case $1 in - --*=*) + --*=?*) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ac_shift=: ;; + --*=) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + ac_shift=: + ;; *) ac_option=$1 ac_optarg=$2 @@ -22063,6 +22022,7 @@ $ac_shift case $ac_optarg in *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; esac as_fn_append CONFIG_FILES " '$ac_optarg'" ac_need_defaults=false;; @@ -22075,7 +22035,7 @@ ac_need_defaults=false;; --he | --h) # Conflict between --help and --header - as_fn_error "ambiguous option: \`$1' + as_fn_error $? "ambiguous option: \`$1' Try \`$0 --help' for more information.";; --help | --hel | -h ) $as_echo "$ac_cs_usage"; exit ;; @@ -22084,7 +22044,7 @@ ac_cs_silent=: ;; # This is an error. - -*) as_fn_error "unrecognized option: \`$1' + -*) as_fn_error $? "unrecognized option: \`$1' Try \`$0 --help' for more information." ;; *) as_fn_append ac_config_targets " $1" @@ -22149,7 +22109,7 @@ "lib-src/ellcc.h") CONFIG_FILES="$CONFIG_FILES lib-src/ellcc.h" ;; "default") CONFIG_COMMANDS="$CONFIG_COMMANDS default" ;; - *) as_fn_error "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; esac done @@ -22172,9 +22132,10 @@ # after its creation but before its name has been assigned to `$tmp'. $debug || { - tmp= + tmp= ac_tmp= trap 'exit_status=$? - { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status ' 0 trap 'as_fn_exit 1' 1 2 13 15 } @@ -22182,12 +22143,13 @@ { tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && - test -n "$tmp" && test -d "$tmp" + test -d "$tmp" } || { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp") -} || as_fn_error "cannot create a temporary directory in ." "$LINENO" 5 +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp # Set up the scripts for CONFIG_FILES section. # No need to generate them if there are no CONFIG_FILES. @@ -22204,12 +22166,12 @@ fi ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then - ac_cs_awk_cr='\r' + ac_cs_awk_cr='\\r' else ac_cs_awk_cr=$ac_cr fi -echo 'BEGIN {' >"$tmp/subs1.awk" && +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && _ACEOF @@ -22218,18 +22180,18 @@ echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && echo "_ACEOF" } >conf$$subs.sh || - as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5 -ac_delim_num=`echo "$ac_subst_vars" | grep -c '$'` + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` ac_delim='%!_!# ' for ac_last_try in false false false false false :; do . ./conf$$subs.sh || - as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5 + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` if test $ac_delim_n = $ac_delim_num; then break elif $ac_last_try; then - as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5 + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi @@ -22237,7 +22199,7 @@ rm -f conf$$subs.sh cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -cat >>"\$tmp/subs1.awk" <<\\_ACAWK && +cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && _ACEOF sed -n ' h @@ -22285,7 +22247,7 @@ rm -f conf$$subs.awk cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 _ACAWK -cat >>"\$tmp/subs1.awk" <<_ACAWK && +cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && for (key in S) S_is_set[key] = 1 FS = "" @@ -22317,21 +22279,29 @@ sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" else cat -fi < "$tmp/subs1.awk" > "$tmp/subs.awk" \ - || as_fn_error "could not setup config files machinery" "$LINENO" 5 -_ACEOF - -# VPATH may cause trouble with some makes, so we remove $(srcdir), -# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ + || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 +_ACEOF + +# VPATH may cause trouble with some makes, so we remove sole $(srcdir), +# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then - ac_vpsub='/^[ ]*VPATH[ ]*=/{ -s/:*\$(srcdir):*/:/ -s/:*\${srcdir}:*/:/ -s/:*@srcdir@:*/:/ -s/^\([^=]*=[ ]*\):*/\1/ + ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ +h +s/// +s/^/:/ +s/[ ]*$/:/ +s/:\$(srcdir):/:/g +s/:\${srcdir}:/:/g +s/:@srcdir@:/:/g +s/^:*// s/:*$// +x +s/\(=[ ]*\).*/\1/ +G +s/\n// s/^[^=]*=[ ]*$// }' fi @@ -22343,7 +22313,7 @@ # No need to generate them if there are no CONFIG_HEADERS. # This happens for instance with `./config.status Makefile'. if test -n "$CONFIG_HEADERS"; then -cat >"$tmp/defines.awk" <<\_ACAWK || +cat >"$ac_tmp/defines.awk" <<\_ACAWK || BEGIN { _ACEOF @@ -22355,11 +22325,11 @@ # handling of long lines. ac_delim='%!_!# ' for ac_last_try in false false :; do - ac_t=`sed -n "/$ac_delim/p" confdefs.h` - if test -z "$ac_t"; then + ac_tt=`sed -n "/$ac_delim/p" confdefs.h` + if test -z "$ac_tt"; then break elif $ac_last_try; then - as_fn_error "could not make $CONFIG_HEADERS" "$LINENO" 5 + as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5 else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi @@ -22444,7 +22414,7 @@ _ACAWK _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 - as_fn_error "could not setup config headers machinery" "$LINENO" 5 + as_fn_error $? "could not setup config headers machinery" "$LINENO" 5 fi # test -n "$CONFIG_HEADERS" @@ -22457,7 +22427,7 @@ esac case $ac_mode$ac_tag in :[FHL]*:*);; - :L* | :C*:*) as_fn_error "invalid tag \`$ac_tag'" "$LINENO" 5;; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac @@ -22476,7 +22446,7 @@ for ac_f do case $ac_f in - -) ac_f="$tmp/stdin";; + -) ac_f="$ac_tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, # because $ac_f cannot contain `:'. @@ -22485,7 +22455,7 @@ [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || - as_fn_error "cannot find input file: \`$ac_f'" "$LINENO" 5;; + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; esac case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac as_fn_append ac_file_inputs " '$ac_f'" @@ -22511,8 +22481,8 @@ esac case $ac_tag in - *:-:* | *:-) cat >"$tmp/stdin" \ - || as_fn_error "could not create $ac_file" "$LINENO" 5 ;; + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; esac ;; esac @@ -22642,23 +22612,24 @@ s&@INSTALL@&$ac_INSTALL&;t t $ac_datarootdir_hack " -eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$tmp/subs.awk" >$tmp/out \ - || as_fn_error "could not create $ac_file" "$LINENO" 5 +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ + >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && - { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } && - { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } && + { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ + "$ac_tmp/out"`; test -z "$ac_out"; } && { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' -which seems to be undefined. Please make sure it is defined." >&5 +which seems to be undefined. Please make sure it is defined" >&5 $as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' -which seems to be undefined. Please make sure it is defined." >&2;} - - rm -f "$tmp/stdin" +which seems to be undefined. Please make sure it is defined" >&2;} + + rm -f "$ac_tmp/stdin" case $ac_file in - -) cat "$tmp/out" && rm -f "$tmp/out";; - *) rm -f "$ac_file" && mv "$tmp/out" "$ac_file";; + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; esac \ - || as_fn_error "could not create $ac_file" "$LINENO" 5 + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; :H) # @@ -22667,21 +22638,21 @@ if test x"$ac_file" != x-; then { $as_echo "/* $configure_input */" \ - && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs" - } >"$tmp/config.h" \ - || as_fn_error "could not create $ac_file" "$LINENO" 5 - if diff "$ac_file" "$tmp/config.h" >/dev/null 2>&1; then + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" + } >"$ac_tmp/config.h" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5 $as_echo "$as_me: $ac_file is unchanged" >&6;} else rm -f "$ac_file" - mv "$tmp/config.h" "$ac_file" \ - || as_fn_error "could not create $ac_file" "$LINENO" 5 + mv "$ac_tmp/config.h" "$ac_file" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 fi else $as_echo "/* $configure_input */" \ - && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs" \ - || as_fn_error "could not create -" "$LINENO" 5 + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \ + || as_fn_error $? "could not create -" "$LINENO" 5 fi ;; @@ -22848,7 +22819,7 @@ ac_clean_files=$ac_clean_files_save test $ac_write_fail = 0 || - as_fn_error "write failure creating $CONFIG_STATUS" "$LINENO" 5 + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 # configure is writing to config.log, and then calls config.status. @@ -22869,7 +22840,7 @@ exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. - $ac_cs_success || as_fn_exit $? + $ac_cs_success || as_fn_exit 1 fi if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 diff -r 861f2601a38b -r 1f0b15040456 configure.ac --- a/configure.ac Sat Feb 20 06:03:00 2010 -0600 +++ b/configure.ac Sun May 01 18:44:03 2011 +0100 @@ -63,20 +63,18 @@ 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 +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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to the Free -Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -Boston, MA 02110-1301, USA. +along with XEmacs. If not, see . For usage, run `./configure --help' For more detailed information on building and installing XEmacs, @@ -977,9 +975,6 @@ XE_MERGED_ARG([sparcworks], AS_HELP_STRING([--with-sparcworks],[Alias for --with-workshop]), [], []) -XE_MERGED_ARG([infodock], - AS_HELP_STRING([--with-infodock],[Support the Infodock version of XEmacs. Infodock is a SourceForge project).]), - [], []) dnl XE_HELP_SUBSECTION([Debugging options]) XE_MERGED_ARG([debug], @@ -1032,13 +1027,13 @@ AS_HELP_STRING([--with-quick-build],[Speed up the build cycle by leaving out steps where XEmacs will still work (more or less) without them. Potentially dangerous if you don't know what you're - doing. This (1) doesn't garbage-collect after loading - each file during dumping, (2) doesn't + doing. This (1) Doesn't garbage-collect after loading + each file during dumping, (2) Doesn't automatically rebuild the DOC file (remove it by hand to get it rebuilt), (3) Removes config.h, lisp.h and associated files from the dependency lists, so changes to these files don't automatically cause all .c files - to be rebuilt.]), + to be rebuilt, (4) Doesn't check for Lisp shadows.]), [], []) XE_MERGED_ARG([union-type], AS_HELP_STRING([--with-union-type],[Use union definition of Lisp_Object type. Known to trigger bugs in some compilers.]), @@ -1108,6 +1103,7 @@ AC_DEFINE(INFODIR_USER_DEFINED) AC_DEFINE(LISPDIR_USER_DEFINED) AC_DEFINE(ETCDIR_USER_DEFINED) + AC_DEFINE(LATE_PACKAGE_DIRECTORIES_USER_DEFINED) fi if test "x$libdir" != "x\${exec_prefix}/lib" @@ -1128,6 +1124,7 @@ inststaticdir='${PROGNAME}' instvardir='${PROGNAME}-${version}' sitemoduledir='${libdir}/${inststaticdir}/site-modules' +with_late_packages='${datadir}/${PROGNAME}' AC_SUBST(inststaticdir) AC_SUBST(statedir,$with_statedir) @@ -1226,27 +1223,8 @@ fi AC_DEFINE_UNQUOTED(EMACS_VERSION, "$version") -if test "$with_infodock" = "yes"; then - if test ! -f ../../ID-INSTALL; then - echo "Cannot build InfoDock without InfoDock sources" - with_infodock=no - fi -fi - -if test "$with_infodock" = "yes"; then - dnl InfoDock version numbers. XEmacs will use the same style of numbering - dnl after the release of XEmacs 21.0. - AC_DEFINE_UNQUOTED(INFODOCK_MAJOR_VERSION, $infodock_major_version) - AC_DEFINE_UNQUOTED(INFODOCK_MINOR_VERSION, $infodock_minor_version) - AC_DEFINE_UNQUOTED(INFODOCK_BUILD_VERSION, $infodock_build_version) - version=${infodock_major_version}.${infodock_minor_version}.${infodock_build_version} - PROGNAME=infodock - SHEBANG_PROGNAME=infodock-script - CPPFLAGS="$CPPFLAGS -DINFODOCK" -else - PROGNAME=xemacs - SHEBANG_PROGNAME=xemacs-script -fi +PROGNAME=xemacs +SHEBANG_PROGNAME=xemacs-script AC_SUBST(SHEBANG_PROGNAME) @@ -4489,7 +4467,7 @@ dnl We define our own getloadavg() using lower level functions. XE_ADD_OBJS(getloadavg.o) - dnl Used by getloadavg() - does not require root priveleges + dnl Used by getloadavg() - does not require root privileges AC_CHECK_LIB(kstat, kstat_open) AC_CHECK_HEADERS(kstat.h) diff -r 861f2601a38b -r 1f0b15040456 etc/COPYING --- a/etc/COPYING Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/COPYING Sun May 01 18:44:03 2011 +0100 @@ -1,286 +1,626 @@ - GNU GENERAL PUBLIC LICENSE - Version 2, June 1991 + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 - Copyright (C) 1989, 1991 Free Software Foundation, Inc. - 59 Temple Place - Suite 330 - Boston, MA 02111-1307, USA. + Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. - Preamble + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -License is intended to guarantee your freedom to share and change free -software--to make sure the software is free for all its users. This -General Public License applies to most of the Free Software -Foundation's software and to any other program whose authors commit to -using it. (Some other Free Software Foundation software is covered by -the GNU Library General Public License instead.) You can apply it to + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for -this service if you wish), that you receive source code or can get it -if you want it, that you can change the software or use pieces of it -in new free programs; and that you know you can do these things. +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. - To protect your rights, we need to make restrictions that forbid -anyone to deny you these rights or to ask you to surrender the rights. -These restrictions translate to certain responsibilities for you if you -distribute copies of the software, or if you modify it. + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. For example, if you distribute copies of such a program, whether -gratis or for a fee, you must give the recipients all the rights that -you have. You must make sure that they, too, receive or can get the -source code. And you must show them these terms so they know their -rights. +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. - We protect your rights with two steps: (1) copyright the software, and -(2) offer you this license which gives you legal permission to copy, -distribute and/or modify the software. + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. - Also, for each author's protection and ours, we want to make certain -that everyone understands that there is no warranty for this free -software. If the software is modified by someone else and passed on, we -want its recipients to know that what they have is not the original, so -that any problems introduced by others will not reflect on the original -authors' reputations. + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. - Finally, any free program is threatened constantly by software -patents. We wish to avoid the danger that redistributors of a free -program will individually obtain patent licenses, in effect making the -program proprietary. To prevent this, we have made it clear that any -patent must be licensed for everyone's free use or not licensed at all. + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. The precise terms and conditions for copying, distribution and modification follow. - - GNU GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. - 0. This License applies to any program or other work which contains -a notice placed by the copyright holder saying it may be distributed -under the terms of this General Public License. The "Program", below, -refers to any such program or work, and a "work based on the Program" -means either the Program or any derivative work under copyright law: -that is to say, a work containing the Program or a portion of it, -either verbatim or with modifications and/or translated into another -language. (Hereinafter, translation is included without limitation in -the term "modification".) Each licensee is addressed as "you". + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. -Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running the Program is not restricted, and the output from the Program -is covered only if its contents constitute a work based on the -Program (independent of having been made by running the Program). -Whether that is true depends on what the Program does. + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. - 1. You may copy and distribute verbatim copies of the Program's -source code as you receive it, in any medium, provided that you -conspicuously and appropriately publish on each copy an appropriate -copyright notice and disclaimer of warranty; keep intact all the -notices that refer to this License and to the absence of any warranty; -and give any other recipients of the Program a copy of this License -along with the Program. + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. -You may charge a fee for the physical act of transferring a copy, and -you may at your option offer warranty protection in exchange for a fee. + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. - 2. You may modify your copy or copies of the Program or any portion -of it, thus forming a work based on the Program, and copy and -distribute such modifications or work under the terms of Section 1 -above, provided that you also meet all of these conditions: + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. - a) You must cause the modified files to carry prominent notices - stating that you changed the files and the date of any change. + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. - b) You must cause any work that you distribute or publish, that in - whole or in part contains or is derived from the Program or any - part thereof, to be licensed as a whole at no charge to all third - parties under the terms of this License. + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. - c) If the modified program normally reads commands interactively - when run, you must cause it, when started running for such - interactive use in the most ordinary way, to print or display an - announcement including an appropriate copyright notice and a - notice that there is no warranty (or else, saying that you provide - a warranty) and that users may redistribute the program under - these conditions, and telling the user how to view a copy of this - License. (Exception: if the Program itself is interactive but - does not normally print such an announcement, your work based on - the Program is not required to print an announcement.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Program, -and can be reasonably considered independent and separate works in -themselves, then this License, and its terms, do not apply to those -sections when you distribute them as separate works. But when you -distribute the same sections as part of a whole which is a work based -on the Program, the distribution of the whole must be on the terms of -this License, whose permissions for other licensees extend to the -entire whole, and thus to each and every part regardless of who wrote it. + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. -Thus, it is not the intent of this section to claim rights or contest -your rights to work written entirely by you; rather, the intent is to -exercise the right to control the distribution of derivative or -collective works based on the Program. + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. -In addition, mere aggregation of another work not based on the Program -with the Program (or with a work based on the Program) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. - 3. You may copy and distribute the Program (or a work based on it, -under Section 2) in object code or executable form under the terms of -Sections 1 and 2 above provided that you also do one of the following: + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. - a) Accompany it with the complete corresponding machine-readable - source code, which must be distributed under the terms of Sections - 1 and 2 above on a medium customarily used for software interchange; or, + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. - b) Accompany it with a written offer, valid for at least three - years, to give any third party, for a charge no more than your - cost of physically performing source distribution, a complete - machine-readable copy of the corresponding source code, to be - distributed under the terms of Sections 1 and 2 above on a medium - customarily used for software interchange; or, + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. - c) Accompany it with the information you received as to the offer - to distribute corresponding source code. (This alternative is - allowed only for noncommercial distribution and only if you - received the program in object code or executable form with such - an offer, in accord with Subsection b above.) + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or -The source code for a work means the preferred form of the work for -making modifications to it. For an executable work, complete source -code means all the source code for all modules it contains, plus any -associated interface definition files, plus the scripts used to -control compilation and installation of the executable. However, as a -special exception, the source code distributed need not include -anything that is normally distributed (in either source or binary -form) with the major components (compiler, kernel, and so on) of the -operating system on which the executable runs, unless that component -itself accompanies the executable. + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. -If distribution of executable or object code is made by offering -access to copy from a designated place, then offering equivalent -access to copy the source code from the same place counts as -distribution of the source code, even though third parties are not -compelled to copy the source along with the object code. - - 4. You may not copy, modify, sublicense, or distribute the Program -except as expressly provided under this License. Any attempt -otherwise to copy, modify, sublicense or distribute the Program is -void, and will automatically terminate your rights under this License. -However, parties who have received copies, or rights, from you under -this License will not have their licenses terminated so long as such -parties remain in full compliance. + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. - 5. You are not required to accept this License, since you have not -signed it. However, nothing else grants you permission to modify or -distribute the Program or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Program (or any work based on the -Program), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Program or works based on it. + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. - 6. Each time you redistribute the Program (or any work based on the -Program), the recipient automatically receives a license from the -original licensor to copy, distribute or modify the Program subject to -these terms and conditions. You may not impose any further -restrictions on the recipients' exercise of the rights granted herein. -You are not responsible for enforcing compliance by third parties to + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of this License. - 7. If, as a consequence of a court judgment or allegation of patent -infringement or for any other reason (not limited to patent issues), -conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot -distribute so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you -may not distribute the Program at all. For example, if a patent -license would not permit royalty-free redistribution of the Program by -all those who receive copies directly or indirectly through you, then -the only way you could satisfy both it and this License would be to -refrain entirely from distribution of the Program. + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. -If any portion of this section is held invalid or unenforceable under -any particular circumstance, the balance of the section is intended to -apply and the section as a whole is intended to apply in other -circumstances. + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. -It is not the purpose of this section to induce you to infringe any -patents or other property right claims or to contest validity of any -such claims; this section has the sole purpose of protecting the -integrity of the free software distribution system, which is -implemented by public license practices. Many people have made -generous contributions to the wide range of software distributed -through that system in reliance on consistent application of that -system; it is up to the author/donor to decide if he or she is willing -to distribute software through any other system and a licensee cannot -impose that choice. + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. -This section is intended to make thoroughly clear what is believed to -be a consequence of the rest of this License. - - 8. If the distribution and/or use of the Program is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Program under this License -may add an explicit geographical distribution limitation excluding -those countries, so that distribution is permitted only in or among -countries not thus excluded. In such case, this License incorporates -the limitation as if written in the body of this License. + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. - 9. The Free Software Foundation may publish revised and/or new versions -of the General Public License from time to time. Such new versions will + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. -Each version is given a distinguishing version number. If the Program -specifies a version number of this License which applies to it and "any -later version", you have the option of following the terms and conditions -either of that version or of any later version published by the Free -Software Foundation. If the Program does not specify a version number of -this License, you may choose any version ever published by the Free Software -Foundation. + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. - 10. If you wish to incorporate parts of the Program into other free -programs whose distribution conditions are different, write to the author -to ask for permission. For software which is copyrighted by the Free -Software Foundation, write to the Free Software Foundation; we sometimes -make exceptions for this. Our decision will be guided by the two goals -of preserving the free status of all derivatives of our free software and -of promoting the sharing and reuse of software generally. + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. - NO WARRANTY + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. - 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY -FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN -OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES -PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED -OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS -TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE -PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, -REPAIR OR CORRECTION. + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. - 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR -REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, -INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING -OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED -TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY -YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER -PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE -POSSIBILITY OF SUCH DAMAGES. + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it @@ -288,15 +628,15 @@ To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively -convey the exclusion of warranty; and each file should have at least +state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. - Copyright (C) 19yy + Copyright (C) - This program is free software; you can redistribute it and/or modify + This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, @@ -305,37 +645,30 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; see the file COPYING. If not, write to - the Free Software Foundation, Inc., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. + along with this program. If not, see . Also add information on how to contact you by electronic and paper mail. -If the program is interactive, make it output a short notice like this -when it starts in an interactive mode: + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: - Gnomovision version 69, Copyright (C) 19yy name of author - Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, the commands you use may -be called something other than `show w' and `show c'; they could even be -mouse-clicks or menu items--whatever suits your program. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the program, if -necessary. Here is a sample; alter the names: +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". - Yoyodyne, Inc., hereby disclaims all copyright interest in the program - `Gnomovision' (which makes passes at compilers) written by James Hacker. - - , 1 April 1989 - Ty Coon, President of Vice + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. -This General Public License does not permit incorporating your program into -proprietary programs. If your program is a subroutine library, you may -consider it more useful to permit linking proprietary applications with the -library. If this is what you want to do, use the GNU Library General -Public License instead of this License. + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff -r 861f2601a38b -r 1f0b15040456 etc/ChangeLog --- a/etc/ChangeLog Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/ChangeLog Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,52 @@ +2011-04-29 Stephen J. Turnbull + + * XEmacs 21.5.31 "ginger" is released. + +2010-12-31 Mats Lidell + + * xemacs.1: Added copyright and license. + +2010-12-31 Mats Lidell + + * emacskeys.sco: remove + * emacsstrs.sco: remove + +2010-11-07 Mats Lidell + + * gnuserv.1: + * gnuserv.README: + Added copyright dated 1998. + +2010-10-30 Mats Lidell + + * unicode/COPYING: + * unicode/ibm/COPYING: + New files. + +2011-04-26 Stephen J. Turnbull + + * XEmacs 21.5.30 "garlic" is released. + +2010-06-13 Stephen J. Turnbull + + * unicode/other/lao.txt: + * tests/external-widget/Makefile: + * tests/external-widget/test-ew-motif: + * tests/external-widget/test-ew-xlib: + * custom/example-themes/example-theme.el: + * custom/example-themes/europe-theme.el: + Correct FSF address in permission notice. + +2010-02-22 Ben Wing + + * dbxrc.in: + Rename objects.c -> fontcolor.c. + +2010-02-22 Ben Wing + + * dbxrc.in: + test-harness.el is in lisp directory now. + 2010-01-28 Jerry James * tests/external-widget/Makefile: Add copyright and license @@ -2049,3 +2098,23 @@ Thu Dec 5 20:42:35 1996 Steven L Baur * edt-user.doc (File): New file from Emacs 19.34. + + +ChangeLog entries synched from GNU Emacs are the property of the FSF. +Other ChangeLog entries are usually the property of the author of the +change. + +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 3 of the License, 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. If not, see . diff -r 861f2601a38b -r 1f0b15040456 etc/ETAGS.EBNF --- a/etc/ETAGS.EBNF Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/ETAGS.EBNF Sun May 01 18:44:03 2011 +0100 @@ -99,16 +99,17 @@ COPYING PERMISSIONS: - This document 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 of the License, or - (at your option) any later version. + This file is part of XEmacs. - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. + 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 3 of the License, 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 this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + along with XEmacs. If not, see . diff -r 861f2601a38b -r 1f0b15040456 etc/ETAGS.README --- a/etc/ETAGS.README Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/ETAGS.README Sun May 01 18:44:03 2011 +0100 @@ -32,18 +32,17 @@ 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. -This file is not considered part of GNU Emacs. +This file is part of XEmacs. -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. +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 3 of the License, or (at your +option) any later version. -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. +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 this program; if not, write to the Free Software Foundation, -Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. +along with XEmacs. If not, see . diff -r 861f2601a38b -r 1f0b15040456 etc/Emacs.ad --- a/etc/Emacs.ad Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/Emacs.ad Sun May 01 18:44:03 2011 +0100 @@ -1,5 +1,29 @@ ! This is the app-defaults file for XEmacs. ! +! Copyright (C) 1997, 1998 Kyle Jones +! Copyright (C) 1998 SL Baur +! Copyright (C) 2000 Andy Piper +! Copyright (C) 2000 Martin Buchholz +! Copyright (C) 2000-2003 Stephen J. Turnbull +! Copyright (C) 2002 Ville SkyttÀ +! Copyright (C) 2010 Jerry James +! +! This file is part of XEmacs. +! +! XEmacs is free software: you can redistribute it and/or modify it +! under the terms of the GNU General Public License as published by the +! Free Software Foundation, either version 3 of the License, 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. If not, see . +! +! ! This used to be identical to sample.Xresources, but the resources ! below have been rewritten to be as general as possible to avoid ! overriding user resources. Other than the form rewriting, both diff -r 861f2601a38b -r 1f0b15040456 etc/HELLO --- a/etc/HELLO Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/HELLO Sun May 01 18:44:03 2011 +0100 @@ -1,47 +1,95 @@ --*- coding: iso-2022-7 -*- +This is a list of ways to say hello in various languages. -You need many fonts to read all. -Please correct this incomplete list and add more! +Non-ASCII examples: + Europe: ,A!(BHola!, Gr,A|_(B Gott, Hyv,Add(B p,Ad(Biv,Add(B, Tere ,Au(Bhtust, Bon,Cu(Bu + Cze,B6f(B!, Dobr,B}(B den, ,L7T`PRabRcYbU(B!, ,FCei\(B ,Fsar(B, $,1J2J0J;J0J@JOJ=J1J0(B + Africa: $(3!A!,!>(B + Middle/Near East: ,Hylem(B, $,1-g.$-s.1.$-g.%(B $,1-y.$.*.#.%(B + South Asia: $,19h9n9x:-9d:'(B, $,15h5n5x6-5d6'(B, $,1?(?.?8?M>u?>?0(B, $,1@H@N@X@m@5@^@P@"(B, $,1;6;A;#;?;,;G(B, + $,1AFAzB4AvB=B AqB*(B, $,1-=U=~=p=B(B, $(7"7"!#C!;"E"S"G!;"7"2"[!;"D"["#"G!>(B + South East Asia: $,1\'\f\:\V\4\?\]\:(B, (1JP:R-4U(B, $,1H9H$HZHYH"HH3gGO<(B -Arabic ([2],GIqjHQYdG[0](B) [2],GecjdY[0](B [2],GeGdqSdG[0](B -Croatian (Hrvatski) Bog (Bok), Dobar dan -Czech (,Bh(Besky) Dobr,B}(B den -Danish (Dansk) Hej, Goddag -English Hello -Esperanto Saluton -Estonian Tere, Tervist -FORTRAN PROGRAM -Finnish (Suomi) Hei -French (Fran,Ag(Bais) Bonjour, Salut -German (Deutsch Nord) Guten Tag -German (Deutsch S,A|(Bd) Gr,A|_(B Gott -Greek (,FEkkgmij\(B) ,FCei\(B ,Fsar(B -Hebrew [2],Hylem[0](B -Irish (Gaeilge) Dia duit, Cad ,Ai(B mar a t,Aa(B t,Az(B? -Italiano Ciao, Buon giorno -Maltese Ciao -Nederlands, Vlaams Hallo, Hoi, Goedendag -Norwegian (Norsk) Hei, God dag -Polish Cze,B6f(B! -Russian (,L@caaZXY(B) ,L7T`PRabRcYbU(B! -Slovak Dobr,B}(B de,Br(B -Spanish (Espa,Aq(Bol) ,A!(BHola! -Swedish (Svenska) Hej, Goddag -Tajik ,LAP[^\(B +LANGUAGE (NATIVE NAME) HELLO +---------------------- ----- +Amharic ($,1O M[MmN{(B) $,1M`MKM](B +Arabic $,1ro(B($,1-g.$-y-q-h.*.1-i(B) $,1-g.$-s.1.$-g.%(B $,1-y.$.*.#.%(B +Bengali ($,17,7>6b727>(B) $,17(7.787M6u7>70(B +Braille $,2(3(1('('(5(B +Burmese ($,1H9H\H4HZH9HL(B) $,1H9H$HZHYH"Hu?(?M?(?!(B) $,1?(?.?8?M>u?>?0(B +Khmer ($,1\7\V\?\V\!\r\8\b\:(B) $,1\'\f\:\V\4\?\]\:(B +Lao ((1>RJRERG(B) (1JP:R-4U(B / (1"mcKib*!4U(B +Malayalam ($,1@N@R@O@^@S@"(B) $,1@H@N@X@m@5@^@P@"(B +Maltese (il-Malti) Bon,Cu(Bu / Sa,C11(Ba +Mathematics $,1x (B p $,1x((B world $,1s"(B hello p $,2!a(B +Nederlands, Vlaams Hallo / Dag +Norwegian (norsk) Hei / God dag +Oriya ($,1:s;\;?:f(B) $,1;6;A;#;?;,;G(B +Polish (j,Bj(Bzyk polski) Dzie,Bq(B dobry! / Cze,B6f(B! +Russian (,L`caaZXY(B) ,L7T`P$(O+Z,LRabRcYbU(B! +Sinhala ($,1B#B2ABB$A}(B) $,1AFAzB4AvB=B AqB*(B +Slovak (sloven,Bh(Bina) Dobr,A}(B de,Br(B +Slovenian (sloven,B9h(Bina) Pozdravljeni! +Spanish (espa,Aq(Bol) ,A!(BHola! +Swedish (p,Ae(B svenska) Hej / Goddag / Hall,Ae(B +Tamil ($,1&=r>!=W>!(B) $,1=h=n=x>-=U=~=p=B(B +Thai (,T@RIRd7B(B) ,TJGQJ4U$CQ:(B / ,TJGQJ4U$hP(B +Tibetan ($(7"7"]"2!;"G#!"2!;(B) $(7"7"!#C!;"E"S"G!;"7"2"[!;"D"["#"G!>(B +Tigrigna ($,1NUP-MmN{(B) $,1MpMKM[NU(B +Turkish (T,A|(Brk,Ag(Be) Merhaba +Ukrainian (,LcZ`Pw]alZP(B) ,L2vbPn(B +Vietnamese (ti,1*(Bng Vi,1.(Bt) Ch,A`(Bo b,1U(Bn -Tigrigna ($(3"8#r!N"^(B) $(3!Q!,!<"8(B -Turkish (T,A|(Brk,Ag(Be) Merhaba -Vietnamese (Ti,1*(Bng Vi,1.(Bt) Ch,1`(Bo b,1U(Bn - -Japanese ($BF|K\8l(B) $B$3$s$K$A$O(B, (I:]FAJ(B, $BqV$(DiQ(B +Japanese ($BF|K\8l(B) $B$3$s$K$A$O(B / (I:]FAJ(B Chinese ($AVPND(B,$AFUM(;0(B,$A::So(B) $ADc:C(B -Cantonese ($(0GnM$(B,$(0N]0*Hd(B) $(0*/=((B, $(0+$)p(B -Hangul ($(CGQ1[(B) $(C>H3gGO<H3gGO=J4O1n(B +Cantonese ($(0GnM$(B,$(0N]0*Hd(B) $(0*/=((B, $(0+$)p(B +Korean ($(CGQ1[(B) $(C>H3gGO<H3gGO=J4O1n(B + + + +Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 + Free Software Foundation, Inc. + +This file is part of XEmacs. -Difference among chinese characters in GB, JIS, KSC, BIG5: - GB -- $AT*Fx(B $A?*7"(B - JIS -- $B855$(B $B3+H/(B - KSC -- $(Cj*Q((B $(CKR[!(B - BIG5 -- $(0&x86(B $(0DeBv(B +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 3 of the License, 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. If not, see . + +;;; Local Variables: +;;; tab-width: 32 +;;; bidi-display-reordering: t +;;; End: diff -r 861f2601a38b -r 1f0b15040456 etc/NEWS --- a/etc/NEWS Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/NEWS Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,27 @@ -*- mode:outline -*- + +Copyright (C) 1998-2000 Hrvoje Niksic +Copyright (C) 2000-2001 Michael Sperber +Copyright (C) 2001 Ben Wing +Copyright (C) 2001 Didier Verna +Copyright (C) 2004 Stephen Turnbull +Copyright (C) 2005-2006 Aidan Kehoe + +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 3 of the License, 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. If not, see . + * Introduction ============== diff -r 861f2601a38b -r 1f0b15040456 etc/ONEWS --- a/etc/ONEWS Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/ONEWS Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,22 @@ -*- mode:outline -*- + +Copyright (C) 1996-1997 Steve Baur + +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 3 of the License, 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. If not, see . + * Changes in XEmacs 20.4 ======================== diff -r 861f2601a38b -r 1f0b15040456 etc/OONEWS --- a/etc/OONEWS Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/OONEWS Sun May 01 18:44:03 2011 +0100 @@ -1,7 +1,28 @@ + -*- mode:outline; minor-mode:outl-mouse -*- C-c TAB This shows subheadings (if any) of current heading. C-c C-s Show _all_ the text and headings under current heading +Copyright (C) 1992-1994 Free Software Foundation, Inc. +Copyright (C) 1995-1996 Chuck Thompson +Copyright (C) 1996-1997 Steve Baur +Copyright (C) 1997 Hrvoje Niksic + +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 3 of the License, 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. If not, see . + * Introduction ============== diff -r 861f2601a38b -r 1f0b15040456 etc/bundled-packages/README --- a/etc/bundled-packages/README Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/bundled-packages/README Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,21 @@ +Copyright 2007 Free Software Foundation + +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 3 of the License, 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. If not, see . + + Package distributions may be placed in this directory. If present and a package-path is configured, packages can be installed using the top-level Makefile. diff -r 861f2601a38b -r 1f0b15040456 etc/bundled-packages/test.sh --- a/etc/bundled-packages/test.sh Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/bundled-packages/test.sh Sun May 01 18:44:03 2011 +0100 @@ -1,5 +1,22 @@ # tests for the bundled packages feature +# Copyright 2007 Free Software Foundation + +# 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 3 of the License, 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. If not, see . + # usage: sh etc/bundled-packages/tests.sh [TMP_TEST_DIR] # Always run this script from the top directory of the source tree. diff -r 861f2601a38b -r 1f0b15040456 etc/custom/check0.xpm --- a/etc/custom/check0.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/custom/check0.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * check0_xpm[] = { "11 11 3 1", " c #E6E6E6E6E6E6", diff -r 861f2601a38b -r 1f0b15040456 etc/custom/check1.xpm --- a/etc/custom/check1.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/custom/check1.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * check1_xpm[] = { "11 11 3 1", " c #737373737373", diff -r 861f2601a38b -r 1f0b15040456 etc/custom/down-pushed.xpm --- a/etc/custom/down-pushed.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/custom/down-pushed.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * down[] = { "10 10 5 1", " c Gray40", @@ -15,4 +31,4 @@ "ooo..XXooo", "ooo..XXooo", "oooo.Xoooo", -"oooo.Xoooo"}; \ No newline at end of file +"oooo.Xoooo"}; diff -r 861f2601a38b -r 1f0b15040456 etc/custom/down.xpm --- a/etc/custom/down.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/custom/down.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * down_xpm[] = { "10 10 5 1", " c Gray90", diff -r 861f2601a38b -r 1f0b15040456 etc/custom/example-themes/europe-theme.el --- a/etc/custom/example-themes/europe-theme.el Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/custom/example-themes/europe-theme.el Sun May 01 18:44:03 2011 +0100 @@ -6,20 +6,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, -;; MA 02111-1301, USA. +;; along with XEmacs. If not, see . ;;;autoload (deftheme europe diff -r 861f2601a38b -r 1f0b15040456 etc/custom/example-themes/example-theme.el --- a/etc/custom/example-themes/example-theme.el Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/custom/example-themes/example-theme.el Sun May 01 18:44:03 2011 +0100 @@ -6,20 +6,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, -;; MA 02111-1301, USA. +;; along with XEmacs. If not, see . ;;;autoload (deftheme example diff -r 861f2601a38b -r 1f0b15040456 etc/custom/face.xpm --- a/etc/custom/face.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/custom/face.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char *face[] = { /* width height num_colors chars_per_pixel */ " 17 17 4 1", diff -r 861f2601a38b -r 1f0b15040456 etc/custom/folder.xpm --- a/etc/custom/folder.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/custom/folder.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char *folder[] = { /* width height num_colors chars_per_pixel */ " 17 17 4 1", diff -r 861f2601a38b -r 1f0b15040456 etc/custom/option.xpm --- a/etc/custom/option.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/custom/option.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char *option[] = { /* width height num_colors chars_per_pixel */ " 17 17 4 1", diff -r 861f2601a38b -r 1f0b15040456 etc/custom/radio0.xpm --- a/etc/custom/radio0.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/custom/radio0.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * radio0_xpm[] = { "12 11 4 1", " c #FFFFFFFFFFFF s background", diff -r 861f2601a38b -r 1f0b15040456 etc/custom/radio1.xpm --- a/etc/custom/radio1.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/custom/radio1.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * radio1_xpm[] = { "12 11 4 1", " c #FFFFFFFFFFFF s background", diff -r 861f2601a38b -r 1f0b15040456 etc/custom/right-pushed.xpm --- a/etc/custom/right-pushed.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/custom/right-pushed.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * right_xpm[] = { "10 10 5 1", " c Gray40", diff -r 861f2601a38b -r 1f0b15040456 etc/custom/right.xpm --- a/etc/custom/right.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/custom/right.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * right_xpm[] = { "10 10 5 1", " c Gray90", diff -r 861f2601a38b -r 1f0b15040456 etc/dbxrc.in --- a/etc/dbxrc.in Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/dbxrc.in Sun May 01 18:44:03 2011 +0100 @@ -4,13 +4,14 @@ ## The generated file depends on src/config.h (currently only in one place). ## Copyright (C) 1998 Free Software Foundation, Inc. +## Copyright (C) 2010 Ben Wing. ## This file is part of XEmacs. -## XEmacs is free software; you can redistribute it and/or modify it +## 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. +## Free Software Foundation, either version 3 of the License, 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 @@ -18,9 +19,7 @@ ## for more details. ## You should have received a copy of the GNU General Public License -## along with XEmacs; see the file COPYING. If not, write to -## the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -## Boston, MA 02110-1301 USA +## along with XEmacs. If not, see . ## Author: Martin Buchholz @@ -194,7 +193,7 @@ end function check-xemacs { - run -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated + run -batch -l test-harness -f batch-test-emacs ../tests/automated } document check-temacs << 'end' @@ -205,7 +204,7 @@ end function check-temacs { - run-temacs -q -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated + run-temacs -q -batch -l test-harness -f batch-test-emacs ../tests/automated } document update-elc << 'end' @@ -277,7 +276,7 @@ elif test $lrecord_type = lrecord_type_coding_system; then pstruct file-coding.c Lisp_Coding_System elif test $lrecord_type = lrecord_type_color_instance; then - pstruct objects.c Lisp_Color_Instance + pstruct fontcolor.c Lisp_Color_Instance elif test $lrecord_type = lrecord_type_command_builder; then pstruct event-stream.c command_builder elif test $lrecord_type = lrecord_type_compiled_function; then @@ -301,7 +300,7 @@ elif test $lrecord_type = lrecord_type_float; then pstruct floatfns.c Lisp_Float elif test $lrecord_type = lrecord_type_font_instance; then - pstruct objects.c Lisp_Font_Instance + pstruct fontcolor.c Lisp_Font_Instance elif test $lrecord_type = lrecord_type_frame; then pstruct frame.c frame elif test $lrecord_type = lrecord_type_glyph; then diff -r 861f2601a38b -r 1f0b15040456 etc/editclient.sh --- a/etc/editclient.sh Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#!/bin/sh -if gnuclient -batch -eval t >/dev/null 2>&1; then - exec gnuclient ${1+"$@"} -else - xemacs -unmapped -f gnuserv-start & - until gnuclient -batch -eval t >/dev/null 2>&1 - do - sleep 1 - done - exec gnuclient ${1+"$@"} -fi - diff -r 861f2601a38b -r 1f0b15040456 etc/emacskeys.sco --- a/etc/emacskeys.sco Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,220 +0,0 @@ -# -# SCO(tm) keyboard mapping file with Emacs meta-keys -# Automatically generated using the emap utility -# -# Below is the uuencoded source for the emap utility. This program -# will, when run on an SCO console, take the current keyboard -# map and set the 'meta' bit for all keys. To make this usable -# under Emacs, edit your termcap and terminfo entries for the -# sco console (the ansi entries) and add the 'km' capability. -# Usage: -# emap [-o] [-f filename] -# If you run the utility with no flags, it will simply modify the -# current keyboard map in kernel memory for the multiscreen on -# which it was invoked. Specifying -f and a filename will cause -# a file suitable for input to the mapkey(M) utility to be generated. -# Specifying -o will produce, on stdout, a file suitable for input -# to the mapkey(M) utility but will NOT modify the in-memory -# map. -# I personally run this utility once, and replace /usr/lib/keyboard/keys -# with the result. You may prefer to run it in your .profile or -# via a shell-script which will in turn invoke emacs. -# -# begin 600 emap.c.gz -# M'XL("'F'RC " V5M87 N8P"=5VUOXC@0_LZOF$W50KIT%^AM[U2V>Z*HW%9+ -# MH2JL=*<6H6"<$A&27&RZ1;?][S=C.X&$%'H7(>S8\\R;QS.3 R]@_G+*X;.0 -# M4R_\,/M2.DB7EH&'J]DUL1(?Y2KB8GMYSE>3T(D5H,2?)8\#8#,GAN,PDD[\ -# MV$P6O4 "+GG!M$HCCV,UXJ]9*FF$(UC@++BX'\$%_%,"L(*E;U5I(L*9F'I))1F$ORM)PZ;Z\F$&_A$Z'%F2 .S_I2\1WID<2+.C)X>ISXW$U9/)HUD -# MK()$UXGA[R0K"T.R-#M<,#UQC:J/9HS-& BK])*ZJH1^][V -# M0X7\RJJ [PLG&DLXGB_L$CE/2$=Z3!]&_'3?^'0V:N*R>I>BKA:J.&ND6\1* -# MSJO@H1C$1S$NN%!!XBI8AY^FJ$45F-U4S&,6K: 2/Q&+NJT0;ABC/GAVM29X -# M\!EZWV_&@V%K>#7 ]_?O;20!=:[TR#D2DO;V?''R!=6_9Z,/:,*]-U+,Z/%0 -# M^O5@/+B]:E^WNE!!VZIDK&?;AF+-CQ[QPY-LAAK/[8W5+ UZP!$;,(TQU\S6-\,?-9!CK_/A06@>"^J/>QN>5#&_AY1!:AX -# M/ZSWYZ"]Y7B!&:48->6NL_3E>691ASS&+WRYH$-IWW5L.#JBB(;/9J5KVSG, -# MUEU%J8=3O*L$.TGYO(>ZW.9XTGHCYZ.,K-0KE*0NH-[X=0<7:\I]JQAN -# MG(I*;#BTWCC+>3-G>OE0'+(R>=+(+S^4RS;\_ GI^T/9MN%WL!X>+#@'2U6( -# M@@?S8%ZO78)KSX>U!E;5+"YQ]@9Q@^K!R9F@>J"S_]HOCDRJ0L.LOZAJ8E)S -# M92/;N_ZC@".H/==.[,?%E(?%E -# MCIB\%'.YQ$X'"=!RM)KJZ<+Q EVDL1G"TJ7+]S&^/.DRK?NBBQIV0^Y%+:W0 -# MQVZ ]1'[!(<)=)>@TFC1;N>Z>X6[-$UK/OXG]=NK,E4^?\P\'[N#>K;H,N3Y -# MR*GI@HK6AQ1!4T71BBD_@JA6RZN -# MW*&[":)'V9_TD&^^^$F,6M^%\\C/ ?T7P?U).,(_%UST"=WXT4.0N['/GB1G -# MY26IT"6G>2&3/E3PE/ZX[H^_7?UUT[JMPA%R5QAMX#OL?++^CK#-I:;(6J/6 -# M@K70S"TA/N0*]$66$;G'#2..L>0&>%X_LJ>E(!4=&G:MV,6I+NUPZ4\A"+%O -# MQ".5',*EC)92>:?(+8V"9. FCG91F8--=V9W8-#N5^3"AN0[@6(U\H)')0TP -# M*H_A:4@CG+&]7DOI>=[#G<@.I@+[_F(<"["OR+!9#V:/NK =O%F(GV(PH5P%JJ=,@>;-<"O< -# MHV\$_A8_O:3]/=/]/X4]+@:V=4*$E!WRRH/;S;;1&V -# ME,5R"/D?[.D@HWT&*5D%!NF-1-2&+,K8:<;)9-%#NHWJXU)_;#*3\S+))Y.P -# MMH)H#XOBM.?B=PX&=,75'Y9K)6O;]6R=FF^+4O.ZH*W3\ZNI\;8@3>]*A/2O -# .]VJJY/\+D-=?N%H1 #5 -# -# end -# -# The output below is the result of running emap on the default -# SCO keymap as installed by SCO. It is the equivalent of the -# at.ibm.usa key map file in /usr/lib/keyboard/keys, but with -# the meta bits set properly. Note that for meta keys to work correctly -# you MUST edit /etc/termcap and /usr/lib/terminfo/terminfo.src and add -# the 'km' capability for the 'ansi' entry, and you must disable channel -# mapping in /etc/default/mapchan for the console screens. Extra function -# keys have been added, and the matching emacsstrs.sco is in this -# directory to make a map which scoansi.el can use. So the sequence of -# events should be: -# a) Copy this file to /usr/lib/keyboard/keys -# b) copy emacsstrs.sco to /usr/lib/keyboard/stings -# c) run mapkey and mapstr and set MAPKEY=yes in /etc/default/boot -# d) Add mapstr -f to your /etc/profile or your shell startup -# e) Arrange to have scoansi.el loaded from your .emacs file. -# -# alt -# scan cntrl alt alt cntrl lock -# code base shift cntrl shift alt shift cntrl shift state -# - 0 nop nop nop nop nop nop nop nop O - 1 esc esc esc esc 0x9b 0x9b 0x9b 0x9b O - 2 '1' '!' nop nop 0xb1 0xa1 nop nop O - 3 '2' '@' nul nul 0xb2 0xc0 0x80 0x80 O - 4 '3' '#' nop nop 0xb3 0xa3 nop nop O - 5 '4' '$' nop nop 0xb4 0xa4 nop nop O - 6 '5' '%' nop nop 0xb5 0xa5 nop nop O - 7 '6' '^' rs rs 0xb6 0xde 0x9e 0x9e O - 8 '7' '&' nop nop 0xb7 0xa6 nop nop O - 9 '8' '*' nop nop 0xb8 0xaa nop nop O - 10 '9' '(' nop nop 0xb9 0xa8 nop nop O - 11 '0' ')' nop nop 0xb0 0xa9 nop nop O - 12 '-' '_' ns ns 0xad 0xdf 0x9f 0x9f O - 13 '=' '+' nop nop 0xbd 0xab nop nop O - 14 bs bs del del 0x88 0x88 0xff 0xff O - 15 ht btab nop nop 0x89 btab nop nop O - 16 'q' 'Q' dc1 dc1 0xf1 0xd1 0x91 0x91 C - 17 'w' 'W' etb etb 0xf7 0xd7 0x97 0x97 C - 18 'e' 'E' enq enq 0xe5 0xc5 0x85 0x85 C - 19 'r' 'R' dc2 dc2 0xf2 0xd2 0x92 0x92 C - 20 't' 'T' dc4 dc4 0xf4 0xd4 0x94 0x94 C - 21 'y' 'Y' em em 0xf9 0xd9 0x99 0x99 C - 22 'u' 'U' nak nak 0xf5 0xd5 0x95 0x95 C - 23 'i' 'I' ht ht 0xe9 0xc9 0x89 0x89 C - 24 'o' 'O' si si 0xef 0xcf 0x8f 0x8f C - 25 'p' 'P' dle dle 0xf0 0xd0 0x90 0x90 C - 26 '[' '{' esc esc 0xdb 0xfb 0x9b 0x9b O - 27 ']' '}' gs gs 0xdd 0xfd 0x9d 0x9d O - 28 cr cr nl nl 0x8d 0x8d 0x8a 0x8a O - 29 ctrl ctrl ctrl ctrl ctrl ctrl ctrl ctrl O - 30 'a' 'A' soh soh 0xe1 0xc1 0x81 0x81 C - 31 's' 'S' dc3 dc3 0xf3 0xd3 0x93 0x93 C - 32 'd' 'D' eot eot 0xe4 0xc4 0x84 0x84 C - 33 'f' 'F' ack ack 0xe6 0xc6 0x86 0x86 C - 34 'g' 'G' bel bel 0xe7 0xc7 0x87 0x87 C - 35 'h' 'H' bs bs 0xe8 0xc8 0x88 0x88 C - 36 'j' 'J' nl nl 0xea 0xca 0x8a 0x8a C - 37 'k' 'K' vt vt 0xeb 0xcb 0x8b 0x8b C - 38 'l' 'L' np np 0xec 0xcc 0x8c 0x8c C - 39 ';' ':' nop nop 0xbb 0xba nop nop O - 40 '\'' '"' nop nop 0xa7 0xa2 nop nop O - 41 '`' '~' nop nop 0xe0 0xfe nop nop O - 42 lshift lshift lshift lshift lshift lshift lshift lshift O - 43 '\\' '|' fs fs 0xdc 0xfc 0x9c 0x9c O - 44 'z' 'Z' sub sub 0xfa 0xda 0x9a 0x9a C - 45 'x' 'X' can can 0xf8 0xd8 0x98 0x98 C - 46 'c' 'C' etx etx 0xe3 0xc3 0x83 0x83 C - 47 'v' 'V' syn syn 0xf6 0xd6 0x96 0x96 C - 48 'b' 'B' stx stx 0xe2 0xc2 0x82 0x82 C - 49 'n' 'N' so so 0xee 0xce 0x8e 0x8e C - 50 'm' 'M' cr cr 0xed 0xcd 0x8d 0x8d C - 51 ',' '<' nop nop 0xac 0xbc nop nop O - 52 '.' '>' nop nop 0xae 0xbe nop nop O - 53 '/' '?' nop nop 0xaf 0xbf nop nop O - 54 rshift rshift rshift rshift rshift rshift rshift rshift O - 55 '*' '*' nscr nscr 0xaa 0xaa nscr nscr O - 56 alt alt alt alt alt alt alt alt O - 57 ' ' ' ' ' ' ' ' 0xa0 0xa0 0xa0 0xa0 O - 58 clock clock clock clock clock clock clock clock O - 59 fkey1 fkey13 fkey25 fkey37 scr1 scr11 scr1 scr11 O - 60 fkey2 fkey14 fkey26 fkey38 scr2 scr12 scr2 scr12 O - 61 fkey3 fkey15 fkey27 fkey39 scr3 scr13 scr3 scr13 O - 62 fkey4 fkey16 fkey28 fkey40 scr4 scr14 scr4 scr14 O - 63 fkey5 fkey17 fkey29 fkey41 scr5 scr15 scr5 scr15 O - 64 fkey6 fkey18 fkey30 fkey42 scr6 scr16 scr6 scr16 O - 65 fkey7 fkey19 fkey31 fkey43 scr7 scr7 scr7 scr7 O - 66 fkey8 fkey20 fkey32 fkey44 scr8 scr8 scr8 scr8 O - 67 fkey9 fkey21 fkey33 fkey45 scr9 scr9 scr9 scr9 O - 68 fkey10 fkey22 fkey34 fkey46 scr10 scr10 scr10 scr10 O - 69 nlock nlock dc3 dc3 nlock nlock 0x93 0x93 O - 70 slock slock del del slock slock 0xff 0xff O - 71 fkey49 '7' '7' '7' '7' 0xb7 0xb7 0xb7 N - 72 fkey50 '8' '8' '8' '8' 0xb8 0xb8 0xb8 N - 73 fkey51 '9' '9' '9' '9' 0xb9 0xb9 0xb9 N - 74 fkey52 '-' '-' '-' '-' 0xad 0xad 0xad N - 75 fkey53 '4' '4' '4' '4' 0xb4 0xb4 0xb4 N - 76 fkey54 '5' '5' '5' '5' 0xb5 0xb5 0xb5 N - 77 fkey55 '6' '6' '6' '6' 0xb6 0xb6 0xb6 N - 78 fkey56 '+' '+' '+' '+' 0xab 0xab 0xab N - 79 fkey57 '1' '1' '1' '1' 0xb1 0xb1 0xb1 N - 80 fkey58 '2' '2' '2' '2' 0xb2 0xb2 0xb2 N - 81 fkey59 '3' '3' '3' '3' 0xb3 0xb3 0xb3 N - 82 fkey60 '0' '0' '0' '0' 0xb0 0xb0 0xb0 N - 83 del '.' del del 0xff 0xae 0xff 0xff N - 84 ns ns ns ns 0x9f 0x9f 0x9f 0x9f O - 85 nop nop nop nop nop nop nop nop O - 86 nop nop nop nop nop nop nop nop O - 87 fkey11 fkey23 fkey35 fkey47 scr11 scr11 scr11 scr11 O - 88 fkey12 fkey24 fkey36 fkey48 scr12 scr12 scr12 scr12 O - 89 nop nop nop nop nop nop nop nop O - 90 nop nop nop nop nop nop nop nop O - 91 nop nop nop nop nop nop nop nop O - 92 nop nop nop nop nop nop nop nop O - 93 nop nop nop nop nop nop nop nop O - 94 nop nop nop nop nop nop nop nop O - 95 nop nop nop nop nop nop nop nop O - 96 fkey50 fkey62 fkey72 fkey50 fkey82 fkey62 fkey72 fkey50 N - 97 fkey53 fkey64 fkey74 fkey53 fkey84 fkey64 fkey74 fkey53 N - 98 fkey58 fkey67 fkey77 fkey58 fkey87 fkey67 fkey77 fkey58 N - 99 fkey55 fkey65 fkey75 fkey55 fkey85 fkey65 fkey75 fkey55 N - 100 fkey49 fkey61 fkey71 fkey49 fkey81 fkey61 fkey71 fkey49 N - 101 nop nop nop nop nop nop nop nop O - 102 fkey57 fkey66 fkey76 fkey57 fkey86 fkey66 fkey76 fkey57 N - 103 fkey59 fkey68 fkey78 fkey59 fkey88 fkey68 fkey78 fkey59 N - 104 fkey60 fkey69 fkey79 fkey60 fkey89 fkey69 fkey79 fkey60 N - 105 del del del del 0xff 0xff 0xff 0xff N - 106 fkey54 fkey54 fkey93 fkey54 fkey96 fkey54 fkey54 fkey54 N - 107 nop nop nop nop nop nop nop nop O - 108 nop nop nop nop nop nop nop nop O - 109 nop nop nop nop nop nop nop nop O - 110 nop nop nop nop nop nop nop nop O - 111 nop nop nop nop nop nop nop nop O - 112 nop nop nop nop nop nop nop nop O - 113 nop nop nop nop nop nop nop nop O - 114 nop nop nop nop nop nop nop nop O - 115 nop nop nop nop nop nop nop nop O - 116 nop nop nop nop nop nop nop nop O - 117 nop nop nop nop nop nop nop nop O - 118 nop nop nop nop nop nop nop nop O - 119 nop nop nop nop nop nop nop nop O - 120 nop nop nop nop nop nop nop nop O - 121 nop nop nop nop nop nop nop nop O - 122 nop nop nop nop nop nop nop nop O - 123 nop nop nop nop nop nop nop nop O - 124 nop nop nop nop nop nop nop nop O - 125 nop nop nop nop nop nop nop nop O - 126 nop nop nop nop nop nop nop nop O - 127 nop nop nop nop nop nop nop nop O - 128 rctrl rctrl rctrl rctrl rctrl rctrl rctrl rctrl O - 129 ralt ralt ralt ralt ralt ralt ralt ralt O - 130 fkey60 fkey69 fkey79 fkey60 fkey89 fkey69 fkey79 fkey60 O - 131 del del del del 0xff 0xff 0xff 0xff N - 132 fkey49 fkey61 fkey71 fkey49 fkey81 fkey61 fkey71 fkey49 N - 133 fkey57 fkey66 fkey76 fkey57 fkey86 fkey66 fkey76 fkey57 N - 134 fkey51 fkey63 fkey73 fkey51 fkey83 fkey63 fkey73 fkey51 N - 135 fkey59 fkey68 fkey78 fkey59 fkey88 fkey68 fkey78 fkey59 N - 136 fkey55 fkey65 fkey75 fkey55 fkey85 fkey65 fkey75 fkey55 N - 137 fkey53 fkey64 fkey74 fkey53 fkey84 fkey64 fkey74 fkey53 N - 138 fkey50 fkey62 fkey72 fkey50 fkey82 fkey62 fkey72 fkey50 N - 139 fkey58 fkey67 fkey77 fkey58 fkey87 fkey67 fkey77 fkey58 N - 140 '/' nop nop nop 0xaf nop nop nop O - 141 cr cr nl nl 0x8d 0x8d 0x8a 0x8a O diff -r 861f2601a38b -r 1f0b15040456 etc/emacsstrs.sco --- a/etc/emacsstrs.sco Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,97 +0,0 @@ -String key values -"\033[M" Function #1 -"\033[N" Function #2 -"\033[O" Function #3 -"\033[P" Function #4 -"\033[Q" Function #5 -"\033[R" Function #6 -"\033[S" Function #7 -"\033[T" Function #8 -"\033[U" Function #9 -"\033[V" Function #10 -"\033[W" Function #11 -"\033[X" Function #12 -"\033[Y" Shift Function #1 -"\033[Z" Shift Function #2 -"\033[a" Shift Function #3 -"\033[b" Shift Function #4 -"\033[c" Shift Function #5 -"\033[d" Shift Function #6 -"\033[e" Shift Function #7 -"\033[f" Shift Function #8 -"\033[g" Shift Function #9 -"\033[h" Shift Function #10 -"\033[i" Shift Function #11 -"\033[j" Shift Function #12 -"\033[k" Control Function #1 -"\033[l" Control Function #2 -"\033[m" Control Function #3 -"\033[n" Control Function #4 -"\033[o" Control Function #5 -"\033[p" Control Function #6 -"\033[q" Control Function #7 -"\033[r" Control Function #8 -"\033[s" Control Function #9 -"\033[t" Control Function #10 -"\033[u" Control Function #11 -"\033[v" Control Function #12 -"\033[w" Ctrl/Shft Function #1 -"\033[x" Ctrl/Shft Function #2 -"\033[y" Ctrl/Shft Function #3 -"\033[z" Ctrl/Shft Function #4 -"\033[@" Ctrl/Shft Function #5 -"\033[[" Ctrl/Shft Function #6 -"\033[\\" Ctrl/Shft Function #7 -"\033[]" Ctrl/Shft Function #8 -"\033[^" Ctrl/Shft Function #9 -"\033[_" Ctrl/Shft Function #10 -"\033[`" Ctrl/Shft Function #11 -"\033[{" Ctrl/Shft Function #12 -"\033[H" Home -"\033[A" Up arrow -"\033[I" Page up -"\033[-" - -"\033[D" Left arrow -"\033[E" 5 -"\033[C" Right arrow -"\033[+" + -"\033[F" End -"\033[B" Down arrow -"\033[G" Page down -"\033[L" Insert -"\033]A" Shift Home -"\033]B" Shift Up -"\033]C" Shift PgUp -"\033]D" Shift Left -"\033]E" Shift Right -"\033]F" Shift End -"\033]G" Shift Down -"\033]H" Shift PgDn -"\033]I" Shift Insert -"\033]J" Shift Delete -"\033]K" Ctrl Home -"\033]L" Ctrl Up -"\033]M" Ctrl PgUp -"\033]N" Ctrl Left -"\033]O" Ctrl Right -"\033]P" Ctrl End -"\033]Q" Ctrl Down -"\033]R" Ctrl PgDn -"\033]S" Ctrl Insert -"\033]T" Ctrl Delete -"\033]U" Alt Home -"\033]V" Alt Up -"\033]W" Alt PgUp -"\033]X" Alt Left -"\033]Y" Alt Right -"\033]Z" Alt End -"\033]a" Alt Down -"\033]b" Alt PgDn -"\033]c" Alt Insert -"\033]d" Alt Delete -"\033]e" Ctrl Keypad + -"\033]f" Ctrl Keypad - -"\033]g" Ctrl Keypad 5 -"\033]h" Alt Keypad + -"\033]i" Alt Keypad - -"\033]j" Alt Keypad 5 diff -r 861f2601a38b -r 1f0b15040456 etc/eos/eos-build.xbm --- a/etc/eos/eos-build.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/eos/eos-build.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/eos/eos-clear-at.xbm --- a/etc/eos/eos-clear-at.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/eos/eos-clear-at.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/eos/eos-cont.xbm --- a/etc/eos/eos-cont.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/eos/eos-cont.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/eos/eos-dismiss.xbm --- a/etc/eos/eos-dismiss.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/eos/eos-dismiss.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/eos/eos-down.xbm --- a/etc/eos/eos-down.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/eos/eos-down.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/eos/eos-evaluate-star.xbm --- a/etc/eos/eos-evaluate-star.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/eos/eos-evaluate-star.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/eos/eos-evaluate.xbm --- a/etc/eos/eos-evaluate.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/eos/eos-evaluate.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/eos/eos-fix.xbm --- a/etc/eos/eos-fix.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/eos/eos-fix.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/eos/eos-intro.xbm --- a/etc/eos/eos-intro.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/eos/eos-intro.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/eos/eos-introB.xbm --- a/etc/eos/eos-introB.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/eos/eos-introB.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/eos/eos-introD.xbm --- a/etc/eos/eos-introD.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/eos/eos-introD.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/eos/eos-introDB.xbm --- a/etc/eos/eos-introDB.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/eos/eos-introDB.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/eos/eos-run.xbm --- a/etc/eos/eos-run.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/eos/eos-run.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/eos/eos-run2.xbm --- a/etc/eos/eos-run2.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/eos/eos-run2.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/eos/eos-step-into.xbm --- a/etc/eos/eos-step-into.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/eos/eos-step-into.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/eos/eos-step-over.xbm --- a/etc/eos/eos-step-over.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/eos/eos-step-over.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/eos/eos-stop-in.xbm --- a/etc/eos/eos-stop-in.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/eos/eos-stop-in.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/eos/eos-stop.xbm --- a/etc/eos/eos-stop.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/eos/eos-stop.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/eos/eos-type.xbm --- a/etc/eos/eos-type.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/eos/eos-type.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/eos/eos-up.xbm --- a/etc/eos/eos-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/eos/eos-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/gnuserv.1 --- a/etc/gnuserv.1 Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/gnuserv.1 Sun May 01 18:44:03 2011 +0100 @@ -297,3 +297,26 @@ 18.52 distribution. Various modifications from Bob Weiner (weiner@mot.com), Darrell Kindred (dkindred@cmu.edu), Arup Mukherjee (arup@cmu.edu), Ben Wing (ben@xemacs.org) and Hrvoje Niksic (hniksic@xemacs.org). + +.SH COPYING +Copyright +.if t \(co +.if n (C) +1998 Andy Norman, Bob Weiner, Darrell Kindred, Arup Mukherjee, Ben +Wing and Hrvoje Niksic. + +.PP +This file is part of XEmacs. +.PP +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 3 of the License, or (at your +option) any later version. +.PP +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. +.PP +You should have received a copy of the GNU General Public License +along with XEmacs. If not, see . diff -r 861f2601a38b -r 1f0b15040456 etc/gnuserv.README --- a/etc/gnuserv.README Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/gnuserv.README Sun May 01 18:44:03 2011 +0100 @@ -2,6 +2,25 @@ This file was never meant to be proper documentation, and now is bitrotted. See the file gnuserv.1 and/or the sources for more information. +Copyright (C) 1998 Andy Norman, Bob Weiner, Darrell Kindred, + Arup Mukherjee, Ben Wing and Hrvoje Niksic. + +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 3 of the License, 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. If not, see . + + **** NOTE: This version of gnuserv has some enhancements over the original version distributed by Andy Norman. See the end of this file for more details. diff -r 861f2601a38b -r 1f0b15040456 etc/gray1.xbm --- a/etc/gray1.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/gray1.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define bg2_width 16 #define bg2_height 16 static char bg2_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/gtkrc --- a/etc/gtkrc Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/gtkrc Sun May 01 18:44:03 2011 +0100 @@ -1,6 +1,11 @@ # Force the window background to be the same as the default face background: # white. +# Copyright 1999 Malcolm Purvis +# This file is part of XEmacs, licensed to you under the GNU +# General Public License, version 3 or later at your option. +# There is NO WARRANTY, explicit or implied, on this file. + style "default_background" { bg[NORMAL] = { 1.0, 1.0, 1.0 } diff -r 861f2601a38b -r 1f0b15040456 etc/recycle.xpm --- a/etc/recycle.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/recycle.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + /* A recycle logo, artist unknown, converted to xpm by jwz */ static char *recycle[] = { /* width height ncolors chars_per_pixel x_hot y_hot */ diff -r 861f2601a38b -r 1f0b15040456 etc/recycle2.xpm --- a/etc/recycle2.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/recycle2.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * recycle2_xpm[] = { /* width height ncolors cpp [x_hot y_hot] */ "32 32 4 1 26 23", diff -r 861f2601a38b -r 1f0b15040456 etc/refcard.tex --- a/etc/refcard.tex Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/refcard.tex Sun May 01 18:44:03 2011 +0100 @@ -12,19 +12,18 @@ % 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 1, or (at your option) -% any later version. +% 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 3 of the License, 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. +% 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, 675 Mass Ave, Cambridge MA 02139, USA. +% along with XEmacs. If not, see . % This file is intended to be processed by plain TeX (TeX82). % @@ -70,9 +69,9 @@ this card provided the copyright notice and this permission notice are preserved on all copies. -For copies of the GNU Emacs manual, write to the Free Software -Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, -USA. +For copies of the GNU Emacs manual, see: + +{\tt http://www.gnu.org/software/emacs/\#Manuals} \endgroup} diff -r 861f2601a38b -r 1f0b15040456 etc/sample.Xresources --- a/etc/sample.Xresources Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/sample.Xresources Sun May 01 18:44:03 2011 +0100 @@ -1,7 +1,30 @@ -! This is a sample .Xresources file. The resources below are the -! actual resources used as defaults for XEmacs, although the -! form of these resources in the XEmacs app-defaults file is -! slightly different. +! This is a sample .Xresources file. + +! Copyright (C) 1997 Steven L Baur +! Copyright (C) 1999 Alexandre Oliva +! Copyright (C) 2002 Giacomo Boffi +! Copyright (C) 2003 Stephen J. Turnbull +! Copyright (C) 2005 Aidan Kehoe + +! 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 3 of the License, 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. If not, see . + + +! The resources below are the actual resources used as defaults for +! XEmacs, although the form of these resources in the XEmacs +! app-defaults file is slightly different. ! ! You can use the examples below as a basis for your own customizations: ! copy and modify any of the resources below into your own ~/.Xresources file. @@ -33,8 +56,8 @@ ! The default face colors are the base for most of the other faces' ! colors. The default background is gray80, and the default foreground ! is black. -XEmacs.default.attributeBackground: gray80 -XEmacs.default.attributeForeground: black +XEmacs.default.attributeBackground: gray80 +! XEmacs.default.attributeForeground: black ! Set the modeline colors. XEmacs.modeline*attributeForeground: Black diff -r 861f2601a38b -r 1f0b15040456 etc/sample.init.el --- a/etc/sample.init.el Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/sample.init.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;; #### to do: ;; -- scan for #### markers and fix the problems noted there. diff -r 861f2601a38b -r 1f0b15040456 etc/tests/external-widget/Makefile --- a/etc/tests/external-widget/Makefile Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/tests/external-widget/Makefile Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ ## This file is part of XEmacs. -## XEmacs is free software; you can redistribute it and/or modify it +## 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. +## Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ ## for more details. ## You should have received a copy of the GNU General Public License -## along with XEmacs; see the file COPYING. If not, write to -## the Free Software Foundation, Inc., 51 Franklin St - Fifth Floor, -## Boston, MA 02110-1301, USA. +## along with XEmacs. If not, see . CFLAGS += -Xc -g -DTOOLTALK EMACSHOME = ../../.. diff -r 861f2601a38b -r 1f0b15040456 etc/tests/external-widget/test-ew-motif.c --- a/etc/tests/external-widget/test-ew-motif.c Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/tests/external-widget/test-ew-motif.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin St - Fifth Floor, -Boston, MA 02110-1301, USA. */ +along with XEmacs. If not, see . */ #include #include diff -r 861f2601a38b -r 1f0b15040456 etc/tests/external-widget/test-ew-xlib.c --- a/etc/tests/external-widget/test-ew-xlib.c Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/tests/external-widget/test-ew-xlib.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin St - Fifth Floor, -Boston, MA 02110-1301, USA. */ +along with XEmacs. If not, see . */ #include #include diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/compile-cap-up.xpm --- a/etc/toolbar/compile-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/compile-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * makefile[] = { "33 33 7 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/compile-cap-xx.xpm --- a/etc/toolbar/compile-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/compile-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * makefile[] = { "33 33 6 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/compile-dn.xbm --- a/etc/toolbar/compile-dn.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/compile-dn.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/compile-up.xbm --- a/etc/toolbar/compile-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/compile-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/compile-up.xpm --- a/etc/toolbar/compile-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/compile-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * makefile[] = { "28 28 6 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/compile-xx.xbm --- a/etc/toolbar/compile-xx.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/compile-xx.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/compile-xx.xpm --- a/etc/toolbar/compile-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/compile-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * makefile[] = { "28 28 6 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/copy-cap-up.xpm --- a/etc/toolbar/copy-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/copy-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * copy[] = { "33 33 5 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/copy-cap-xx.xpm --- a/etc/toolbar/copy-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/copy-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * copy[] = { "33 33 4 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/copy-dn.xbm --- a/etc/toolbar/copy-dn.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/copy-dn.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/copy-up.xbm --- a/etc/toolbar/copy-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/copy-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/copy-up.xpm --- a/etc/toolbar/copy-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/copy-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * copy[] = { "28 28 4 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/copy-xx.xbm --- a/etc/toolbar/copy-xx.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/copy-xx.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/copy-xx.xpm --- a/etc/toolbar/copy-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/copy-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * copy[] = { "28 28 4 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/cut-cap-up.xpm --- a/etc/toolbar/cut-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/cut-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * cut[] = { "33 33 4 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/cut-cap-xx.xpm --- a/etc/toolbar/cut-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/cut-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * cut[] = { "33 33 4 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/cut-dn.xbm --- a/etc/toolbar/cut-dn.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/cut-dn.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/cut-up.xbm --- a/etc/toolbar/cut-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/cut-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/cut-up.xpm --- a/etc/toolbar/cut-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/cut-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * cut[] = { "28 28 4 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/cut-xx.xbm --- a/etc/toolbar/cut-xx.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/cut-xx.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/cut-xx.xpm --- a/etc/toolbar/cut-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/cut-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * cut[] = { "28 28 4 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/debug-cap-up.xpm --- a/etc/toolbar/debug-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/debug-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * bug_xpm[] = { "33 33 7 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/debug-cap-xx.xpm --- a/etc/toolbar/debug-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/debug-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * bug_xpm[] = { "33 33 6 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/debug-dn.xbm --- a/etc/toolbar/debug-dn.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/debug-dn.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/debug-up.xbm --- a/etc/toolbar/debug-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/debug-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/debug-up.xpm --- a/etc/toolbar/debug-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/debug-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * bug_xpm[] = { "28 28 6 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/debug-xx.xbm --- a/etc/toolbar/debug-xx.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/debug-xx.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/debug-xx.xpm --- a/etc/toolbar/debug-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/debug-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * bug_xpm[] = { "28 28 6 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/disk-cap-up.xpm --- a/etc/toolbar/disk-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/disk-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * disk[] = { "33 33 6 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/disk-cap-xx.xpm --- a/etc/toolbar/disk-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/disk-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * disk[] = { "33 33 5 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/disk-dn.xbm --- a/etc/toolbar/disk-dn.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/disk-dn.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/disk-up.xbm --- a/etc/toolbar/disk-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/disk-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/disk-up.xpm --- a/etc/toolbar/disk-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/disk-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * disk[] = { "28 28 5 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/disk-xx.xbm --- a/etc/toolbar/disk-xx.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/disk-xx.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/disk-xx.xpm --- a/etc/toolbar/disk-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/disk-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * disk[] = { "28 28 5 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/file-cap-up.xpm --- a/etc/toolbar/file-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/file-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * file[] = { "33 33 5 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/file-cap-xx.xpm --- a/etc/toolbar/file-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/file-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * file[] = { "33 33 4 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/file-dn.xbm --- a/etc/toolbar/file-dn.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/file-dn.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/file-up.xbm --- a/etc/toolbar/file-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/file-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/file-up.xpm --- a/etc/toolbar/file-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/file-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * file[] = { "28 28 4 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/file-xx.xbm --- a/etc/toolbar/file-xx.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/file-xx.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/file-xx.xpm --- a/etc/toolbar/file-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/file-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * file[] = { "28 28 4 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/folder-cap-up.xpm --- a/etc/toolbar/folder-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/folder-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * folder[] = { "33 33 5 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/folder-cap-xx.xpm --- a/etc/toolbar/folder-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/folder-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * folder[] = { "33 33 4 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/folder-dn.xbm --- a/etc/toolbar/folder-dn.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/folder-dn.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/folder-up.xbm --- a/etc/toolbar/folder-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/folder-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/folder-up.xpm --- a/etc/toolbar/folder-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/folder-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * folder[] = { "28 28 4 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/folder-xx.xbm --- a/etc/toolbar/folder-xx.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/folder-xx.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/folder-xx.xpm --- a/etc/toolbar/folder-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/folder-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * folder[] = { "28 28 4 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-def-cap-up.xpm --- a/etc/toolbar/info-def-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-def-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * info[] = { "33 33 2 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-def-cap-xx.xpm --- a/etc/toolbar/info-def-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-def-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * info[] = { "33 33 2 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-def-dn.xbm --- a/etc/toolbar/info-def-dn.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-def-dn.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-def-up.xbm --- a/etc/toolbar/info-def-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-def-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-def-up.xpm --- a/etc/toolbar/info-def-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-def-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * info[] = { "28 28 2 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-def-xx.xbm --- a/etc/toolbar/info-def-xx.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-def-xx.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-def-xx.xpm --- a/etc/toolbar/info-def-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-def-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * info[] = { "28 28 2 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-exit-cap-up.xpm --- a/etc/toolbar/info-exit-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-exit-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char *exit-up[] = { /* width height num_colors chars_per_pixel */ "32 32 6 1", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-exit-cap-xx.xpm --- a/etc/toolbar/info-exit-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-exit-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char *exit-up[] = { /* width height num_colors chars_per_pixel */ "32 32 6 1", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-exit-dn.xbm --- a/etc/toolbar/info-exit-dn.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-exit-dn.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 32 #define noname_height 32 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-exit-up.xbm --- a/etc/toolbar/info-exit-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-exit-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 32 #define noname_height 32 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-exit-up.xpm --- a/etc/toolbar/info-exit-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-exit-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char *exit-up[] = { /* width height num_colors chars_per_pixel */ "32 32 6 1", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-exit-xx.xbm --- a/etc/toolbar/info-exit-xx.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-exit-xx.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 32 #define noname_height 32 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-exit-xx.xpm --- a/etc/toolbar/info-exit-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-exit-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char *exit-up[] = { /* width height num_colors chars_per_pixel */ "32 32 6 1", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-exit.xbm --- a/etc/toolbar/info-exit.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-exit.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 32 #define noname_height 32 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-exit.xpm --- a/etc/toolbar/info-exit.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-exit.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char *exit-up[] = { /* width height num_colors chars_per_pixel */ "32 32 6 1", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-next-cap-up.xpm --- a/etc/toolbar/info-next-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-next-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * file[] = { /* width height num_colors chars_per_pixel */ "28 28 5 1", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-next-cap-xx.xpm --- a/etc/toolbar/info-next-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-next-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * file[] = { /* width height num_colors chars_per_pixel */ "28 28 5 1", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-next-dn.xbm --- a/etc/toolbar/info-next-dn.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-next-dn.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-next-up.xbm --- a/etc/toolbar/info-next-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-next-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-next-up.xpm --- a/etc/toolbar/info-next-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-next-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * file[] = { /* width height num_colors chars_per_pixel */ "28 28 5 1", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-next-xx.xbm --- a/etc/toolbar/info-next-xx.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-next-xx.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-next-xx.xpm --- a/etc/toolbar/info-next-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-next-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * file[] = { /* width height num_colors chars_per_pixel */ "28 28 5 1", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-next.xbm --- a/etc/toolbar/info-next.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-next.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-next.xpm --- a/etc/toolbar/info-next.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-next.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * file[] = { /* width height num_colors chars_per_pixel */ "28 28 5 1", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-prev-cap-up.xpm --- a/etc/toolbar/info-prev-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-prev-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * left-arrow_xpm[] = { /* width height num_colors chars_per_pixel */ "28 28 3 1", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-prev-cap-xx.xpm --- a/etc/toolbar/info-prev-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-prev-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * left-arrow_xpm[] = { /* width height num_colors chars_per_pixel */ "28 28 3 1", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-prev-dn.xbm --- a/etc/toolbar/info-prev-dn.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-prev-dn.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-prev-up.xbm --- a/etc/toolbar/info-prev-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-prev-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-prev-up.xpm --- a/etc/toolbar/info-prev-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-prev-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * left-arrow_xpm[] = { /* width height num_colors chars_per_pixel */ "28 28 3 1", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-prev-xx.xbm --- a/etc/toolbar/info-prev-xx.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-prev-xx.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-prev-xx.xpm --- a/etc/toolbar/info-prev-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-prev-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * left-arrow_xpm[] = { /* width height num_colors chars_per_pixel */ "28 28 3 1", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-prev.xbm --- a/etc/toolbar/info-prev.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-prev.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-prev.xpm --- a/etc/toolbar/info-prev.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-prev.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * left-arrow_xpm[] = { /* width height num_colors chars_per_pixel */ "28 28 3 1", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-up-cap-up.xpm --- a/etc/toolbar/info-up-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-up-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * up-arrow_xpm[] = { /* width height num_colors chars_per_pixel */ "28 28 3 1", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-up-cap-xx.xpm --- a/etc/toolbar/info-up-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-up-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * up-arrow_xpm[] = { /* width height num_colors chars_per_pixel */ "28 28 3 1", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-up-dn.xbm --- a/etc/toolbar/info-up-dn.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-up-dn.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-up-up.xbm --- a/etc/toolbar/info-up-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-up-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-up-up.xpm --- a/etc/toolbar/info-up-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-up-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * up-arrow_xpm[] = { /* width height num_colors chars_per_pixel */ "28 28 3 1", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-up-xx.xbm --- a/etc/toolbar/info-up-xx.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-up-xx.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-up-xx.xpm --- a/etc/toolbar/info-up-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-up-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * up-arrow_xpm[] = { /* width height num_colors chars_per_pixel */ "28 28 3 1", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-up.xbm --- a/etc/toolbar/info-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/info-up.xpm --- a/etc/toolbar/info-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/info-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * up-arrow_xpm[] = { /* width height num_colors chars_per_pixel */ "28 28 3 1", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/last-win-cap-up.xpm --- a/etc/toolbar/last-win-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/last-win-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * last_win_xpm[] = { "33 33 5 1", " c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/last-win-cap-xx.xpm --- a/etc/toolbar/last-win-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/last-win-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * last_win_xpm[] = { "33 33 5 1", " c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/last-win-dn.xbm --- a/etc/toolbar/last-win-dn.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/last-win-dn.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/last-win-up.xbm --- a/etc/toolbar/last-win-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/last-win-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/last-win-up.xpm --- a/etc/toolbar/last-win-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/last-win-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * last_win_xpm[] = { "28 28 5 1", " c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/last-win-xx.xbm --- a/etc/toolbar/last-win-xx.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/last-win-xx.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/last-win-xx.xpm --- a/etc/toolbar/last-win-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/last-win-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * last_win_xpm[] = { "28 28 5 1", " c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/mail-cap-up.xpm --- a/etc/toolbar/mail-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/mail-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * mail[] = { "33 33 6 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/mail-cap-xx.xpm --- a/etc/toolbar/mail-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/mail-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * mail[] = { "33 33 5 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/mail-dn.xbm --- a/etc/toolbar/mail-dn.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/mail-dn.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/mail-up.xbm --- a/etc/toolbar/mail-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/mail-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/mail-up.xpm --- a/etc/toolbar/mail-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/mail-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * mail[] = { "28 28 5 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/mail-xx.xbm --- a/etc/toolbar/mail-xx.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/mail-xx.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/mail-xx.xpm --- a/etc/toolbar/mail-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/mail-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * mail[] = { "28 28 5 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/news-cap-up.xpm --- a/etc/toolbar/news-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/news-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * news_xpm[] = { "33 33 6 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/news-cap-xx.xpm --- a/etc/toolbar/news-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/news-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * news_xpm[] = { "33 33 5 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/news-dn.xbm --- a/etc/toolbar/news-dn.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/news-dn.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/news-up.xbm --- a/etc/toolbar/news-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/news-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/news-up.xpm --- a/etc/toolbar/news-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/news-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * news_xpm[] = { "28 28 5 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/news-xx.xbm --- a/etc/toolbar/news-xx.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/news-xx.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/news-xx.xpm --- a/etc/toolbar/news-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/news-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * news_xpm[] = { "28 28 5 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/next-win-cap-up.xpm --- a/etc/toolbar/next-win-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/next-win-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * next_win_xpm[] = { "33 33 5 1", " c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/next-win-cap-xx.xpm --- a/etc/toolbar/next-win-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/next-win-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * next_win_xpm[] = { "33 33 5 1", " c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/next-win-dn.xbm --- a/etc/toolbar/next-win-dn.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/next-win-dn.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/next-win-up.xbm --- a/etc/toolbar/next-win-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/next-win-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/next-win-up.xpm --- a/etc/toolbar/next-win-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/next-win-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * next_win_xpm[] = { "28 28 5 1", " c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/next-win-xx.xbm --- a/etc/toolbar/next-win-xx.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/next-win-xx.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/next-win-xx.xpm --- a/etc/toolbar/next-win-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/next-win-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * next_win_xpm[] = { "28 28 5 1", " c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/paste-cap-up.xpm --- a/etc/toolbar/paste-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/paste-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * paste[] = { "33 33 6 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/paste-cap-xx.xpm --- a/etc/toolbar/paste-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/paste-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * paste[] = { "33 33 5 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/paste-dn.xbm --- a/etc/toolbar/paste-dn.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/paste-dn.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/paste-up.xbm --- a/etc/toolbar/paste-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/paste-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/paste-up.xpm --- a/etc/toolbar/paste-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/paste-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * paste[] = { "28 28 5 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/paste-xx.xbm --- a/etc/toolbar/paste-xx.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/paste-xx.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/paste-xx.xpm --- a/etc/toolbar/paste-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/paste-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * paste[] = { "28 28 5 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/printer-cap-up.xpm --- a/etc/toolbar/printer-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/printer-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * printer[] = { "33 33 7 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/printer-cap-xx.xpm --- a/etc/toolbar/printer-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/printer-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * printer[] = { "33 33 6 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/printer-dn.xbm --- a/etc/toolbar/printer-dn.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/printer-dn.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/printer-up.xbm --- a/etc/toolbar/printer-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/printer-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/printer-up.xpm --- a/etc/toolbar/printer-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/printer-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * printer[] = { "28 28 6 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/printer-xx.xbm --- a/etc/toolbar/printer-xx.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/printer-xx.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/printer-xx.xpm --- a/etc/toolbar/printer-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/printer-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * printer[] = { "28 28 6 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/replace-cap-up.xpm --- a/etc/toolbar/replace-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/replace-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * replace[] = { "33 33 2 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/replace-cap-xx.xpm --- a/etc/toolbar/replace-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/replace-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * replace[] = { "33 33 2 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/replace-dn.xbm --- a/etc/toolbar/replace-dn.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/replace-dn.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/replace-up.xbm --- a/etc/toolbar/replace-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/replace-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/replace-up.xpm --- a/etc/toolbar/replace-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/replace-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * replace[] = { "28 28 2 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/replace-xx.xbm --- a/etc/toolbar/replace-xx.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/replace-xx.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/replace-xx.xpm --- a/etc/toolbar/replace-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/replace-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * replace[] = { "28 28 2 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/spell-cap-up.xpm --- a/etc/toolbar/spell-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/spell-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * dict[] = { "33 33 7 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/spell-cap-xx.xpm --- a/etc/toolbar/spell-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/spell-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * dict[] = { "33 33 6 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/spell-dn.xbm --- a/etc/toolbar/spell-dn.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/spell-dn.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/spell-up.xbm --- a/etc/toolbar/spell-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/spell-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/spell-up.xpm --- a/etc/toolbar/spell-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/spell-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * dict[] = { "28 28 6 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/spell-xx.xbm --- a/etc/toolbar/spell-xx.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/spell-xx.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/spell-xx.xpm --- a/etc/toolbar/spell-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/spell-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * dict[] = { "28 28 6 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/undo-cap-up.xpm --- a/etc/toolbar/undo-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/undo-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * undo[] = { "33 33 6 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/undo-cap-xx.xpm --- a/etc/toolbar/undo-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/undo-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * undo[] = { "33 33 5 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/undo-dn.xbm --- a/etc/toolbar/undo-dn.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/undo-dn.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/undo-up.xbm --- a/etc/toolbar/undo-up.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/undo-up.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/undo-up.xpm --- a/etc/toolbar/undo-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/undo-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * undo[] = { "28 28 5 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/undo-xx.xbm --- a/etc/toolbar/undo-xx.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/undo-xx.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 28 #define noname_height 28 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/undo-xx.xpm --- a/etc/toolbar/undo-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/undo-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * undo[] = { "28 28 5 1", "X c Gray75 s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/workshop-cap-up.xpm --- a/etc/toolbar/workshop-cap-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/workshop-cap-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * xemacs-cap-workshop_xpm[] = { "33 33 9 1", " c #BDBDBDBDBDBD s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/workshop-cap-xx.xpm --- a/etc/toolbar/workshop-cap-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/workshop-cap-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * xemacs-cap-workshop-xx_xpm[] = { "33 33 8 1", " c #BDBDBDBDBDBD s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/workshop-up.xpm --- a/etc/toolbar/workshop-up.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/workshop-up.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * xemacs-workshop_xpm[] = { "28 28 8 1", " c #BDBDBDBDBDBD s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/toolbar/workshop-xx.xpm --- a/etc/toolbar/workshop-xx.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/toolbar/workshop-xx.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * xemacs-workshop-xx_xpm[] = { "28 28 8 1", " c #BDBDBDBDBDBD s backgroundToolBarColor", diff -r 861f2601a38b -r 1f0b15040456 etc/trash.xpm --- a/etc/trash.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/trash.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + /* A trash can, drawn by jwz */ static char *trash[] = { /* width height ncolors chars_per_pixel x_hot y_hot */ diff -r 861f2601a38b -r 1f0b15040456 etc/unicode/COPYING --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/unicode/COPYING Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,9 @@ +These files are *not* part of XEmacs. + +They are all available publicly from O'Reilly Associates or the +Unicode Consortium, and are collected here *unchanged* for the +convenience of the user/builder of XEmacs. Redistribution is governed +by their own licensing notices. + +See "ibm/COPYING", "mule-ucs/README" and "unicode-consortium/COPYING" +for details. diff -r 861f2601a38b -r 1f0b15040456 etc/unicode/ibm/COPYING --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/unicode/ibm/COPYING Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,48 @@ +UNICODE, INC. LICENSE AGREEMENT - DATA FILES AND SOFTWARE + + Unicode Data Files include all data files under the directories +http://www.unicode.org/Public/, http://www.unicode.org/reports/, and +http://www.unicode.org/cldr/data/ . Unicode Software includes any source code +published in the Unicode Standard or under the directories +http://www.unicode.org/Public/, http://www.unicode.org/reports/, and +http://www.unicode.org/cldr/data/. + + NOTICE TO USER: Carefully read the following legal agreement. BY +DOWNLOADING, INSTALLING, COPYING OR OTHERWISE USING UNICODE INC.'S DATA FILES +("DATA FILES"), AND/OR SOFTWARE ("SOFTWARE"), YOU UNEQUIVOCALLY ACCEPT, AND +AGREE TO BE BOUND BY, ALL OF THE TERMS AND CONDITIONS OF THIS AGREEMENT. IF YOU +DO NOT AGREE, DO NOT DOWNLOAD, INSTALL, COPY, DISTRIBUTE OR USE THE DATA FILES +OR SOFTWARE. + + COPYRIGHT AND PERMISSION NOTICE + + Copyright © 1991-2009 Unicode, Inc. All rights reserved. Distributed under +the Terms of Use in http://www.unicode.org/copyright.html. + + Permission is hereby granted, free of charge, to any person obtaining a copy +of the Unicode data files and any associated documentation (the "Data Files") or +Unicode software and any associated documentation (the "Software") to deal in +the Data Files or Software without restriction, including without limitation the +rights to use, copy, modify, merge, publish, distribute, and/or sell copies of +the Data Files or Software, and to permit persons to whom the Data Files or +Software are furnished to do so, provided that (a) the above copyright notice(s) +and this permission notice appear with all copies of the Data Files or Software, +(b) both the above copyright notice(s) and this permission notice appear in +associated documentation, and (c) there is clear notice in each modified Data +File or in the Software as well as in the documentation associated with the Data +File(s) or Software that the data or software has been modified. + + THE DATA FILES AND SOFTWARE ARE PROVIDED "AS IS", WITHOUT WARRANTY OF ANY +KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT OF THIRD +PARTY RIGHTS. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR HOLDERS INCLUDED IN THIS +NOTICE BE LIABLE FOR ANY CLAIM, OR ANY SPECIAL INDIRECT OR CONSEQUENTIAL +DAMAGES, OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, +WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING +OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THE DATA FILES OR +SOFTWARE. + + Except as contained in this notice, the name of a copyright holder shall not +be used in advertising or otherwise to promote the sale, use or other dealings +in these Data Files or Software without prior written authorization of the +copyright holder. diff -r 861f2601a38b -r 1f0b15040456 etc/unicode/other/lao.txt --- a/etc/unicode/other/lao.txt Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/unicode/other/lao.txt Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ ## This file is part of XEmacs. -## XEmacs is free software; you can redistribute it and/or modify it +## 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. +## Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ ## for more details. ## You should have received a copy of the GNU General Public License -## along with XEmacs; see the file COPYING. If not, write to -## the Free Software Foundation, Inc., 51 Franklin St - Fifth Floor, -## Boston, MA 02110-1301, USA. +## along with XEmacs. If not, see . ## Made up based on the comment in lao.el: diff -r 861f2601a38b -r 1f0b15040456 etc/unicode/unicode-consortium/COPYING --- a/etc/unicode/unicode-consortium/COPYING Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/unicode/unicode-consortium/COPYING Sun May 01 18:44:03 2011 +0100 @@ -2,9 +2,20 @@ Copyright (c) 2007 The Free Software Foundation, Inc. -This file is part of XEmacs. It is licensed to you under the -conditions of the GNU General Public License, version 2 or any later -version published by the FSF, at your option. +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 3 of the License, 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. If not, see . Other files in this directory are subject to O'Reilly Media and Unicode Consortium licenses. The files oreilly.html and diff -r 861f2601a38b -r 1f0b15040456 etc/xemacs-beta.xpm --- a/etc/xemacs-beta.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/xemacs-beta.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char *magick[] = { /* columns rows colors chars-per-pixel */ "388 145 19 1", diff -r 861f2601a38b -r 1f0b15040456 etc/xemacs-fe.sh --- a/etc/xemacs-fe.sh Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/xemacs-fe.sh Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,20 @@ # $.Id: emacs-fe,v 1.8 1996/03/07 04:32:33 friedman Exp $ -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# +# 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 3 of the License, 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 this program; if not, you can either send email to this -# program's maintainer or write to: The Free Software Foundation, -# Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA. +# along with XEmacs. If not, see . # Commentary: diff -r 861f2601a38b -r 1f0b15040456 etc/xemacs-icon.xpm --- a/etc/xemacs-icon.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/xemacs-icon.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char *XEmacs48_xpm[] = { /* width height ncolors chars_per_pixel */ "48 48 12 1", diff -r 861f2601a38b -r 1f0b15040456 etc/xemacs-icon2.xbm --- a/etc/xemacs-icon2.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/xemacs-icon2.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define noname_width 50 #define noname_height 50 static char noname_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/xemacs-icon2.xpm --- a/etc/xemacs-icon2.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/xemacs-icon2.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * xemacs_xpm[] = { /* XEmacs pixmap * width height ncolors chars_per_pixel */ diff -r 861f2601a38b -r 1f0b15040456 etc/xemacs-icon3.xpm --- a/etc/xemacs-icon3.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/xemacs-icon3.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char * xemacs_xpm[] = { /* width height num_colors chars_per_pixel */ "48 48 11 1", diff -r 861f2601a38b -r 1f0b15040456 etc/xemacs.1 --- a/etc/xemacs.1 Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/xemacs.1 Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,4 @@ +.\" See section COPYING for copyright and redistribution information. .TH XEMACS 1 "2000-09-20" .UC 4 .SH NAME @@ -795,3 +796,49 @@ or from a mirror site near you. Mirror sites are listed in the file etc/FTP in the XEmacs distribution or see the Web site for an up-to-date list of mirror sites. + +.SH COPYING +Copyright +.if t \(co +.if n (C) +2004 Shyamal Prasad +.br +Copyright +.if t \(co +.if n (C) +1998, 2000 Martin Buchholz +.br +Copyright +.if t \(co +.if n (C) +1998 Andreas Jaeger +.br +Copyright +.if t \(co +.if n (C) +1998 Michael Sperber +.br +Copyright +.if t \(co +.if n (C) +1997, 1998 SL Baur +.br +Copyright +.if t \(co +.if n (C) +1992-1997 Ben Wing +.PP +This file is part of XEmacs. +.PP +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 3 of the License, or (at your +option) any later version. +.PP +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. +.PP +You should have received a copy of the GNU General Public License +along with XEmacs. If not, see . diff -r 861f2601a38b -r 1f0b15040456 etc/xemacs.xbm --- a/etc/xemacs.xbm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/xemacs.xbm Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +/* 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 3 of the License, 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. If not, see . */ + #define xemacs_width 266 #define xemacs_height 61 static unsigned char xemacs_bits[] = { diff -r 861f2601a38b -r 1f0b15040456 etc/xemacs.xpm --- a/etc/xemacs.xpm Sat Feb 20 06:03:00 2010 -0600 +++ b/etc/xemacs.xpm Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,20 @@ /* XPM */ + +/* 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 3 of the License, 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. If not, see . */ + static char *noname[] = { /* width height ncolors chars_per_pixel */ "388 145 25 1", diff -r 861f2601a38b -r 1f0b15040456 lib-src/ChangeLog --- a/lib-src/ChangeLog Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/ChangeLog Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,69 @@ +2011-04-29 Stephen J. Turnbull + + * XEmacs 21.5.31 "ginger" is released. + +2011-04-26 Stephen J. Turnbull + + * XEmacs 21.5.30 "garlic" is released. + +2011-01-15 Mike Sperber + + * fakemail.c: #include on FreeBSD, since we no + longer have freebsd.h. + +2010-06-14 Stephen J. Turnbull + + * gnuserv.c: + * gnuserv.h: + * gnuslib.c: + Add standard permission boilerplate. + + * ad2c: + Add copyright notices based on internal evidence. + +2010-06-14 Stephen J. Turnbull + + * cvtmail.c: + * fakemail.c: + * make-path.c: + * profile.c: + * tcp.c: + Fix typo (doubled phrase) in permission notice. + +2010-06-13 Stephen J. Turnbull + + * ad2c: Correct FSF address in permission notice. + +2010-06-02 Aidan Kehoe + + * gnuclient.c (main): + If gnuclient was built with GTK support, and is asking a gnuserv + without GTK support to open a frame, fall back to X11, don't + throw an error on the server side, invisible to the client. + +2010-04-17 Aidan Kehoe + + * make-docfile.c (scan_lisp_file): + Even if a function doesn't have a doc string, store its file name + in DOC. + +2010-03-02 Ben Wing + + * digest-doc.c: + * make-path.c: + `emacs' isn't defined, but HAVE_CONFIG_H is, so use it to get + config.h. + + * getopt.h: + Conditionalize on HAVE_CONFIG_H to get real prototypes. + +2010-02-25 Ben Wing + + * make-docfile.c: + * make-docfile.c (write_c_args): + Convert newlines to spaces so that argument lists are always on one + line, because that's what function-documentation-1 expects. + 2010-02-19 Ben Wing * digest-doc.c: @@ -2158,3 +2224,22 @@ * update-elc.sh: Corrections to protect against too smart /bin/sh'es. + +ChangeLog entries synched from GNU Emacs are the property of the FSF. +Other ChangeLog entries are usually the property of the author of the +change. + +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 3 of the License, 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. If not, see . diff -r 861f2601a38b -r 1f0b15040456 lib-src/Makefile.in.in --- a/lib-src/Makefile.in.in Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/Makefile.in.in Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ ## This file is part of XEmacs. -## XEmacs is free software; you can redistribute it and/or modify it +## 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. +## Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ ## for more details. ## You should have received a copy of the GNU General Public License -## along with XEmacs; see the file COPYING. If not, write to -## the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -## Boston, MA 02111-1307, USA. +## along with XEmacs. If not, see . ## Note: FSF Makefile.in.in does something weird so that the comments ## above a certain point in this file are in shell format instead of diff -r 861f2601a38b -r 1f0b15040456 lib-src/ad2c --- a/lib-src/ad2c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/ad2c Sun May 01 18:44:03 2011 +0100 @@ -1,5 +1,9 @@ #!/bin/sh # +# Copyright (C) 1990, 1991 George Ferguson +# Copyright (C) 1992 Charles Hannum +# Copyright (C) 1992 Matthew Stier +# # ad2c : Convert app-defaults file to C strings decls. # # George Ferguson, ferguson@cs.rcohester.edu, 12 Nov 1990. @@ -13,21 +17,19 @@ # Escape quotes after escaping backslashes. # # This file is part of XEmacs. -# -# XEmacs is free software; you can redistribute it and/or modify it +# +# 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. -# +# Free Software Foundation, either version 3 of the License, or (at your +# option) any later version. +# # XEmacs is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License # for more details. -# +# # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -# Boston, MA 02111-1301, USA. */ +# along with XEmacs. If not, see . # # Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lib-src/add-big-package.sh --- a/lib-src/add-big-package.sh Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/add-big-package.sh Sun May 01 18:44:03 2011 +0100 @@ -7,21 +7,19 @@ # Keywords: packages internal # 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. - +# +# 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 3 of the License, or (at your +# option) any later version. +# +# XEmacs is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. +# along with XEmacs. If not, see . ### Commentary: diff -r 861f2601a38b -r 1f0b15040456 lib-src/b2m.c --- a/lib-src/b2m.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/b2m.c Sun May 01 18:44:03 2011 +0100 @@ -1,12 +1,13 @@ /* * b2m - a filter for Babyl -> Unix mail files + * The copyright on this file has been disclaimed. * * usage: b2m < babyl > mailbox * * I find this useful whenever I have to use a * system which - shock horror! - doesn't run - * Gnu emacs. At least now I can read all my - * Gnumacs Babyl format mail files! + * GNU Emacs. At least now I can read all my + * GNU Emacs Babyl format mail files! * * it's not much but it's free! * @@ -30,7 +31,8 @@ #include #include #include -#ifdef WIN32_NATIVE +#include +#ifdef MSDOS #include #endif @@ -39,20 +41,20 @@ #undef FALSE #define FALSE 0 -/* Exit codes for success and failure. */ -#ifdef VMS -#define GOOD 1 -#define BAD 0 -#else -#define GOOD 0 -#define BAD 1 -#endif - #define streq(s,t) (strcmp (s, t) == 0) #define strneq(s,t,n) (strncmp (s, t, n) == 0) typedef int logical; +#define TM_YEAR_BASE 1900 + +/* Nonzero if TM_YEAR is a struct tm's tm_year value that causes + asctime to have well-defined behavior. */ +#ifndef TM_YEAR_IN_ASCTIME_RANGE +# define TM_YEAR_IN_ASCTIME_RANGE(tm_year) \ + (1000 - TM_YEAR_BASE <= (tm_year) && (tm_year) <= 9999 - TM_YEAR_BASE) +#endif + /* * A `struct linebuffer' is a structure which holds a line of text. * `readline' reads a line from a stream into a linebuffer and works @@ -64,12 +66,10 @@ char *buffer; }; - -static long *xmalloc (unsigned int); -static long *xrealloc (void *, unsigned int); -static char *concat (char *s1, char *s2, char *s3); -static long readline (struct linebuffer *, FILE *); -static void fatal (char *); +long *xmalloc (unsigned int), *xrealloc (char *, unsigned int); +char *concat (char *, char *, char *); +long readline (struct linebuffer *, register FILE *); +void fatal (char *); /* * xnew -- allocate storage. SYNOPSIS: Type *xnew (int n, Type); @@ -80,31 +80,73 @@ char *progname; -int -main (int argc, char *argv[]) +struct option longopts[] = { - logical labels_saved, printing, header; + { "help", no_argument, NULL, 'h' }, + { "version", no_argument, NULL, 'V' }, + { 0 } +}; + +extern int optind; + +int +main (int argc, char **argv) +{ + logical labels_saved, printing, header, first, last_was_blank_line; time_t ltoday; - char *labels = NULL, *p, *today; + struct tm *tm; + char *labels, *p, *today; struct linebuffer data; -#ifdef WIN32_NATIVE +#ifdef MSDOS _fmode = O_BINARY; /* all of files are treated as binary files */ +#if __DJGPP__ > 1 if (!isatty (fileno (stdout))) setmode (fileno (stdout), O_BINARY); if (!isatty (fileno (stdin))) setmode (fileno (stdin), O_BINARY); +#else /* not __DJGPP__ > 1 */ + (stdout)->_flag &= ~_IOTEXT; + (stdin)->_flag &= ~_IOTEXT; +#endif /* not __DJGPP__ > 1 */ #endif progname = argv[0]; - if (argc != 1) + while (1) + { + int opt = getopt_long (argc, argv, "hV", longopts, 0); + if (opt == EOF) + break; + + switch (opt) + { + case 'V': + printf ("%s (XEmacs %s)\n", "b2m", EMACS_VERSION); + puts ("b2m is in the public domain."); + exit (EXIT_SUCCESS); + + case 'h': + fprintf (stderr, "Usage: %s unixmailbox\n", progname); + exit (EXIT_SUCCESS); + } + } + + if (optind != argc) { fprintf (stderr, "Usage: %s unixmailbox\n", progname); - exit (GOOD); + exit (EXIT_SUCCESS); } - labels_saved = printing = header = FALSE; + + labels_saved = printing = header = last_was_blank_line = FALSE; + first = TRUE; ltoday = time (0); - today = ctime (<oday); + /* Convert to a string, checking for out-of-range time stamps. + Don't use 'ctime', as that might dump core if the hardware clock + is set to a bizarre value. */ + tm = localtime (<oday); + if (! (tm && TM_YEAR_IN_ASCTIME_RANGE (tm->tm_year) + && (today = asctime (tm)))) + fatal ("current time is out of range"); data.size = 200; data.buffer = xnew (200, char); @@ -127,6 +169,10 @@ continue; else if (data.buffer[1] == '\f') { + if (first) + first = FALSE; + else if (! last_was_blank_line) + puts(""); /* Save labels. */ readline (&data, stdin); p = strtok (data.buffer, " ,\r\n\t"); @@ -152,9 +198,16 @@ } if (printing) - puts (data.buffer); + { + puts (data.buffer); + if (data.buffer[0] == '\0') + last_was_blank_line = TRUE; + else + last_was_blank_line = FALSE; + } } - return 0; + + return EXIT_SUCCESS; } @@ -163,7 +216,7 @@ * Return a newly-allocated string whose contents * concatenate those of s1, s2, s3. */ -static char * +char * concat (char *s1, char *s2, char *s3) { int len1 = strlen (s1), len2 = strlen (s2), len3 = strlen (s3); @@ -182,8 +235,9 @@ * Return the number of characters read from `stream', * which is the length of the line including the newline, if any. */ -static long -readline (struct linebuffer *linebuffer, FILE *stream) +long +readline (struct linebuffer *linebuffer, register FILE *stream) + { char *buffer = linebuffer->buffer; register char *p = linebuffer->buffer; @@ -205,12 +259,13 @@ } if (c == EOF) { + *p = '\0'; chars_deleted = 0; break; } if (c == '\n') { - if (p[-1] == '\r' && p > buffer) + if (p > buffer && p[-1] == '\r') { *--p = '\0'; chars_deleted = 2; @@ -231,7 +286,7 @@ /* * Like malloc but get fatal error if memory is exhausted. */ -static long * +long * xmalloc (unsigned int size) { long *result = (long *) malloc (size); @@ -240,8 +295,8 @@ return result; } -static long * -xrealloc (void *ptr, unsigned int size) +long * +xrealloc (char *ptr, unsigned int size) { long *result = (long *) realloc (ptr, size); if (result == NULL) @@ -249,10 +304,11 @@ return result; } -static void +void fatal (char *message) { fprintf (stderr, "%s: %s\n", progname, message); - exit (BAD); + exit (EXIT_FAILURE); } +/* b2m.c ends here */ diff -r 861f2601a38b -r 1f0b15040456 lib-src/config.values.sh --- a/lib-src/config.values.sh Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/config.values.sh Sun May 01 18:44:03 2011 +0100 @@ -4,26 +4,26 @@ # config.values.sh --- create config.values.in from ../configure +# Copyright (C) 1997, 1999 Martin Buchholz + # Author: Martin Buchholz # Maintainer: Martin Buchholz # Keywords: configure elisp report-xemacs-bugs # 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. - +# +# 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 3 of the License, or (at your +# option) any later version. +# +# XEmacs is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. +# along with XEmacs. If not, see . ### Commentary: diff -r 861f2601a38b -r 1f0b15040456 lib-src/cvtmail.c --- a/lib-src/cvtmail.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/cvtmail.c Sun May 01 18:44:03 2011 +0100 @@ -1,20 +1,18 @@ /* Copyright (C) 1985, 1993, 1994 Free Software Foundation 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 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 3 of the License, 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. +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 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.28. */ diff -r 861f2601a38b -r 1f0b15040456 lib-src/ellcc.c --- a/lib-src/ellcc.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/ellcc.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,10 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. - +along with XEmacs. If not, see . Author: J. Kean Johnston (jkj@sco.com). Please mail bugs and suggestions to the XEmacs maintainer. */ diff -r 861f2601a38b -r 1f0b15040456 lib-src/ellcc.h.in --- a/lib-src/ellcc.h.in Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/ellcc.h.in Sun May 01 18:44:03 2011 +0100 @@ -3,7 +3,22 @@ /* Most of this is required due to a bug in the GCC compiler driver which prevents us from passing this on the command line. It also reduces the compiler command line length, which can be a problem - on some systems. */ + on some systems. + +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 3 of the License, 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. If not, see . */ #ifndef ELLCC_HDR #define ELLCC_HDR diff -r 861f2601a38b -r 1f0b15040456 lib-src/etags.c --- a/lib-src/etags.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/etags.c Sun May 01 18:44:03 2011 +0100 @@ -34,19 +34,18 @@ This file is not considered part of GNU Emacs. -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. +This program is free software: you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation, either version 3 of the License, or (at your +option) any later version. + +This program is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software Foundation, -Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ +along with this program. If not, see . */ /* NB To comply with the above BSD license, copyright information is diff -r 861f2601a38b -r 1f0b15040456 lib-src/fakemail.c --- a/lib-src/fakemail.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/fakemail.c Sun May 01 18:44:03 2011 +0100 @@ -3,20 +3,18 @@ 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 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 3 of the License, 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. +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 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.28. */ @@ -146,6 +144,10 @@ extern char *malloc (), *realloc (); #endif +#if defined(__FreeBSD__) +#include +#endif + #if defined(__FreeBSD_version) && __FreeBSD_version >= 400000 #define CURRENT_USER #endif diff -r 861f2601a38b -r 1f0b15040456 lib-src/fix-perms.sh --- a/lib-src/fix-perms.sh Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/fix-perms.sh Sun May 01 18:44:03 2011 +0100 @@ -7,21 +7,19 @@ # Keywords: internal # 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. - +# +# 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 3 of the License, or (at your +# option) any later version. +# +# XEmacs is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. +# along with XEmacs. If not, see . ### Commentary: diff -r 861f2601a38b -r 1f0b15040456 lib-src/getopt.c --- a/lib-src/getopt.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/getopt.c Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ NOTE: The canonical source of this file is maintained with the GNU C Library. Bugs can be reported to bug-glibc@prep.ai.mit.edu. -This program is free software; you can redistribute it and/or modify it +This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. +Free Software Foundation, either version 3 of the License, or (at your +option) any later version. -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. +This program is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, -USA. */ +along with this program. If not, see . */ /* This tells Alpha OSF/1 not to define a getopt prototype in . Ditto for AIX 3.2 and . */ diff -r 861f2601a38b -r 1f0b15040456 lib-src/getopt.h --- a/lib-src/getopt.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/getopt.h Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,18 @@ NOTE: The canonical source of this file is maintained with the GNU C Library. Bugs can be reported to bug-glibc@prep.ai.mit.edu. -This program is free software; you can redistribute it and/or modify it +This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. +Free Software Foundation, either version 3 of the License, or (at your +option) any later version. -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. +This program is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, -USA. */ +along with this program. If not, see . */ #ifndef _GETOPT_H #define _GETOPT_H 1 @@ -98,7 +96,7 @@ #define required_argument 1 #define optional_argument 2 -#if defined (__GNU_LIBRARY__) || defined (__cplusplus) || defined (CYGWIN) +#if defined (__GNU_LIBRARY__) || defined (__cplusplus) || defined (HAVE_CONFIG_H) /* Many other libraries have conflicting prototypes for getopt, with differences in the consts, in stdlib.h. To avoid compilation errors, only prototype getopt for the GNU C library. */ diff -r 861f2601a38b -r 1f0b15040456 lib-src/getopt1.c --- a/lib-src/getopt1.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/getopt1.c Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,18 @@ NOTE: The canonical source of this file is maintained with the GNU C Library. Bugs can be reported to bug-glibc@prep.ai.mit.edu. -This program is free software; you can redistribute it and/or modify it +This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. +Free Software Foundation, either version 3 of the License, or (at your +option) any later version. -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. +This program is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, -USA. */ +along with this program. If not, see . */ #ifdef HAVE_CONFIG_H #include diff -r 861f2601a38b -r 1f0b15040456 lib-src/gnuattach --- a/lib-src/gnuattach Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/gnuattach Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,18 @@ # Copyright (C) 1997 Free Software Foundation, Inc. -# XEmacs is free software; you can redistribute it and/or modify it +# 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. - +# Free Software Foundation, either version 3 of the License, or (at your +# option) any later version. +# # XEmacs is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License # for more details. - +# # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. +# along with XEmacs. If not, see . echo "$0: Please use \`gnuclient -nw' instead." >&2 exit 1 diff -r 861f2601a38b -r 1f0b15040456 lib-src/gnuclient.c --- a/lib-src/gnuclient.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/gnuclient.c Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,10 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. - +along with XEmacs. If not, see . Author: Andy Norman (ange@hplb.hpl.hp.com), based on 'etc/emacsclient.c' from the GNU Emacs 18.52 distribution. @@ -300,7 +297,7 @@ main (int argc, char *argv[]) { int starting_line = 0; /* line to start editing at */ - char command[QXE_PATH_MAX+50];/* emacs command buffer */ + char command[QXE_PATH_MAX + 512];/* emacs command buffer */ char fullpath[QXE_PATH_MAX+1];/* full pathname to file */ char *eval_form = NULL; /* form to evaluate with `-eval' */ char *eval_function = NULL; /* function to evaluate with `-f' */ @@ -645,7 +642,11 @@ #endif #ifdef HAVE_GTK else if (display) - strcpy (command, "(gnuserv-edit-files '(gtk nil) '("); + sprintf (command, + /* #### We should probably do this sort of thing for + other window systems. */ + "(gnuserv-edit-files (assoc* t '((gtk nil) (x %s)) " + ":key #'valid-device-type-p) '(", clean_string (display)); #endif #ifdef HAVE_MS_WINDOWS else diff -r 861f2601a38b -r 1f0b15040456 lib-src/gnudoit --- a/lib-src/gnudoit Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/gnudoit Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,18 @@ # Copyright (C) 1997 Free Software Foundation, Inc. -# XEmacs is free software; you can redistribute it and/or modify it +# 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. - +# Free Software Foundation, either version 3 of the License, or (at your +# option) any later version. +# # XEmacs is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License # for more details. - +# # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. +# along with XEmacs. If not, see . if [ x"$1" = x-q ] then diff -r 861f2601a38b -r 1f0b15040456 lib-src/gnuserv.c --- a/lib-src/gnuserv.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/gnuserv.c Sun May 01 18:44:03 2011 +0100 @@ -2,10 +2,20 @@ Server code for handling requests from clients and forwarding them on to the XEmacs process. - This file is part of XEmacs. + 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 3 of the License, or (at your + option) any later version. - Copying is permitted under those conditions described by the GNU - General Public License. + 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. If not, see . Copyright (C) 1989 Free Software Foundation, Inc. diff -r 861f2601a38b -r 1f0b15040456 lib-src/gnuserv.h --- a/lib-src/gnuserv.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/gnuserv.h Sun May 01 18:44:03 2011 +0100 @@ -2,12 +2,22 @@ Header file for the XEmacs server and client C code. + Copyright (C) 1989 Free Software Foundation, Inc. + This file is part of XEmacs. - Copying is permitted under those conditions described by the GNU - General Public License. + 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 3 of the License, or (at your + option) any later version. - Copyright (C) 1989 Free Software Foundation, Inc. + 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. If not, see . Author: Andy Norman (ange@hplb.hpl.hp.com), based on 'etc/server.c' and 'etc/emacsclient.c' from the 18.52 GNU diff -r 861f2601a38b -r 1f0b15040456 lib-src/gnuslib.c --- a/lib-src/gnuslib.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/gnuslib.c Sun May 01 18:44:03 2011 +0100 @@ -1,10 +1,22 @@ /* -*-C-*- Common library code for the XEmacs server and client. + + This file is part of XEmacs. - Copying is permitted under those conditions described by the GNU - General Public License. + 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 3 of the License, 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. If not, see . Copyright (C) 1989 Free Software Foundation, Inc. diff -r 861f2601a38b -r 1f0b15040456 lib-src/gzip-el.sh --- a/lib-src/gzip-el.sh Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/gzip-el.sh Sun May 01 18:44:03 2011 +0100 @@ -9,21 +9,19 @@ # Keywords: internal # 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. - +# +# 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 3 of the License, or (at your +# option) any later version. +# +# XEmacs is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. +# along with XEmacs. If not, see . # # diff -r 861f2601a38b -r 1f0b15040456 lib-src/i.c --- a/lib-src/i.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/i.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* When run with an argument, i treats it as a command line, and pipes command stdin, stdout and stderr to its own respective streams. How diff -r 861f2601a38b -r 1f0b15040456 lib-src/installexe.sh --- a/lib-src/installexe.sh Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/installexe.sh Sun May 01 18:44:03 2011 +0100 @@ -3,21 +3,19 @@ # Copyright (C) 1998 Andy Piper # 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 +# +# 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 3 of the License, 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. - +# +# XEmacs is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to the Free -# Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301, USA. +# along with XEmacs. If not, see . install_prog=$1 shift diff -r 861f2601a38b -r 1f0b15040456 lib-src/make-docfile.c --- a/lib-src/make-docfile.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/make-docfile.c Sun May 01 18:44:03 2011 +0100 @@ -3,24 +3,22 @@ Free Software Foundation, Inc. Copyright (C) 1995 Board of Trustees, University of Illinois. Copyright (C) 1998, 1999 J. Kean Johnston. - Copyright (C) 2001, 2002 Ben Wing. + Copyright (C) 2001, 2002, 2010 Ben Wing. 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 21.3. */ @@ -651,11 +649,11 @@ } /* Print the C argument list as it would appear in lisp: - print underscores as hyphens, and print commas and newlines + print underscores as hyphens, and print commas, tabs and newlines as spaces. Collapse adjacent spaces into one. */ if (c == '_') c = '-'; - else if (c == ',' /* || c == '\n' */) + else if (c == ',' || c == '\n' || c == '\t') c = ' '; /* XEmacs change: handle \n below for readability */ @@ -682,18 +680,28 @@ in_ident = 0; just_spaced = 0; } - /* XEmacs change: if the character is carriage return or linefeed, - escape it for the compiler */ +#if 0 + /* [[ XEmacs change: if the character is carriage return or linefeed, + escape it for the compiler ]] I doubt the clause with '\r' ever + worked right, and outputting newlines now screws up the regexp + in function-documentation-1, so don't do this; instead, we treat + newlines like spaces. --ben */ else if (c == '\n') { putc('\\', out); putc('\n', out); + c = ' '; } else if (c == '\r') { putc('\\', out); putc('\r', out); } +#else + else if (c == '\r') /* Just eat it, since we expect a newline to + follow */ + ; +#endif /* (not) 0 */ else if (c != ' ' || !just_spaced) { if (c >= 'a' && c <= 'z') @@ -1074,6 +1082,7 @@ { char buffer[BUFSIZ]; char type; + int no_docstring = 0; /* If not at end of line, skip till we get to one. */ if (c != '\n') @@ -1177,7 +1186,7 @@ fprintf (stderr, "## non-docstring in %s (%s)\n", buffer, filename); #endif - continue; + no_docstring = 1; } } @@ -1207,7 +1216,7 @@ fprintf (stderr, "## non-docstring in %s (%s)\n", buffer, filename); #endif - continue; + no_docstring = 1; } } } @@ -1266,7 +1275,7 @@ fprintf (stderr, "## non-docstring in %s (%s)\n", buffer, filename); #endif - continue; + no_docstring = 1; } } } @@ -1323,7 +1332,7 @@ fprintf (stderr, "## non-docstring in %s (%s)\n", buffer, filename); #endif - continue; + no_docstring = 1; } } } @@ -1381,7 +1390,7 @@ fprintf (stderr, "## non-docstring in %s (%s)\n", buffer, filename); #endif - continue; + no_docstring = 1; } } } @@ -1412,15 +1421,18 @@ putc (037, outfile); putc (type, outfile); fprintf (outfile, "%s\n", buffer); - if (saved_string) - { - fputs (saved_string, outfile); - /* Don't use one dynamic doc string twice. */ - free (saved_string); - saved_string = 0; - } - else - read_c_string (infile, 1, 0); + if (!no_docstring) + { + if (saved_string) + { + fputs (saved_string, outfile); + /* Don't use one dynamic doc string twice. */ + free (saved_string); + saved_string = 0; + } + else + read_c_string (infile, 1, 0); + } } fclose (infile); return 0; diff -r 861f2601a38b -r 1f0b15040456 lib-src/make-dump-id.c --- a/lib-src/make-dump-id.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/make-dump-id.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ #include #include diff -r 861f2601a38b -r 1f0b15040456 lib-src/make-msgfile.lex --- a/lib-src/make-msgfile.lex Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/make-msgfile.lex Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Written by Ben Wing, November 1994. Some code based on earlier make-msgfile.c. */ diff -r 861f2601a38b -r 1f0b15040456 lib-src/make-mswin-unicode.pl --- a/lib-src/make-mswin-unicode.pl Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/make-mswin-unicode.pl Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ## 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 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 3 of the License, 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. +## XEmacs is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +## for more details. ## You should have received a copy of the GNU General Public License -## along with XEmacs; see the file COPYING. If not, write to the Free -## Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -## 02111-1307, USA. +## along with XEmacs. If not, see . eval 'exec perl -w -S $0 ${1+"$@"}' if 0; diff -r 861f2601a38b -r 1f0b15040456 lib-src/make-path.c --- a/lib-src/make-path.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/make-path.c Sun May 01 18:44:03 2011 +0100 @@ -3,20 +3,18 @@ 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 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 3 of the License, 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. +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 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.28. */ @@ -26,7 +24,7 @@ command on some of the purer BSD systems (like Mt. Xinu) don't have that option. */ -#ifdef emacs +#ifdef HAVE_CONFIG_H #include #endif diff -r 861f2601a38b -r 1f0b15040456 lib-src/movemail.c --- a/lib-src/movemail.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/movemail.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,10 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. - +along with XEmacs. If not, see . Please mail bugs and suggestions to the XEmacs maintainer. */ diff -r 861f2601a38b -r 1f0b15040456 lib-src/ootags.c --- a/lib-src/ootags.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/ootags.c Sun May 01 18:44:03 2011 +0100 @@ -4,19 +4,18 @@ This file is not considered part of GNU Emacs. -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. +This program is free software: you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation, either version 3 of the License, or (at your +option) any later version. + +This program is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software Foundation, -Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ +along with this program. If not, see . */ /* * Authors: diff -r 861f2601a38b -r 1f0b15040456 lib-src/pop.c --- a/lib-src/pop.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/pop.c Sun May 01 18:44:03 2011 +0100 @@ -6,20 +6,18 @@ 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -Boston, MA 02110-1301, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 22.0.50. */ diff -r 861f2601a38b -r 1f0b15040456 lib-src/pop.h --- a/lib-src/pop.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/pop.h Sun May 01 18:44:03 2011 +0100 @@ -5,20 +5,18 @@ 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -Boston, MA 02110-1301, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 22.0.50. */ diff -r 861f2601a38b -r 1f0b15040456 lib-src/profile.c --- a/lib-src/profile.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/profile.c Sun May 01 18:44:03 2011 +0100 @@ -4,22 +4,20 @@ Author: Boaz Ben-Zvi - This file is part of XEmacs. + 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 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 3 of the License, 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. + 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 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. If not, see . */ /* Synched up with: FSF 19.28. */ /* #### Not sure if this is needed for XEmacs. */ diff -r 861f2601a38b -r 1f0b15040456 lib-src/qsort.c --- a/lib-src/qsort.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/qsort.c Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,18 @@ This file is part of GNU CC. -GNU QSORT 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 QSORT 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 3 of the License, or (at your +option) any later version. -GNU QSORT 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. +GNU QSORT 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 QSORT; see the file COPYING. If not, write to -the Free the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with GNU QSORT. If not, see . */ /* Synched up with: FSF 19.28. */ diff -r 861f2601a38b -r 1f0b15040456 lib-src/rcs2log --- a/lib-src/rcs2log Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/rcs2log Sun May 01 18:44:03 2011 +0100 @@ -34,20 +34,18 @@ # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2001, 2002 # Free Software Foundation, Inc. -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# +# This program is free software: you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by the +# Free Software Foundation, either version 3 of the License, or (at your +# option) any later version. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# # You should have received a copy of the GNU General Public License -# along with this program; see the file COPYING. If not, write to the -# Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. +# along with this program. If not, see . Copyright='Copyright (C) 2002 Free Software Foundation, Inc. This program comes with NO WARRANTY, to the extent permitted by law. diff -r 861f2601a38b -r 1f0b15040456 lib-src/sorted-doc.c --- a/lib-src/sorted-doc.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/sorted-doc.c Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,20 @@ Copyright (C) 1989, 1992, 1994, 1996, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. -This file is part of GNU Emacs. +This file is part of XEmacs. -GNU Emacs is free software: you can redistribute it and/or modify +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 3 of the License, or (at your option) any later version. -GNU Emacs is distributed in the hope that it will be useful, +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 GNU Emacs. If not, see . */ +along with XEmacs. If not, see . */ /* Synced up with: GNU 23.1.92. */ /* Synced by: Ben Wing, 2-17-10. */ diff -r 861f2601a38b -r 1f0b15040456 lib-src/tcp.c --- a/lib-src/tcp.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/tcp.c Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ 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 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 3 of the License, 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. +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 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. +along with XEmacs. If not, see . * * Yasunari, Itoh at PFU limited contributed for Fujitsu UTS and SX/A. diff -r 861f2601a38b -r 1f0b15040456 lib-src/update-autoloads.sh --- a/lib-src/update-autoloads.sh Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/update-autoloads.sh Sun May 01 18:44:03 2011 +0100 @@ -6,21 +6,19 @@ # Keywords: internal # 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. - +# +# 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 3 of the License, or (at your +# option) any later version. +# +# XEmacs is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. +# along with XEmacs. If not, see . ### Commentary: diff -r 861f2601a38b -r 1f0b15040456 lib-src/update-custom.sh --- a/lib-src/update-custom.sh Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/update-custom.sh Sun May 01 18:44:03 2011 +0100 @@ -7,21 +7,19 @@ # Keywords: internal # 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. - +# +# 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 3 of the License, or (at your +# option) any later version. +# +# XEmacs is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. +# along with XEmacs. If not, see . ### Commentary: diff -r 861f2601a38b -r 1f0b15040456 lib-src/winclient.c --- a/lib-src/winclient.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lib-src/winclient.c Sun May 01 18:44:03 2011 +0100 @@ -3,20 +3,18 @@ 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. - You should have received a copy of the GNU General Public License - along with XEmacs; see the file COPYING. If not, write to - the Free Software Foundation, Inc., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ +You should have received a copy of the GNU General Public License +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 lisp/ChangeLog --- a/lisp/ChangeLog Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/ChangeLog Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,1684 @@ +2011-05-01 Aidan Kehoe + + * buff-menu.el (list-buffers-directory): + * buff-menu.el (default-list-buffers-identification): + * cus-file.el (custom-file-base): + * cus-file.el (custom-file): + * cus-file.el (make-custom-file-name): + * menubar.el (menu-split-long-menu): + * newcomment.el: + * newcomment.el (indent-for-comment): + * newcomment.el (comment-column): + * newcomment.el (comment-start): + * newcomment.el (comment-start-skip): + * newcomment.el (comment-end-skip): + * newcomment.el (comment-end): + * newcomment.el (comment-indent-function): + * newcomment.el (comment-style): + * newcomment.el (comment-padding): + * newcomment.el (comment-multi-line): + * newcomment.el (comment-normalize-vars): + * newcomment.el (comment-indent): + * newcomment.el (comment-set-column): + * newcomment.el (comment-kill): + * newcomment.el (uncomment-region): + * newcomment.el (comment-region): + * newcomment.el (comment-or-uncomment-region): + * newcomment.el (comment-dwim): + * newcomment.el (comment-indent-new-line): + * x-win-sun.el (x-win-init-sun): + * x-win-xfree86.el (x-win-init-xfree86): + * mule/mule-composite.el: + * mule/mule-composite.el (reference-point-alist): + * mule/mule-composite.el (compose-region): + * mule/mule-composite.el (decompose-region): + * mule/mule-composite.el (compose-string): + * mule/mule-composite.el (decompose-string): + * mule/mule-composite.el (compose-chars): + * mule/mule-composite.el (find-composition): + * mule/mule-composite.el (compose-chars-after): + * mule/mule-composite.el (compose-last-chars): + * mule/mule-composite.el (decompose-composite-char): + Remove all autoload cookies from dumped files, they're needless + and confusing. + +2011-04-30 Didier Verna + + * subr.el (looking-back): New function. + +2011-04-30 Didier Verna + + * special-mode.el: New file. + * special-mode.el (special-mode-map): New variable. + * special-mode.el (special-mode): New function. + * dumped-lisp.el (preloaded-file-list): Add special-mode. + +2011-04-30 Stephen J. Turnbull + + * faces.el (face-property-matching-instance): + Allow backward compatibility to the 21.4 API. Update docstring. + +2011-04-29 Stephen J. Turnbull + + * XEmacs 21.5.31 "ginger" is released. + +2011-04-26 Stephen J. Turnbull + + * XEmacs 21.5.30 "garlic" is released. + +2011-04-24 Aidan Kehoe + + * cl-macs.el (symbol-macrolet): + * cl-macs.el (lexical-let): + * cl.el: + * cl.el (cl-macroexpand): + Distinct symbol macros with identical string names should + nonetheless expand to different things; implement this, storing + the symbol's eq-hash in the macro environment, rather than its + string name. + +2011-04-23 Aidan Kehoe + + * cl-extra.el (define-char-comparisons): + Add type-checking when the various character-specific comparison + predicates are used; don't check types if + byte-compile-delete-errors is non-nil at compile-time, instead use + the corresponding built-in numeric byte codes. + +2011-04-23 Aidan Kehoe + + * font.el: + * font.el (font-warn): Removed. + * font.el (font-hex-string-to-number): Removed. + * font.el (internal-facep): + * font.el (font-lookup-rgb-components): + * font.el (font-parse-rgb-components): + Use #'string-to-number with the BASE argument instead of + #'font-hex-string-to-number, #'display-warning instead of + #'font-warn. + This entire file smells bitrotted, with lots of functions of very + little relevance to XEmacs, but addressing that is more work than + I can do today. + +2011-04-17 Aidan Kehoe + + * cl-extra.el: + * cl-extra.el ('char<): New. + * cl-extra.el ('char>=): New. + * cl-extra.el ('char>): New. + * cl-extra.el ('char<=): New. + * cl-extra.el (alpha-char-p): New. + * cl-extra.el (graphic-char-p): New. + * cl-extra.el (standard-char-p): New. + * cl-extra.el (char-name): New. + * cl-extra.el (name-char): New. + * cl-extra.el (upper-case-p): New. + * cl-extra.el (lower-case-p): New. + * cl-extra.el (both-case-p): New. + * cl-extra.el (char-upcase): New. + * cl-extra.el (char-downcase): New. + * cl-extra.el (integer-length): New. + Add various functions dealing (mainly) with characters, making + some Common Lisp code easier to port. + * descr-text.el (describe-char-unicode-data): + Add an autoload for this function, used by #'char-name. + +2011-04-12 Aidan Kehoe + + * mule/mule-win32-init.el (windows-874): + No longer create this coding system, now it's provided by thai.el; + thanks for the report of the associated Win32 build problem, Mats! + +2011-04-08 Aidan Kehoe + + * unicode.el (load-unicode-tables): + No longer include thai-xtis in the default Unicode precedence list. + * mule/thai.el: + * mule/thai.el (tis-620): + * mule/thai.el (windows-874): + * mule/thai.el ("Thai"): + Move the Thai language environment and the TIS-620 coding system + to this file; add support for Microsoft's code page 874. + * mule/thai-util.el: + * mule/thai-xtis.el: + Remove these two files; XTIS was always non-standard and was never + widely implemented, and we've never supported the character + composition necessary for thai-util.el. + * dumped-lisp.el (preloaded-file-list): + Drop thai-xtis, dump thai.el instead. + +2011-04-02 Aidan Kehoe + + * cl.el (cadr, caddr, cadddr): + Document some equivalences for these functions. + +2011-04-02 Aidan Kehoe + + * bytecomp.el (byte-compile-output-preface): New. + * bytecomp.el (byte-compile-output-file-form): + * bytecomp.el (byte-compile-output-docform): + * bytecomp.el (byte-compile-file-form): + * bytecomp.el (byte-compile-file-form-defmumble): + * bytecomp.el (symbol-value): + * bytecomp.el (byte-compile-symbol-value): New. + * cl-macs.el (load-time-value): + No longer implement load-time-value by very hackishly redefining + #'byte-compile-file-form-defmumble, instead make the appropriate + changes in #'byte-compile-file-form-defmumble and + #'byte-compile-file-form instead. We also add a specific byte-compile + method for #'symbol-value, using the add-properties-to-a-gensym + approach that worked for #'block and #'return-from. + +2011-03-29 Aidan Kehoe + + * cl-extra.el (cl-finite-do, cl-float-limits): + Don't make these available as functions in the dumped image, since + they're only called at dump time. + * obsolete.el (cl-float-limits): + Make this an alias to #'identity (since it's called at dump time), + mark it as obsolete in 21.5. + +2011-03-29 Aidan Kehoe + + * cl.el: + * cl.el (least-positive-float): + * cl.el (least-positive-normalized-float): + * cl.el (least-negative-normalized-float): + * cl.el (float-epsilon): + * cl.el (float-negative-epsilon): + Document some previously-undocumented float constants here. + * cl.el (oddp): + * cl.el (evenp): + Change numeric comparison to use #'eql instead of #'eq in + passing. + +2011-03-24 Jerry James + + * cl-macs.el (loop): "arbitary" -> "arbitrary". + * coding.el (force-coding-system-equivalency): "compatiblity" -> + "compatibility". + * cus-edit.el (custom-variable-pre-reset-standard): "explictly" -> + "explicitly" and fix grammar. + (custom-face-pre-reset-standard): "explictly" -> "explicitly". + * etags.el (pop-tag-mark): "seperate" -> "separate". + * files.el (make-temp-file): "analagous" -> "analogous". + * font-menu.el (font-menu-ignore-scaled-fonts): "noticably" -> + "noticeably". + * fontconfig.el (fc-pattern-get-or-compute-size): "unsucessful" -> + "unsuccessful". + * gnome-widgets.el: "writen" -> "written", "choosed" -> "chosen", + "existance" -> "existence". + * gtk-ffi.el (gtk-ffi-debug): "wiht" -> "with". + * gtk-widgets.el: "wil" -> "will", "occure" -> "occur", "efficent" -> + "efficient", "mannor" -> "manner", "negitive" -> "negative", + "particulary" -> "particularly". + * info.el (Info-suffixed-file): "independantly" -> "independently". + * minibuf.el (minibuffer): "Controling" -> "Controlling". + * mule/ccl.el (define-ccl-program): "correponding" -> "corresponding". + * mule/indian.el: "apperance" -> "appearance" and correct grammar. + * mule/kinsoku.el (kinsoku-process-extend): "permissable" -> + "permissible", "deliberatly" -> "deliberately", and correct grammar. + (kinsoku-process-shrink): "permissable" -> "permissible". + * mule/lao-util.el (lao-vowel-reordering-rule): "follwoing" -> + "following", "alwasy" -> "always". + (lao-transcribe-single-roman-syllable-to-lao): "beggining" -> + "beginning". + * mule/latin.el: "idiosyncracy" -> "idiosyncrasy". + * mule/thai-util.el: "repetion" -> "repetition". + * package-get.el (package-get-require-base): "explictly" -> + "explicitly". + * packages.el (packages-find-package-data-path): "hierachies" -> + "hierarchies". + * paragraphs.el (use-hard-newlines): "preceeding" -> "preceding". + * startup.el (command-line): "intial" -> "initial". + * toolbar-itmes.el (toolbar-news): "Unkown" -> "Unknown". + +2011-03-24 Aidan Kehoe + + * custom.el (custom-add-to-group): + Warn if adding an option to the nil group; this is usually an + error on the part of the programmer. + * cmdloop.el (suggest-key-bindings): + Specify a group for this variable, it didn't previously have one. + +2011-03-21 Aidan Kehoe + + * cl-macs.el (revappend, nreconc): + Add compiler macros for these two functions. (They used to be + inline, but that involves needless binding of the arguments.) + +2011-03-21 Aidan Kehoe + + * cl-macs.el (cl-non-fixnum-number-p): + This should return t under 64-bit builds for fixnums that would + be bignums on a 32-bit machine; make it so. + +2011-03-19 Stephen J. Turnbull + + * faces.el (face-spec-set-match-display): + Protect against `display-color-cells' returning nil. + Delete unreferenced let-binding of `min-colors'. + +2011-03-17 Aidan Kehoe + + * bytecomp.el (byte-compile-catch): + * bytecomp.el (byte-compile-throw): + Correct some minor problems in my last change. Happy St. Patrick's + day, everyone! + +2011-03-17 Aidan Kehoe + + * bytecomp.el (byte-compile-catch): + * bytecomp.el (byte-compile-throw): + * cl-macs.el (return-from): + With `block' and `return-from', a nil NAME is perfectly + legitimate, and the corresponding `catch' statements need be + removed by the byte-compiler. 5dd1ba5e0113 , my change of + 2011-02-12, didn't do this; correct that now. + +2011-03-15 Aidan Kehoe + + * bytecomp.el: + Don't generate the old-eq, old-memq, old-equal bytecodes any more, + but keep the information about them around for the sake of the + disassembler. + +2011-03-14 Jeff Sparkes + + * custom.el (defface): Document `min-colors' specifier. + + * faces.el (face-spec-set-match-display): Add `min-colors' + specifer for defface. + +2011-03-12 Aidan Kehoe + + * isearch-mode.el (isearch-mode-map): + Document why we bind the ASCII characters to isearch-printing-char + in more detail. + * isearch-mode.el (isearch-maybe-frob-keyboard-macros): + If `this-command' is nil and the keys typed would normally be + bound to `self-insert-command' in the global map, force + `isearch-printing-char' to be called with an appropriate value for + last-command-event. Addresses an issue where searching for + characters generated from x-compose.el and XIM threw errors for me + in dired. + +2011-03-10 Aidan Kehoe + + * etags.el (buffer-tag-table-list): + * files.el (find-file-read-only): + * files.el (find-file-read-only-other-window): + * info.el (Info-dir-outdated-p): + * info.el (Info-dump-dir-entries): + * info.el (Info-rebuild-dir): + * menubar-items.el (default-menubar): + * mouse.el (drag-window-divider): + * mouse.el (vertical-divider-map): + * test-harness.el (emacs-lisp-file-regexp): + Eliminate byte-compile warnings, again aside from those linked to + Stephen's various non-defined fontconfig functions. + +2011-03-10 Aidan Kehoe + + * cmdloop.el (yes-or-no-p): + * cmdloop.el (y-or-n-p): + * descr-text.el (describe-char): + * diagnose.el (show-memory-usage): + * diagnose.el (show-object-memory-usage-stats): + * diagnose.el (show-mc-alloc-memory-usage): + * diagnose.el (show-gc-stats): + * faces.el (face-font-instance): + * gtk-font-menu.el (gtk-reset-device-font-menus): + * help.el (help-symbol-function-context-menu): + * help.el (help-symbol-variable-context-menu): + * help.el (help-symbol-function-and-variable-context-menu): + * help.el (help-find-source-or-scroll-up): + * help.el (help-mouse-find-source-or-track): + * help.el (temp-buffer-resize-mode): + * minibuf.el (mouse-read-file-name-1): + * obsolete.el (find-non-ascii-charset-string): + * obsolete.el (find-non-ascii-charset-region): + * occur.el (occur-engine): + * paragraphs.el (forward-paragraph): + * paragraphs.el (forward-sentence): + * select.el (activate-region-as-selection): + * select.el (select-make-extent-for-selection): + * simple.el (zmacs-make-extent-for-region): + Use quote, not function, for quoting symbols that may not be + fboundp at the point they are read (again, a style issue, since + Common Lisp throws an error on this, but we don't, and have no + plans to.) + +2011-03-08 Aidan Kehoe + + * cl-macs.el: + * cl-macs.el (loop): + * cl-macs.el (cl-expand-do-loop): + * cl-macs.el (shiftf): + * cl-macs.el (rotatef): + * cl-macs.el (assert): + * cl-macs.el (cl-defsubst-expand): + * etags.el (buffer-tag-table-list): + * frame.el: + * frame.el (frame-notice-user-settings): + * frame.el (minibuffer-frame-list): + * frame.el (get-frame-for-buffer-noselect): + Use Common Lisp-derived builtins in a few more places, none of + them performance-critical, but the style is better. + +2011-03-08 Aidan Kehoe + + * buff-menu.el (list-buffers-noselect): + * byte-optimize.el (byte-optimize-identity): + * byte-optimize.el (byte-optimize-if): + * byte-optimize.el (byte-optimize-nth): + * byte-optimize.el (byte-optimize-nthcdr): + * bytecomp.el (byte-compile-warn-wrong-args): + * bytecomp.el (byte-compile-two-args-19->20): + * bytecomp.el (byte-compile-list): + * bytecomp.el (byte-compile-beginning-of-line): + * bytecomp.el (byte-compile-set): + * bytecomp.el (byte-compile-set-default): + * bytecomp.el (byte-compile-values): + * bytecomp.el (byte-compile-values-list): + * bytecomp.el (byte-compile-integerp): + * bytecomp.el (byte-compile-multiple-value-list-internal): + * bytecomp.el (byte-compile-throw): + * cl-macs.el (cl-do-arglist): + * cl-macs.el (cl-parse-loop-clause): + * cl-macs.el (multiple-value-bind): + * cl-macs.el (multiple-value-setq): + * cl-macs.el (get-setf-method): + * cmdloop.el (command-error): + * cmdloop.el (y-or-n-p-minibuf): + * cmdloop.el (yes-or-no-p-minibuf): + * coding.el (unencodable-char-position): + * cus-edit.el (custom-face-prompt): + * cus-edit.el (custom-buffer-create-internal): + * cus-edit.el (widget-face-action): + * cus-edit.el (custom-group-value-create): + * descr-text.el (describe-char-unicode-data): + * dialog-gtk.el (popup-builtin-question-dialog): + * dragdrop.el (experimental-dragdrop-drop-log-function): + * dragdrop.el (experimental-dragdrop-drop-mime-default): + * easymenu.el (easy-menu-add): + * easymenu.el (easy-menu-remove): + * faces.el (read-face-name): + * faces.el (set-face-stipple): + * files.el (file-name-non-special): + * font.el (font-combine-fonts): + * font.el (font-set-face-font): + * font.el (font-parse-rgb-components): + * font.el (font-rgb-color-p): + * font.el (font-color-rgb-components): + * gnuserv.el (gnuserv-edit-files): + * help.el (key-or-menu-binding): + * help.el (function-documentation-1): + * help.el (function-documentation): + * info.el (info): + * isearch-mode.el (isearch-exit): + * isearch-mode.el (isearch-edit-string): + * isearch-mode.el (isearch-*-char): + * isearch-mode.el (isearch-complete1): + * ldap.el (ldap-encode-country-string): + * ldap.el (ldap-decode-string): + * minibuf.el (read-file-name-internal-1): + * minibuf.el (read-non-nil-coding-system): + * minibuf.el (get-user-response): + * mouse.el (drag-window-divider): + * mule/ccl.el: + * mule/ccl.el (ccl-compile-if): + * mule/ccl.el (ccl-compile-break): + * mule/ccl.el (ccl-compile-repeat): + * mule/ccl.el (ccl-compile-write-repeat): + * mule/ccl.el (ccl-compile-call): + * mule/ccl.el (ccl-compile-end): + * mule/ccl.el (ccl-compile-read-multibyte-character): + * mule/ccl.el (ccl-compile-write-multibyte-character): + * mule/ccl.el (ccl-compile-translate-character): + * mule/ccl.el (ccl-compile-mule-to-unicode): + * mule/ccl.el (ccl-compile-unicode-to-mule): + * mule/ccl.el (ccl-compile-lookup-integer): + * mule/ccl.el (ccl-compile-lookup-character): + * mule/ccl.el (ccl-compile-map-multiple): + * mule/ccl.el (ccl-compile-map-single): + * mule/devan-util.el (devanagari-compose-to-one-glyph): + * mule/devan-util.el (devanagari-composition-component): + * mule/mule-cmds.el (finish-set-language-environment): + * mule/viet-util.el: + * mule/viet-util.el (viet-encode-viscii-char): + * multicast.el (open-multicast-group): + * newcomment.el (comment-quote-nested): + * newcomment.el (comment-region): + * newcomment.el (comment-dwim): + * regexp-opt.el (regexp-opt-group): + * replace.el (map-query-replace-regexp): + * specifier.el (derive-device-type-from-tag-set): + * subr.el (skip-chars-quote): + * test-harness.el (test-harness-from-buffer): + * test-harness.el (batch-test-emacs): + * wid-edit.el (widget-choice-action): + * wid-edit.el (widget-symbol-prompt-internal): + * wid-edit.el (widget-color-action): + * window-xemacs.el (push-window-configuration): + * window-xemacs.el (pop-window-configuration): + * window.el (quit-window): + * x-compose.el (electric-diacritic): + It's better style, and cheaper (often one assembler instruction + vs. a C funcall in the byte code), to use `eql' instead of `=' + when it's clear what numerical type a given result will be. Change + much of our code to do this, with the help of a byte-compiler + change (not comitted) that looked for calls to #'length (which + always returns an integer) in its args. + +2011-03-08 Aidan Kehoe + + * format.el (format-delq-cons): Removed. + * format.el (format-make-relatively-unique): Removed. + * format.el (format-common-tail): Removed. + * format.el (format-reorder): Removed. + * format.el (format-annotate-region): + * format.el (format-annotate-single-property-change): + * format.el (format-annotate-atomic-property-change): + Remove various functions from this file that re-implemented Common + Lisp functions that we have built-in. + +2011-03-08 Aidan Kehoe + + * select.el (selection-preferred-types): + * select.el (cut-copy-clear-internal): + * select.el (create-image-functions): + * select.el (select-convert-from-image/gif): + * select.el (select-convert-from-image/jpeg): + * select.el (select-convert-from-image/png): + * select.el (select-convert-from-image/tiff): + * select.el (select-convert-from-image/xpm): + * select.el (select-convert-from-image/xbm): + * select.el (selection-converter-in-alist): + Make my Lisp a little more sophisticated in this file. + +2011-03-08 Aidan Kehoe + + * package-ui.el (pui-add-required-packages): + * packages.el (packages-handle-package-dumped-lisps): + * bytecomp-runtime.el (byte-compile-with-fboundp): + * bytecomp-runtime.el (globally-declare-fboundp): + * bytecomp-runtime.el + (byte-compile-with-byte-compiler-warnings-suppressed): + * mule/devan-util.el (devanagari-reorder-glyphs-for-composition): + * mule/devan-util.el (devanagari-compose-to-one-glyph): + * mule/japanese.el: + * mule/japanese.el ("Japanese"): + * mule/make-coding-system.el (fixed-width-generate-helper): + * mule/mule-category.el (defined-category-list): + * mule/mule-category.el (undefined-category-designator): + Style change: remove redundant lambdas, things like (mapcar + #'(lambda (pkg) (symbol-name pkg)) ...) => (mapcar #'symbol-name ...). + +2011-02-16 Aidan Kehoe + + * bytecomp.el (byte-compile-normal-call): + Check that the car of FORM is a symbol before examining its + properties; it can be a lambda form if byte-optimize.el hasn't + worked its magic and transformed such a lambda call into inline + code. + +2011-02-12 Aidan Kehoe + + * bytecomp.el: + * bytecomp.el (byte-compile-initial-macro-environment): + * bytecomp.el (unwind-protect): + * bytecomp.el (byte-compile-active-blocks): + * bytecomp.el (byte-compile-catch): + * bytecomp.el ('return-from-1): Removed. + * bytecomp.el ('block-1): Removed. + * bytecomp.el (byte-compile-block-1): Removed. + * bytecomp.el (byte-compile-return-from-1): Removed. + * bytecomp.el (byte-compile-throw): + * cl-macs.el (block): + * cl-macs.el (return-from): + In my last change, the elimination of `block's that were never + `return-from'd didn't work if `cl-macroexpand-all' was called + explicitly, something much code in cl-macs.el does. Change the + implementation to something that doesn't require shadowing of the + macros in `byte-compile-initial-macro-environment', putting a + `cl-block-name' property on the gensym'd symbol argument to + `catch' instead. + +2011-02-09 Aidan Kehoe + + * cl.el (acons): Removed, make the implementation in alloc.c + visible to Lisp instead. + +2011-02-07 Aidan Kehoe + + * bytecomp.el: + * bytecomp.el (byte-compile-initial-macro-environment): + Shadow `block', `return-from' here, we implement them differently + when byte-compiling. + + * bytecomp.el (byte-compile-active-blocks): New. + * bytecomp.el (byte-compile-block-1): New. + * bytecomp.el (byte-compile-return-from-1): New. + * bytecomp.el (return-from-1): New. + * bytecomp.el (block-1): New. + These are two aliases that exist to have their own associated + byte-compile functions, which functions implement `block' and + `return-from'. + + * cl-extra.el (cl-macroexpand-all): + Fix a bug here when macros in the environment have been compiled. + + * cl-macs.el (block): + * cl-macs.el (return): + * cl-macs.el (return-from): + Be more careful about lexical scope in these macros. + + * cl.el: + * cl.el ('cl-block-wrapper): Removed. + * cl.el ('cl-block-throw): Removed. + These aren't needed in code generated by this XEmacs. They + shouldn't be needed in code generated by XEmacs 21.4, but if it + turns out the packages do need them, we can put them back. + +2011-01-30 Mike Sperber + + * font-lock.el (font-lock-fontify-pending-extents): Don't fail if + `font-lock-mode' is unset, which can happen in the middle of + `revert-buffer'. + +2011-01-23 Aidan Kehoe + + * cl-macs.el (delete): + * cl-macs.el (delq): + * cl-macs.el (remove): + * cl-macs.el (remq): + Don't use the compiler macro if these functions were given the + wrong number of arguments, as happens in lisp-tests.el. + * cl-seq.el (remove, remq): Removed. + I added these to subr.el, and forgot to remove them from here. + +2011-01-22 Aidan Kehoe + + * bytecomp.el (byte-compile-setq, byte-compile-set): + Remove kludge allowing keywords' values to be set, all the code + that does that is gone. + + * cl-compat.el (elt-satisfies-test-p): + * faces.el (set-face-parent): + * faces.el (face-doc-string): + * gtk-font-menu.el: + * gtk-font-menu.el (gtk-reset-device-font-menus): + * msw-font-menu.el: + * msw-font-menu.el (mswindows-reset-device-font-menus): + * package-get.el (package-get-installedp): + * select.el (select-convert-from-image-data): + * sound.el: + * sound.el (load-sound-file): + * x-font-menu.el (x-reset-device-font-menus-core): + Don't quote keywords, they're self-quoting, and the + win from backward-compatibility is sufficiently small now that the + style problem overrides it. + +2011-01-22 Aidan Kehoe + + * cl-macs.el (block, return-from): Require that NAME be a symbol + in these macros, as always documented in the #'block docstring and + as required by Common Lisp. + * descr-text.el (unidata-initialize-unihan-database): + Correct the use of non-symbols in #'block and #'return-from in + this function. + +2011-01-15 Aidan Kehoe + + * cl-extra.el (concatenate): Accept more complicated TYPEs in this + function, handing the sequences over to #'coerce if we don't + understand them here. + * cl-macs.el (inline): Don't proclaim #'concatenate as inline, its + compiler macro is more useful than doing that. + +2011-01-11 Aidan Kehoe + + * subr.el (delete, delq, remove, remq): Move #'remove, #'remq + here, they don't belong in cl-seq.el; move #'delete, #'delq here + from fns.c, implement them in terms of #'delete*, allowing support + for sequences generally. + * update-elc.el (do-autoload-commands): Use #'delete*, not #'delq + here, now the latter's no longer dumped. + * cl-macs.el (delete, delq): Add compiler macros transforming + #'delete and #'delq to #'delete* calls. + +2011-01-10 Aidan Kehoe + + * dialog.el (make-dialog-box): Correct a misplaced parenthesis + here, thank you Mats Lidell in 87zkr9gqrh.fsf@mail.contactor.se ! + +2011-01-02 Aidan Kehoe + + * dialog.el (make-dialog-box): + * list-mode.el (display-completion-list): + These functions used to use cl-parsing-keywords; change them to + use defun* instead, fixing the build. (Not sure what led to me + not including this change in d1b17a33450b!) + +2011-01-02 Aidan Kehoe + + * cl-macs.el (define-star-compiler-macros): + Make sure the form has ITEM and LIST specified before attempting + to change to calls with explicit tests; necessary for some tests + in lisp-tests.el to compile correctly. + (stable-union, stable-intersection): Add compiler macros for these + functions, in the same way we do for most of the other functions + in cl-seq.el. + +2011-01-01 Aidan Kehoe + + * cl-macs.el (dolist, dotimes, do-symbols, macrolet) + (symbol-macrolet): + Define these macros with defmacro* instead of parsing the argument + list by hand, for the sake of style and readability; use backquote + where appropriate, instead of calling #'list and and friends, for + the same reason. + +2010-12-30 Aidan Kehoe + + * x-misc.el (device-x-display): + Provide this function, documented in the Lispref for years, but + not existing previously. Thank you Julian Bradfield, thank you + Jeff Mincy. + +2010-12-30 Aidan Kehoe + + * cl-seq.el: + Move the heavy lifting from this file to C. Dump the + cl-parsing-keywords macro, but don't use defun* for the functions + we define that do take keywords, dynamic scope lossage makes that + not practical. + * subr.el (sort, fillarray): Move these aliases here. + (map-plist): #'nsublis is now built-in, but at this point #'eql + isn't necessarily available as a test; use #'eq. + * obsolete.el (cl-delete-duplicates): Make this available for old + compiler macros and old code. + (memql): Document that this is equivalent to #'member*, and worse. + * cl.el (adjoin, subst): Removed. These are in C. + +2010-12-30 Aidan Kehoe + + * simple.el (assoc-ignore-case): Remove a duplicate definition of + this function (it's already in subr.el). + * iso8859-1.el (char-width): + On non-Mule, make this function equivalent to that produced by + (constantly 1), but preserve its docstring. + * subr.el (subst-char-in-string): Define this in terms of + #'substitute, #'nsubstitute. + (string-width): Define this using #'reduce and #'char-width. + (char-width): Give this a simpler definition, it makes far more + sense to check for mule at load time and redefine, as we do in + iso8859-1.el. + (store-substring): Implement this in terms of #'replace, now + #'replace is cheap. + +2010-12-30 Aidan Kehoe + + * update-elc.el (lisp-files-needed-for-byte-compilation) + (lisp-files-needing-early-byte-compilation): + cl-macs belongs in the former, not the latter, it is as + fundamental as bytecomp.el. + +2010-12-30 Aidan Kehoe + + * cl.el: + Provde the Common Lisp program-error, type-error as error + symbols. This doesn't nearly go far enough for anyone using the + Common Lisp errors. + +2010-12-29 Aidan Kehoe + + * cl-macs.el (delete-duplicates): + If the form has an incorrect number of arguments, don't attempt a + compiler macroexpansion. + +2010-12-29 Aidan Kehoe + + * cl-macs.el (cl-safe-expr-p): + Forms that start with the symbol lambda are also safe. + +2010-12-29 Aidan Kehoe + + * cl-macs.el (= < > <= >=): + For these functions' compiler macros, the optimisation is safe + even if the first and the last arguments have side effects, since + they're only used the once. + +2010-12-29 Aidan Kehoe + + * cl-macs.el (inline-side-effect-free-compiler-macros): + Unroll a loop here at macro-expansion time, so these compiler + macros are compiled. Use #'eql instead of #'eq in a couple of + places for better style. + +2010-12-29 Aidan Kehoe + + * cl-extra.el (notany, notevery): Avoid some dynamic scope + stupidity with local variable names in these functions, when they + weren't prefixed with cl-; go into some more detail in the doc + strings. + +2010-12-29 Aidan Kehoe + + * byte-optimize.el (side-effect-free-fns): #'remove, #'remq are + free of side-effects. + (side-effect-and-error-free-fns): + Drop dot, dot-marker from the list. + +2010-11-17 Aidan Kehoe + + * cl-extra.el (coerce): + In the argument list, name the first argument OBJECT, not X; the + former name was always used in the doc string and is clearer. + Handle vector type specifications which include the length of the + target sequence, error if there's a mismatch. + * cl-macs.el (cl-make-type-test): Handle type specifications + starting with the symbol 'eql. + +2010-11-14 Aidan Kehoe + + * cl-macs.el (eql): Don't remove the byte-compile property of this + symbol. That was necessary to override a bug in bytecomp.el where + #'eql was confused with #'eq, which bug we no longer have. + If neither expression is constant, don't attempt to handle the + expression in this compiler macro, leave it to byte-compile-eql, + which produces better code anyway. + * bytecomp.el (eq): #'eql is not the function associated with the + byte-eq byte code. + (byte-compile-eql): Add an explicit compile method for this + function, for cases where the cl-macs compiler macro hasn't + reduced it to #'eq or #'equal. + +2010-10-25 Aidan Kehoe + + Add compiler macros and compilation sanity-checking for various + functions that take keywords. + + * byte-optimize.el (side-effect-free-fns): #'symbol-value is + side-effect free and not error free. + * bytecomp.el (byte-compile-normal-call): Check keyword argument + lists for sanity; store information about the positions where + keyword arguments start using the new byte-compile-keyword-start + property. + * cl-macs.el (cl-const-expr-val): Take a new optional argument, + cl-not-constant, defaulting to nil, in this function; return it if + the expression is not constant. + (cl-non-fixnum-number-p): Make this into a separate function, we + want to pass it to #'every. + (eql): Use it. + (define-star-compiler-macros): Use the same code to generate the + member*, assoc* and rassoc* compiler macros; special-case some + code in #'add-to-list in subr.el. + (remove, remq): Add compiler macros for these two functions, in + preparation for #'remove being in C. + (define-foo-if-compiler-macros): Transform (remove-if-not ...) calls to + (remove ... :if-not) at compile time, which will be a real win + once the latter is in C. + (define-substitute-if-compiler-macros) + (define-subst-if-compiler-macros): Similarly for these functions. + (delete-duplicates): Change this compiler macro to use + #'plists-equal; if we don't have information about the type of + SEQUENCE at compile time, don't bother attempting to inline the + call, the function will be in C soon enough. + (equalp): Remove an old commented-out compiler macro for this, if + we want to see it it's in version control. + (subst-char-in-string): Transform this to a call to nsubstitute or + nsubstitute, if that is appropriate. + * cl.el (ldiff): Don't call setf here, this makes for a load-time + dependency problem in cl-macs.el + +2010-06-14 Stephen J. Turnbull + + * term/vt100.el: + Refer to XEmacs, not GNU Emacs, in permissions. + + * term/bg-mouse.el: + * term/sup-mouse.el: + Put copyright notice in canonical "Copyright DATE AUTHOR" form. + Refer to XEmacs, not GNU Emacs, in permissions. + + * site-load.el: + Add permission boilerplate. + + * mule/canna-leim.el: + * alist.el: + Refer to XEmacs, not APEL/this program, in permissions. + + * mule/canna-leim.el: + Remove my copyright, I've assigned it to the FSF. + +2010-06-14 Stephen J. Turnbull + + * gtk.el: + * gtk-widget-accessors.el: + * gtk-package.el: + * gtk-marshal.el: + * gtk-compose.el: + * gnome.el: + Add copyright notice based on internal evidence. + +2010-06-14 Stephen J. Turnbull + + * easymenu.el: Add reference to COPYING to permission notice. + + * gutter.el: + * gutter-items.el: + * menubar-items.el: + Fix typo "Xmacs" in permissions notice. + +2010-06-14 Stephen J. Turnbull + + * auto-save.el: + * font.el: + * fontconfig.el: + * mule/kinsoku.el: + Add "part of XEmacs" text to permission notice. + +2010-10-14 Aidan Kehoe + + * byte-optimize.el (side-effect-free-fns): + * cl-macs.el (remf, getf): + * cl-extra.el (tailp, cl-set-getf, cl-do-remf): + * cl.el (ldiff, endp): + Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp; + add circularity checking for the first two. + + #'cl-set-getf and #'cl-do-remf were Lisp implementations of + #'plist-put and #'plist-remprop; change the names to aliases, + changes the macros that use them to using #'plist-put and + #'plist-remprop directly. + +2010-10-12 Aidan Kehoe + + * abbrev.el (fundamental-mode-abbrev-table, global-abbrev-table): + Create both these abbrev tables using the usual + #'define-abbrev-table calls, rather than attempting to + special-case them. + * cl-extra.el: Force cl-macs to be loaded here, if cl-extra.el is + being loaded interpreted. Previously other, later files would + redundantly call (load "cl-macs") when interpreted, it's more + reasonable to do it here, once. + * cmdloop.el (read-quoted-char-radix): Use defcustom here, we + don't have any dump-order dependencies that would prevent that. + * custom.el (eval-when-compile): Don't load cl-macs when + interpreted or when byte-compiling, rely on cl-extra.el in the + former case and the appropriate entry in bytecomp-load-hook in the + latter. Get rid of custom-declare-variable-list, we have no + dump-time dependencies that would require it. + * faces.el (eval-when-compile): Don't load cl-macs when + interpreted or when byte-compiling. + * packages.el: Remove some inaccurate comments. + * post-gc.el (cleanup-simple-finalizers): Use #'delete-if-not + here, now the order of preloaded-file-list has been changed to + make it available. + * subr.el (custom-declare-variable-list): Remove. No need for it. + Also remove a stub define-abbrev-table from this file, given the + current order of preloaded-file-list there's no need for it. + +2010-10-10 Aidan Kehoe + + * bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are + also constant. + (byte-compile-initial-macro-environment): In #'the, if FORM is + constant and does not match TYPE, warn at byte-compile time. + +2010-10-10 Aidan Kehoe + + * backquote.el (bq-vector-contents, bq-list*): Remove; the former + is equivalent to (append VECTOR nil), the latter to (list* ...). + (bq-process-2): Use (append VECTOR nil) instead of using + #'bq-vector-contents to convert to a list. + (bq-process-1): Now we use list* instead of bq-list + * subr.el (list*): Moved from cl.el, since it is now required to + be available the first time a backquoted form is encountered. + * cl.el (list*): Move to subr.el. + +2010-09-16 Aidan Kehoe + + * test-harness.el (Check-Message): + Add an omitted comma here, thank you the buildbot. + +2010-09-16 Aidan Kehoe + + * hash-table.el (hash-table-key-list, hash-table-value-list) + (hash-table-key-value-alist, hash-table-key-value-plist): + Remove some useless #'nreverse calls in these files; our hash + tables have no order, it's not helpful to pretend they do. + * behavior.el (read-behavior): + Do the same in this file, in some code evidently copied from + hash-table.el. + +2010-09-16 Aidan Kehoe + + * info.el (Info-insert-dir): + * format.el (format-deannotate-region): + * files.el (cd, save-buffers-kill-emacs): + Use #'some, #'every and related functions for applying boolean + operations to lists, instead of rolling our own ones that cons and + don't short-circuit. + +2010-09-16 Aidan Kehoe + + * bytecomp.el (byte-compile-initial-macro-environment): + * cl-macs.el (the): + Rephrase the docstring, make its implementation when compiling + files a little nicer. + +2010-09-16 Aidan Kehoe + + * descr-text.el (unidata-initialize-unicodedata-database) + (unidata-initialize-unihan-database, describe-char-unicode-data) + (describe-char-unicode-data): + Wrap calls to the database functions with (with-fboundp ...), + avoiding byte compile warnings on builds without support for the + database functions. + (describe-char): (reduce #'max ...), not (apply #'max ...), no + need to cons needlessly. + (describe-char): Remove a redundant lambda wrapping + #'extent-properties. + (describe-char-unicode-data): Call #'nsubst when replacing "" with + nil in the result of #'split-string, instead of consing inside + mapcar. + +2010-09-16 Aidan Kehoe + + * x-faces.el (x-available-font-sizes): + * specifier.el (let-specifier): + * package-ui.el (pui-add-required-packages): + * msw-faces.el (mswindows-available-font-sizes): + * modeline.el (modeline-minor-mode-menu): + * minibuf.el (minibuf-directory-files): + Replace the O2N (delq nil (mapcar (lambda (W) (and X Y)) Z)) with + the ON (mapcan (lambda (W) (and X (list Y))) Z) in these files. + +2010-09-16 Aidan Kehoe + + * cl-macs.el (= < > <= >=): + When these functions are handed more than two arguments, and those + arguments have no side effects, transform to a series of two + argument calls, avoiding funcall in the byte-compiled code. + * mule/mule-cmds.el (finish-set-language-environment): + Take advantage of this change in a function called 256 times at + startup. + +2010-09-16 Aidan Kehoe + + * bytecomp.el (byte-compile-function-form, byte-compile-quote) + (byte-compile-quote-form): + Warn at compile time, and error at runtime, if a (quote ...) or a + (function ...) form attempts to quote more than one object. + +2010-09-16 Aidan Kehoe + + * byte-optimize.el (byte-optimize-apply): Transform (apply 'nconc + (mapcar ...)) to (mapcan ...); warn about use of the first idiom. + + * update-elc.el (do-autoload-commands): + * packages.el (packages-find-package-library-path): + * frame.el (frame-list): + * extents.el (extent-descendants): + * etags.el (buffer-tag-table-files): + * dumped-lisp.el (preloaded-file-list): + * device.el (device-list): + * bytecomp-runtime.el (proclaim-inline, proclaim-notinline) + Use #'mapcan, not (apply #'nconc (mapcar ...) in all these files. + + * bytecomp-runtime.el (eval-when-compile, eval-and-compile): + In passing, mention that these macros also evaluate the body when + interpreted. + +2010-09-16 Aidan Kehoe + + * cl-macs.el (the): Add a docstring and an implementation for this + macro. + * bytecomp.el (byte-compile-initial-macro-environment): Add #'the + to this, checking byte-compile-delete-errors to decide whether to + make the type assertion. Change the initvalue to use backquote and + preceding commas for the lambda expressions, to allow the latter + to be compiled. + +2010-09-06 Aidan Kehoe + + * cl-seq.el (replace): + Move this function, with added bounds-checking per ANSI Common + Lisp, to fns.c. + +2010-09-05 Aidan Kehoe + + * x-compose.el (define-compose-map, compose-map) + (decide-on-bindings): Support the precomposed characters with + stroke here too, necessary for Polish and Danish, among others. + * x-init.el (x-initialize-compose): Add the appropriate map + autoloads and bindings here. + +2010-09-03 Aidan Kehoe + + * cl-extra.el (coerce): + Add fixnum as an accepted destination type. + +2010-09-02 Aidan Kehoe + + * obsolete.el (process-get): + Make #'process-get, #'process-put, #'process-plist, + #'set-process-plist available as aliases to the more general + functions #'get, #'put, #'object-plist, #'object-setplist, for GNU + compatibility. + +2010-08-20 Mike Sperber + + * files.el (save-some-buffers-action-alist): Add. + (save-some-buffers-1): Use (synching with (GPLv2) FSF Emacs. + +2010-08-18 Mike Sperber + + * files.el (diff-files-for-recover): Abstract this out out + `recover-file'. + (diff-buffer-with-file): Add from (GPLv2) FSF Emacs. + (recover-file): Use `diff-files-for-recover'. + +2010-08-15 Aidan Kehoe + + * specifier.el (canonicalize-inst-pair, canonicalize-spec): + If a specifier tag set is correct, but an instantiator is not in + an accepted format, don't error with the message "Invalid + specifier tag set". + Also, when we error, use error-symbols, for better structured + error handling and more ease when testing. + +2010-07-24 Aidan Kehoe + + * cl-extra.el (concatenate): + * cl-seq.el (remove*, cl-delete-duplicates): + Bit vectors are also sequences; enforce this in these functions. + * cl-macs.el (concatenate): + If TYPE is constant, don't inline #'concatenate, replace it by a + call to the appropriate C functions. + +2010-06-13 Stephen J. Turnbull + + * gnome.el: + * gtk-compose.el: + * gtk-marshal.el: + * gtk-package.el: + * gtk-widget-accessors.el: + * gtk.el: + * hyper-apropos.el: + * multicast.el: + * view-less.el: + Correct FSF address in permission notice. + +2010-06-08 Aidan Kehoe + + * diagnose.el (show-gc-stats): + Fix a misspelling in a heading in this function. + +2010-06-08 Aidan Kehoe + + * paragraphs.el (sentence-end): + * gtk-faces.el: + * custom.el (custom-declare-variable): + Remove all core code calls to #'purecopy. + * obsolete.el (purecopy): + Make the function itself an obsolete alias to #'identity. + +2010-06-06 Aidan Kehoe + + * cl-seq.el (reduce): + Move this to fns.c. + +2010-06-02 Aidan Kehoe + + * cl-macs.el (complement): + * cl-extra.el (complement): + Add an implementation and a compiler macro for #'complement, as + specified by CL. For discussion; the compiler macro may be a + little too aggressive about taking the compile time argument lists + of the functions it is inverting. + +2010-06-02 Aidan Kehoe + + * version.el: + (emacs-version): + * startup.el (command-line): + * simple.el (display-warning, emacs-name): + * packages.el (packages-package-hierarchy-directory-names): + * loadup.el (Dumping): + * dumped-lisp.el (preloaded-file-list): + Remove all InfoDock-specific code. + +2010-05-31 Aidan Kehoe + + * specifier.el (current-display-table): + Use keywords in the structure syntax here, now we've moved to that + by default in C. + +2010-05-30 Aidan Kehoe + + * cl.el: Remove extraneous empty lines. + Remove the commented-out Lisp implementation of #'last, + #'copy-list. + Remove #'cl-maclisp-member. + (acons, pairlis): Have the argument list reflect the docstring for + these functions. + + * cl-macs.el (defun*): Have the argument list reflect the + docstring. + Document the syntax of keywords in ARGLIST. + (defmacro*): Have the argument list reflect the docstring. + Document &body, &whole and &environment. + (function*): Have the argument list reflect the docstring. + (loop): Have the argument list reflect the docstring. + (eval-when, dolist, dotimes, do-symbols, flet, labels, macrolet, + symbol-macrolet): + Specify the argument list using the arguments: (...) syntax. + (define-setf-method, rotatef, defsubst*): Have the argument list + reflect the docstring. + (letf, letf*): + Specify the argument list using the arguments: (...) syntax. + (svref, acons, pairlis): Add compiler macros for these functions. + + * cl-extra.el: Remove the commented-out Lisp implementation of + #'equalp. If we want to look at it, it's in version control. + (cl-expt): Remove this. The subr #'expt is always available. + Call #'cl-float-limits at dump time. + Remove the commented-out Lisp implementation of #'subseq. + (concatenate): Use (error 'invalid-argument ...) here, if TYPE is + not understood. + (list-length): Don't manually get the length of a list, call + #'length and return nil if the list is circular. + + * byte-optimize.el (equalp): This needs + byte-optimize-binary-predicate as its optimizer, as do the other + equality predicates. + +2010-05-30 Aidan Kehoe + + * subr.el (float-time): Add this function, available in editfns.c + in GNU. + +2010-05-16 Aidan Kehoe + + * files.el (default-file-system-ignore-case): + Move this to fileio.c, where it's a constant boolean variable + initialised at dump time. + +2010-04-29 Aidan Kehoe + + * cmdloop.el (suggest-key-bindings): + Make this available, documenting that it's for GNU Emacs + compatibility. + Implement it in terms of teach-extended-commands-p and + teach-extended-commands-timeout, using Ben's + set-symbol-value-handler functionality. + +2010-04-17 Aidan Kehoe + + * loadup.el (load-history): Be a bit more discriminate in the + entries we remove from load-history, only removing those where the + information is entirely available from DOC. + Fixes problems finding the files that dumped undocumented + variables were loaded from, reported by Didier Verna. + * loadhist.el (symbol-file): Correct a regexp here, I had + forgotten to double a backslash. + +2010-04-15 Aidan Kehoe + + * files.el (hack-local-variables-prop-line) + (hack-one-local-variable): + Only attempt to call MODENAME-mode on encountering a + -*-MODENAME-*- line if the corresponding symbol has a function + binding, avoiding an error if, for example, opening a log file + with XLFDs and wild cards. Thanks for the bug report, Henrique + Martins! + +2010-04-09 Didier Verna + + * hyper-apropos.el (hyper-apropos-get-doc): Use [not available] + when a function's arglist is unknown (this happens for autoloaded + functions). + +2010-04-07 Didier Verna + + * font-lock.el (lisp-font-lock-keywords-2): Add missing CL style + lambda list constructs (&key etc.). + * lisp-mode.el (lisp-function-and-type-regexp): Recognize defun* + as well as defun. + +2010-04-02 Aidan Kehoe + + * descr-text.el (describe-char-unicode-data): + Don't give up if describe-char-use-cache is t and the database + isn't readable, warn and insert the entire UnicodeData.txt file + instead. + +2010-04-01 Aidan Kehoe + + * cl-seq.el (fill, sort*, merge): Move these functions to fns.c. + (stable-sort): Make this docstring reflect the argument names used + in the #'sort* docstring. + * cl-macs.el (stable-sort): Make #'stable-sort exactly equivalent + to #'sort* in compiled code. + + * bytecomp.el (byte-compile-maybe-add-*): + New macro, for functions like #'sort and #'mapcar that, to be + strictly compatible, should only take two args, but in our + implementation can take more, because they're aliases of #'sort* + and #'mapcar*. + (byte-compile-mapcar, byte-compile-sort, byte-compile-fillarray): + Use this new macro. + (map-into): Add a byte-compile method for #'map-into in passing. + + * apropos.el (apropos-print): Use #'sort* with a :key argument, + now it's in C. + * compat.el (extent-at): Ditto. + * register.el (list-registers): Ditto. + * package-ui.el (pui-list-packages): Ditto. + * help.el (sorted-key-descriptions): Ditto. + +2010-02-22 Ben Wing + + * dumped-lisp.el (preloaded-file-list): + * font.el (font-tty-find-closest-color): + * fontcolor.el: + * fontcolor.el (ws-object-property-1): Removed. + * fontcolor.el (fontcolor-property-1): New. + * fontcolor.el (font-name): + * fontcolor.el (font-ascent): + * fontcolor.el (font-descent): + * fontcolor.el (font-width): + * fontcolor.el (font-height): + * fontcolor.el (font-proportional-p): + * fontcolor.el (font-properties): + * fontcolor.el (font-truename): + * fontcolor.el (color-name): + * fontcolor.el (color-rgb-components): + * x-faces.el: + Rename objects.el -> fontcolor.el. + +2010-02-22 Ben Wing + + * obsolete.el: + * obsolete.el ('show-buffer): New. + * obsolete.el ('buffer-flush-undo): New. + * obsolete.el (buffer-local-value): New. + * obsolete.el (Info-default-directory-list): Removed. + * obsolete.el (x-color-values): New. + * obsolete.el (mswindows-color-list): + * obsolete.el (init-file-user): Removed. + * obsolete.el ('pui-add-install-directory): Removed. + * obsolete.el (line-beginning-position): + * obsolete.el ('line-beginning-position): New. + * obsolete.el ('line-end-position): New. + * obsolete.el (obsolete-throw): New. + * obsolete.el ('cl-mapc): New. + * obsolete.el ('byte-code-function-p): New. + * obsolete.el ('interactive-form): New. + * obsolete.el ('assq-delete-all): New. + * obsolete.el (makehash): New. + * obsolete.el ('user-original-login-name): Removed. + * obsolete.el ('isearch-yank-x-selection): Removed. + * obsolete.el ('isearch-yank-x-clipboard): Removed. + * obsolete.el ('display-column-mode): New. + Rearrange; create some new categories out of "misc" stuff, + put categories in alphabetical order, move remaning "misc" + stuff to bottom. + +2010-03-29 Aidan Kehoe + + * hyper-apropos.el (hyper-apropos-get-doc): + Use help.el's #'function-arglist, #'function-documentation, + #'symbol-file in this function, instead of rolling our own. + +2010-03-25 Ben Wing + + * diagnose.el (show-memory-usage): + * diagnose.el (show-object-memory-usage-stats): + Further changes to correspond with changes in the C code; + add an additional column in show-object-memory-usage-stats showing + the ancillary Lisp overhead used with each type; shrink columns for + windows in show-memory-usage to get it to fit in 79 chars. + +2010-03-26 Aidan Kehoe + + * descr-text.el (describe-char-display): + Behave better on builds without database support, and for + characters where no font is available. Especially relevant on + Win32. + +2010-03-23 Aidan Kehoe + + * x-win-xfree86.el (x-win-init-xfree86): + If iso-left-tab (something ISO-specified and portable in theory; + in practice only seen with XFree86 and derived non-US layouts) + exists on the keyboard layout, make it equivalent to shift-tab, + addressing the issue FKtPp sees in + http://mid.gmane.org/1269358206.4873.1.camel@fktpp-laptop . + +2010-03-21 Aidan Kehoe + + * cl-extra.el (cl-prettyprint): + Handle (function ...) specially here, as we do (quote ...). + +2010-03-20 Ben Wing + + * diagnose.el (show-memory-usage): + * diagnose.el (show-object-memory-usage-stats): + Further changes to correspond with changes in the C code; + add an additional column showing the overhead used with each type, + and add it into the grand total memory usage. + +2010-03-19 Ben Wing + + * diagnose.el (show-object-memory-usage-stats): + Rewrite to take into account non-lisp-storage statistics + returned by garbage-collect-1 and friends. + +2010-03-18 Ben Wing + + * diagnose.el (show-memory-usage): + Rewrite to take into account API changes in memory-usage functions. + +2010-03-20 Aidan Kehoe + + * cl-macs.el (notany, notevery): + Correct these compiler macros. + +2010-03-15 Ben Wing + + * mule/mule-cmds.el: + * mule/mule-cmds.el (finish-set-language-environment): + Fix bug in generating display-table entries for error octet characters. + +2010-03-12 Ben Wing + + * test-harness.el (test-harness-from-buffer): + Undo change of e.g. (Assert (equalp ...)) to (Assert-equalp ...). + Get rid of `Assert-equalp' and friends, `Assert-test', and + `Assert-test-not'. Instead, make `Assert' smart enough to do the + equivalent functionality when an expression like (Assert (equalp ...)) + is seen. + +2010-03-11 Aidan Kehoe + + * setup-paths.el (paths-find-emacs-roots) + (paths-construct-info-path): + Pass :from-end t to the delete-duplicates calls in these + functions, now the compiler macro no longer defaults it to t. + +2010-03-07 Ben Wing + + * disp-table.el: + * disp-table.el (standard-display-g1): + * disp-table.el (standard-display-graphic): + Fix up docs; add comments about authorship. + +2010-03-06 Ben Wing + + * test-harness.el: + * test-harness.el (test-harness-backtrace): New. + * test-harness.el (test-harness-assertion-failure-do-debug): + * test-harness.el (test-harness-unexpected-error-do-debug): + Use the print settings from edebug.el to make backtraces not + be so huge. + +2010-03-06 Aidan Kehoe + + * bytecomp.el (byte-compile-compiled-obj-to-list): + Remove this function, printing a compiled object to a string and + then reading back a substring is senseless, just use the + compiled-function slot accessor functions. + +2010-03-05 Aidan Kehoe + + * cl-macs.el (delete-duplicates): + Correct the logic of this compiler macro when :from-end is nil, + avoiding a hang in query-coding-tests.el. Thanks for the reports, + Vin and Mats! + +2010-03-04 Aidan Kehoe + + * make-docfile.el (process-args): + Use #'subseq here, not #'substring, fixing the native Windows + build. Thank you for the error report, Vin! + +2010-03-03 Aidan Kehoe + + Move byte code #o117 to #'subseq, not #'substring. + Make #'substring available as an alias for #'subseq in Lisp. + * bytecomp.el (79, subseq, substring): + * bytecomp.el (byte-compile-subseq): New. + * update-elc.el (update-elc-chop-extension): Use #'subseq, not + #'substring, the latter is not yet available. + * subr.el (substring): New alias, to #'subseq. + +2010-03-02 Aidan Kehoe + + * cl-macs.el (delete-dups): New compiler macro for this function, + expanding to inline byte codes. + (delete-duplicates): Handle the :from-end argument correctly in + this compiler macro. + +2010-03-01 Aidan Kehoe + + * cl-seq.el (cl-parsing-keywords): + * cl-macs.el (cl-do-arglist): + Use the new invalid-keyword-argument error here. + +2010-02-26 Aidan Kehoe + + Back out Ben's revision c673987f5f3d. + * coding.el: + Add a compiler macro for #'make-coding-system on non-Mule builds + too, to fix the problem he addressed with that changeset. + * mule/make-coding-system.el (fixed-width-private-use-start): + Don't call (decode-char ... 'ucs) here, it can make bootstrapping + harder. + +2010-02-26 Ben Wing + + * autoload.el (autoload-featurep-protect-autoloads): + Always insert a coding-system cookie, either raw-text-unix or + escape-quoted. As before, insert an error statement when an + escape-quoted auto-autoload is loaded in a non-Mule XEmacs. + + This fixes problems when the default coding system is UTF-8, + as in Cygwin. Under some circumstances, the file can get + written out as raw text and read in as UTF-8, where invididual + high-bytes are usually invalid UTF-8 sequences and lead to + error octets in the buffer; when written out again, these + force escape-quoted. Result: auto-autoloads.el for the + source-tree lisp/ directory would end up as escape-quoted. + +2010-02-25 Didier Verna + + The background-placement face property. + * cl-macs.el (face-background-placement): New defsetf. + * cus-face.el (custom-face-attributes): + * faces.el (face-interactive): + * faces.el (set-face-property): + * faces.el (face-equal): + * faces.el (init-other-random-faces): Update. + * faces.el (face-background-placement): + * faces.el (set-face-background-placement): + * faces.el (face-background-placement-instance): + * faces.el (face-background-placement-instance-p): + * frame.el (set-frame-background-placement): + * frame.el (frame-background-placement): + * frame.el (frame-background-placement-instance): + * objects.el (make-face-background-placement-specifier): New. + +2010-02-25 Ben Wing + + * autoload.el (make-autoload): + Call cl-function-arglist with one arg. + + * cl-macs.el (cl-function-arglist): + * cl-macs.el (cl-transform-lambda): + Make cl-function-arglist take only one arg, the arglist; no + function name passed. Also make sure to print () instead of nil + when empty arglist, or function-documentation-1 won't recognize + the arguments: line. + * help.el (function-arglist): If empty arg, don't display extra + space after function name. + +2010-02-24 Aidan Kehoe + + * cl-extra.el (constantly): + Normally return a compiled function from #'constantly if we are + handed a single argument. Shouldn't actually matter, the overhead + for returning a single constant in a lambda form vs. in a compiled + function is minuscule, but using compiled functions as much as + possible is good style in XEmacs, our interpreter is not stellar + (nor indeed should it need to be). + +2010-02-23 Ben Wing + + * help.el: fux typo in comment. (oops) + +2010-02-23 Ben Wing + + * autoload.el: + * autoload.el (make-autoload): + * cl-macs.el (cl-function-arglist): + * cl-macs.el (cl-transform-lambda): + Don't add argument list with the tag "Common Lisp lambda list:"; + instead add in "standard" form using "arguments:" and omitting the + function name. Add an arg to `cl-function-arglist' to omit the + name and use it in autoload.el instead of just hacking it off. + + * help.el: + * help.el (function-arglist): + * help.el (function-documentation-1): New. + Extract out common code to recognize and/or strip the arglist from + documentation into `function-documentation-1'. Use in + `function-arglist' and `function-documentation'. Modify + `function-arglist' so it looks for the `arguments: ' stuff in all + doc strings, not just subrs/autoloads, so that CL functions get + recognized properly. Change the regexp used to match "arguments: " + specs to allow nested parens inside the arg list (happens when you + have a default value specified in a CL arglist). + +2010-02-22 Ben Wing + + * test-harness.el: + * test-harness.el (test-harness-from-buffer): + * test-harness.el (batch-test-emacs): + Move file from tests/automated into lisp/ so it gets + byte-compiled. This significantly reduces the amount of extra + crap in outputted backtraces. Delete hack in batch-test-emacs to + look for test-harness.el in the test directory since it's not there + any more. + + Also, in `Check-Message', incorporate call to `Skip-Test-Unless' + in the macro output rather than its body, to avoid problems byte- + compiling the file -- `Skip-Test-Unless' isn't available in the + environment during byte-compilation so we can't call it then. + +2010-02-22 Ben Wing + + * cl-seq.el: + * cl-seq.el (stable-union): New. + * cl-seq.el (stable-intersection): New. + New functions to do stable set operations, i.e. preserve the order + of the elements in the argument lists, and prefer LIST1 over LIST2 + when ordering the combined result. The result looks as much like + LIST1 as possible, followed (in the case of `stable-union') by + any necessary elements from LIST2, in order. This is contrary to + `union' and `intersection', which are not required to be order- + preserving and are not -- they prefer LIST2 and output results in + backwards order. + +2010-02-22 Ben Wing + + * cl-seq.el: + * cl-seq.el (reduce): + * cl-seq.el (fill): + * cl-seq.el (replace): + * cl-seq.el (remove*): + * cl-seq.el (remove-if): + * cl-seq.el (remove-if-not): + * cl-seq.el (delete*): + * cl-seq.el (delete-if): + * cl-seq.el (delete-if-not): + * cl-seq.el (remove-duplicates): + * cl-seq.el (delete-duplicates): + * cl-seq.el (substitute): + * cl-seq.el (substitute-if): + * cl-seq.el (substitute-if-not): + * cl-seq.el (nsubstitute): + * cl-seq.el (nsubstitute-if): + * cl-seq.el (nsubstitute-if-not): + * cl-seq.el (find): + * cl-seq.el (find-if): + * cl-seq.el (find-if-not): + * cl-seq.el (position): + * cl-seq.el (position-if): + * cl-seq.el (position-if-not): + * cl-seq.el (count): + * cl-seq.el (count-if): + * cl-seq.el (count-if-not): + * cl-seq.el (mismatch): + * cl-seq.el (search): + * cl-seq.el (sort*): + * cl-seq.el (stable-sort): + * cl-seq.el (merge): + * cl-seq.el (member*): + * cl-seq.el (member-if): + * cl-seq.el (member-if-not): + * cl-seq.el (assoc*): + * cl-seq.el (assoc-if): + * cl-seq.el (assoc-if-not): + * cl-seq.el (rassoc*): + * cl-seq.el (rassoc-if): + * cl-seq.el (rassoc-if-not): + * cl-seq.el (union): + * cl-seq.el (nunion): + * cl-seq.el (intersection): + * cl-seq.el (nintersection): + * cl-seq.el (set-difference): + * cl-seq.el (nset-difference): + * cl-seq.el (set-exclusive-or): + * cl-seq.el (nset-exclusive-or): + * cl-seq.el (subsetp): + * cl-seq.el (subst-if): + * cl-seq.el (subst-if-not): + * cl-seq.el (nsubst): + * cl-seq.el (nsubst-if): + * cl-seq.el (nsubst-if-not): + * cl-seq.el (sublis): + * cl-seq.el (nsublis): + * cl-seq.el (tree-equal): + * cl-seq.el (cl-tree-equal-rec): + * cl.el: + * cl.el (pushnew): + * cl.el (adjoin): + * cl.el (subst): + Document the keywords to the various sequence/list functions. + +2010-02-21 Ben Wing + + * diagnose.el: + * diagnose.el (show-object-memory-usage-stats): + Fix errors preventing this from working properly, account for + words like "entry" pluralized to "entries". + +2010-02-22 Aidan Kehoe + + * cl-extra.el (constantly): + Add this function, from ANSI Common Lisp, using the SBCL extension + that extra arguments to it are passed back as multiple values in + the constructed function. + * cl-macs.el (constantly): + In the compiler macro for #'constantly, construct a + compiled-function object almost every time, at compile time when + all arguments are constant, and at runtime when they vary. + 2010-02-19 Ben Wing * paragraphs.el: @@ -28842,3 +30523,23 @@ standard font-lock faces). * version.el: Bumped up to b31. + + +ChangeLog entries synched from GNU Emacs are the property of the FSF. +Other ChangeLog entries are usually the property of the author of the +change. + +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 3 of the License, 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. If not, see . diff -r 861f2601a38b -r 1f0b15040456 lisp/ChangeLog.GTK --- a/lisp/ChangeLog.GTK Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/ChangeLog.GTK Sun May 01 18:44:03 2011 +0100 @@ -247,3 +247,20 @@ * gtk-faces.el (gtk-init-face-from-resources): Set the highlight face as well. + +Copyright (C) 2000 William M. Perry + +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 3 of the License, 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. If not, see . diff -r 861f2601a38b -r 1f0b15040456 lisp/abbrev.el --- a/lisp/abbrev.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/abbrev.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.34 (With some additions) @@ -120,31 +118,12 @@ (setplist sym (or count 0)) name)) +(define-abbrev-table 'fundamental-mode-abbrev-table nil) +(and (eq major-mode 'fundamental-mode) + (not local-abbrev-table) + (setq local-abbrev-table fundamental-mode-abbrev-table)) -;; Fixup stuff from bootstrap def of define-abbrev-table in subr.el -(let ((l abbrev-table-name-list)) - (while l - (let ((fixup (car l))) - (if (consp fixup) - (progn - (setq abbrev-table-name-list (delq fixup abbrev-table-name-list)) - (define-abbrev-table (car fixup) (cdr fixup)))) - (setq l (cdr l)))) - ;; These are no longer initialized by C code - (if (not global-abbrev-table) - (progn - (setq global-abbrev-table (make-abbrev-table)) - (setq abbrev-table-name-list (cons 'global-abbrev-table - abbrev-table-name-list)))) - (if (not fundamental-mode-abbrev-table) - (progn - (setq fundamental-mode-abbrev-table (make-abbrev-table)) - (setq abbrev-table-name-list (cons 'fundamental-mode-abbrev-table - abbrev-table-name-list)))) - (and (eq major-mode 'fundamental-mode) - (not local-abbrev-table) - (setq local-abbrev-table fundamental-mode-abbrev-table))) - +(define-abbrev-table 'global-abbrev-table nil) (defun define-global-abbrev (name expansion) "Define ABBREV as a global abbreviation for EXPANSION." diff -r 861f2601a38b -r 1f0b15040456 lisp/about.el --- a/lisp/about.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/about.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/alist.el --- a/lisp/alist.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/alist.el Sun May 01 18:44:03 2011 +0100 @@ -7,10 +7,10 @@ ;; This file is part of APEL (A Portable Emacs Library). -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. +;; 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 3 of the License, or (at your +;; option) any later version. ;; This program is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of @@ -18,9 +18,7 @@ ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;;###autoload diff -r 861f2601a38b -r 1f0b15040456 lisp/apropos.el --- a/lisp/apropos.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/apropos.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Last synched with FSF 19.34, diverged since. @@ -500,8 +498,7 @@ (if doc-fn (funcall doc-fn apropos-accumulator)) (setq apropos-accumulator - (sort apropos-accumulator (lambda (a b) - (string-lessp (car a) (car b))))) + (sort* apropos-accumulator #'string-lessp :key #'car)) (and apropos-label-face (or (symbolp apropos-label-face) (facep apropos-label-face)) ; XEmacs diff -r 861f2601a38b -r 1f0b15040456 lisp/auto-save.el --- a/lisp/auto-save.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/auto-save.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,20 @@ ;; Keywords: extensions, dumped ;; Version: 1.26 -;; 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. +;; This file is part of XEmacs. -;; 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. +;; 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 3 of the License, or (at your +;; option) any later version. + +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF diff -r 861f2601a38b -r 1f0b15040456 lisp/auto-show.el --- a/lisp/auto-show.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/auto-show.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Emacs/Mule zeta. diff -r 861f2601a38b -r 1f0b15040456 lisp/autoload.el --- a/lisp/autoload.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/autoload.el Sun May 01 18:44:03 2011 +0100 @@ -2,7 +2,7 @@ ;; Copyright (C) 1991-1994, 1997, 2003 Free Software Foundation, Inc. ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp. -;; Copyright (C) 1996, 2000, 2002, 2003, 2004 Ben Wing. +;; Copyright (C) 1996, 2000, 2002, 2003, 2004, 2010 Ben Wing. ;; Original Author: Roland McGrath ;; Heavily Modified: XEmacs Maintainers @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 21.2 by Ben Wing. ;;; Note that update-file-autoloads is seriously modified and not really @@ -286,14 +284,11 @@ (body (nthcdr (get car 'doc-string-elt) form)) (doc (if (stringp (car body)) (pop body)))) (if (memq car '(defmacro defmacro* defun defun*)) - (let ((arglist (nth 2 form)) - (placeholder (eval-when-compile (gensym)))) + (let ((arglist (nth 2 form))) (setq doc (concat (or doc "") "\n\narguments: " - (replace-in-string - (cl-function-arglist placeholder arglist) - (format "^(%s ?" placeholder) - "(") "\n")))) + (cl-function-arglist arglist) + "\n")))) ;; `define-generic-mode' quotes the name, so take care of that (list 'autoload (if (listp name) name (list 'quote name)) file doc (or (and (memq car '(define-skeleton define-derived-mode @@ -1091,11 +1086,13 @@ ;; recognized only one of the two magic-cookie styles (the -*- kind) ;; in find-file, but both of them in load. We go ahead and put both ;; in, just to be safe. + (insert (format " -*- coding: %s -*-\n" buffer-file-coding-system)) (when (eq buffer-file-coding-system 'escape-quoted) - (insert " -*- coding: escape-quoted; -*- -\(or (featurep 'mule) (error \"Loading this file requires Mule support\")) -;;;###coding system: escape-quoted")) - (insert "\n(if (featurep '" sym ")") + (insert "(or (featurep 'mule) ") + (insert "(error \"Loading this file requires Mule support\"))\n")) + (insert (format ";;;###coding system: %s\n" + buffer-file-coding-system)) + (insert "(if (featurep '" sym ")") (insert " (error \"Feature " sym " already loaded\"))\n") (goto-char (point-max)) (save-excursion diff -r 861f2601a38b -r 1f0b15040456 lisp/backquote.el --- a/lisp/backquote.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/backquote.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,20 @@ ;; 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. +;; This file is part of XEmacs. -;; 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. +;; 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 3 of the License, or (at your +;; option) any later version. + +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched with FSF. @@ -184,19 +184,10 @@ ;;; ---------------------------------------------------------------- -(defun bq-vector-contents (vec) - (let ((contents nil) - (n (length vec))) - (while (> n 0) - (setq n (1- n)) - (setq contents (cons (aref vec n) contents))) - contents)) - ;;; This does the expansion from table 2. (defun bq-process-2 (code) (cond ((vectorp code) - (let* ((dflag-d - (bq-process-2 (bq-vector-contents code)))) + (let* ((dflag-d (bq-process-2 (append code nil)))) (cons 'vector (bq-process-1 (car dflag-d) (cdr dflag-d))))) ((atom code) (cond ((null code) (cons nil nil)) @@ -278,26 +269,7 @@ (list 'quote thing)) ((eq flag 'vector) (list 'apply '(function vector) thing)) - (t (cons (cdr - (assq flag - '((cons . cons) - (list* . bq-list*) - (list . list) - (append . append) - (nconc . nconc)))) - thing)))) - -;;; ---------------------------------------------------------------- - -(defmacro bq-list* (&rest args) - "Return a list of its arguments with last cons a dotted pair." - (setq args (reverse args)) - (let ((result (car args))) - (setq args (cdr args)) - (while args - (setq result (list 'cons (car args) result)) - (setq args (cdr args))) - result)) + (t (cons flag thing)))) (provide 'backquote) diff -r 861f2601a38b -r 1f0b15040456 lisp/behavior-defs.el --- a/lisp/behavior-defs.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/behavior-defs.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/behavior.el --- a/lisp/behavior.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/behavior.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -349,15 +347,11 @@ (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) + (let (list) + (maphash #'(lambda (key value) + (push (cons (symbol-name key) value) list)) + behavior-hash-table) + list) nil must-match initial-contents (or history 'behavior-history) default-value))) (if (and result (stringp result)) diff -r 861f2601a38b -r 1f0b15040456 lisp/blessmail.el --- a/lisp/blessmail.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/blessmail.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.34. diff -r 861f2601a38b -r 1f0b15040456 lisp/buff-menu.el --- a/lisp/buff-menu.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/buff-menu.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.34 except as noted. @@ -512,10 +510,7 @@ (make-variable-buffer-local 'list-buffers-identification) ;; XEmacs -;;;###autoload (defvar list-buffers-directory nil) - -;;;###autoload (make-variable-buffer-local 'list-buffers-directory) ;; #### not synched @@ -643,8 +638,8 @@ (if (memq files-only '(t nil)) #'(lambda (b) (let ((n (buffer-name b))) - (cond ((and (/= 0 (length n)) - (= (aref n 0) ?\ )) + (cond ((and (not (eql 0 (length n))) + (eql (aref n 0) ?\ )) ;;don't mention if starts with " " nil) (files-only diff -r 861f2601a38b -r 1f0b15040456 lisp/buffer.el --- a/lisp/buffer.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/buffer.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.30 buffer.c. diff -r 861f2601a38b -r 1f0b15040456 lisp/build-report.el --- a/lisp/build-report.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/build-report.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: XEmacs build package build-report.el Revision 1.49. diff -r 861f2601a38b -r 1f0b15040456 lisp/byte-optimize.el --- a/lisp/byte-optimize.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/byte-optimize.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 20.7 except where marked. ;;; [[ Synched up with: FSF 20.7. ]] @@ -823,7 +821,7 @@ (nth 1 form) (byte-compile-warn "identity called with %d arg%s, but requires 1" (length (cdr form)) - (if (= 1 (length (cdr form))) "" "s")) + (if (eql 1 (length (cdr form))) "" "s")) form)) (defun byte-optimize-car (form) @@ -877,6 +875,7 @@ (put 'eq 'byte-optimizer 'byte-optimize-binary-predicate) (put 'eql 'byte-optimizer 'byte-optimize-binary-predicate) (put 'equal 'byte-optimizer 'byte-optimize-binary-predicate) +(put 'equalp 'byte-optimizer 'byte-optimize-binary-predicate) (put 'string= 'byte-optimizer 'byte-optimize-binary-predicate) (put 'string-equal 'byte-optimizer 'byte-optimize-binary-predicate) @@ -1020,7 +1019,7 @@ ;; Don't make a double negative; ;; instead, take away the one that is there. (if (and (consp clause) (memq (car clause) '(not null)) - (= (length clause) 2)) ; (not xxxx) or (not (xxxx)) + (eql (length clause) 2)) ; (not xxxx) or (not (xxxx)) (nth 1 clause) (list 'not clause)) (if (nthcdr 4 form) @@ -1118,17 +1117,26 @@ ;; The funcall optimizer can then transform (funcall 'foo ...) -> (foo ...). (let ((fn (nth 1 form)) (last (nth (1- (length form)) form))) ; I think this really is fastest - (or (if (or (null last) - (eq (car-safe last) 'quote)) - (if (listp (nth 1 last)) - (let ((butlast (nreverse (cdr (reverse (cdr (cdr form))))))) - (nconc (list 'funcall fn) butlast - (mapcar #'(lambda (x) (list 'quote x)) (nth 1 last)))) - (byte-compile-warn - "last arg to apply can't be a literal atom: %s" - (prin1-to-string last)) - nil)) - form))) + (if (and (eq last (third form)) + (consp last) + (eq 'mapcar (car last)) + (equal fn ''nconc)) + (progn + (byte-compile-warn + "(apply 'nconc (mapcar ..)), use #'mapcan instead: %s" last) + (cons 'mapcan (cdr last))) + (or (if (or (null last) + (eq (car-safe last) 'quote)) + (if (listp (nth 1 last)) + (let ((butlast (nreverse (cdr (reverse (cdr (cdr form))))))) + (nconc (list 'funcall fn) butlast + (mapcar #'(lambda (x) (list 'quote x)) + (nth 1 last)))) + (byte-compile-warn + "last arg to apply can't be a literal atom: %s" + (prin1-to-string last)) + nil)) + form)))) (put 'funcall 'byte-optimizer 'byte-optimize-funcall) (put 'apply 'byte-optimizer 'byte-optimize-apply) @@ -1153,7 +1161,7 @@ (put 'nth 'byte-optimizer 'byte-optimize-nth) (defun byte-optimize-nth (form) - (if (and (= (safe-length form) 3) (memq (nth 1 form) '(0 1))) + (if (and (eql (safe-length form) 3) (memq (nth 1 form) '(0 1))) (list 'car (if (zerop (nth 1 form)) (nth 2 form) (list 'cdr (nth 2 form)))) @@ -1161,7 +1169,7 @@ (put 'nthcdr 'byte-optimizer 'byte-optimize-nthcdr) (defun byte-optimize-nthcdr (form) - (if (and (= (safe-length form) 3) (not (memq (nth 1 form) '(0 1 2)))) + (if (and (eql (safe-length form) 3) (not (memq (nth 1 form) '(0 1 2)))) (byte-optimize-predicate form) (let ((count (nth 1 form))) (setq form (nth 2 form)) @@ -1215,7 +1223,7 @@ ;; coordinates-in-window-p not in XEmacs copy-marker cos count-lines default-boundp default-value denominator documentation downcase - elt exp expt fboundp featurep + elt endp exp expt fboundp featurep file-directory-p file-exists-p file-locked-p file-name-absolute-p file-newer-than-file-p file-readable-p file-symlink-p file-writable-p float floor format @@ -1235,9 +1243,10 @@ marker-buffer max member memq min mod next-window nth nthcdr number-to-string numerator parse-colon-path plist-get previous-window - radians-to-degrees rassq regexp-quote reverse round + radians-to-degrees rassq rassoc remove remq regexp-quote reverse round sin sqrt string< string= string-equal string-lessp string-to-char - string-to-int string-to-number substring symbol-plist + string-to-int string-to-number substring symbol-plist symbol-value + symbol-name symbol-function symbol tan upcase user-variable-p vconcat ;; XEmacs change: window-edges -> window-pixel-edges window-buffer window-dedicated-p window-pixel-edges window-height @@ -1260,7 +1269,7 @@ current-buffer ;; XEmacs: extent functions, frame-live-p, various other stuff devicep device-live-p - dot dot-marker eobp eolp eq eql equal eventp extentp + eobp eolp eq eql equal eventp extentp extent-live-p fixnump floatingp floatp framep frame-live-p get-largest-window get-lru-window hash-table-p diff -r 861f2601a38b -r 1f0b15040456 lisp/bytecomp-runtime.el --- a/lisp/bytecomp-runtime.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/bytecomp-runtime.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.30. @@ -53,30 +51,26 @@ "Cause the named functions to be open-coded when called from compiled code. They will only be compiled open-coded when `byte-optimize' is true." (cons 'eval-and-compile - (apply - 'nconc - (mapcar - #'(lambda (x) - `((or (memq (get ',x 'byte-optimizer) - '(nil byte-compile-inline-expand)) - (error - "%s already has a byte-optimizer, can't make it inline" - ',x)) - (put ',x 'byte-optimizer 'byte-compile-inline-expand))) - fns)))) + (mapcan + #'(lambda (x) + `((or (memq (get ',x 'byte-optimizer) + '(nil byte-compile-inline-expand)) + (error + "%s already has a byte-optimizer, can't make it inline" + ',x)) + (put ',x 'byte-optimizer 'byte-compile-inline-expand))) + fns))) (defmacro proclaim-notinline (&rest fns) "Cause the named functions to no longer be open-coded." (cons 'eval-and-compile - (apply - 'nconc - (mapcar - #'(lambda (x) - `((if (eq (get ',x 'byte-optimizer) - 'byte-compile-inline-expand) - (put ',x 'byte-optimizer nil)))) - fns)))) + (mapcan + #'(lambda (x) + `((if (eq (get ',x 'byte-optimizer) + 'byte-compile-inline-expand) + (put ',x 'byte-optimizer nil)))) + fns))) ;; This has a special byte-hunk-handler in bytecomp.el. (defmacro defsubst (name arglist &rest body) @@ -163,7 +157,7 @@ (put 'eval-when-compile 'lisp-indent-hook 0) (defmacro eval-when-compile (&rest body) - "Like `progn', but evaluates the body at compile time. + "Like `progn', but evaluates BODY at compile time, and when interpeted. The result of the body appears to the compiler as a quoted constant." ;; Not necessary because we have it in b-c-initial-macro-environment ;; (list 'quote (eval (cons 'progn body))) @@ -171,7 +165,8 @@ (put 'eval-and-compile 'lisp-indent-hook 0) (defmacro eval-and-compile (&rest body) - "Like `progn', but evaluates the body at compile time and at load time." + "Like `progn', but evaluates the body at compile time and at load time, +and when interpreted." ;; Remember, it's magic. (cons 'progn body)) @@ -313,7 +308,7 @@ (let ((symbols (eval (car (cdr form))))) (unless (consp symbols) (setq symbols (list symbols))) - (setq symbols (mapcar #'(lambda (sym) (cons sym nil)) symbols)) + (setq symbols (mapcar #'list symbols)) (setq byte-compile-unresolved-functions (set-difference byte-compile-unresolved-functions symbols :key #'car)) @@ -430,7 +425,7 @@ ;; have an autoload later in the file for any functions in FUNCTIONS. ;; This is not something that code should ever do, though.) (setq byte-compile-autoload-environment - (append (mapcar #'(lambda (sym) (cons sym nil)) functions) + (append (mapcar #'list functions) byte-compile-autoload-environment))) nil) diff -r 861f2601a38b -r 1f0b15040456 lisp/bytecomp.el --- a/lisp/bytecomp.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/bytecomp.el Sun May 01 18:44:03 2011 +0100 @@ -14,20 +14,18 @@ ;; 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. +;; 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 3 of the License, or (at your +;; option) any later version. + +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.30. @@ -455,6 +453,9 @@ "Alist of variables bound in the context of the current form, that is, the current lexical environment. This list lives partly on the specbind stack. The cdr of each cell is an integer bitmask.") +(defvar byte-compile-output-preface nil + "Form to output before current by `byte-compile-output-file-form' +This is used for implementing `load-time-value'.") (defvar byte-compile-force-escape-quoted nil "If t, `byte-compile-maybe-reset-coding' always chooses `escape-quoted' @@ -493,13 +494,25 @@ (fset (car elt) (cdr elt))))))) (defconst byte-compile-initial-macro-environment - '((byte-compiler-options . (lambda (&rest forms) - (apply 'byte-compiler-options-handler forms))) - (eval-when-compile . (lambda (&rest body) - (list 'quote (byte-compile-eval (cons 'progn body))))) - (eval-and-compile . (lambda (&rest body) - (byte-compile-eval (cons 'progn body)) - (cons 'progn body)))) + `((byte-compiler-options + . ,#'(lambda (&rest forms) + (apply 'byte-compiler-options-handler forms))) + (eval-when-compile + . ,#'(lambda (&rest body) + (list 'quote (byte-compile-eval (cons 'progn body))))) + (eval-and-compile + . ,#'(lambda (&rest body) + (byte-compile-eval (cons 'progn body)) + (cons 'progn body))) + (the . + ,#'(lambda (type form) + (if (cl-const-expr-p form) + (or (eval (cl-make-type-test form type)) + (byte-compile-warn + "%s is not of type %s" form type))) + (if byte-compile-delete-errors + form + (funcall (cdr (symbol-function 'the)) type form))))) "The default macro-environment passed to macroexpand by the compiler. Placing a macro here will cause a macro to have different semantics when expanded by the compiler as when expanded by the interpreter.") @@ -609,7 +622,7 @@ (byte-defop 76 -1 byte-set) (byte-defop 77 -1 byte-fset) ; this was commented out (byte-defop 78 -1 byte-get) -(byte-defop 79 -2 byte-substring) +(byte-defop 79 -2 byte-subseq) (byte-defop 80 -1 byte-concat2) (byte-defop 81 -2 byte-concat3) (byte-defop 82 -3 byte-concat4) @@ -1383,7 +1396,7 @@ (defmacro byte-compile-constp (form) ;; Returns non-nil if FORM is a constant. - `(cond ((consp ,form) (eq (car ,form) 'quote)) + `(cond ((consp ,form) (memq (car ,form) '(quote function))) ((symbolp ,form) (byte-compile-constant-symbol-p ,form)) (t))) @@ -1965,8 +1978,12 @@ (not byte-compile-emacs19-compatibility)) '(t) nil)) print-gensym-alist) + (when byte-compile-output-preface + (princ "\n(progn " byte-compile-outbuffer) + (prin1 byte-compile-output-preface byte-compile-outbuffer)) (princ "\n" byte-compile-outbuffer) (prin1 form byte-compile-outbuffer) + (when byte-compile-output-preface (princ ")" byte-compile-outbuffer)) nil))) (defun byte-compile-output-docform (preface name info form specindex quoted) @@ -2004,12 +2021,6 @@ (> (length (nth (nth 1 info) form)) 0) (char= (aref (nth (nth 1 info) form) 0) ?*)) (setq position (- position))))) - - (if preface - (progn - (insert preface) - (prin1 name byte-compile-outbuffer))) - (insert (car info)) (let ((print-escape-newlines t) (print-readably t) ; print #[] for bytecode, 'x for (quote x) ;; Use a cons cell to say that we want @@ -2020,6 +2031,15 @@ '(t) nil)) print-gensym-alist (index 0)) + (when byte-compile-output-preface + (princ "\n(progn " byte-compile-outbuffer) + (prin1 byte-compile-output-preface byte-compile-outbuffer)) + (byte-compile-flush-pending) + (if preface + (progn + (insert preface) + (prin1 name byte-compile-outbuffer))) + (insert (car info)) (prin1 (car form) byte-compile-outbuffer) (while (setq form (cdr form)) (setq index (1+ index)) @@ -2046,7 +2066,9 @@ (goto-char (point-max))))) (t (prin1 (car form) byte-compile-outbuffer))))) - (insert (nth 2 info)))))) + (insert (nth 2 info)) + (when byte-compile-output-preface + (princ ")" byte-compile-outbuffer)))))) nil) (defvar for-effect) ; ## Kludge! This should be an arg, not a special. @@ -2082,6 +2104,7 @@ (defun byte-compile-file-form (form) (let ((byte-compile-current-form nil) ; close over this for warnings. + (byte-compile-output-preface nil) handler) (cond ((not (consp form)) @@ -2247,22 +2270,6 @@ (defun byte-compile-file-form-defmacro (form) (byte-compile-file-form-defmumble form t)) -(defun byte-compile-compiled-obj-to-list (obj) - ;; #### this is fairly disgusting. Rewrite the code instead - ;; so that it doesn't create compiled objects in the first place! - ;; Much better than creating them and then "uncreating" them - ;; like this. - (read (concat "(" - (substring (let ((print-readably t) - (print-gensym - (if (and byte-compile-print-gensym - (not byte-compile-emacs19-compatibility)) - '(t) nil)) - (print-gensym-alist nil)) - (prin1-to-string obj)) - 2 -1) - ")"))) - (defun byte-compile-file-form-defmumble (form macrop) (let* ((name (car (cdr form))) (this-kind (if macrop 'byte-compile-macro-environment @@ -2330,7 +2337,14 @@ (byte-compile-warn "Probable `\"' without `\\' in doc string of %s" (nth 1 form)))) (let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form)))) - (code (byte-compile-byte-code-maker new-one))) + (code (byte-compile-byte-code-maker new-one)) + (docform-info + (cond ((atom code) ; compiled-function-p + (if macrop '(" '(macro . #[" 4 "]))") '(" #[" 4 "])"))) + ((eq (car code) 'quote) + (setq code new-one) + (if macrop '(" '(macro " 2 "))") '(" '(" 2 "))"))) + ((if macrop '(" (cons 'macro (" 5 ")))") '(" (" 5 "))")))))) (if this-one (setcdr this-one new-one) (set this-kind @@ -2339,60 +2353,35 @@ (eq 'quote (car-safe code)) (eq 'lambda (car-safe (nth 1 code)))) (cons (car form) - (cons name (cdr (nth 1 code)))) + (cons name (cdr (nth 1 code)))) (byte-compile-flush-pending) (if (not (stringp (nth 3 form))) - ;; No doc string. Provide -1 as the "doc string index" - ;; so that no element will be treated as a doc string. - (byte-compile-output-docform - "\n(defalias '" - name - (cond ((atom code) - (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]"))) - ((eq (car code) 'quote) - (setq code new-one) - (if macrop '(" '(macro " -1 ")") '(" '(" -1 ")"))) - ((if macrop '(" (cons 'macro (" -1 "))") '(" (" -1 ")")))) - ;; FSF just calls `(append code nil)' here but that relies - ;; on horrible C kludges in concat() that accept byte- - ;; compiled objects and pretend they're vectors. - (if (compiled-function-p code) - (byte-compile-compiled-obj-to-list code) - (append code nil)) - (and (atom code) byte-compile-dynamic - 1) - nil) - ;; Output the form by hand, that's much simpler than having - ;; b-c-output-file-form analyze the defalias. - (byte-compile-output-docform - "\n(defalias '" - name - (cond ((atom code) ; compiled-function-p - (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]"))) - ((eq (car code) 'quote) - (setq code new-one) - (if macrop '(" '(macro " 2 ")") '(" '(" 2 ")"))) - ((if macrop '(" (cons 'macro (" 5 "))") '(" (" 5 ")")))) - ;; The result of byte-compile-byte-code-maker is either a - ;; compiled-function object, or a list of some kind. If it's - ;; not a cons, we must coerce it into a list of the elements - ;; to be printed to the file. - (if (consp code) - code - (nconc (list - (compiled-function-arglist code) - (compiled-function-instructions code) - (compiled-function-constants code) - (compiled-function-stack-depth code)) - (let ((doc (documentation code t))) - (if doc (list doc))) - (if (commandp code) - (list (nth 1 (compiled-function-interactive code)))))) - (and (atom code) byte-compile-dynamic - 1) + ;; No doc string. Provide -1 as the "doc string index" so that + ;; no element will be treated as a doc string by + ;; byte-compile-output-doc-form. + (setq docform-info (list (first docform-info) -1 + (third docform-info)))) + (byte-compile-output-docform + "\n(defalias '" + name + docform-info + ;; The result of byte-compile-byte-code-maker is either a + ;; compiled-function object, or a list of some kind. If it's not a + ;; cons, we must coerce it into a list of the elements to be + ;; printed to the file. + (if (consp code) + code + (list* (compiled-function-arglist code) + (compiled-function-instructions code) + (compiled-function-constants code) + (compiled-function-stack-depth code) + (compiled-function-doc-string code) + (if (commandp code) + (list (nth 1 (compiled-function-interactive code)))))) + (and (atom code) byte-compile-dynamic + 1) nil)) - (princ ")" byte-compile-outbuffer) - nil)))) + nil))) ;; Print Lisp object EXP in the output file, inside a comment, ;; and return the file position it will have. @@ -2858,7 +2847,83 @@ (when for-effect (byte-compile-discard))) +;; Generate the list of functions with keyword arguments like so: +;; +;; (delete-duplicates +;; (sort* +;; (loop +;; for symbol being each symbol in obarray +;; with arglist = nil +;; if (and (fboundp symbol) +;; (ignore-errors (setq symbol (indirect-function symbol))) +;; (cond +;; ((and (subrp symbol) (setq symbol (intern (subr-name symbol))))) +;; ((and (compiled-function-p symbol) +;; (setq symbol (compiled-function-annotation symbol))))) +;; (setq arglist (function-arglist symbol)) +;; (setq arglist (ignore-errors (read-from-string arglist))) +;; (setq arglist (car arglist)) +;; (setq arglist (position '&key arglist))) +;; collect (cons symbol arglist)) +;; #'string-lessp +;; :key #'car) :test #'eq :key #'car) +;; +;; That won't include those that take advantage of cl-seq.el's +;; cl-parsing-keywords macro, but the below list does. + +(map nil + (function* + (lambda ((function . nargs)) + ;; Document that the car of OBJECT, a symbol, describes a function + ;; taking keyword arguments from the argument index described by + ;; the cdr of OBJECT. + (put function 'byte-compile-keyword-start nargs))) + '((adjoin . 3) (assoc* . 3) (assoc-if . 3) (assoc-if-not . 3) + (count . 3) (count-if . 3) (count-if-not . 3) (define-behavior . 3) + (define-behavior-group . 2) (delete* . 3) (delete-duplicates . 2) + (delete-if . 3) (delete-if-not . 3) (fill . 3) (find . 3) (find-if . 3) + (find-if-not . 3) (internal-make-translation-table . 1) + (make-Print-context . 1) (make-hash-table . 1) (make-saved-window . 1) + (make-window-configuration . 1) (member* . 3) + (member-if . 3) (member-if-not . 3) (merge . 5) (nsublis . 3) + (nsubst . 4) (nsubst-if . 4) (nsubst-if-not . 4) (nsubstitute . 4) + (nsubstitute-if . 4) (nsubstitute-if-not . 4) (override-behavior . 2) + (position . 3) (position-if . 3) (position-if-not . 3) (rassoc* . 3) + (rassoc-if . 3) (rassoc-if-not . 3) (reduce . 3) (remove* . 3) + (remove-duplicates . 2) (remove-if . 3) (remove-if-not . 3) + (replace . 3) (sort* . 3) (stable-sort . 3) (sublis . 3) + (subsetp . 3) (subst . 4) (subst-if . 4) (subst-if-not . 4) + (substitute . 4) (substitute-if . 4) (substitute-if-not . 4) + (tree-equal . 3))) + (defun byte-compile-normal-call (form) + (and (symbolp (car form)) (get (car form) 'byte-compile-keyword-start) + (let ((plist (nthcdr (get (car form) 'byte-compile-keyword-start) + form))) + (symbol-macrolet + ((not-present '#:not-present)) + (if (not (valid-plist-p plist)) + (byte-compile-warn + "#'%s: ill-formed keyword argument list: %S" (car form) plist) + (and + (memq 'callargs byte-compile-warnings) + (map nil + (function* + (lambda ((function . nargs)) + (and (setq function (plist-get plist function + not-present)) + (not (eq function not-present)) + (byte-compile-constp function) + (byte-compile-callargs-warn + (cons (eval function) + (member* + nargs + ;; Dummy arguments. There's no need for + ;; it to be longer than even 2, now, but + ;; very little harm in it. + '(9 8 7 6 5 4 3 2 1))))))) + '((:key . 1) (:test . 2) (:test-not . 2) + (:if . 1) (:if-not . 1)))))))) (if byte-compile-generate-call-tree (byte-compile-annotate-call-tree form)) (byte-compile-push-constant (car form)) @@ -3087,7 +3152,7 @@ (byte-defop-compiler car 1) (byte-defop-compiler cdr 1) (byte-defop-compiler length 1) -(byte-defop-compiler symbol-value 1) +(byte-defop-compiler symbol-value) (byte-defop-compiler symbol-function 1) (byte-defop-compiler (1+ byte-add1) 1) (byte-defop-compiler (1- byte-sub1) 1) @@ -3104,14 +3169,15 @@ (byte-defop-compiler fixnump 1) (byte-defop-compiler skip-chars-forward 1-2+1) (byte-defop-compiler skip-chars-backward 1-2+1) -(byte-defop-compiler (eql byte-eq) 2) -(byte-defop-compiler20 old-eq 2) -(byte-defop-compiler20 old-memq 2) +(byte-defop-compiler eq 2) +; (byte-defop-compiler20 old-eq 2) +; (byte-defop-compiler20 old-memq 2) (byte-defop-compiler cons 2) (byte-defop-compiler aref 2) (byte-defop-compiler get 2+1) (byte-defop-compiler nth 2) -(byte-defop-compiler substring 2-3) +(byte-defop-compiler subseq byte-compile-subseq) +(byte-defop-compiler (substring byte-subseq) 2-3) (byte-defop-compiler (move-marker byte-set-marker) 2-3) (byte-defop-compiler set-marker 2-3) (byte-defop-compiler match-beginning 1) @@ -3122,7 +3188,7 @@ (byte-defop-compiler string< 2) (byte-defop-compiler (string-equal byte-string=) 2) (byte-defop-compiler (string-lessp byte-string<) 2) -(byte-defop-compiler20 old-equal 2) +; (byte-defop-compiler20 old-equal 2) (byte-defop-compiler nthcdr 2) (byte-defop-compiler elt 2) (byte-defop-compiler20 old-member 2) @@ -3163,7 +3229,7 @@ (when (memq 'subr-callargs byte-compile-warnings) (byte-compile-warn "%s called with %d arg%s, but requires %s" (car form) (length (cdr form)) - (if (= 1 (length (cdr form))) "" "s") n))) + (if (eql 1 (length (cdr form))) "" "s") n))) (defun byte-compile-subr-wrong-args (form n) (byte-compile-warn-wrong-args form n) @@ -3288,7 +3354,7 @@ ;; XEmacs: used for functions that have a different opcode in v19 than v20. ;; this includes `eq', `equal', and other old-ified functions. (defun byte-compile-two-args-19->20 (form) - (if (not (= (length form) 3)) + (if (not (eql (length form) 3)) (byte-compile-subr-wrong-args form 2) (byte-compile-form (car (cdr form))) ;; Push the arguments (byte-compile-form (nth 2 form)) @@ -3389,7 +3455,7 @@ (let* ((args (cdr form)) (nargs (length args))) (cond - ((= nargs 0) + ((eql nargs 0) (byte-compile-constant nil)) ((< nargs 5) (mapc 'byte-compile-form args) @@ -3524,6 +3590,12 @@ the syntax (function (lambda (...) ...)) instead.")))) (byte-compile-two-args form)) +(defun byte-compile-subseq (form) + (byte-compile-two-or-three-args form) + ;; Check that XEmacs supports the substring-subseq equivalence. + (pushnew '(eq 'subseq (symbol-function 'substring)) + byte-compile-checks-on-load :test #'equal)) + (defmacro byte-compile-funarg-n (&rest n) `#'(lambda (form) ,@(loop @@ -3535,8 +3607,8 @@ (null (memq 'quoted-lambda byte-compile-warnings)) (byte-compile-warn - "Passing a quoted lambda to #'%s, forcing \ -function quoting" (car form)))) + "Passing a quoted lambda (arg %d) to #'%s, \ +forcing function quoting" ,en (car form)))) (setcar fn 'function)))) (byte-compile-normal-call form))) @@ -3574,15 +3646,37 @@ (setq form (cons 'mapl (cdr form)))) (byte-compile-funarg form)) +;; For when calls to #'sort or #'mapcar have more than two args, something +;; recent XEmacs can handle, but GNU and 21.4 can't. +(defmacro byte-compile-maybe-add-* (complex max) + `#'(lambda (form) + (when (> (length (cdr form)) ,max) + (when (memq 'callargs byte-compile-warnings) + (byte-compile-warn + "#'%s called with %d arguments, using #'%s instead" + (car form) (length (cdr form)) ',complex)) + (setq form (cons ',complex (cdr form)))) + (funcall (or (get ',complex 'byte-compile) + 'byte-compile-normal-call) form))) + +(defalias 'byte-compile-mapcar (byte-compile-maybe-add-* mapcar* 2)) + +(defalias 'byte-compile-sort (byte-compile-maybe-add-* sort* 2)) + +(defalias 'byte-compile-fillarray (byte-compile-maybe-add-* fill 2)) + ;; (function foo) must compile like 'foo, not like (symbol-function 'foo). ;; Otherwise it will be incompatible with the interpreter, ;; and (funcall (function foo)) will lose with autoloads. (defun byte-compile-function-form (form) - (byte-compile-constant - (cond ((symbolp (nth 1 form)) - (nth 1 form)) - ((byte-compile-lambda (nth 1 form)))))) + (if (cddr form) + (byte-compile-normal-call + `(signal 'wrong-number-of-arguments '(function ,(length (cdr form))))) + (byte-compile-constant + (cond ((symbolp (nth 1 form)) + (nth 1 form)) + ((byte-compile-lambda (nth 1 form))))))) (defun byte-compile-insert (form) (cond ((null (cdr form)) @@ -3611,7 +3705,7 @@ (let ((len (length form))) (cond ((> len 3) (byte-compile-subr-wrong-args form "0-2")) - ((or (= len 3) (not (byte-compile-constp (nth 1 form)))) + ((or (eql len 3) (not (byte-compile-constp (nth 1 form)))) (byte-compile-normal-call form)) (t (byte-compile-form @@ -3644,13 +3738,10 @@ ;; Odd number of args? Let `set' get the error. (byte-compile-form `(set ',var) for-effect) (setq val (pop args)) - (if (keywordp var) - ;; (setq :foo ':foo) compatibility kludge - (byte-compile-form `(set ',var ,val) (if args t for-effect)) - (byte-compile-form val) - (unless (or args for-effect) - (byte-compile-out 'byte-dup 0)) - (byte-compile-variable-ref 'byte-varset var)))))) + (byte-compile-form val) + (unless (or args for-effect) + (byte-compile-out 'byte-dup 0)) + (byte-compile-variable-ref 'byte-varset var))))) (setq for-effect nil)) (defun byte-compile-set (form) @@ -3660,11 +3751,10 @@ (let ((symform (nth 1 form)) (valform (nth 2 form)) sym) - (if (and (= (length form) 3) - (= (safe-length symform) 2) + (if (and (eql (length form) 3) + (eql (safe-length symform) 2) (eq (car symform) 'quote) - (symbolp (setq sym (car (cdr symform)))) - (not (byte-compile-constant-symbol-p sym))) + (symbolp (setq sym (car (cdr symform))))) (byte-compile-setq `(setq ,sym ,valform)) (byte-compile-two-args form)))) @@ -3685,8 +3775,7 @@ (let* ((args (cdr form)) (nargs (length args)) (var (car args))) - (when (and (= (safe-length var) 2) - (eq (car var) 'quote)) + (when (and (eql (safe-length var) 2) (eq (car var) 'quote)) (let ((sym (nth 1 var))) (cond ((not (symbolp sym)) @@ -3705,18 +3794,23 @@ (t (byte-compile-warn "assignment to free variable %s" sym) (push sym byte-compile-free-assignments))))) - (if (= nargs 2) + (if (eql nargs 2) ;; now emit a normal call to set-default (byte-compile-normal-call form) (byte-compile-subr-wrong-args form 2)))) (defun byte-compile-quote (form) - (byte-compile-constant (car (cdr form)))) + (if (cddr form) + (byte-compile-normal-call + `(signal 'wrong-number-of-arguments '(quote ,(length (cdr form))))) + (byte-compile-constant (car (cdr form))))) (defun byte-compile-quote-form (form) - (byte-compile-constant (byte-compile-top-level (nth 1 form)))) - + (if (cddr form) + (byte-compile-normal-call + `(signal 'wrong-number-of-arguments '(quote ,(length (cdr form))))) + (byte-compile-constant (byte-compile-top-level (nth 1 form))))) ;;; control structures @@ -3750,7 +3844,8 @@ (byte-defop-compiler-1 while) (byte-defop-compiler-1 funcall) (byte-defop-compiler-1 apply byte-compile-funarg) -(byte-defop-compiler-1 mapcar byte-compile-maybe-mapc) +(byte-defop-compiler-1 mapcar byte-compile-mapcar) +(byte-defop-compiler-1 mapcar* byte-compile-maybe-mapc) (byte-defop-compiler-1 mapatoms byte-compile-funarg) (byte-defop-compiler-1 mapconcat byte-compile-funarg) (byte-defop-compiler-1 mapc byte-compile-funarg) @@ -3768,7 +3863,6 @@ (byte-defop-compiler-1 map-plist byte-compile-funarg) (byte-defop-compiler-1 map-range-table byte-compile-funarg) (byte-defop-compiler-1 map-syntax-table byte-compile-funarg) -(byte-defop-compiler-1 mapcar* byte-compile-maybe-mapc) (byte-defop-compiler-1 remove-if byte-compile-funarg) (byte-defop-compiler-1 remove-if-not byte-compile-funarg) @@ -3796,8 +3890,9 @@ (byte-defop-compiler-1 get-window-with-predicate byte-compile-funarg) (byte-defop-compiler-1 map byte-compile-funarg-2) +(byte-defop-compiler-1 map-into byte-compile-funarg-2) (byte-defop-compiler-1 apropos-internal byte-compile-funarg-2) -(byte-defop-compiler-1 sort byte-compile-funarg-2) +(byte-defop-compiler-1 sort byte-compile-sort) (byte-defop-compiler-1 sort* byte-compile-funarg-2) (byte-defop-compiler-1 stable-sort byte-compile-funarg-2) (byte-defop-compiler-1 substitute-if byte-compile-funarg-2) @@ -3818,6 +3913,8 @@ (byte-defop-compiler-1 let*) (byte-defop-compiler-1 integerp) +(byte-defop-compiler-1 eql) +(byte-defop-compiler-1 fillarray) (defun byte-compile-progn (form) (byte-compile-body-do-effect (cdr form))) @@ -3834,7 +3931,7 @@ (byte-compile-body form t)) (defun byte-compile-values (form) - (if (= 2 (length form)) + (if (eql 2 (length form)) (if (byte-compile-constp (second form)) (byte-compile-form-do-effect (second form)) ;; #'or compiles to bytecode, #'values doesn't: @@ -3842,7 +3939,7 @@ (byte-compile-normal-call form))) (defun byte-compile-values-list (form) - (if (and (= 2 (length form)) + (if (and (eql 2 (length form)) (or (null (second form)) (and (consp (second form)) (eq (car (second form)) @@ -4021,7 +4118,7 @@ ;; anyway). (defun byte-compile-integerp (form) - (if (/= 2 (length form)) + (if (not (eql (length form) 2)) (byte-compile-subr-wrong-args form 1) (let ((donetag (byte-compile-make-tag)) (wintag (byte-compile-make-tag)) @@ -4051,6 +4148,24 @@ (byte-compile-constant t) (byte-compile-out-tag donetag)))) +(defun byte-compile-eql (form) + (if (eql 3 (length form)) + (let ((donetag (byte-compile-make-tag)) + (eqtag (byte-compile-make-tag))) + (mapc 'byte-compile-form (cdr form)) + (byte-compile-out 'byte-dup 0) + (byte-compile-out 'byte-numberp 0) + (byte-compile-goto 'byte-goto-if-nil eqtag) + (byte-compile-out 'byte-dup 0) + (byte-compile-out 'byte-fixnump 0) + (byte-compile-goto 'byte-goto-if-not-nil eqtag) + (byte-compile-out 'byte-equal 0) + (byte-compile-goto 'byte-goto donetag) + (byte-compile-out-tag eqtag) + (byte-compile-out 'byte-eq 0) + (byte-compile-out-tag donetag)) + (byte-compile-subr-wrong-args form 2))) + ;;(byte-defop-compiler-1 /= byte-compile-negated) (byte-defop-compiler-1 atom byte-compile-negated) (byte-defop-compiler-1 nlistp byte-compile-negated) @@ -4083,11 +4198,35 @@ (byte-defop-compiler-1 with-output-to-temp-buffer) ;; no track-mouse. +(defvar byte-compile-active-blocks nil) + (defun byte-compile-catch (form) - (byte-compile-form (car (cdr form))) - (byte-compile-push-constant - (byte-compile-top-level (cons 'progn (cdr (cdr form))) for-effect)) - (byte-compile-out 'byte-catch 0)) + "Byte-compile and return a `catch' from. + +If FORM is the result of macroexpanding a `block' form (the TAG argument is +a quoted symbol with a `cl-block-name' property) and there is no +corresponding `return-from' within the block--or equivalently, it was +optimized away--just byte compile and return the BODY." + (let* ((symbol (car-safe (cdr-safe (nth 1 form)))) + (not-present '#:not-present) + (block (and symbol (symbolp symbol) + (get symbol 'cl-block-name not-present))) + (elt (and (not (eq block not-present)) (list block))) + (byte-compile-active-blocks + (if elt + (cons elt byte-compile-active-blocks) + byte-compile-active-blocks)) + (body + (byte-compile-top-level (cons 'progn (cddr form)) + (and (not elt) for-effect)))) + (if (and elt (not (cdr elt))) + ;; A lexical block without any contained return-from clauses: + (byte-compile-form body) + ;; A normal catch call, or a lexical block with a contained + ;; return-from clause. + (byte-compile-form (car (cdr form))) + (byte-compile-push-constant body) + (byte-compile-out 'byte-catch 0)))) (defun byte-compile-unwind-protect (form) (byte-compile-push-constant @@ -4184,6 +4323,29 @@ (byte-compile-body (cdr (cdr form))) (byte-compile-out 'byte-temp-output-buffer-show 0)) +(defun byte-compile-symbol-value (form) + (symbol-macrolet ((not-present '#:not-present)) + (let ((cl-load-time-value-form not-present) + (byte-compile-bound-variables byte-compile-bound-variables) gensym) + (and (consp (cadr form)) + (eq 'quote (caadr form)) + (setq gensym (cadadr form)) + (symbolp gensym) + (setq cl-load-time-value-form + (get gensym 'cl-load-time-value-form not-present))) + (unless (eq cl-load-time-value-form not-present) + (setq byte-compile-bound-variables + (acons gensym byte-compile-global-bit + byte-compile-bound-variables) + byte-compile-output-preface + (byte-compile-top-level + (if byte-compile-output-preface + `(progn (setq ,gensym ,cl-load-time-value-form) + ,byte-compile-output-preface) + `(setq ,gensym ,cl-load-time-value-form)) + t 'file))) + (byte-compile-one-arg form)))) + (defun byte-compile-multiple-value-call (form) (if (< (length form) 2) (progn @@ -4209,7 +4371,7 @@ :test #'equal))) (defun byte-compile-multiple-value-list-internal (form) - (if (/= 4 (length form)) + (if (not (eql 4 (length form))) (progn (byte-compile-warn-wrong-args form 3) (byte-compile-normal-call @@ -4231,17 +4393,30 @@ ;; form, it provokes an invalid-function error instead (or at least it ;; should; there's a kludge around for the moment in eval.c that avoids ;; that, but this file should not assume that that will always be there). - (if (/= 2 (length (cdr form))) + (if (not (eql 2 (length (cdr form)))) (progn (byte-compile-warn-wrong-args form 2) (byte-compile-normal-call `(signal 'wrong-number-of-arguments '(,(car form) ,(length (cdr form)))))) - (byte-compile-form (nth 1 form)) ;; Push the arguments - (byte-compile-form (nth 2 form)) + ;; If this form was macroexpanded from `return-from', mark the + ;; corresponding block as having been referenced. + (let* ((symbol (car-safe (cdr-safe (nth 1 form)))) + (not-present '#:not-present) + (block (if (and symbol (symbolp symbol)) + (get symbol 'cl-block-name not-present) + not-present)) + (assq (and (not (eq block not-present)) + (assq block byte-compile-active-blocks)))) + (if assq + (setcdr assq t) + (if (not (eq block not-present)) + ;; No corresponding enclosing block. + (byte-compile-warn "return-from: no enclosing block named `%s'" + block)))) + (mapc 'byte-compile-form (cdr form)) ;; Push the arguments (byte-compile-out (get (car form) 'byte-opcode) 0) - (pushnew '(null (function-max-args 'throw)) - byte-compile-checks-on-load + (pushnew '(null (function-max-args 'throw)) byte-compile-checks-on-load :test #'equal))) ;;; top-level forms elsewhere diff -r 861f2601a38b -r 1f0b15040456 lisp/callers-of-rpt.el --- a/lisp/callers-of-rpt.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/callers-of-rpt.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: not in FSF diff -r 861f2601a38b -r 1f0b15040456 lisp/check-features.el --- a/lisp/check-features.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/check-features.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF diff -r 861f2601a38b -r 1f0b15040456 lisp/cl-compat.el --- a/lisp/cl-compat.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/cl-compat.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 21.3. @@ -75,9 +73,9 @@ (assq key klist)) (defun elt-satisfies-test-p (item elt klist) - (let ((test-not (cdr (assq ':test-not klist))) - (test (cdr (assq ':test klist))) - (key (cdr (assq ':key klist)))) + (let ((test-not (cdr (assq :test-not klist))) + (test (cdr (assq :test klist))) + (key (cdr (assq :key klist)))) (if key (setq elt (funcall key elt))) (if test-not (not (funcall test-not item elt)) (funcall (or test 'eql) item elt)))) diff -r 861f2601a38b -r 1f0b15040456 lisp/cl-extra.el --- a/lisp/cl-extra.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/cl-extra.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 21.3. @@ -51,190 +49,100 @@ (eval-when-compile (require 'obsolete)) -(or (memq 'cl-19 features) - (error "Tried to load `cl-extra' before `cl'!")) - - ;;; Type coercion. -(defun coerce (x type) +(defun coerce (object type) "Coerce OBJECT to type TYPE. TYPE is a Common Lisp type specifier." - (cond ((eq type 'list) (if (listp x) x (append x nil))) - ((eq type 'vector) (if (vectorp x) x (vconcat x))) - ((eq type 'string) (if (stringp x) x (concat x))) - ((eq type 'array) (if (arrayp x) x (vconcat x))) - ((and (eq type 'character) (stringp x) (= (length x) 1)) (aref x 0)) - ((and (eq type 'character) (symbolp x)) (coerce (symbol-name x) type)) + (cond ((eq type 'list) (if (listp object) object (append object nil))) + ((eq type 'vector) (if (vectorp object) object (vconcat object))) + ((eq type 'string) (if (stringp object) object (concat object))) + ((eq type 'array) (if (arrayp object) object (vconcat object))) + ((and (eq type 'character) (stringp object) + (eql (length object) 1)) (aref object 0)) + ((and (eq type 'character) (symbolp object)) + (coerce (symbol-name object) type)) ;; XEmacs addition character <-> integer coercions - ((and (eq type 'character) (char-int-p x)) (int-char x)) - ((and (eq type 'integer) (characterp x)) (char-int x)) - ((eq type 'float) (float x)) + ((and (eq type 'character) (char-int-p object)) (int-char object)) + ((and (memq type '(integer fixnum)) (characterp object)) + (char-int object)) + ((eq type 'float) (float object)) ;; XEmacs addition: enhanced numeric type coercions ((and-fboundp 'coerce-number - (memq type '(integer ratio bigfloat)) - (coerce-number x type))) + (memq type '(integer ratio bigfloat fixnum)) + (coerce-number object type))) ;; XEmacs addition: bit-vector coercion ((or (eq type 'bit-vector) (eq type 'simple-bit-vector)) - (if (bit-vector-p x) x (apply 'bit-vector (append x nil)))) + (if (bit-vector-p object) + object + (apply 'bit-vector (append object nil)))) ;; XEmacs addition: weak-list coercion ((eq type 'weak-list) - (if (weak-list-p x) x + (if (weak-list-p object) object (let ((wl (make-weak-list))) - (set-weak-list-list wl (if (listp x) x (append x nil))) + (set-weak-list-list wl (if (listp object) + object + (append object nil))) wl))) ((and - (consp type) - (or (eq (car type) 'vector) - (eq (car type) 'simple-array) - (eq (car type) 'simple-vector)) - (cond - ((equal (cdr-safe type) '(*)) - (coerce x 'vector)) - ((equal (cdr-safe type) '(bit)) - (coerce x 'bit-vector)) - ((equal (cdr-safe type) '(character)) - (coerce x 'string))))) - ((typep x type) x) - (t (error "Can't coerce %s to type %s" x type)))) - + (memq (car-safe type) '(vector simple-array)) + (loop + for (ignore elements length) = type + initially (declare (special ignore)) + return (if (or (memq length '(* nil)) (eql length (length object))) + (cond + ((memq elements '(t * nil)) + (coerce object 'vector)) + ((memq elements '(string-char character)) + (coerce object 'string)) + ((eq elements 'bit) + (coerce object 'bit-vector))) + (error + 'wrong-type-argument + "Type specifier length must equal sequence length" + type))))) + ((eq (car-safe type) 'simple-vector) + (coerce object (list* 'vector t (cdr type)))) + ((memq (car-safe type) + '(string simple-string base-string simple-base-string)) + (coerce object (list* 'vector 'character (cdr type)))) + ((eq (car-safe type) 'bit-vector) + (coerce object (list* 'vector 'bit (cdr type)))) + ((typep object type) object) + (t (error 'invalid-operation + "Can't coerce object to type" object type)))) -;;;;; Predicates. -;; -;;;; I'd actually prefer not to have this inline, the space -;;;; vs. amount-it's-called trade-off isn't reasonable, but that would -;;;; introduce bytecode problems with the compiler macro in cl-macs.el. -;;(defsubst cl-string-vector-equalp (cl-string cl-vector) -;; "Helper function for `equalp', which see." -;;; (check-argument-type #'stringp cl-string) -;;; (check-argument-type #'vector cl-vector) -;; (let ((cl-i (length cl-string)) -;; cl-char cl-other) -;; (when (= cl-i (length cl-vector)) -;; (while (and (>= (setq cl-i (1- cl-i)) 0) -;; (or (eq (setq cl-char (aref cl-string cl-i)) -;; (setq cl-other (aref cl-vector cl-i))) -;; (and (characterp cl-other) ; Note we want to call this -;; ; as rarely as possible, it -;; ; doesn't have a bytecode. -;; (eq (downcase cl-char) (downcase cl-other)))))) -;; (< cl-i 0)))) -;; -;;;; See comment on cl-string-vector-equalp above. -;;(defsubst cl-bit-vector-vector-equalp (cl-bit-vector cl-vector) -;; "Helper function for `equalp', which see." -;;; (check-argument-type #'bit-vector-p cl-bit-vector) -;;; (check-argument-type #'vectorp cl-vector) -;; (let ((cl-i (length cl-bit-vector)) -;; cl-other) -;; (when (= cl-i (length cl-vector)) -;; (while (and (>= (setq cl-i (1- cl-i)) 0) -;; (numberp (setq cl-other (aref cl-vector cl-i))) -;; ;; Differs from clisp here. -;; (= (aref cl-bit-vector cl-i) cl-other))) -;; (< cl-i 0)))) -;; -;;;; These two helper functions call equalp recursively, the two above have no -;;;; need to. -;;(defsubst cl-vector-array-equalp (cl-vector cl-array) -;; "Helper function for `equalp', which see." -;;; (check-argument-type #'vector cl-vector) -;;; (check-argument-type #'arrayp cl-array) -;; (let ((cl-i (length cl-vector))) -;; (when (= cl-i (length cl-array)) -;; (while (and (>= (setq cl-i (1- cl-i)) 0) -;; (equalp (aref cl-vector cl-i) (aref cl-array cl-i)))) -;; (< cl-i 0)))) -;; -;;(defsubst cl-hash-table-contents-equalp (cl-hash-table-1 cl-hash-table-2) -;; "Helper function for `equalp', which see." -;; (symbol-macrolet -;; ;; If someone has gone and fished the uninterned symbol out of this -;; ;; function's constants vector, and subsequently stored it as a value -;; ;; in a hash table, it's their own damn fault when -;; ;; `cl-hash-table-contents-equalp' gives the wrong answer. -;; ((equalp-default '#:equalp-default)) -;; (loop -;; for x-key being the hash-key in cl-hash-table-1 -;; using (hash-value x-value) -;; with y-value = nil -;; always (and (not (eq equalp-default -;; (setq y-value (gethash x-key cl-hash-table-2 -;; equalp-default)))) -;; (equalp y-value x-value))))) -;; -;;(defun equalp (x y) -;; "Return t if two Lisp objects have similar structures and contents. -;; -;;This is like `equal', except that it accepts numerically equal -;;numbers of different types (float, integer, bignum, bigfloat), and also -;;compares strings and characters case-insensitively. -;; -;;Arrays (that is, strings, bit-vectors, and vectors) of the same length and -;;with contents that are `equalp' are themselves `equalp'. -;; -;;Two hash tables are `equalp' if they have the same test (see -;;`hash-table-test'), if they have the same number of entries, and if, for -;;each entry in one hash table, its key is equivalent to a key in the other -;;hash table using the hash table test, and its value is `equalp' to the other -;;hash table's value for that key." -;; (cond ((eq x y)) -;; ((stringp x) -;; (if (stringp y) -;; (eq t (compare-strings x nil nil y nil nil t)) -;; (if (vectorp y) -;; (cl-string-vector-equalp x y) -;; ;; bit-vectors and strings are only equalp if they're -;; ;; zero-length: -;; (and (equal "" x) (equal #* y))))) -;; ((numberp x) -;; (and (numberp y) (= x y))) -;; ((consp x) -;; (while (and (consp x) (consp y) (equalp (car x) (car y))) -;; (setq x (cdr x) y (cdr y))) -;; (and (not (consp x)) (equalp x y))) -;; (t -;; ;; From here on, the type tests don't (yet) have bytecodes. -;; (let ((x-type (type-of x))) -;; (cond ((eq 'vector x-type) -;; (if (stringp y) -;; (cl-string-vector-equalp y x) -;; (if (vectorp y) -;; (cl-vector-array-equalp x y) -;; (if (bit-vector-p y) -;; (cl-bit-vector-vector-equalp y x))))) -;; ((eq 'character x-type) -;; (and (characterp y) -;; ;; If the characters are actually identical, the -;; ;; first eq test will have caught them above; we only -;; ;; need to check them case-insensitively here. -;; (eq (downcase x) (downcase y)))) -;; ((eq 'hash-table x-type) -;; (and (hash-table-p y) -;; (eq (hash-table-test x) (hash-table-test y)) -;; (= (hash-table-count x) (hash-table-count y)) -;; (cl-hash-table-contents-equalp x y))) -;; ((eq 'bit-vector x-type) -;; (if (bit-vector-p y) -;; (equal x y) -;; (if (vectorp y) -;; (cl-bit-vector-vector-equalp x y) -;; ;; bit-vectors and strings are only equalp if they're -;; ;; zero-length: -;; (and (equal "" y) (equal #* x))))) -;; (t (equal x y))))))) +;; XEmacs; #'equalp is in C. ;; XEmacs; #'map, #'mapc, #'mapl, #'maplist, #'mapcon, #'some and #'every ;; are now in C, together with #'map-into, which was never in this file. -(defun notany (cl-pred cl-seq &rest cl-rest) - "Return true if PREDICATE is false of every element of SEQ or SEQs." - (not (apply 'some cl-pred cl-seq cl-rest))) +;; The compiler macro for this in cl-macs.el means if #'complement is handed +;; a constant expression, byte-compiled code will see a byte-compiled +;; function. +(defun complement (function &optional documentation) + "Return a function which gives the logical inverse of what FUNCTION would." + `(lambda (&rest arguments) ,@(if documentation (list documentation)) + (not (apply ',function arguments)))) + +(defun notany (cl-predicate cl-seq &rest cl-rest) + "Return true if PREDICATE is false of every element of SEQUENCE. -(defun notevery (cl-pred cl-seq &rest cl-rest) - "Return true if PREDICATE is false of some element of SEQ or SEQs." - (not (apply 'every cl-pred cl-seq cl-rest))) +With optional SEQUENCES, call PREDICATE each time with as many arguments as +there are SEQUENCES (plus one for the element from SEQUENCE). + +arguments: (PREDICATE SEQUENCES &rest SEQUENCES)" + (not (apply 'some cl-predicate cl-seq cl-rest))) + +(defun notevery (cl-predicate cl-seq &rest cl-rest) + "Return true if PREDICATE is false of some element of SEQUENCE. + +With optional SEQUENCES, call PREDICATE each time with as many arguments as +there are SEQUENCES (plus one for the element from SEQUENCE). + +arguments: (PREDICATE SEQUENCES &rest SEQUENCES)" + (not (apply 'every cl-predicate cl-seq cl-rest))) ;;; Support for `loop'. (defalias 'cl-map-keymap 'map-keymap) @@ -348,7 +256,6 @@ (makunbound (car cl-progv-save))) (pop cl-progv-save))) - ;;; Numbers. (defun gcd (&rest args) @@ -381,14 +288,6 @@ g) (if (eq a 0) 0 (signal 'arith-error nil)))) -;; XEmacs addition -(defun cl-expt (x y) - "Return X raised to the power of Y. Works only for integer arguments." - (if (<= y 0) (if (= y 0) 1 (if (memq x '(-1 1)) (cl-expt x (- y)) 0)) - (* (if (= (% y 2) 0) 1 x) (cl-expt (* x x) (/ y 2))))) -(or (and (fboundp 'expt) (subrp (symbol-function 'expt))) - (defalias 'expt 'cl-expt)) - ;; We can't use macrolet in this file; whence the literal macro ;; definition-and-call: ((macro . (lambda (&rest symbols) @@ -464,86 +363,9 @@ (and (vectorp object) (= (length object) 4) (eq (aref object 0) 'cl-random-state-tag))) - -;; Implementation limits. - -(defun cl-finite-do (func a b) - (condition-case nil - (let ((res (funcall func a b))) ; check for IEEE infinity - (and (numberp res) (/= res (/ res 2)) res)) - (arith-error nil))) - -(defvar most-positive-float) -(defvar most-negative-float) -(defvar least-positive-float) -(defvar least-negative-float) -(defvar least-positive-normalized-float) -(defvar least-negative-normalized-float) -(defvar float-epsilon) -(defvar float-negative-epsilon) - -(defun cl-float-limits () - (or most-positive-float (not (numberp '2e1)) - (let ((x '2e0) y z) - ;; Find maximum exponent (first two loops are optimizations) - (while (cl-finite-do '* x x) (setq x (* x x))) - (while (cl-finite-do '* x (/ x 2)) (setq x (* x (/ x 2)))) - (while (cl-finite-do '+ x x) (setq x (+ x x))) - (setq z x y (/ x 2)) - ;; Now fill in 1's in the mantissa. - (while (and (cl-finite-do '+ x y) (/= (+ x y) x)) - (setq x (+ x y) y (/ y 2))) - (setq most-positive-float x - most-negative-float (- x)) - ;; Divide down until mantissa starts rounding. - (setq x (/ x z) y (/ 16 z) x (* x y)) - (while (condition-case nil (and (= x (* (/ x 2) 2)) (> (/ y 2) 0)) - (arith-error nil)) - (setq x (/ x 2) y (/ y 2))) - (setq least-positive-normalized-float y - least-negative-normalized-float (- y)) - ;; Divide down until value underflows to zero. - (setq x (/ 1 z) y x) - (while (condition-case nil (> (/ x 2) 0) (arith-error nil)) - (setq x (/ x 2))) - (setq least-positive-float x - least-negative-float (- x)) - (setq x '1e0) - (while (/= (+ '1e0 x) '1e0) (setq x (/ x 2))) - (setq float-epsilon (* x 2)) - (setq x '1e0) - (while (/= (- '1e0 x) '1e0) (setq x (/ x 2))) - (setq float-negative-epsilon (* x 2)))) - nil) - - ;;; Sequence functions. -;XEmacs -- our built-in is more powerful. -;(defun subseq (seq start &optional end) -; "Return the subsequence of SEQ from START to END. -;If END is omitted, it defaults to the length of the sequence. -;If START or END is negative, it counts from the end." -; (if (stringp seq) (substring seq start end) -; (let (len) -; (and end (< end 0) (setq end (+ end (setq len (length seq))))) -; (if (< start 0) (setq start (+ start (or len (setq len (length seq)))))) -; (cond ((listp seq) -; (if (> start 0) (setq seq (nthcdr start seq))) -; (if end -; (let ((res nil)) -; (while (>= (setq end (1- end)) start) -; (push (pop seq) res)) -; (nreverse res)) -; (copy-sequence seq))) -; (t -; (or end (setq end (or len (length seq)))) -; (let ((res (make-vector (max (- end start) 0) nil)) -; (i 0)) -; (while (< start end) -; (aset res i (aref seq start)) -; (setq i (1+ i) start (1+ start))) -; res)))))) +;; XEmacs; #'subseq is in C. (defun concatenate (type &rest seqs) "Concatenate, into a sequence of type TYPE, the argument SEQUENCES." @@ -551,8 +373,9 @@ (case type (vector (apply 'vconcat seqs)) (string (apply 'concat seqs)) - (list (apply 'append (append seqs '(nil)))) - (t (error "Not a sequence type name: %s" type)))) + (list (reduce 'append seqs :from-end t :initial-value nil)) + (bit-vector (apply 'bvconcat seqs)) + (t (coerce (reduce 'append seqs :from-end t :initial-value nil) type)))) ;;; List functions. @@ -564,39 +387,29 @@ "Equivalent to (nconc (nreverse X) Y)." (nconc (nreverse x) y)) -(defun list-length (x) - "Return the length of a list. Return nil if list is circular." - (let ((n 0) (fast x) (slow x)) - (while (and (cdr fast) (not (and (eq fast slow) (> n 0)))) - (setq n (+ n 2) fast (cdr (cdr fast)) slow (cdr slow))) - (if fast (if (cdr fast) nil (1+ n)) n))) - +;; XEmacs; check LIST for type and circularity. (defun tailp (sublist list) "Return true if SUBLIST is a tail of LIST." - (while (and (consp list) (not (eq sublist list))) - (setq list (cdr list))) - (if (numberp sublist) (equal sublist list) (eq sublist list))) + (check-argument-type #'listp list) + (let ((before list) (evenp t)) + (while (and (consp list) (not (eq sublist list))) + (setq list (cdr list) + evenp (not evenp)) + (if evenp (setq before (cdr before))) + (if (eq before list) (error 'circular-list list))) + (eql sublist list))) (defalias 'cl-copy-tree 'copy-tree) - ;;; Property lists. ;; XEmacs: our `get' groks DEFAULT. (defalias 'get* 'get) (defalias 'getf 'plist-get) -(defun cl-set-getf (plist tag val) - (let ((p plist)) - (while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p)))) - (if p (progn (setcar (cdr p) val) plist) (list* tag val plist)))) - -(defun cl-do-remf (plist tag) - (let ((p (cdr plist))) - (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p)))) - (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) - -;; XEmacs change: we have a builtin remprop +;; XEmacs; these are built-in. +(defalias 'cl-set-getf 'plist-put) +(defalias 'cl-do-remf 'plist-remprop) (defalias 'cl-remprop 'remprop) (defun get-properties (plist indicator-list) @@ -612,6 +425,32 @@ ((memq (car plst) indicator-list) (return (values (car plst) (cadr plst) plst)))))) +;; See also the compiler macro in cl-macs.el. +(defun constantly (value &rest more-values) + "Construct a function always returning VALUE, and possibly MORE-VALUES. + +The constructed function accepts any number of arguments, and ignores them. + +Members of MORE-VALUES, if provided, will be passed as multiple values; see +`multiple-value-bind' and `multiple-value-setq'." + (symbol-macrolet + ((arglist '(&rest ignore))) + (if (or more-values (eval-when-compile (not (cl-compiling-file)))) + `(lambda ,arglist (values-list ',(cons value more-values))) + (make-byte-code + arglist + (eval-when-compile + (let ((compiled (byte-compile-sexp #'(lambda (&rest ignore) + (declare (ignore ignore)) + 'placeholder)))) + (assert (and + (equal [placeholder] + (compiled-function-constants compiled)) + (= 1 (compiled-function-stack-depth compiled))) + t + "Our assumptions about compiled code appear not to hold.") + (compiled-function-instructions compiled))) + (vector value) 1)))) ;;; Hash tables. @@ -662,15 +501,19 @@ (defun cl-prettyprint (form) "Insert a pretty-printed rendition of a Lisp FORM in current buffer." - (let ((pt (point)) last) + (let ((pt (point)) last just) (insert "\n" (prin1-to-string form) "\n") (setq last (point)) (goto-char (1+ pt)) - (while (search-forward "(quote " last t) - (delete-backward-char 7) - (insert "'") + (while (re-search-forward "(\\(?:\\(?:function\\|quote\\) \\)" last t) + (delete-region (match-beginning 0) (match-end 0)) + (if (= (length "(function ") (- (match-end 0) (match-beginning 0))) + (insert "#'") + (insert "'")) + (setq just (point)) (forward-sexp) - (delete-char 1)) + (delete-char 1) + (goto-char just)) (goto-char (1+ pt)) (cl-do-prettyprint))) @@ -767,8 +610,11 @@ '((quote --cl-rest--))))))) (list (car form) (list* 'lambda (cadadr form) body)))) (let ((found (assq (cadr form) env))) - ;; XEmacs: cadr/caddr operate on nil without errors - (if (eq (cadr (caddr found)) 'cl-labels-args) + ;; XEmacs: cadr/caddr operate on nil without errors. But the + ;; macro definition may be compiled, in which case there's + ;; nothing for us to do. + (if (and (listp (cdr found)) + (eq (cadr (caddr found)) 'cl-labels-args)) (cl-macroexpand-all (cadr (caddr (cadddr found))) env) form)))) ((memq (car form) '(defun defmacro)) @@ -794,7 +640,231 @@ (prog1 (cl-prettyprint form) (message "")))) +;; XEmacs addition; force cl-macs to be available from here on when +;; compiling files to be dumped. This is more reasonable than forcing other +;; files to do the same, multiple times. +(eval-when-compile (or (cl-compiling-file) (load "cl-macs"))) +;; Implementation limits. + +;; XEmacs; call cl-float-limits at dump time. +(labels + ((cl-finite-do (func a b) + (condition-case nil + (let ((res (funcall func a b))) ; check for IEEE infinity + (and (numberp res) (/= res (/ res 2)) res)) + (arith-error nil))) + (cl-float-limits () + (unless most-positive-float + (let ((x 2e0) y z) + ;; Find maximum exponent (first two loops are optimizations) + (while (cl-finite-do '* x x) (setq x (* x x))) + (while (cl-finite-do '* x (/ x 2)) (setq x (* x (/ x 2)))) + (while (cl-finite-do '+ x x) (setq x (+ x x))) + (setq z x y (/ x 2)) + ;; Now fill in 1's in the mantissa. + (while (and (cl-finite-do '+ x y) (/= (+ x y) x)) + (setq x (+ x y) y (/ y 2))) + (setq most-positive-float x + most-negative-float (- x)) + ;; Divide down until mantissa starts rounding. + (setq x (/ x z) y (/ 16 z) x (* x y)) + (while (condition-case nil (and (= x (* (/ x 2) 2)) (> (/ y 2) 0)) + (arith-error nil)) + (setq x (/ x 2) y (/ y 2))) + (setq least-positive-normalized-float y + least-negative-normalized-float (- y)) + ;; Divide down until value underflows to zero. + (setq x (/ 1 z) y x) + (while (condition-case nil (> (/ x 2) 0) (arith-error nil)) + (setq x (/ x 2))) + (setq least-positive-float x + least-negative-float (- x)) + (setq x 1e0) + (while (/= (+ 1e0 x) 1e0) (setq x (/ x 2))) + (setq float-epsilon (* x 2)) + (setq x 1e0) + (while (/= (- 1e0 x) 1e0) (setq x (/ x 2))) + (setq float-negative-epsilon (* x 2)))))) + (cl-float-limits)) + + +;;; Character functions. +(macrolet + ((define-char-comparisons (&rest alist) + "Provide Common Lisp's character-specific comparison predicates. + +These throw errors if any arguments are non-characters, conflicting with +typical emacs behavior. This is not the case if +`byte-compile-delete-errors' is non-nil; see the documentation of that +variable. + +This doesn't include the case-insensitive comparisons, and it probably +should." + (let* ((functions (mapcar 'car alist)) + (map (mapcar #'(lambda (symbol) + `(,symbol . + ,(intern (substring (symbol-name symbol) + (length "char"))))) + functions))) + `(progn + (mapc + (function* + (lambda ((function . cl-unsafe-comparison)) + (put function 'cl-unsafe-comparison cl-unsafe-comparison) + (put function 'cl-compiler-macro + #'(lambda (form &rest arguments) + (if byte-compile-delete-errors + (cons (get (car form) 'cl-unsafe-comparison) + (cdr form)) + form))))) + ',map) + ,@(mapcar + (function* + (lambda ((function . documentation)) + `(defun ,function (character &rest more-characters) + ,documentation + (check-type character character) + (check-type more-characters + (satisfies (lambda (list) + (every 'characterp list)))) + (apply ',(cdr (assq function map)) + character more-characters)))) + alist))))) + (define-char-comparisons + (char= . "Return t if all character arguments are the same object.") + (char/= . "Return t if no two character arguments are the same object.") + (char< . "Return t if the character arguments monotonically increase.") + (char> . "Return t if the character arguments monotonically decrease.") + (char<= . "Return t if the character arguments are monotonically \ +nondecreasing.") + (char>= . "Return t if the character arguments are monotonically \ +nonincreasing."))) + +(defun* digit-char-p (character &optional (radix 10)) + "Return non-nil if CHARACTER represents a digit in base RADIX. + +RADIX defaults to ten. The actual non-nil value returned is the integer +value of the character in base RADIX." + (check-type character character) + (check-type radix integer) + (if (<= radix 10) + (and (<= ?0 character (+ ?0 radix -1)) (- character ?0)) + (or (and (<= ?0 character ?9) (- character ?0)) + (and (<= ?a character (+ ?a (setq radix (- radix 11)))) + (+ character (- 10 ?a))) + (and (<= ?A character (+ ?A radix)) + (+ character (- 10 ?A)))))) + +(defun* digit-char (weight &optional (radix 10)) + "Return a character representing the integer WEIGHT in base RADIX. + +RADIX defaults to ten. If no such character exists, return nil." + (check-type weight integer) + (check-type radix integer) + (and (natnump weight) (< weight radix) + (if (< weight 10) + (int-char (+ ?0 weight)) + (int-char (+ ?A (- weight 10)))))) + +(defun alpha-char-p (character) + "Return t if CHARACTER is alphabetic, in some alphabet. + +Han characters are regarded as alphabetic." + (check-type character character) + (and (eql ?w (char-syntax character (standard-syntax-table))) + (not (<= ?0 character ?9)))) + +(defun graphic-char-p (character) + "Return t if CHARACTER is not a control character. + +Control characters are those in the range ?\\x00 to ?\\x15 and ?\\x7f to +?\\x9f, inclusive." + (check-type character character) + (not (or (<= ?\x00 character ?\x1f) (<= ?\x7f character ?\x9f)))) + +(defun standard-char-p (character) + "Return t if CHARACTER is one of Common Lisp's standard characters. + +These are the non-control ASCII characters, plus the newline character." + (check-type character character) + (or (<= ?\x20 character ?\x7e) (eql character ?\n))) + +(symbol-macrolet + ((names '((?\x08 . "Backspace") (?\x09 . "Tab") (?\x0a . "Newline") + (?\x0C . "Page") (?\x0d . "Return") (?\x20 . "Space") + (?\x7f . "Rubout")))) + + (defun char-name (character) + "Return a string naming CHARACTER. + +For the limited number of characters where the character name has been +specified by Common Lisp, this always returns the appropriate string +name. Otherwise, `char-name' requires that the Unicode database be +available; see `describe-char-unicode-data'." + (check-type character character) + (or (cdr (assq character names)) + (let ((unicode-data + (assoc "Name" (describe-char-unicode-data character)))) + (and unicode-data + (if (string-match "^<[^>]+>$" (cadr unicode-data)) + (format "U%04X" (char-to-unicode character)) + (replace-in-string (cadr unicode-data) " " "_" t)))))) + + (defun name-char (name) + "Return a character with name NAME, a string." + (or (car (rassoc* name names :test #'equalp)) + (if (string-match "^[uU][0-9A-Fa-f]+$" name) + (unicode-to-char (string-to-number (subseq name 1) 16)) + (with-current-buffer (get-buffer-create " *Unicode Data*") + (require 'descr-text) + (when (zerop (buffer-size)) + ;; Don't use -literally in case of DOS line endings. + (insert-file-contents describe-char-unicodedata-file)) + (goto-char (point-min)) + (setq case-fold-search nil) + (and (re-search-forward (format #r"^\([0-9A-F]\{4,6\}\);%s;" + (upcase (replace-in-string + name "_" " " t))) nil t) + (unicode-to-char (string-to-number (match-string 1) 16)))))))) + +(defun upper-case-p (character) + "Return t if CHARACTER is majuscule in the standard case table." + (and (stringp character) (check-type character character)) + (with-case-table (standard-case-table) + (not (eq character (downcase character))))) + +(defun lower-case-p (character) + "Return t if CHARACTER is minuscule in the standard case table." + (and (stringp character) (check-type character character)) + (with-case-table (standard-case-table) + (not (eq character (upcase character))))) + +(defun both-case-p (character) + "Return t if CHARACTER has case information in the standard case table." + (and (stringp character) (check-type character character)) + (with-case-table (standard-case-table) + (or (not (eq character (upcase character))) + (not (eq character (downcase character)))))) + +(defun char-upcase (character) + "If CHARACTER is lowercase, return its corresponding uppercase character. +Otherwise, return CHARACTER." + (and (stringp character) (check-type character character)) + (with-case-table (standard-case-table) (upcase character))) + +(defun char-downcase (character) + "If CHARACTER is uppercase, return its corresponding lowercase character. +Otherwise, return CHARACTER." + (and (stringp character) (check-type character character)) + (with-case-table (standard-case-table) (downcase character))) + +(defun integer-length (integer) + "Return the number of bits need to represent INTEGER in two's complement." + (ecase (signum integer) + (0 0) + (-1 (1- (length (format "%b" (- integer))))) + (1 (length (format "%b" integer))))) (run-hooks 'cl-extra-load-hook) diff -r 861f2601a38b -r 1f0b15040456 lisp/cl-macs.el --- a/lisp/cl-macs.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/cl-macs.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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. +;; 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 3 of the License, or (at your +;; option) any later version. + +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 21.3. @@ -111,7 +109,8 @@ ;;; Check if no side effects. (defun cl-safe-expr-p (x) - (or (not (and (consp x) (not (memq (car x) '(quote function function*))))) + (or (not (and (consp x) (not (memq (car x) + '(quote function function* lambda))))) (and (symbolp (car x)) (or (memq (car x) cl-simple-funcs) (memq (car x) cl-safe-funcs) @@ -135,8 +134,11 @@ (setq xs (cdr xs))) (not xs)) -(defun cl-const-expr-val (x) - (and (eq (cl-const-expr-p x) t) (if (consp x) (nth 1 x) x))) +(defun cl-const-expr-val (x &optional cl-not-constant) + (let ((cl-const-expr-p (cl-const-expr-p x))) + (cond ((eq cl-const-expr-p t) (if (consp x) (nth 1 x) x)) + ((eq cl-const-expr-p 'func) (nth 1 x)) + (cl-not-constant)))) (defun cl-expr-access-order (x v) (if (cl-const-expr-p x) v @@ -175,8 +177,8 @@ ;;; Program structure. ;;;###autoload -(defmacro defun* (name args &rest body) - "(defun* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function. +(defmacro defun* (name arglist &optional docstring &rest body) + "Define NAME as a function. Like normal `defun', except ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (block NAME ...). @@ -193,7 +195,24 @@ bound to nil. -- &key specifies keyword arguments. The format of each argument is - VAR || ( { VAR || (KEYWORD VAR) } [INITFORM [SVAR]]) -- #### document me. + VAR || ( { VAR || (KEYWORD VAR) } [INITFORM [SVAR]]). + + If VAR is specified on its own, VAR is bound within BODY to the value + supplied by the caller for the corresponding keyword; for example, &key + my-value means callers write :my-value RUNTIME-EXPRESSION. + + If (VAR INITFORM) is specified, INITFORM is an expression evaluated at + runtime to determine a default value for VAR. + + If (VAR INITFORM SVAR) is specified, SVAR is variable available within + BODY that is non-nil if VAR was explicitly specified in the calling + expression. + + If ((KEYWORD VAR)) is specified, KEYWORD is the keyword to be used by + callers, and VAR is the corresponding variable binding within BODY. + + In calls to NAME, values for a given keyword may be supplied multiple + times. The first value is the only one used. -- &allow-other-keys means that if other keyword arguments are given that are not specifically list in the arg list, they are allowed, rather than an @@ -203,13 +222,13 @@ The format of each binding is VAR || (VAR [INITFORM]) -- exactly like the format of `let'/`let*' bindings. " - (let* ((res (cl-transform-lambda (cons args body) name)) + (let* ((res (cl-transform-lambda (list* arglist docstring body) name)) (form (list* 'defun name (cdr res)))) (if (car res) (list 'progn (car res) form) form))) ;;;###autoload -(defmacro defmacro* (name args &rest body) - "(defmacro* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro. +(defmacro defmacro* (name arglist &optional docstring &rest body) + "Define NAME as a macro. Like normal `defmacro', except ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (block NAME ...). @@ -219,7 +238,18 @@ &aux are allowed, as in `defun*'. -- Three additional lambda-list keywords are allowed: &body, &whole, and - &environment. #### Document me. + &environment: + + &body is equivalent to &rest, but is intended to indicate that the + following arguments are the body of some piece of code, and should be + indented as such. + + &whole must come first; it is followed by a single variable that, at + macro expansion time, reflects all the arguments supplied to the macro, + as if it had been declared with a single &rest argument. + + &environment specifies local semantics for various macros for use within + the expansion of BODY. See the ENVIRONMENT argument to `macroexpand'. -- The macro arg list syntax allows for \"destructuring\" -- see also `destructuring-bind', which destructures exactly like `defmacro*', and @@ -248,20 +278,20 @@ are ignored, not enough arguments cause the remaining parameters to receive a value of nil, etc. " - (let* ((res (cl-transform-lambda (cons args body) name)) + (let* ((res (cl-transform-lambda (list* arglist docstring body) name)) (form (list* 'defmacro name (cdr res)))) (if (car res) (list 'progn (car res) form) form))) ;;;###autoload -(defmacro function* (func) - "(function* SYMBOL-OR-LAMBDA): introduce a function. +(defmacro function* (symbol-or-lambda) + "Introduce a function. Like normal `function', except that if argument is a lambda form, its ARGLIST allows full Common Lisp conventions." - (if (eq (car-safe func) 'lambda) - (let* ((res (cl-transform-lambda (cdr func) 'cl-none)) + (if (eq (car-safe symbol-or-lambda) 'lambda) + (let* ((res (cl-transform-lambda (cdr symbol-or-lambda) 'cl-none)) (form (list 'function (cons 'lambda (cdr res))))) (if (car res) (list 'progn (car res) form) form)) - (list 'function func))) + (list 'function symbol-or-lambda))) (defun cl-transform-function-property (func prop form) (let ((res (cl-transform-lambda form func))) @@ -297,9 +327,9 @@ (mapcar 'cl-upcase-arg arg))) (t arg))) ; Maybe we are in initializer -;; npak@ispras.ru +;; npak@ispras.ru, modified by ben@666.com ;;;###autoload -(defun cl-function-arglist (name arglist) +(defun cl-function-arglist (arglist) "Returns string with printed representation of arguments list. Supports Common Lisp lambda lists." (if (not (or (listp arglist) (symbolp arglist))) @@ -307,21 +337,20 @@ (check-argument-type #'true-list-p arglist) (let ((print-gensym nil)) (condition-case nil - (prin1-to-string - (cons (if (eq name 'cl-none) 'lambda name) - (cond ((null arglist) nil) - ((listp arglist) (cl-upcase-arg arglist)) - ((symbolp arglist) - (cl-upcase-arg (list '&rest arglist))) - (t (wrong-type-argument 'listp arglist))))) - (t "Not available"))))) + (let ((args (cond ((null arglist) nil) + ((listp arglist) (cl-upcase-arg arglist)) + ((symbolp arglist) + (cl-upcase-arg (list '&rest arglist))) + (t (wrong-type-argument 'listp arglist))))) + (if args (prin1-to-string args) "()")) + (t "Not available"))))) (defun cl-transform-lambda (form bind-block) (let* ((args (car form)) (body (cdr form)) (bind-defs nil) (bind-enquote nil) (bind-inits nil) (bind-lets nil) (bind-forms nil) (header nil) (simple-args nil) - (complex-arglist (cl-function-arglist bind-block args)) + (complex-arglist (cl-function-arglist args)) (doc "")) (while (or (stringp (car body)) (eq (car-safe (car body)) 'interactive)) (push (pop body) header)) @@ -348,12 +377,12 @@ ;; Add CL lambda list to documentation, if the CL lambda list differs ;; from the non-CL lambda list. npak@ispras.ru (unless (equal complex-arglist - (cl-function-arglist bind-block simple-args)) + (cl-function-arglist simple-args)) (and (stringp (car header)) (setq doc (pop header))) - (push (concat doc - "\n\nCommon Lisp lambda list:\n" - " " complex-arglist "\n\n") - header)) + ;; Stick the arguments onto the end of the doc string in a way that + ;; will be recognized specially by `function-arglist'. + (push (concat doc "\n\narguments: " complex-arglist "\n") + header)) (if (null args) (list* nil simple-args (nconc header body)) (if (memq '&optional simple-args) (push '&optional args)) @@ -397,7 +426,7 @@ (or (eq p args) (setq minarg (list 'cdr minarg))) (setq p (cdr p))) (if (memq (car p) '(nil &aux)) - (setq minarg (list '= (list 'length restarg) + (setq minarg (list 'eql (list 'length restarg) (length (ldiff args p))) exactarg (not (eq args p))))) (while (and args (not (memq (car args) lambda-list-keywords))) @@ -495,8 +524,7 @@ (list t (list 'error - (format "Keyword argument %%s not one of %s" - keys) + ''invalid-keyword-argument (list 'car var))))))) (push (list 'let (list (list var restarg)) check) bind-forms))) (while (and (eq (car args) '&aux) (pop args)) @@ -557,10 +585,12 @@ ;;;###autoload (defmacro eval-when (when &rest body) - "(eval-when (WHEN...) BODY...): control when BODY is evaluated. + "Control when BODY is evaluated. If `compile' is in WHEN, BODY is evaluated when compiled at top-level. If `load' is in WHEN, BODY is evaluated when loaded after top-level compile. -If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level." +If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. + +arguments: ((&rest WHEN) &body BODY)" (if (and (fboundp 'cl-compiling-file) (cl-compiling-file) (not cl-not-toplevel) (not (boundp 'for-effect))) ; horrible kludge (let ((comp (or (memq 'compile when) (memq :compile-toplevel when))) @@ -589,25 +619,15 @@ (defmacro load-time-value (form &optional read-only) "Like `progn', but evaluates the body at load time. The result of the body appears to the compiler as a quoted constant." - (if (cl-compiling-file) - (let* ((temp (gentemp "--cl-load-time--")) - (set (list 'set (list 'quote temp) form))) - (if (and (fboundp 'byte-compile-file-form-defmumble) - (boundp 'this-kind) (boundp 'that-one)) - (fset 'byte-compile-file-form - (list 'lambda '(form) - (list 'fset '(quote byte-compile-file-form) - (list 'quote - (symbol-function 'byte-compile-file-form))) - (list 'byte-compile-file-form (list 'quote set)) - '(byte-compile-file-form form))) - ;; XEmacs change - (print set (symbol-value ;;'outbuffer - 'byte-compile-output-buffer - ))) - (list 'symbol-value (list 'quote temp))) - (list 'quote (eval form)))) - + (let ((gensym (gensym))) + ;; The body of this macro really should be (cons 'progn form), with the + ;; hairier stuff in a shadowed version in + ;; byte-compile-initial-macro-environment. That doesn't work because + ;; cl-macs.el doesn't respect byte-compile-macro-environment, which is + ;; something we should change. + (put gensym 'cl-load-time-value-form form) + (set gensym (eval form)) + `(symbol-value ',gensym))) ;;; Conditional control structures. @@ -700,6 +720,7 @@ ;;; Blocks and exits. +(defvar cl-active-block-names nil) ;;;###autoload (defmacro block (name &rest body) @@ -709,45 +730,22 @@ in two respects: First, the NAME is an unevaluated symbol rather than a quoted symbol or other form; and second, NAME is lexically rather than dynamically scoped: Only references to it within BODY will work. These -references may appear inside macro expansions, but not inside functions -called from BODY." - (if (cl-safe-expr-p (cons 'progn body)) (cons 'progn body) - (list 'cl-block-wrapper - (list* 'catch (list 'quote (intern (format "--cl-block-%s--" name))) - body)))) - -(defvar cl-active-block-names nil) - -(put 'cl-block-wrapper 'byte-compile - #'(lambda (cl-form) - (if (/= (length cl-form) 2) - (byte-compile-warn-wrong-args cl-form 1)) - - (if (fboundp 'byte-compile-form-do-effect) ; Check for optimizing - ; compiler - (progn - (let* ((cl-entry (cons (nth 1 (nth 1 (nth 1 cl-form))) nil)) - (cl-active-block-names (cons cl-entry - cl-active-block-names)) - (cl-body (byte-compile-top-level - (cons 'progn (cddr (nth 1 cl-form)))))) - (if (cdr cl-entry) - (byte-compile-form (list 'catch (nth 1 (nth 1 cl-form)) - cl-body)) - (byte-compile-form cl-body)))) - (byte-compile-form (nth 1 cl-form))))) - -(put 'cl-block-throw 'byte-compile - #'(lambda (cl-form) - (let ((cl-found (assq (nth 1 (nth 1 cl-form)) cl-active-block-names))) - (if cl-found (setcdr cl-found t))) - (byte-compile-throw (cons 'throw (cdr cl-form))))) +references may appear inside macro expansions and in lambda expressions, but +not inside other functions called from BODY." + (let ((cl-active-block-names (acons name (copy-symbol name) + cl-active-block-names)) + (body (cons 'progn body))) + ;; Tell the byte-compiler this is a block, not a normal catch call, and + ;; as such it can eliminate it if that's appropriate: + (put (cdar cl-active-block-names) 'cl-block-name name) + `(catch ',(cdar cl-active-block-names) + ,(cl-macroexpand-all body cl-macro-environment)))) ;;;###autoload (defmacro return (&optional result) "Return from the block named nil. This is equivalent to `(return-from nil RESULT)'." - (list 'return-from nil result)) + `(return-from nil ,result)) ;;;###autoload (defmacro return-from (name &optional result) @@ -756,9 +754,13 @@ returning RESULT from that form (or nil if RESULT is omitted). This is compatible with Common Lisp, but note that `defun' and `defmacro' do not create implicit blocks as they do in Common Lisp." - (let ((name2 (intern (format "--cl-block-%s--" name)))) - (list 'cl-block-throw (list 'quote name2) result))) - + `(throw ',(or (cdr (assq name cl-active-block-names)) + ;; Tell the byte-compiler the original name of the block, + ;; leave any warning to it. + (let ((copy-symbol (copy-symbol name))) + (put copy-symbol 'cl-block-name name) + copy-symbol)) + ,result)) ;;; The "loop" macro. @@ -770,8 +772,8 @@ (defvar loop-result-var) (defvar loop-steps) (defvar loop-symbol-macs) ;;;###autoload -(defmacro loop (&rest args) - "(loop CLAUSE...): The Common Lisp `loop' macro. +(defmacro loop (&rest clauses) + "The Common Lisp `loop' macro. The loop macro consists of a series of clauses, which do things like iterate variables, set conditions for exiting the loop, accumulating values @@ -814,7 +816,7 @@ `return-from'.) Another extremely useful feature of loops is called \"destructuring\". If, -in place of VAR, a list (possibly dotted, possibly a tree of arbitary +in place of VAR, a list (possibly dotted, possibly a tree of arbitrary complexity) is given, the value to be assigned is assumed to have a similar structure to the list given, and variables in the list will be matched up with corresponding elements in the structure. For example: @@ -1052,8 +1054,8 @@ Specify the name for block surrounding the loop, in place of nil. (See `block'.) " - (if (not (memq t (mapcar 'symbolp (delq nil (delq t (copy-list args)))))) - (list 'block nil (list* 'while t args)) + (if (notany #'symbolp (set-difference clauses '(nil t))) + (list 'block nil (list* 'while t clauses)) (let ((loop-name nil) (loop-bindings nil) (loop-body nil) (loop-steps nil) (loop-result nil) (loop-result-explicit nil) @@ -1061,8 +1063,8 @@ (loop-accum-var nil) (loop-accum-vars nil) (loop-initially nil) (loop-finally nil) (loop-map-form nil) (loop-first-flag nil) - (loop-destr-temps nil) (loop-symbol-macs nil)) - (setq args (append args '(cl-end-loop))) + (loop-destr-temps nil) (loop-symbol-macs nil) + (args (append clauses '(cl-end-loop)))) (while (not (eq (car args) 'cl-end-loop)) (cl-parse-loop-clause)) (if loop-finish-flag (push (list (list loop-finish-flag t)) loop-bindings)) @@ -1251,7 +1253,7 @@ (seq (cl-pop2 args)) (temp-seq (gensym)) (temp-idx (if (eq (car args) 'using) - (if (and (= (length (cadr args)) 2) + (if (and (eql (length (cadr args)) 2) (eq (caadr args) 'index)) (cadr (cl-pop2 args)) (error "Bad `using' clause")) @@ -1282,7 +1284,7 @@ (or (memq (car args) '(in of)) (error "Expected `of'")) (let* ((table (cl-pop2 args)) (other (if (eq (car args) 'using) - (if (and (= (length (cadr args)) 2) + (if (and (eql (length (cadr args)) 2) (memq (caadr args) hash-types) (not (eq (caadr args) word))) (cadr (cl-pop2 args)) @@ -1338,7 +1340,7 @@ (let* ((map (cl-pop2 args)) other-word (other (if (eq (car args) 'using) - (if (and (= (length (cadr args)) 2) + (if (and (eql (length (cadr args)) 2) (memq (setq other-word (caadr args)) key-types) (not (eq (caadr args) word))) @@ -1634,12 +1636,12 @@ steps) (list* 'while (list 'not (car endtest)) (append body - (let ((sets (mapcar + (let ((sets (mapcan #'(lambda (c) (and (consp c) (cdr (cdr c)) - (list (car c) (nth 2 c)))) + (list + (list (car c) (nth 2 c))))) steps))) - (setq sets (delq nil sets)) (and sets (list (cons (if (or star (not (cdr sets))) 'setq 'psetq) @@ -1647,45 +1649,42 @@ (or (cdr endtest) '(nil))))) ;;;###autoload -(defmacro dolist (spec &rest body) - "(dolist (VAR LIST [RESULT]) BODY...): loop over a list. +(defmacro* dolist ((var list &optional result) &body body) + "Loop over a list. Evaluate BODY with VAR bound to each `car' from LIST, in turn. Then evaluate RESULT to get return value, default nil." - (let ((temp (gensym "--dolist-temp--"))) - (list 'block nil - (list* 'let (list (list temp (nth 1 spec)) (car spec)) - (list* 'while temp (list 'setq (car spec) (list 'car temp)) - (append body (list (list 'setq temp - (list 'cdr temp))))) - (if (cdr (cdr spec)) - (cons (list 'setq (car spec) nil) (cdr (cdr spec))) - '(nil)))))) + (let ((gensym (gensym))) + `(block nil + (let ((,gensym ,list) ,var) + (while ,gensym + (setq ,var (car ,gensym)) + ,@body + (setq ,gensym (cdr ,gensym))) + ,@(if result `((setq ,var nil) ,result)))))) ;;;###autoload -(defmacro dotimes (spec &rest body) - "(dotimes (VAR COUNT [RESULT]) BODY...): loop a certain number of times. +(defmacro* dotimes ((var count &optional result) &body body) + "Loop a certain number of times. Evaluate BODY with VAR bound to successive integers from 0, inclusive, to COUNT, exclusive. Then evaluate RESULT to get return value, default nil." - (let ((temp (gensym "--dotimes-temp--"))) - (list 'block nil - (list* 'let (list (list temp (nth 1 spec)) (list (car spec) 0)) - (list* 'while (list '< (car spec) temp) - (append body (list (list 'incf (car spec))))) - (or (cdr (cdr spec)) '(nil)))))) + (let* ((limit (if (cl-const-expr-p count) count (gensym))) + (bind (if (cl-const-expr-p count) nil `((,limit ,count))))) + `(block nil + (let ((,var 0) ,@bind) + (while (< ,var ,limit) + ,@body + (setq ,var (1+ ,var))) + ,@(if result (list result)))))) ;;;###autoload -(defmacro do-symbols (spec &rest body) - "(dosymbols (VAR [OBARRAY [RESULT]]) BODY...): loop over all symbols. +(defmacro* do-symbols ((var &optional obarray result) &rest body) + "Loop over all interned symbols. Evaluate BODY with VAR bound to each interned symbol, or to each symbol from OBARRAY." - ;; Apparently this doesn't have an implicit block. - (list 'block nil - (list 'let (list (car spec)) - (list* 'mapatoms - (list 'function (list* 'lambda (list (car spec)) body)) - (and (cadr spec) (list (cadr spec)))) - (caddr spec)))) + `(block nil + (mapatoms #'(lambda (,var) ,@body) ,@(and obarray (list obarray))) + ,@(if result `((let (,var) ,result))))) ;;;###autoload (defmacro do-all-symbols (spec &rest body) @@ -1720,11 +1719,13 @@ ;;; This should really have some way to shadow 'byte-compile properties, etc. ;;;###autoload (defmacro flet (bindings &rest body) - "(flet ((FUNC ARGLIST BODY...) ...) FORM...): make temporary function defns. + "Make temporary function definitions. This is an analogue of `let' that operates on the function cell of FUNC rather than its value cell. The FORMs are evaluated with the specified function definitions in place, then the definitions are undone (the FUNCs -go back to their previous definitions, or lack thereof)." +go back to their previous definitions, or lack thereof). + +arguments: (((FUNC ARGLIST &body BODY) &rest FUNCTIONS) &body FORM)" (list* 'letf* (mapcar #'(lambda (x) @@ -1745,9 +1746,11 @@ ;;;###autoload (defmacro labels (bindings &rest body) - "(labels ((FUNC ARGLIST BODY...) ...) FORM...): make temporary func bindings. + "Make temporary func bindings. This is like `flet', except the bindings are lexical instead of dynamic. -Unlike `flet', this macro is fully compliant with the Common Lisp standard." +Unlike `flet', this macro is fully compliant with the Common Lisp standard. + +arguments: (((FUNC ARGLIST &body BODY) &rest FUNCTIONS) &body FORM)" (let ((vars nil) (sets nil) (cl-macro-environment cl-macro-environment)) (while bindings (let ((var (gensym))) @@ -1764,33 +1767,36 @@ ;; The following ought to have a better definition for use with newer ;; byte compilers. ;;;###autoload -(defmacro macrolet (bindings &rest body) - "(macrolet ((NAME ARGLIST BODY...) ...) FORM...): make temporary macro defns. +(defmacro* macrolet (((name arglist &optional docstring &body body) + &rest macros) &body form) + "Make temporary macro definitions. This is like `flet', but for macros instead of functions." - (if (cdr bindings) - (list 'macrolet - (list (car bindings)) (list* 'macrolet (cdr bindings) body)) - (if (null bindings) (cons 'progn body) - (let* ((name (caar bindings)) - (res (cl-transform-lambda (cdar bindings) name))) - (eval (car res)) - (cl-macroexpand-all (cons 'progn body) - (cons (list* name 'lambda (cdr res)) - cl-macro-environment)))))) + (cl-macroexpand-all (cons 'progn form) + (nconc + (loop + for (name . details) + in (cons (list* name arglist docstring body) macros) + collect + (list* name 'lambda + (prog1 + (cdr (setq details (cl-transform-lambda + details name))) + (eval (car details))))) + cl-macro-environment))) ;;;###autoload -(defmacro symbol-macrolet (bindings &rest body) - "(symbol-macrolet ((NAME EXPANSION) ...) FORM...): make symbol macro defns. +(defmacro* symbol-macrolet (((name expansion) &rest symbol-macros) &body form) + "Make symbol macro definitions. Within the body FORMs, references to the variable NAME will be replaced by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...)." - (if (cdr bindings) - (list 'symbol-macrolet - (list (car bindings)) (list* 'symbol-macrolet (cdr bindings) body)) - (if (null bindings) (cons 'progn body) - (cl-macroexpand-all (cons 'progn body) - (cons (list (symbol-name (caar bindings)) - (cadar bindings)) - cl-macro-environment))))) + (check-type name symbol) + (cl-macroexpand-all (cons 'progn form) + (nconc (list (list (eq-hash name) expansion)) + (loop + for (name expansion) in symbol-macros + do (check-type name symbol) + collect (list (eq-hash name) expansion)) + cl-macro-environment))) (defvar cl-closure-vars nil) ;;;###autoload @@ -1801,8 +1807,9 @@ (let* ((cl-closure-vars cl-closure-vars) (vars (mapcar #'(lambda (x) (or (consp x) (setq x (list x))) - (push (gensym (format "--%s--" (car x))) - cl-closure-vars) + (push (gensym (concat "--" (symbol-name (car x)) + "--" )) + cl-closure-vars) (set (car cl-closure-vars) [bad-lexical-ref]) (list (car x) (cadr x) (car cl-closure-vars))) bindings)) @@ -1810,7 +1817,7 @@ (cl-macroexpand-all (cons 'progn body) (nconc (mapcar #'(lambda (x) - (list (symbol-name (car x)) + (list (eq-hash (car x)) (list 'symbol-value (caddr x)) t)) vars) @@ -1864,7 +1871,7 @@ Returns the value given by the last element of BODY." (if (null syms) `(progn ,form ,@body) - (if (= 1 (length syms)) + (if (eql 1 (length syms)) ;; Code written to deal with other "implementations" of multiple ;; values may have a one-element SYMS. `(let ((,(car syms) ,form)) @@ -1891,7 +1898,7 @@ (if (null syms) ;; Never return multiple values from multiple-value-setq: (and form `(values ,form)) - (if (= 1 (length syms)) + (if (eql 1 (length syms)) `(setq ,(car syms) ,form) (let ((temp (gensym))) `(let* ((,temp (multiple-value-list-internal 0 ,(length syms) ,form))) @@ -1920,7 +1927,19 @@ ;;;###autoload (defmacro locally (&rest body) (cons 'progn body)) ;;;###autoload -(defmacro the (type form) form) +(defmacro the (type form) + "Assert that FORM gives a result of type TYPE, and return that result. + +TYPE is a Common Lisp type specifier. + +If macro expansion of a `the' form happens during byte compilation, and the +byte compiler customization variable `byte-compile-delete-errors' is +non-nil, `the' is equivalent to FORM without any type checks." + (if (cl-safe-expr-p form) + `(prog1 ,form (assert ,(cl-make-type-test form type) t)) + (let ((saved (gensym))) + `(let ((,saved ,form)) + (prog1 ,saved (assert ,(cl-make-type-test saved type) t)))))) (defvar cl-proclaim-history t) ; for future compilers (defvar cl-declare-stack t) ; for future compilers @@ -1994,20 +2013,20 @@ ;;; Generalized variables. ;;;###autoload -(defmacro define-setf-method (func args &rest body) - "(define-setf-method NAME ARGLIST BODY...): define a `setf' method. -This method shows how to handle `setf's to places of the form (NAME ARGS...). -The argument forms ARGS are bound according to ARGLIST, as if NAME were +(defmacro define-setf-method (name arglist &rest body) + "Define a `setf' method. +This method shows how to handle `setf's to places of the form (NAME ARGLIST...). +The argument forms are bound according to ARGLIST, as if NAME were going to be expanded as a macro, then the BODY forms are executed and must return a list of five elements: a temporary-variables list, a value-forms list, a store-variables list (of length one), a store-form, and an access- form. See `defsetf' for a simpler way to define most setf-methods." (append '(eval-when (compile load eval)) (if (stringp (car body)) - (list (list 'put (list 'quote func) '(quote setf-documentation) + (list (list 'put (list 'quote name) '(quote setf-documentation) (pop body)))) (list (cl-transform-function-property - func 'setf-method (cons args body))))) + name 'setf-method (cons arglist body))))) (defalias 'define-setf-expander 'define-setf-method) ;;;###autoload @@ -2160,6 +2179,8 @@ (defsetf face-background (f &optional s) (x) (list 'set-face-background f x s)) (defsetf face-background-pixmap (f &optional s) (x) (list 'set-face-background-pixmap f x s)) +(defsetf face-background-placement (f &optional s) (x) + (list 'set-face-background-placement f x s)) (defsetf face-font (f &optional s) (x) (list 'set-face-font f x s)) (defsetf face-foreground (f &optional s) (x) (list 'set-face-foreground f x s)) (defsetf face-underline-p (f &optional s) (x) @@ -2351,7 +2372,7 @@ (append (nth 1 method) (list tag def)) (list store-temp) (list 'let (list (list (car (nth 2 method)) - (list 'cl-set-getf (nth 4 method) + (list 'plist-put (nth 4 method) tag-temp store-temp))) (nth 3 method) store-temp) (list 'getf (nth 4 method) tag-temp def-temp)))) @@ -2404,7 +2425,7 @@ (or (and method (let ((cl-macro-environment env)) (setq method (apply method (cdr place)))) - (if (and (consp method) (= (length method) 5)) + (if (and (consp method) (eql (length method) 5)) method (error "Setf-method for %s returns malformed method" func))) @@ -2541,7 +2562,7 @@ (list 'progn (cl-setf-do-store (nth 1 method) (list 'cddr tval)) t) - (list 'cl-do-remf tval ttag))))) + (list 'plist-remprop tval ttag))))) ;;;###autoload (defmacro shiftf (place &rest args) @@ -2549,7 +2570,7 @@ Example: (shiftf A B C) sets A to B, B to C, and returns the old A. Each PLACE may be a symbol, or any generalized variable allowed by `setf'." ;; XEmacs change: use iteration instead of recursion - (if (not (memq nil (mapcar 'symbolp (butlast (cons place args))))) + (if (every #'symbolp (butlast (cons place args))) (list* 'prog1 place (let ((sets nil)) (while args @@ -2566,18 +2587,18 @@ form))) ;;;###autoload -(defmacro rotatef (&rest args) - "(rotatef PLACE...): rotate left among PLACEs. +(defmacro rotatef (&rest places) + "Rotate left among PLACES. Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil. Each PLACE may be a symbol, or any generalized variable allowed by `setf'." - (if (not (memq nil (mapcar 'symbolp args))) - (and (cdr args) + (if (every #'symbolp places) + (and (cdr places) (let ((sets nil) - (first (car args))) - (while (cdr args) - (setq sets (nconc sets (list (pop args) (car args))))) - (nconc (list 'psetf) sets (list (car args) first)))) - (let* ((places (reverse args)) + (first (car places))) + (while (cdr places) + (setq sets (nconc sets (list (pop places) (car places))))) + (nconc (list 'psetf) sets (list (car places) first)))) + (let* ((places (reverse places)) (temp (gensym "--rotatef--")) (form temp)) (while (cdr places) @@ -2613,14 +2634,16 @@ ;;;###autoload (defmacro letf (bindings &rest body) - "(letf ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs. + "Temporarily bind to PLACEs. This is the analogue of `let', but with generalized variables (in the sense of `setf') for the PLACEs. Each PLACE is set to the corresponding VALUE, then the BODY forms are executed. On exit, either normally or because of a `throw' or error, the PLACEs are set back to their original values. Note that this macro is *not* available in Common Lisp. As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', -the PLACE is not modified before executing BODY." +the PLACE is not modified before executing BODY. + +arguments: (((PLACE VALUE) &rest BINDINGS) &body BODY)" (if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings))) (list* 'let bindings body) (let ((lets nil) @@ -2715,14 +2738,16 @@ ;;;###autoload (defmacro letf* (bindings &rest body) - "(letf* ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs. + "Temporarily bind to PLACES. This is the analogue of `let*', but with generalized variables (in the sense of `setf') for the PLACEs. Each PLACE is set to the corresponding VALUE, then the BODY forms are executed. On exit, either normally or because of a `throw' or error, the PLACEs are set back to their original values. Note that this macro is *not* available in Common Lisp. As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', -the PLACE is not modified before executing BODY." +the PLACE is not modified before executing BODY. + +arguments: (((PLACE VALUE) &rest BINDINGS) &body BODY)" (if (null bindings) (cons 'progn body) (setq bindings (reverse bindings)) @@ -3053,6 +3078,8 @@ (cdr type)))) ((memq (car-safe type) '(member member*)) (list 'and (list 'member* val (list 'quote (cdr type))) t)) + ((eq (car-safe type) 'eql) + (list 'eql (cadr type) val)) ((eq (car-safe type) 'satisfies) (list (cadr type) val)) (t (error "Bad type spec: %s" type))))) @@ -3091,11 +3118,7 @@ omitted, a default message listing FORM itself is used." (and (or (not (cl-compiling-file)) (< cl-optimize-speed 3) (= cl-optimize-safety 3)) - (let ((sargs (and show-args (delq nil (mapcar - #'(lambda (x) - (and (not (cl-const-expr-p x)) - x)) - (cdr form)))))) + (let ((sargs (and show-args (remove-if #'cl-const-expr-p (cdr form))))) (list 'progn (list 'or form (if string @@ -3163,105 +3186,135 @@ (byte-compile-normal-call form) (byte-compile-form form))) -(defmacro defsubst* (name args &rest body) - "(defsubst* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function. +(defmacro defsubst* (name arglist &optional docstring &rest body) + "Define NAME as a function. Like `defun', except the function is automatically declared `inline', ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (block NAME ...)." - (let* ((argns (cl-arglist-args args)) (p argns) - (pbody (cons 'progn body)) + (let* ((argns (cl-arglist-args arglist)) (p argns) + (exec-body (if (or (stringp docstring) (null docstring)) + body + (cons docstring body))) + (pbody (cons 'progn exec-body)) (unsafe (not (cl-safe-expr-p pbody)))) - (while (and p (eq (cl-expr-contains args (car p)) 1)) (pop p)) + (while (and p (eq (cl-expr-contains arglist (car p)) 1)) (pop p)) (list 'progn (if p nil ; give up if defaults refer to earlier args (list 'define-compiler-macro name - (if (memq '&key args) - (list* '&whole 'cl-whole '&cl-quote args) - (cons '&cl-quote args)) + (if (memq '&key arglist) + (list* '&whole 'cl-whole '&cl-quote arglist) + (cons '&cl-quote arglist)) (list* 'cl-defsubst-expand (list 'quote argns) - (list 'quote (list* 'block name body)) + (list 'quote (list* 'block name exec-body)) (not (or unsafe (cl-expr-access-order pbody argns))) - (and (memq '&key args) 'cl-whole) unsafe argns))) - (list* 'defun* name args body)))) + (and (memq '&key arglist) 'cl-whole) unsafe argns))) + (list* 'defun* name arglist docstring body)))) (defun cl-defsubst-expand (argns body simple whole unsafe &rest argvs) (if (and whole (not (cl-safe-expr-p (cons 'progn argvs)))) whole (if (cl-simple-exprs-p argvs) (setq simple t)) - (let ((lets (delq nil - (mapcar* #'(lambda (argn argv) - (if (or simple (cl-const-expr-p argv)) - (progn (setq body (subst argv argn body)) - (and unsafe (list argn argv))) - (list argn argv))) - argns argvs)))) + (let ((lets (mapcan #'(lambda (argn argv) + (if (or simple (cl-const-expr-p argv)) + (progn (setq body (subst argv argn body)) + (and unsafe (list (list argn argv)))) + (list (list argn argv)))) + argns argvs))) (if lets (list 'let lets body) body)))) +;; When a 64-bit build is byte-compiling code, some of its native fixnums +;; will not be represented as fixnums if the byte-compiled code is read by +;; the Lisp reader in a 32-bit build. So in that case we need to check the +;; range of fixnums as well as their types. XEmacs doesn't support machines +;; with word size less than 32, so it's OK to have that as the minimum. +(macrolet + ((most-negative-fixnum-on-32-bit-machines () (lognot (1- (lsh 1 30)))) + (most-positive-fixnum-on-32-bit-machines () (lsh 1 30))) + (defun cl-non-fixnum-number-p (object) + "Return t if OBJECT is a number not guaranteed to be immediate." + (and (numberp object) + (or (not (fixnump object)) + (not (<= (most-negative-fixnum-on-32-bit-machines) + object + (most-positive-fixnum-on-32-bit-machines))))))) ;;; Compile-time optimizations for some functions defined in this package. ;;; Note that cl.el arranges to force cl-macs to be loaded at compile-time, ;;; mainly to make sure these macros will be present. -(put 'eql 'byte-compile nil) (define-compiler-macro eql (&whole form a b) (cond ((eq (cl-const-expr-p a) t) (let ((val (cl-const-expr-val a))) - (if (and (numberp val) (not (fixnump val))) + (if (cl-non-fixnum-number-p val) (list 'equal a b) (list 'eq a b)))) ((eq (cl-const-expr-p b) t) (let ((val (cl-const-expr-val b))) - (if (and (numberp val) (not (fixnump val))) + (if (cl-non-fixnum-number-p val) (list 'equal a b) (list 'eq a b)))) - ((cl-simple-expr-p a 5) - (list 'if (list 'numberp a) - (list 'equal a b) - (list 'eq a b))) - ((and (cl-safe-expr-p a) - (cl-simple-expr-p b 5)) - (list 'if (list 'numberp b) - (list 'equal a b) - (list 'eq a b))) (t form))) -(define-compiler-macro member* (&whole form a list &rest keys) - (let ((test (and (= (length keys) 2) (eq (car keys) :test) - (cl-const-expr-val (nth 1 keys)))) - a-val) - (cond ((eq test 'eq) (list 'memq a list)) - ((eq test 'equal) (list 'member a list)) - ((or (null keys) (eq test 'eql)) - (if (eq (cl-const-expr-p a) t) - (list (if (and (numberp (setq a-val (cl-const-expr-val a))) - (not (fixnump a-val))) - 'member - 'memq) - a list) - (if (eq (cl-const-expr-p list) t) - (let ((p (cl-const-expr-val list)) (mb nil) (mq nil)) - (if (not (cdr p)) - (and p (list 'eql a (list 'quote (car p)))) - (while p - (if (and (numberp (car p)) (not (fixnump (car p)))) - (setq mb t) - (or (fixnump (car p)) (symbolp (car p)) (setq mq t))) - (setq p (cdr p))) - (if (not mb) (list 'memq a list) - (if (not mq) (list 'member a list) form)))) - form))) - (t form)))) - -(define-compiler-macro assoc* (&whole form a list &rest keys) - (let ((test (and (= (length keys) 2) (eq (car keys) :test) - (cl-const-expr-val (nth 1 keys)))) - a-val) - (cond ((eq test 'eq) (list 'assq a list)) - ((eq test 'equal) (list 'assoc a list)) - ((and (eq (cl-const-expr-p a) t) (or (null keys) (eq test 'eql))) - (if (and (numberp (setq a-val (cl-const-expr-val a))) - (not (fixnump a-val))) - (list 'assoc a list) (list 'assq a list))) - (t form)))) +(macrolet + ((define-star-compiler-macros (&rest macros) + "For `member*', `assoc*' and `rassoc*' with constant ITEM or +:test arguments, use the versions with explicit tests if that makes sense." + (list* + 'progn + (mapcar + (function* + (lambda ((star-function eq-function equal-function)) + `(define-compiler-macro ,star-function (&whole form &rest keys) + (if (< (length form) 3) + form + (condition-case nil + (symbol-macrolet ((not-constant '#:not-constant)) + (let* ((item (pop keys)) + (list (pop keys)) + (test-expr (plist-get keys :test ''eql)) + (test (cl-const-expr-val test-expr not-constant)) + (item-val (cl-const-expr-val item not-constant)) + (list-val (cl-const-expr-val list not-constant))) + (if (and keys (not (and (eq :test (car keys)) + (eql 2 (length keys))))) + form + (cond ((eq test 'eq) `(,',eq-function ,item ,list)) + ((eq test 'equal) + `(,',equal-function ,item ,list)) + ((and (eq test 'eql) + (not (eq not-constant item-val))) + (if (cl-non-fixnum-number-p item-val) + `(,',equal-function ,item ,list) + `(,',eq-function ,item ,list))) + ((and (eq test 'eql) (not (eq not-constant + list-val))) + (if (some 'cl-non-fixnum-number-p list-val) + `(,',equal-function ,item ,list) + ;; This compiler macro used to limit + ;; calls to ,,eq-function to lists where + ;; all elements were either fixnums or + ;; symbols. There's no reason to do this. + `(,',eq-function ,item ,list))) + ;; This is a hilariously specific case; see + ;; add-to-list in subr.el. + ((and (eq test not-constant) + (eq 'or (car-safe test-expr)) + (eql 3 (length test-expr)) + (every #'cl-safe-expr-p (cdr form)) + `(if ,(second test-expr) + (,',star-function ,item ,list :test + ,(second test-expr)) + (,',star-function + ,item ,list :test + ,(third test-expr))))) + (t form))))) + ;; No need to warn about a malformed property list, + ;; #'byte-compile-normal-call will do that for us. + (malformed-property-list form)))))) + macros)))) + (define-star-compiler-macros + (member* memq member) + (assoc* assq assoc) + (rassoc* rassq rassoc))) (define-compiler-macro adjoin (&whole form a list &rest keys) (if (and (cl-simple-expr-p a) (cl-simple-expr-p list) @@ -3269,6 +3322,151 @@ (list 'if (list* 'member* a list keys) list (list 'cons a list)) form)) +(define-compiler-macro delete (&whole form &rest args) + (if (eql 3 (length form)) + (symbol-macrolet ((not-constant '#:not-constant)) + (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant))) + (if (and (cdr form) (not (eq not-constant cl-const-expr-val)) + (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val) + (characterp cl-const-expr-val))) + (cons 'delete* (cdr form)) + `(delete* ,@(cdr form) :test #'equal)))) + form)) + +(define-compiler-macro delq (&whole form &rest args) + (if (eql 3 (length form)) + (symbol-macrolet + ((not-constant '#:not-constant)) + (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant))) + (if (and (cdr form) (not (eq not-constant cl-const-expr-val)) + (not (cl-non-fixnum-number-p cl-const-expr-val))) + (cons 'delete* (cdr form)) + `(delete* ,@(cdr form) :test #'eq)))) + form)) + +(define-compiler-macro remove (&whole form &rest args) + (if (eql 3 (length form)) + (symbol-macrolet + ((not-constant '#:not-constant)) + (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant))) + (if (and (cdr form) (not (eq not-constant cl-const-expr-val)) + (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val) + (characterp cl-const-expr-val))) + (cons 'remove* (cdr form)) + `(remove* ,@(cdr form) :test #'equal)))) + form)) + +(define-compiler-macro remq (&whole form &rest args) + (if (eql 3 (length form)) + (symbol-macrolet + ((not-constant '#:not-constant)) + (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant))) + (if (and (cdr form) (not (eq not-constant cl-const-expr-val)) + (not (cl-non-fixnum-number-p cl-const-expr-val))) + (cons 'remove* (cdr form)) + `(remove* ,@(cdr form) :test #'eq)))) + form)) + +(macrolet + ((define-foo-if-compiler-macros (&rest alist) + "Avoid the funcall, variable binding and keyword parsing overhead +for the FOO-IF and FOO-IF-NOT functions, transforming to forms using the +non-standard :if and :if-not keywords at compile time." + (cons + 'progn + (mapcar + (function* + (lambda ((function-if . function)) + (let ((keyword (if (equal (substring (symbol-name function-if) -3) + "not") + :if-not + :if))) + `(define-compiler-macro ,function-if (&whole form &rest args) + (if (and (nthcdr 2 form) + (or (consp (cl-const-expr-val (second form))) + (cl-safe-expr-p (second form)))) + ;; It doesn't matter what the second argument is, it's + ;; ignored by FUNCTION. We know that the symbol + ;; FUNCTION is in the constants vector, so use it. + `(,',function ',',function ,(third form) ,,keyword + ,(second form) ,@(nthcdr 3 form)) + form))))) + alist)))) + (define-foo-if-compiler-macros + (remove-if . remove*) + (remove-if-not . remove*) + (delete-if . delete*) + (delete-if-not . delete*) + (find-if . find) + (find-if-not . find) + (position-if . position) + (position-if-not . position) + (count-if . count) + (count-if-not . count) + (member-if . member*) + (member-if-not . member*) + (assoc-if . assoc*) + (assoc-if-not . assoc*) + (rassoc-if . rassoc*) + (rassoc-if-not . rassoc*))) + +(macrolet + ((define-substitute-if-compiler-macros (&rest alist) + "Like the above, but for `substitute-if' and friends." + (cons + 'progn + (mapcar + (function* + (lambda ((function-if . function)) + (let ((keyword (if (equal (substring (symbol-name function-if) -3) + "not") + :if-not + :if))) + `(define-compiler-macro ,function-if (&whole form &rest args) + (if (and (nthcdr 3 form) + (or (consp (cl-const-expr-val (third form))) + (cl-safe-expr-p (third form)))) + `(,',function ,(second form) ',',function ,(fourth form) + ,,keyword ,(third form) ,@(nthcdr 4 form)) + form))))) + alist)))) + (define-substitute-if-compiler-macros + (substitute-if . substitute) + (substitute-if-not . substitute) + (nsubstitute-if . nsubstitute) + (nsubstitute-if-not . nsubstitute))) + +(macrolet + ((define-subst-if-compiler-macros (&rest alist) + "Like the above, but for `subst-if' and friends." + (cons + 'progn + (mapcar + (function* + (lambda ((function-if . function)) + (let ((keyword (if (equal (substring (symbol-name function-if) -3) + "not") + :if-not + :if))) + `(define-compiler-macro ,function-if (&whole form &rest args) + (if (and (nthcdr 3 form) + (or (consp (cl-const-expr-val (third form))) + (cl-safe-expr-p (third form)))) + `(,',function ,(if (cl-const-expr-p (second form)) + `'((nil . ,(cl-const-expr-val + (second form)))) + `(list (cons ',',function + ,(second form)))) + ,(fourth form) ,,keyword ,(third form) + ,@(nthcdr 4 form)) + form))))) + alist)))) + (define-subst-if-compiler-macros + (subst-if . sublis) + (subst-if-not . sublis) + (nsubst-if . nsublis) + (nsubst-if-not . nsublis))) + (define-compiler-macro list* (arg &rest others) (let* ((args (reverse (cons arg others))) (form (car args))) @@ -3292,50 +3490,66 @@ (list 'let (list (list temp val)) (subst temp val res))))) form)) -;; XEmacs; inline delete-duplicates if it's called with a literal -;; #'equal or #'eq and no other keywords, we want the speed in -;; font-lock.el. -(define-compiler-macro delete-duplicates (&whole form cl-seq &rest cl-keys) - (let ((listp-check - (if (memq (car-safe cl-seq) - ;; No need to check for a list at runtime with these. We - ;; could expand the list, but these are all the functions - ;; in the relevant context at the moment. - '(nreverse append nconc mapcan mapcar)) - t - '(listp begin)))) - (cond ((and (= 4 (length form)) - (eq :test (third form)) - (or (equal '(quote eq) (fourth form)) - (equal '(function eq) (fourth form)))) - `(let* ((begin ,cl-seq) - (cl-seq begin)) - (if ,listp-check - (progn - (while cl-seq - (setq cl-seq (setcdr cl-seq (delq (car cl-seq) - (cdr cl-seq))))) - begin) - ;; Call cl-delete-duplicates explicitly, to avoid the form - ;; getting compiler-macroexpanded again: - (cl-delete-duplicates begin ',cl-keys nil)))) - ((and (= 4 (length form)) - (eq :test (third form)) - (or (equal '(quote equal) (fourth form)) - (equal '(function equal) (fourth form)))) - `(let* ((begin ,cl-seq) - (cl-seq begin)) - (if ,listp-check - (progn - (while cl-seq - (setq cl-seq (setcdr cl-seq (delete (car cl-seq) - (cdr cl-seq))))) - begin) - ;; Call cl-delete-duplicates explicitly, to avoid the form - ;; getting compiler-macroexpanded again: - (cl-delete-duplicates begin ',cl-keys nil)))) - (t - form)))) +(define-compiler-macro delete-dups (list) + `(delete-duplicates (the list ,list) :test #'equal :from-end t)) + +;; XEmacs; inline delete-duplicates if it's called with one of the +;; common compile-time constant tests and an optional :from-end +;; argument, we want the speed in font-lock.el. +(define-compiler-macro delete-duplicates (&whole form &rest cl-keys) + (let ((cl-seq (if cl-keys (pop cl-keys)))) + (if (or + (not (or (memq (car-safe cl-seq) + ;; No need to check for a list at runtime with + ;; these. We could expand the list, but these are all + ;; the functions in the relevant context at the moment. + '(nreverse append nconc mapcan mapcar string-to-list)) + (and (listp cl-seq) (equal (butlast cl-seq) '(the list))))) + ;; Wrong number of arguments. + (not (cdr form))) + form + (cond + ((or (plists-equal cl-keys '(:test 'eq) t) + (plists-equal cl-keys '(:test #'eq) t)) + `(let* ((begin ,cl-seq) + cl-seq) + (while (memq (car begin) (cdr begin)) + (setq begin (cdr begin))) + (setq cl-seq begin) + (while (cddr cl-seq) + (if (memq (cadr cl-seq) (cddr cl-seq)) + (setcdr (cdr cl-seq) (cddr cl-seq))) + (setq cl-seq (cdr cl-seq))) + begin)) + ((or (plists-equal cl-keys '(:test 'eq :from-end t) t) + (plists-equal cl-keys '(:test #'eq :from-end t) t)) + `(let* ((begin ,cl-seq) + (cl-seq begin)) + (while cl-seq + (setq cl-seq (setcdr cl-seq + (delq (car cl-seq) (cdr cl-seq))))) + begin)) + ((or (plists-equal cl-keys '(:test 'equal) t) + (plists-equal cl-keys '(:test #'equal) t)) + `(let* ((begin ,cl-seq) + cl-seq) + (while (member (car begin) (cdr begin)) + (setq begin (cdr begin))) + (setq cl-seq begin) + (while (cddr cl-seq) + (if (member (cadr cl-seq) (cddr cl-seq)) + (setcdr (cdr cl-seq) (cddr cl-seq))) + (setq cl-seq (cdr cl-seq))) + begin)) + ((or (plists-equal cl-keys '(:test 'equal :from-end t) t) + (plists-equal cl-keys '(:test #'equal :from-end t) t)) + `(let* ((begin ,cl-seq) + (cl-seq begin)) + (while cl-seq + (setq cl-seq (setcdr cl-seq (delete (car cl-seq) + (cdr cl-seq))))) + begin)) + (t form))))) ;; XEmacs; it's perfectly reasonable, and often much clearer to those ;; reading the code, to call regexp-quote on a constant string, which is @@ -3434,139 +3648,172 @@ ;; byte-optimize.el). (t form))))) -;;(define-compiler-macro equalp (&whole form x y) -;; "Expand calls to `equalp' where X or Y is a constant expression. -;; -;;Much of the processing that `equalp' does is dependent on the types of both -;;of its arguments, and with type information for one of them, we can -;;eliminate much of the body of the function at compile time. -;; -;;Where both X and Y are constant expressions, `equalp' is evaluated at -;;compile time by byte-optimize.el--this compiler macro passes FORM through to -;;the byte optimizer in those cases." -;; ;; Cases where both arguments are constant are handled in -;; ;; byte-optimize.el, we only need to handle those cases where one is -;; ;; constant here. -;; (let* ((equalp-sym (eval-when-compile (gensym))) -;; (let-form '(progn)) -;; (check-bit-vector t) -;; (check-string t) -;; (original-y y) -;; equalp-temp checked) -;; (macrolet -;; ((unordered-check (check) -;; `(prog1 -;; (setq checked -;; (or ,check -;; (prog1 ,(sublis '((x . y) (y . x)) check :test #'eq) -;; (setq equalp-temp x x y y equalp-temp)))) -;; (when checked -;; (unless (symbolp y) -;; (setq let-form `(let ((,equalp-sym ,y))) y equalp-sym)))))) -;; ;; In the bodies of the below clauses, x is always a constant expression -;; ;; of the type we're interested in, and y is always a symbol that refers -;; ;; to the result non-constant side of the comparison. -;; (cond ((unordered-check (and (arrayp x) (not (cl-const-expr-p y)))) -;; ;; Strings and other arrays. A vector containing the same -;; ;; character elements as a given string is equalp to that string; -;; ;; a bit-vector can only be equalp to a string if both are -;; ;; zero-length. -;; (cond -;; ((member x '("" #* [])) -;; ;; No need to protect against multiple evaluation here: -;; `(and (member ,original-y '("" #* [])) t)) -;; ((stringp x) -;; `(,@let-form -;; (if (stringp ,y) -;; (eq t (compare-strings ,x nil nil -;; ,y nil nil t)) -;; (if (vectorp ,y) -;; (cl-string-vector-equalp ,x ,y))))) -;; ((bit-vector-p x) -;; `(,@let-form -;; (if (bit-vector-p ,y) -;; ;; No need to call equalp on each element here: -;; (equal ,x ,y) -;; (if (vectorp ,y) -;; (cl-bit-vector-vector-equalp ,x ,y))))) -;; (t -;; (loop -;; for elt across x -;; ;; We may not need to check the other argument if it's a -;; ;; string or bit vector, depending on the contents of x: -;; always (progn -;; (unless (characterp elt) (setq check-string nil)) -;; (unless (and (numberp elt) (or (= elt 0) (= elt 1))) -;; (setq check-bit-vector nil)) -;; (or check-string check-bit-vector))) -;; `(,@let-form -;; (cond -;; ,@(if check-string -;; `(((stringp ,y) -;; (cl-string-vector-equalp ,y ,x)))) -;; ,@(if check-bit-vector -;; `(((bit-vector-p ,y) -;; (cl-bit-vector-vector-equalp ,y ,x)))) -;; ((vectorp ,y) -;; (cl-vector-array-equalp ,x ,y))))))) -;; ((unordered-check (and (characterp x) (not (cl-const-expr-p y)))) -;; `(,@let-form -;; (or (eq ,x ,y) -;; ;; eq has a bytecode, char-equal doesn't. -;; (and (characterp ,y) -;; (eq (downcase ,x) (downcase ,y)))))) -;; ((unordered-check (and (numberp x) (not (cl-const-expr-p y)))) -;; `(,@let-form -;; (and (numberp ,y) -;; (= ,x ,y)))) -;; ((unordered-check (and (hash-table-p x) (not (cl-const-expr-p y)))) -;; ;; Hash tables; follow the CL spec. -;; `(,@let-form -;; (and (hash-table-p ,y) -;; (eq ',(hash-table-test x) (hash-table-test ,y)) -;; (= ,(hash-table-count x) (hash-table-count ,y)) -;; (cl-hash-table-contents-equalp ,x ,y)))) -;; ((unordered-check -;; ;; Symbols; eq. -;; (and (not (cl-const-expr-p y)) -;; (or (memq x '(nil t)) -;; (and (eq (car-safe x) 'quote) (symbolp (second x)))))) -;; (cons 'eq (cdr form))) -;; ((unordered-check -;; ;; Compare conses at runtime, there's no real upside to -;; ;; unrolling the function -> they fall through to the next -;; ;; clause in this function. -;; (and (cl-const-expr-p x) (not (consp x)) -;; (not (cl-const-expr-p y)))) -;; ;; All other types; use equal. -;; (cons 'equal (cdr form))) -;; ;; Neither side is a constant expression, do all our evaluation at -;; ;; runtime (or both are, and equalp will be called from -;; ;; byte-optimize.el). -;; (t form))))) - (define-compiler-macro notany (&whole form &rest cl-rest) - (cons 'not (cons 'some (cdr cl-rest)))) + `(not (some ,@(cdr form)))) (define-compiler-macro notevery (&whole form &rest cl-rest) - (cons 'not (cons 'every (cdr cl-rest)))) - -(mapc - #'(lambda (y) - (put (car y) 'side-effect-free t) - (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro) - (put (car y) 'cl-compiler-macro - (list 'lambda '(w x) - (if (symbolp (cadr y)) - (list 'list (list 'quote (cadr y)) - (list 'list (list 'quote (caddr y)) 'x)) - (cons 'list (cdr y)))))) - '((first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x) + `(not (every ,@(cdr form)))) + +(define-compiler-macro constantly (&whole form value &rest more-values) + (cond + ((< (length form) 2) + ;; Error at runtime: + form) + ((cl-const-exprs-p (cdr form)) + `#'(lambda (&rest ignore) (values ,@(cdr form)))) + (t + (let* ((num-values (length (cdr form))) + (placeholders-counts (make-vector num-values -1)) + (placeholders (loop + for i from 0 below num-values + collect (make-symbol (format "%d" i)))) + (compiled + (byte-compile-sexp + `#'(lambda (&rest ignore) + ;; Compiles to a references into the compiled function + ;; constants vector: + (values ,@(mapcar #'quote-maybe placeholders))))) + position) + `(make-byte-code '(&rest ignore) + ,(compiled-function-instructions compiled) + (vector ,@(loop + for constant across (compiled-function-constants compiled) + collect (if (setq position + (position constant placeholders)) + (prog2 + (incf (aref placeholders-counts position)) + (nth position (cdr form))) + (quote-maybe constant)) + finally + (assert (every #'zerop placeholders-counts) + t "Placeholders should each have been used once"))) + ,(compiled-function-stack-depth compiled)))))) + +(define-compiler-macro stable-sort (&whole form &rest cl-rest) + (cons 'sort* (cdr form))) + +(define-compiler-macro svref (&whole form) + (cons 'aref (cdr form))) + +(define-compiler-macro acons (a b c) + `(cons (cons ,a ,b) ,c)) + +(define-compiler-macro pairlis (a b &optional c) + `(nconc (mapcar* #'cons ,a ,b) ,c)) + +(define-compiler-macro revappend (&whole form &rest args) + (if (eql 3 (length form)) `(nconc (reverse ,(pop args)) ,(pop args)) form)) + +(define-compiler-macro nreconc (&whole form &rest args) + (if (eql 3 (length form)) `(nconc (nreverse ,(pop args)) ,(pop args)) form)) + +(define-compiler-macro complement (&whole form fn) + (if (or (eq (car-safe fn) 'function) (eq (car-safe fn) 'quote)) + (cond + ((and (symbolp (second fn)) (get (second fn) 'byte-compile-negated-op)) + (list 'function (get (second fn) 'byte-compile-negated-op))) + ((and (symbolp (second fn)) (fboundp (second fn)) + (compiled-function-p (indirect-function (second fn)))) + (let* ((cf (indirect-function (second fn))) + (cfa (compiled-function-arglist cf)) + (do-apply (memq '&rest cfa))) + `#'(lambda ,cfa + (not (,@(if do-apply `(apply ',(second fn)) (list (second fn))) + ,@(remq '&optional + (remq '&rest cfa))))))) + (t + `#'(lambda (&rest arguments) + (not (apply ,fn arguments))))) + ;; Determine the function to call at runtime. + (destructuring-bind + (arglist instructions constants stack-depth) + (let ((compiled-lambda + (byte-compile-sexp + #'(lambda (&rest arguments) + (not (apply 'placeholder arguments)))))) + (list + (compiled-function-arglist compiled-lambda) + (compiled-function-instructions compiled-lambda) + (append (compiled-function-constants compiled-lambda) nil) + (compiled-function-stack-depth compiled-lambda))) + `(make-byte-code + ',arglist ,instructions (vector + ,@(nsublis + (list (cons (quote-maybe + 'placeholder) + fn)) + (mapcar #'quote-maybe constants) + :test #'equal)) + ,stack-depth)))) + +(define-compiler-macro concatenate (&whole form type &rest seqs) + (if (and (cl-const-expr-p type) (memq (cl-const-expr-val type) + '(vector bit-vector list string))) + (case (cl-const-expr-val type) + (list (append (list 'append) (cddr form) '(nil))) + (vector (cons 'vconcat (cddr form))) + (bit-vector (cons 'bvconcat (cddr form))) + (string (cons 'concat (cddr form)))) + form)) + +(define-compiler-macro subst-char-in-string (&whole form fromchar tochar + string &optional inplace) + (if (every #'cl-safe-expr-p (cdr form)) + `(funcall (if ,inplace #'nsubstitute #'substitute) ,tochar ,fromchar + (the string ,string) :test #'eq) + form)) + +(define-compiler-macro stable-union (&whole form &rest cl-keys) + (if (> (length form) 2) + (list* 'union (pop cl-keys) (pop cl-keys) :stable t cl-keys) + form)) + +(define-compiler-macro stable-intersection (&whole form &rest cl-keys) + (if (> (length form) 2) + (list* 'intersection (pop cl-keys) (pop cl-keys) :stable t cl-keys) + form)) + +(map nil + #'(lambda (function) + ;; There are byte codes for the two-argument versions of these + ;; functions; if the form has more arguments and those arguments + ;; have no side effects, transform to a series of two-argument + ;; calls. + (put function 'cl-compiler-macro + #'(lambda (form &rest arguments) + (if (or (null (nthcdr 3 form)) + (notevery #'cl-safe-expr-p (butlast (cdr arguments)))) + form + (cons 'and (mapcon + #'(lambda (rest) + (and (cdr rest) + `((,(car form) ,(pop rest) + ,(car rest))))) + (cdr form))))))) + '(= < > <= >=)) + +;; XEmacs; unroll this loop at macro-expansion time, so the compiler macros +;; are byte-compiled. +(macrolet + ((inline-side-effect-free-compiler-macros (&rest details) + (cons + 'progn + (loop + for (function . details) in details + nconc `((put ',function 'side-effect-free t) + (define-compiler-macro ,function (&whole form x) + ,(if (symbolp (car details)) + (reduce #'(lambda (object1 object2) + `(list ',object1 ,object2)) + details :from-end t :initial-value 'x) + (cons 'list details)))))))) + (inline-side-effect-free-compiler-macros + (first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x) (fifth 'nth 4 x) (sixth 'nth 5 x) (seventh 'nth 6 x) (eighth 'nth 7 x) (ninth 'nth 8 x) (tenth 'nth 9 x) - (rest 'cdr x) (endp 'null x) (plusp '> x 0) (minusp '< x 0) - (oddp 'eq (list 'logand x 1) 1) - (evenp 'eq (list 'logand x 1) 0) + (rest 'cdr x) (plusp '> x 0) (minusp '< x 0) + (oddp 'eql (list 'logand x 1) 1) + (evenp 'eql (list 'logand x 1) 0) (caar car car) (cadr car cdr) (cdar cdr car) (cddr cdr cdr) (caaar car caar) (caadr car cadr) (cadar car cdar) (caddr car cddr) (cdaar cdr caar) (cdadr cdr cadr) @@ -3577,10 +3824,9 @@ (cdadar cdr cadar) (cdaddr cdr caddr) (cddaar cdr cdaar) (cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr))) -;;; Things that are inline. -(proclaim '(inline acons map concatenate -;; XEmacs omission: gethash is builtin - cl-set-elt revappend nreconc)) +;;; Things that are inline. XEmacs; the functions that used to be here have +;;; compiler macros or are built-in. +(proclaim '(inline cl-set-elt)) ;;; Things that are side-effect-free. Moved to byte-optimize.el ;(mapcar (function (lambda (x) (put x 'side-effect-free t))) diff -r 861f2601a38b -r 1f0b15040456 lisp/cl-seq.el --- a/lisp/cl-seq.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/cl-seq.el Sun May 01 18:44:03 2011 +0100 @@ -1,6 +1,7 @@ ;;; cl-seq.el --- Common Lisp extensions for XEmacs Lisp (part three) ;; Copyright (C) 1993 Free Software Foundation, Inc. +;; Copyright (C) 2010 Ben Wing. ;; Author: Dave Gillespie ;; Maintainer: XEmacs Development Team @@ -9,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 21.3. @@ -46,902 +45,315 @@ ;; See cl.el for Change Log. - ;;; Code: -(or (memq 'cl-19 features) - (error "Tried to load `cl-seq' before `cl'!")) - - -;;; Keyword parsing. This is special-cased here so that we can compile -;;; this file independent from cl-macs. - -(defmacro cl-parsing-keywords (kwords other-keys &rest body) - "Helper macro for functions with keyword arguments. -This is a temporary solution, until keyword arguments are natively supported. -Declare your function ending with (... &rest cl-keys), then wrap the -function body in a call to `cl-parsing-keywords'. - -KWORDS is a list of keyword definitions. Each definition should be -either a keyword or a list (KEYWORD DEFAULT-VALUE). In the former case, -the default value is nil. The keywords are available in BODY as the name -of the keyword, minus its initial colon and prepended with `cl-'. +;; XEmacs; all the heavy lifting of this file is now in C. There's no need +;; for the cl-parsing-keywords macro. We could use defun* for the +;; keyword-parsing code, which would avoid the necessity of the arguments: +;; () lists in the docstrings, but that often breaks because of dynamic +;; scope (e.g. a variable called start bound in this file and one in a +;; user-supplied test predicate may well interfere with each other). -OTHER-KEYS specifies other keywords that are accepted but ignored. It -is either the value 't' (ignore all other keys, equivalent to the -&allow-other-keys argument declaration in Common Lisp) or a list in the -same format as KWORDS. If keywords are given that are not in KWORDS -and not allowed by OTHER-KEYS, an error will normally be signalled; but -the caller can override this by specifying a non-nil value for the -keyword :allow-other-keys (which defaults to t)." - (cons - 'let* - (cons (mapcar - (function - (lambda (x) - (let* ((var (if (consp x) (car x) x)) - (mem (list 'car (list 'cdr (list 'memq (list 'quote var) - 'cl-keys))))) - (if (eq var :test-not) - (setq mem (list 'and mem (list 'setq 'cl-test mem) t))) - (if (eq var :if-not) - (setq mem (list 'and mem (list 'setq 'cl-if mem) t))) - (list (intern - (format "cl-%s" (substring (symbol-name var) 1))) - (if (consp x) (list 'or mem (car (cdr x))) mem))))) - kwords) - (append - (and (not (eq other-keys t)) - (list - (list 'let '((cl-keys-temp cl-keys)) - (list 'while 'cl-keys-temp - (list 'or (list 'memq '(car cl-keys-temp) - (list 'quote - (mapcar - (function - (lambda (x) - (if (consp x) - (car x) x))) - (append kwords - other-keys)))) - '(car (cdr (memq (quote :allow-other-keys) - cl-keys))) - '(error "Bad keyword argument %s" - (car cl-keys-temp))) - '(setq cl-keys-temp (cdr (cdr cl-keys-temp))))))) - body)))) -(put 'cl-parsing-keywords 'lisp-indent-function 2) -(put 'cl-parsing-keywords 'edebug-form-spec '(sexp sexp &rest form)) +(defun remove-if (cl-predicate cl-seq &rest cl-keys) + "Remove all items satisfying PREDICATE in SEQUENCE. -(defmacro cl-check-key (x) - (list 'if 'cl-key (list 'funcall 'cl-key x) x)) +This is a non-destructive function; it makes a copy of SEQUENCE if necessary +to avoid corrupting the original SEQUENCE. If SEQUENCE is a list, the copy +may share list structure with SEQUENCE. If no item satisfies PREDICATE, +SEQUENCE itself is returned, unmodified. + +See `remove*' for the meaning of the keywords. -(defmacro cl-check-test-nokey (item x) - (list 'cond - (list 'cl-test - (list 'eq (list 'not (list 'funcall 'cl-test item x)) - 'cl-test-not)) - (list 'cl-if - (list 'eq (list 'not (list 'funcall 'cl-if x)) 'cl-if-not)) - (list 't (list 'if (list 'numberp item) - (list 'equal item x) (list 'eq item x))))) - -(defmacro cl-check-test (item x) - (list 'cl-check-test-nokey item (list 'cl-check-key x))) +arguments: (PREDICATE SEQUENCE &key (KEY #'IDENTITY) (START 0) END FROM-END COUNT)" + (apply 'remove* 'remove* cl-seq :if cl-predicate cl-keys)) -(defmacro cl-check-match (x y) - (setq x (list 'cl-check-key x) y (list 'cl-check-key y)) - (list 'if 'cl-test - (list 'eq (list 'not (list 'funcall 'cl-test x y)) 'cl-test-not) - (list 'if (list 'numberp x) - (list 'equal x y) (list 'eq x y)))) +(defun remove-if-not (cl-predicate cl-seq &rest cl-keys) + "Remove all items not satisfying PREDICATE in SEQUENCE. -(put 'cl-check-key 'edebug-form-spec 'edebug-forms) -(put 'cl-check-test 'edebug-form-spec 'edebug-forms) -(put 'cl-check-test-nokey 'edebug-form-spec 'edebug-forms) -(put 'cl-check-match 'edebug-form-spec 'edebug-forms) - -(defvar cl-test) (defvar cl-test-not) -(defvar cl-if) (defvar cl-if-not) -(defvar cl-key) - +This is a non-destructive function; it makes a copy of SEQUENCE if necessary +to avoid corrupting the original SEQUENCE. If SEQUENCE is a list, the copy +may share list structure with SEQUENCE. -(defun reduce (cl-func cl-seq &rest cl-keys) - "Reduce two-argument FUNCTION across SEQUENCE. -Keywords supported: :start :end :from-end :initial-value :key" - (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) () - (or (listp cl-seq) (setq cl-seq (append cl-seq nil))) - (setq cl-seq (subseq cl-seq cl-start cl-end)) - (if cl-from-end (setq cl-seq (nreverse cl-seq))) - (let ((cl-accum (cond ((memq :initial-value cl-keys) cl-initial-value) - (cl-seq (cl-check-key (pop cl-seq))) - (t (funcall cl-func))))) - (if cl-from-end - (while cl-seq - (setq cl-accum (funcall cl-func (cl-check-key (pop cl-seq)) - cl-accum))) - (while cl-seq - (setq cl-accum (funcall cl-func cl-accum - (cl-check-key (pop cl-seq)))))) - cl-accum))) +See `remove*' for the meaning of the keywords. + +arguments: (PREDICATE SEQUENCE &key (KEY #'IDENTITY) (START 0) END FROM-END COUNT)" + (apply 'remove* 'remove* cl-seq :if-not cl-predicate cl-keys)) -(defun fill (seq item &rest cl-keys) - "Fill the elements of SEQ with ITEM. -Keywords supported: :start :end" - (cl-parsing-keywords ((:start 0) :end) () - (if (listp seq) - (let ((p (nthcdr cl-start seq)) - (n (if cl-end (- cl-end cl-start) 8000000))) - (while (and p (>= (setq n (1- n)) 0)) - (setcar p item) - (setq p (cdr p)))) - (or cl-end (setq cl-end (length seq))) - (if (and (= cl-start 0) (= cl-end (length seq))) - (fillarray seq item) - (while (< cl-start cl-end) - (aset seq cl-start item) - (setq cl-start (1+ cl-start))))) - seq)) +(defun delete-if (cl-predicate cl-seq &rest cl-keys) + "Remove all items satisfying PREDICATE in SEQUENCE. + +This is a destructive function; if SEQUENCE is a list, it reuses its +storage. If SEQUENCE is an array and some element satisfies SEQUENCE, a +copy is always returned. -(defun replace (cl-seq1 cl-seq2 &rest cl-keys) - "Replace the elements of SEQ1 with the elements of SEQ2. -SEQ1 is destructively modified, then returned. -Keywords supported: :start1 :end1 :start2 :end2" - (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) () - (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1)) - (or (= cl-start1 cl-start2) - (let* ((cl-len (length cl-seq1)) - (cl-n (min (- (or cl-end1 cl-len) cl-start1) - (- (or cl-end2 cl-len) cl-start2)))) - (while (>= (setq cl-n (1- cl-n)) 0) - (cl-set-elt cl-seq1 (+ cl-start1 cl-n) - (elt cl-seq2 (+ cl-start2 cl-n)))))) - (if (listp cl-seq1) - (let ((cl-p1 (nthcdr cl-start1 cl-seq1)) - (cl-n1 (if cl-end1 (- cl-end1 cl-start1) 4000000))) - (if (listp cl-seq2) - (let ((cl-p2 (nthcdr cl-start2 cl-seq2)) - (cl-n (min cl-n1 - (if cl-end2 (- cl-end2 cl-start2) 4000000)))) - (while (and cl-p1 cl-p2 (>= (setq cl-n (1- cl-n)) 0)) - (setcar cl-p1 (car cl-p2)) - (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)))) - (setq cl-end2 (min (or cl-end2 (length cl-seq2)) - (+ cl-start2 cl-n1))) - (while (and cl-p1 (< cl-start2 cl-end2)) - (setcar cl-p1 (aref cl-seq2 cl-start2)) - (setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2))))) - (setq cl-end1 (min (or cl-end1 (length cl-seq1)) - (+ cl-start1 (- (or cl-end2 (length cl-seq2)) - cl-start2)))) - (if (listp cl-seq2) - (let ((cl-p2 (nthcdr cl-start2 cl-seq2))) - (while (< cl-start1 cl-end1) - (aset cl-seq1 cl-start1 (car cl-p2)) - (setq cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1)))) - (while (< cl-start1 cl-end1) - (aset cl-seq1 cl-start1 (aref cl-seq2 cl-start2)) - (setq cl-start2 (1+ cl-start2) cl-start1 (1+ cl-start1)))))) - cl-seq1)) +See `remove*' for the meaning of the keywords. + +arguments: (PREDICATE SEQUENCE &key (KEY #'IDENTITY) (START 0) END FROM-END COUNT)" + (apply 'delete* 'delete* cl-seq :if cl-predicate cl-keys)) + +(defun delete-if-not (cl-predicate cl-seq &rest cl-keys) + "Remove all items not satisfying PREDICATE in SEQUENCE. + +This is a destructive function; it reuses the storage of SEQUENCE whenever +possible. + +See `remove*' for the meaning of the keywords. + +arguments: (PREDICATE SEQUENCE &key (KEY #'IDENTITY) (START 0) END FROM-END COUNT)" + (apply 'delete* 'delete* cl-seq :if-not cl-predicate cl-keys)) + +(defun substitute-if (cl-new cl-predicate cl-seq &rest cl-keys) + "Substitute NEW for all items satisfying PREDICATE in SEQUENCE. -(defun remove* (cl-item cl-seq &rest cl-keys) - "Remove all occurrences of ITEM in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. -Keywords supported: :test :test-not :key :count :start :end :from-end" - (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end - (:start 0) :end) () - (if (<= (or cl-count (setq cl-count 8000000)) 0) - cl-seq - (if (or (nlistp cl-seq) (and cl-from-end (< cl-count 4000000))) - (let ((cl-i (cl-position cl-item cl-seq cl-start cl-end - cl-from-end))) - (if cl-i - (let ((cl-res (apply 'delete* cl-item (append cl-seq nil) - (append (if cl-from-end - (list :end (1+ cl-i)) - (list :start cl-i)) - cl-keys)))) - (if (listp cl-seq) cl-res - (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))) - cl-seq)) - (setq cl-end (- (or cl-end 8000000) cl-start)) - (if (= cl-start 0) - (while (and cl-seq (> cl-end 0) - (cl-check-test cl-item (car cl-seq)) - (setq cl-end (1- cl-end) cl-seq (cdr cl-seq)) - (> (setq cl-count (1- cl-count)) 0)))) - (if (and (> cl-count 0) (> cl-end 0)) - (let ((cl-p (if (> cl-start 0) (nthcdr cl-start cl-seq) - (setq cl-end (1- cl-end)) (cdr cl-seq)))) - (while (and cl-p (> cl-end 0) - (not (cl-check-test cl-item (car cl-p)))) - (setq cl-p (cdr cl-p) cl-end (1- cl-end))) - (if (and cl-p (> cl-end 0)) - (nconc (ldiff cl-seq cl-p) - (if (= cl-count 1) (cdr cl-p) - (and (cdr cl-p) - (apply 'delete* cl-item - (copy-sequence (cdr cl-p)) - :start 0 :end (1- cl-end) - :count (1- cl-count) cl-keys)))) - cl-seq)) - cl-seq))))) +This is a non-destructive function; it makes a copy of SEQUENCE if necessary +to avoid corrupting the original SEQUENCE. + +See `remove*' for the meaning of the keywords. -(defun remove-if (cl-pred cl-list &rest cl-keys) - "Remove all items satisfying PREDICATE in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. -Keywords supported: :key :count :start :end :from-end" - (apply 'remove* nil cl-list :if cl-pred cl-keys)) +arguments: (NEW PREDICATE SEQUENCE &key (KEY #'identity) (START 0) END COUNT FROM-END)" + (apply 'substitute cl-new 'substitute cl-seq :if cl-predicate cl-keys)) + +(defun substitute-if-not (cl-new cl-predicate cl-seq &rest cl-keys) + "Substitute NEW for all items not satisfying PREDICATE in SEQUENCE. -(defun remove-if-not (cl-pred cl-list &rest cl-keys) - "Remove all items not satisfying PREDICATE in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. -Keywords supported: :key :count :start :end :from-end" - (apply 'remove* nil cl-list :if-not cl-pred cl-keys)) +This is a non-destructive function; it makes a copy of SEQUENCE if necessary +to avoid corrupting the original SEQUENCE. + +See `remove*' for the meaning of the keywords. -(defun delete* (cl-item cl-seq &rest cl-keys) - "Remove all occurrences of ITEM in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. -Keywords supported: :test :test-not :key :count :start :end :from-end" - (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end - (:start 0) :end) () - (if (<= (or cl-count (setq cl-count 8000000)) 0) - cl-seq - (if (listp cl-seq) - (if (and cl-from-end (< cl-count 4000000)) - (let (cl-i) - (while (and (>= (setq cl-count (1- cl-count)) 0) - (setq cl-i (cl-position cl-item cl-seq cl-start - cl-end cl-from-end))) - (if (= cl-i 0) (setq cl-seq (cdr cl-seq)) - (let ((cl-tail (nthcdr (1- cl-i) cl-seq))) - (setcdr cl-tail (cdr (cdr cl-tail))))) - (setq cl-end cl-i)) - cl-seq) - (setq cl-end (- (or cl-end 8000000) cl-start)) - (if (= cl-start 0) - (progn - (while (and cl-seq - (> cl-end 0) - (cl-check-test cl-item (car cl-seq)) - (setq cl-end (1- cl-end) cl-seq (cdr cl-seq)) - (> (setq cl-count (1- cl-count)) 0))) - (setq cl-end (1- cl-end))) - (setq cl-start (1- cl-start))) - (if (and (> cl-count 0) (> cl-end 0)) - (let ((cl-p (nthcdr cl-start cl-seq))) - (while (and (cdr cl-p) (> cl-end 0)) - (if (cl-check-test cl-item (car (cdr cl-p))) - (progn - (setcdr cl-p (cdr (cdr cl-p))) - (if (= (setq cl-count (1- cl-count)) 0) - (setq cl-end 1))) - (setq cl-p (cdr cl-p))) - (setq cl-end (1- cl-end))))) - cl-seq) - (apply 'remove* cl-item cl-seq cl-keys))))) +arguments: (NEW PREDICATE SEQUENCE &key (KEY #'identity) (START 0) END COUNT FROM-END)" + (apply 'substitute cl-new 'substitute cl-seq :if-not cl-predicate + cl-keys)) -(defun delete-if (cl-pred cl-list &rest cl-keys) - "Remove all items satisfying PREDICATE in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. -Keywords supported: :key :count :start :end :from-end" - (apply 'delete* nil cl-list :if cl-pred cl-keys)) - -(defun delete-if-not (cl-pred cl-list &rest cl-keys) - "Remove all items not satisfying PREDICATE in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. -Keywords supported: :key :count :start :end :from-end" - (apply 'delete* nil cl-list :if-not cl-pred cl-keys)) +(defun nsubstitute-if (cl-new cl-predicate cl-seq &rest cl-keys) + "Substitute NEW for all items satisfying PREDICATE in SEQUENCE. -;; XEmacs change: this is in subr.el in Emacs -(defun remove (cl-item cl-seq) - "Remove all occurrences of ITEM in SEQ, testing with `equal' -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. -Also see: `remove*', `delete', `delete*'" - (remove* cl-item cl-seq ':test 'equal)) +This is destructive function; it modifies SEQUENCE directly, never returning +a copy. See `substitute-if' for a non-destructive version. -;; XEmacs change: this is in subr.el in Emacs -(defun remq (cl-elt cl-list) - "Remove all occurrences of ELT in LIST, comparing with `eq'. -This is a non-destructive function; it makes a copy of LIST to avoid -corrupting the original LIST. -Also see: `delq', `delete', `delete*', `remove', `remove*'." - (if (memq cl-elt cl-list) - (delq cl-elt (copy-list cl-list)) - cl-list)) - -(defun remove-duplicates (cl-seq &rest cl-keys) - "Return a copy of SEQ with all duplicate elements removed. -Keywords supported: :test :test-not :key :start :end :from-end" - (cl-delete-duplicates cl-seq cl-keys t)) - -(defun delete-duplicates (cl-seq &rest cl-keys) - "Remove all duplicate elements from SEQ (destructively). -Keywords supported: :test :test-not :key :start :end :from-end" - (cl-delete-duplicates cl-seq cl-keys nil)) +See `remove*' for the meaning of the keywords. -(defun cl-delete-duplicates (cl-seq cl-keys cl-copy) - (if (listp cl-seq) - (cl-parsing-keywords (:test :test-not :key (:start 0) :end :from-end :if) - () - (if cl-from-end - (let ((cl-p (nthcdr cl-start cl-seq)) cl-i) - (setq cl-end (- (or cl-end (length cl-seq)) cl-start)) - (while (> cl-end 1) - (setq cl-i 0) - (while (setq cl-i (cl-position (cl-check-key (car cl-p)) - (cdr cl-p) cl-i (1- cl-end))) - (if cl-copy (setq cl-seq (copy-sequence cl-seq) - cl-p (nthcdr cl-start cl-seq) cl-copy nil)) - (let ((cl-tail (nthcdr cl-i cl-p))) - (setcdr cl-tail (cdr (cdr cl-tail)))) - (setq cl-end (1- cl-end))) - (setq cl-p (cdr cl-p) cl-end (1- cl-end) - cl-start (1+ cl-start))) - cl-seq) - (setq cl-end (- (or cl-end (length cl-seq)) cl-start)) - (while (and (cdr cl-seq) (= cl-start 0) (> cl-end 1) - (cl-position (cl-check-key (car cl-seq)) - (cdr cl-seq) 0 (1- cl-end))) - (setq cl-seq (cdr cl-seq) cl-end (1- cl-end))) - (let ((cl-p (if (> cl-start 0) (nthcdr (1- cl-start) cl-seq) - (setq cl-end (1- cl-end) cl-start 1) cl-seq))) - (while (and (cdr (cdr cl-p)) (> cl-end 1)) - (if (cl-position (cl-check-key (car (cdr cl-p))) - (cdr (cdr cl-p)) 0 (1- cl-end)) - (progn - (if cl-copy (setq cl-seq (copy-sequence cl-seq) - cl-p (nthcdr (1- cl-start) cl-seq) - cl-copy nil)) - (setcdr cl-p (cdr (cdr cl-p)))) - (setq cl-p (cdr cl-p))) - (setq cl-end (1- cl-end) cl-start (1+ cl-start))) - cl-seq))) - (let ((cl-res (cl-delete-duplicates (append cl-seq nil) cl-keys nil))) - (if (stringp cl-seq) (concat cl-res) (vconcat cl-res))))) +arguments: (NEW PREDICATE SEQUENCE &key (KEY #'identity) (START 0) END COUNT FROM-END)" + (apply 'nsubstitute cl-new 'nsubstitute cl-seq :if cl-predicate + cl-keys)) + +(defun nsubstitute-if-not (cl-new cl-predicate cl-seq &rest cl-keys) + "Substitute NEW for all items not satisfying PREDICATE in SEQUENCE. + +This is destructive function; it modifies SEQUENCE directly, never returning +a copy. See `substitute-if-not' for a non-destructive version. + +See `remove*' for the meaning of the keywords. -(defun substitute (cl-new cl-old cl-seq &rest cl-keys) - "Substitute NEW for OLD in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. -Keywords supported: :test :test-not :key :count :start :end :from-end" - (cl-parsing-keywords (:test :test-not :key :if :if-not :count - (:start 0) :end :from-end) () - (if (or (eq cl-old cl-new) - (<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0)) - cl-seq - (let ((cl-i (cl-position cl-old cl-seq cl-start cl-end))) - (if (not cl-i) - cl-seq - (setq cl-seq (copy-sequence cl-seq)) - (or cl-from-end - (progn (cl-set-elt cl-seq cl-i cl-new) - (setq cl-i (1+ cl-i) cl-count (1- cl-count)))) - (apply 'nsubstitute cl-new cl-old cl-seq :count cl-count - :start cl-i cl-keys)))))) +arguments: (NEW PREDICATE SEQUENCE &key (KEY #'identity) (START 0) END COUNT FROM-END)" + (apply 'nsubstitute cl-new 'nsubstitute cl-seq :if-not cl-predicate + cl-keys)) -(defun substitute-if (cl-new cl-pred cl-list &rest cl-keys) - "Substitute NEW for all items satisfying PREDICATE in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. -Keywords supported: :key :count :start :end :from-end" - (apply 'substitute cl-new nil cl-list :if cl-pred cl-keys)) +(defun find-if (cl-predicate cl-seq &rest cl-keys) + "Find the first item satisfying PREDICATE in SEQUENCE. -(defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys) - "Substitute NEW for all items not satisfying PREDICATE in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. -Keywords supported: :key :count :start :end :from-end" - (apply 'substitute cl-new nil cl-list :if-not cl-pred cl-keys)) +Return the matching item, or DEFAULT (not a keyword specified for this +function by Common Lisp) if not found. -(defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys) - "Substitute NEW for OLD in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. -Keywords supported: :test :test-not :key :count :start :end :from-end" - (cl-parsing-keywords (:test :test-not :key :if :if-not :count - (:start 0) :end :from-end) () - (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0) - (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000))) - (let ((cl-p (nthcdr cl-start cl-seq))) - (setq cl-end (- (or cl-end 8000000) cl-start)) - (while (and cl-p (> cl-end 0) (> cl-count 0)) - (if (cl-check-test cl-old (car cl-p)) - (progn - (setcar cl-p cl-new) - (setq cl-count (1- cl-count)))) - (setq cl-p (cdr cl-p) cl-end (1- cl-end)))) - (or cl-end (setq cl-end (length cl-seq))) - (if cl-from-end - (while (and (< cl-start cl-end) (> cl-count 0)) - (setq cl-end (1- cl-end)) - (if (cl-check-test cl-old (elt cl-seq cl-end)) - (progn - (cl-set-elt cl-seq cl-end cl-new) - (setq cl-count (1- cl-count))))) - (while (and (< cl-start cl-end) (> cl-count 0)) - (if (cl-check-test cl-old (aref cl-seq cl-start)) - (progn - (aset cl-seq cl-start cl-new) - (setq cl-count (1- cl-count)))) - (setq cl-start (1+ cl-start)))))) - cl-seq)) +See `remove*' for the meaning of the other keywords. + +arguments: (PREDICATE SEQUENCE &key (KEY #'identity) (START 0) END FROM-END DEFAULT)" + (apply 'find 'find cl-seq :if cl-predicate cl-keys)) -(defun nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys) - "Substitute NEW for all items satisfying PREDICATE in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. -Keywords supported: :key :count :start :end :from-end" - (apply 'nsubstitute cl-new nil cl-list :if cl-pred cl-keys)) +(defun find-if-not (cl-predicate cl-seq &rest cl-keys) + "Find the first item not satisfying PREDICATE in SEQUENCE. -(defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys) - "Substitute NEW for all items not satisfying PREDICATE in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. -Keywords supported: :key :count :start :end :from-end" - (apply 'nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys)) +Return the matching ITEM, or DEFAULT (not a keyword specified for this +function by Common Lisp) if not found. + +See `remove*' for the meaning of the keywords. -(defun find (cl-item cl-seq &rest cl-keys) - "Find the first occurrence of ITEM in LIST. -Return the matching ITEM, or nil if not found. -Keywords supported: :test :test-not :key :start :end :from-end" - (let ((cl-pos (apply 'position cl-item cl-seq cl-keys))) - (and cl-pos (elt cl-seq cl-pos)))) - -(defun find-if (cl-pred cl-list &rest cl-keys) - "Find the first item satisfying PREDICATE in LIST. -Return the matching ITEM, or nil if not found. -Keywords supported: :key :start :end :from-end" - (apply 'find nil cl-list :if cl-pred cl-keys)) +arguments: (PREDICATE SEQUENCE &key (KEY #'identity) (START 0) END FROM-END DEFAULT)" + (apply 'find 'find cl-seq :if-not cl-predicate cl-keys)) -(defun find-if-not (cl-pred cl-list &rest cl-keys) - "Find the first item not satisfying PREDICATE in LIST. -Return the matching ITEM, or nil if not found. -Keywords supported: :key :start :end :from-end" - (apply 'find nil cl-list :if-not cl-pred cl-keys)) +(defun position-if (cl-predicate cl-seq &rest cl-keys) + "Find the first item satisfying PREDICATE in SEQUENCE. -(defun position (cl-item cl-seq &rest cl-keys) - "Find the first occurrence of ITEM in LIST. Return the index of the matching item, or nil if not found. -Keywords supported: :test :test-not :key :start :end :from-end" - (cl-parsing-keywords (:test :test-not :key :if :if-not - (:start 0) :end :from-end) () - (cl-position cl-item cl-seq cl-start cl-end cl-from-end))) + +See `remove*' for the meaning of the keywords. -(defun cl-position (cl-item cl-seq cl-start &optional cl-end cl-from-end) - (if (listp cl-seq) - (let ((cl-p (nthcdr cl-start cl-seq))) - (or cl-end (setq cl-end 8000000)) - (let ((cl-res nil)) - (while (and cl-p (< cl-start cl-end) (or (not cl-res) cl-from-end)) - (if (cl-check-test cl-item (car cl-p)) - (setq cl-res cl-start)) - (setq cl-p (cdr cl-p) cl-start (1+ cl-start))) - cl-res)) - (or cl-end (setq cl-end (length cl-seq))) - (if cl-from-end - (progn - (while (and (>= (setq cl-end (1- cl-end)) cl-start) - (not (cl-check-test cl-item (aref cl-seq cl-end))))) - (and (>= cl-end cl-start) cl-end)) - (while (and (< cl-start cl-end) - (not (cl-check-test cl-item (aref cl-seq cl-start)))) - (setq cl-start (1+ cl-start))) - (and (< cl-start cl-end) cl-start)))) +arguments: (PREDICATE SEQUENCE &key (KEY #'identity) (START 0) END FROM-END)" + (apply 'position 'position cl-seq :if cl-predicate cl-keys)) -(defun position-if (cl-pred cl-list &rest cl-keys) - "Find the first item satisfying PREDICATE in LIST. -Return the index of the matching item, or nil if not found. -Keywords supported: :key :start :end :from-end" - (apply 'position nil cl-list :if cl-pred cl-keys)) - -(defun position-if-not (cl-pred cl-list &rest cl-keys) - "Find the first item not satisfying PREDICATE in LIST. -Return the index of the matching item, or nil if not found. -Keywords supported: :key :start :end :from-end" - (apply 'position nil cl-list :if-not cl-pred cl-keys)) +(defun position-if-not (cl-predicate cl-seq &rest cl-keys) + "Find the first item not satisfying PREDICATE in SEQUENCE. -(defun count (cl-item cl-seq &rest cl-keys) - "Count the number of occurrences of ITEM in LIST. -Keywords supported: :test :test-not :key :start :end" - (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) () - (let ((cl-count 0) cl-x) - (or cl-end (setq cl-end (length cl-seq))) - (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq))) - (while (< cl-start cl-end) - (setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start))) - (if (cl-check-test cl-item cl-x) (setq cl-count (1+ cl-count))) - (setq cl-start (1+ cl-start))) - cl-count))) +Return the index of the matching item, or nil if not found. + +See `remove*' for the meaning of the keywords. -(defun count-if (cl-pred cl-list &rest cl-keys) - "Count the number of items satisfying PREDICATE in LIST. -Keywords supported: :key :start :end" - (apply 'count nil cl-list :if cl-pred cl-keys)) - -(defun count-if-not (cl-pred cl-list &rest cl-keys) - "Count the number of items not satisfying PREDICATE in LIST. -Keywords supported: :key :start :end" - (apply 'count nil cl-list :if-not cl-pred cl-keys)) +arguments: (PREDICATE SEQUENCE &key (KEY #'identity) (START 0) END FROM-END)" + (apply 'position 'position cl-seq :if-not cl-predicate cl-keys)) -(defun mismatch (cl-seq1 cl-seq2 &rest cl-keys) - "Compare SEQ1 with SEQ2, return index of first mismatching element. -Return nil if the sequences match. If one sequence is a prefix of the -other, the return value indicates the end of the shorter sequence. -Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end" - (cl-parsing-keywords (:test :test-not :key :from-end - (:start1 0) :end1 (:start2 0) :end2) () - (or cl-end1 (setq cl-end1 (length cl-seq1))) - (or cl-end2 (setq cl-end2 (length cl-seq2))) - (if cl-from-end - (progn - (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2) - (cl-check-match (elt cl-seq1 (1- cl-end1)) - (elt cl-seq2 (1- cl-end2)))) - (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2))) - (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2)) - (1- cl-end1))) - (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1))) - (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2)))) - (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2) - (cl-check-match (if cl-p1 (car cl-p1) - (aref cl-seq1 cl-start1)) - (if cl-p2 (car cl-p2) - (aref cl-seq2 cl-start2)))) - (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2) - cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2))) - (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2)) - cl-start1))))) +(defun count-if (cl-predicate cl-seq &rest cl-keys) + "Count the number of items satisfying PREDICATE in SEQUENCE. + +See `remove*' for the meaning of the keywords. -(defun search (cl-seq1 cl-seq2 &rest cl-keys) - "Search for SEQ1 as a subsequence of SEQ2. -Return the index of the leftmost element of the first match found; -return nil if there are no matches. -Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end" - (cl-parsing-keywords (:test :test-not :key :from-end - (:start1 0) :end1 (:start2 0) :end2) () - (or cl-end1 (setq cl-end1 (length cl-seq1))) - (or cl-end2 (setq cl-end2 (length cl-seq2))) - (if (>= cl-start1 cl-end1) - (if cl-from-end cl-end2 cl-start2) - (let* ((cl-len (- cl-end1 cl-start1)) - (cl-first (cl-check-key (elt cl-seq1 cl-start1))) - (cl-if nil) cl-pos) - (setq cl-end2 (- cl-end2 (1- cl-len))) - (while (and (< cl-start2 cl-end2) - (setq cl-pos (cl-position cl-first cl-seq2 - cl-start2 cl-end2 cl-from-end)) - (apply 'mismatch cl-seq1 cl-seq2 - :start1 (1+ cl-start1) :end1 cl-end1 - :start2 (1+ cl-pos) :end2 (+ cl-pos cl-len) - :from-end nil cl-keys)) - (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos)))) - (and (< cl-start2 cl-end2) cl-pos))))) +arguments: (PREDICATE SEQUENCE &key (KEY #'identity) (START 0) END FROM-END)" + (apply 'count 'count cl-seq :if cl-predicate cl-keys)) + +(defun count-if-not (cl-predicate cl-seq &rest cl-keys) + "Count the number of items not satisfying PREDICATE in SEQUENCE. -(defun sort* (cl-seq cl-pred &rest cl-keys) - "Sort the argument SEQUENCE according to PREDICATE. -This is a destructive function; it reuses the storage of SEQUENCE if possible. -Keywords supported: :key" - (if (nlistp cl-seq) - (replace cl-seq (apply 'sort* (append cl-seq nil) cl-pred cl-keys)) - (cl-parsing-keywords (:key) () - (if (memq cl-key '(nil identity)) - (sort cl-seq cl-pred) - (sort cl-seq (function (lambda (cl-x cl-y) - (funcall cl-pred (funcall cl-key cl-x) - (funcall cl-key cl-y))))))))) +See `remove*' for the meaning of the keywords. -(defun stable-sort (cl-seq cl-pred &rest cl-keys) +arguments: (PREDICATE SEQUENCE &key (KEY #'identity) (START 0) END FROM-END)" + (apply 'count 'count cl-seq :if-not cl-predicate cl-keys)) + +(defun stable-sort (cl-seq cl-predicate &rest cl-keys) "Sort the argument SEQUENCE stably according to PREDICATE. This is a destructive function; it reuses the storage of SEQUENCE if possible. -Keywords supported: :key" - (apply 'sort* cl-seq cl-pred cl-keys)) +Keywords supported: :key +:key specifies a one-argument function that transforms elements of SEQUENCE +into \"comparison keys\" before the test predicate is applied. See +`member*' for more information. -(defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys) - "Destructively merge the two sequences to produce a new sequence. -TYPE is the sequence type to return, SEQ1 and SEQ2 are the two -argument sequences, and PRED is a `less-than' predicate on the elements. -Keywords supported: :key" - (or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil))) - (or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil))) - (cl-parsing-keywords (:key) () - (let ((cl-res nil)) - (while (and cl-seq1 cl-seq2) - (if (funcall cl-pred (cl-check-key (car cl-seq2)) - (cl-check-key (car cl-seq1))) - (push (pop cl-seq2) cl-res) - (push (pop cl-seq1) cl-res))) - (coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type)))) +arguments: (SEQUENCE PREDICATE &key (KEY #'identity))" + (apply 'sort* cl-seq cl-predicate cl-keys)) -;;; See compiler macro in cl-macs.el -(defun member* (cl-item cl-list &rest cl-keys) - "Find the first occurrence of ITEM in LIST. -Return the sublist of LIST whose car is ITEM. -Keywords supported: :test :test-not :key" - (if cl-keys - (cl-parsing-keywords (:test :test-not :key :if :if-not) () - (while (and cl-list (not (cl-check-test cl-item (car cl-list)))) - (setq cl-list (cdr cl-list))) - cl-list) - (if (and (numberp cl-item) (not (fixnump cl-item))) - (member cl-item cl-list) - (memq cl-item cl-list)))) - -(defun member-if (cl-pred cl-list &rest cl-keys) +(defun member-if (cl-predicate cl-list &rest cl-keys) "Find the first item satisfying PREDICATE in LIST. Return the sublist of LIST whose car matches. -Keywords supported: :key" - (apply 'member* nil cl-list :if cl-pred cl-keys)) +See `member*' for the meaning of :key. -(defun member-if-not (cl-pred cl-list &rest cl-keys) +arguments: (PREDICATE LIST &key (KEY #'identity))" + (apply 'member* 'member* cl-list :if cl-predicate cl-keys)) + +(defun member-if-not (cl-predicate cl-list &rest cl-keys) "Find the first item not satisfying PREDICATE in LIST. Return the sublist of LIST whose car matches. -Keywords supported: :key" - (apply 'member* nil cl-list :if-not cl-pred cl-keys)) +See `member*' for the meaning of :key. -(defun cl-adjoin (cl-item cl-list &rest cl-keys) - (if (cl-parsing-keywords (:key) t - (apply 'member* (cl-check-key cl-item) cl-list cl-keys)) - cl-list - (cons cl-item cl-list))) +arguments: (PREDICATE LIST &key (KEY #'identity))" + (apply 'member* 'member* cl-list :if-not cl-predicate cl-keys)) + +(defun assoc-if (cl-predicate cl-alist &rest cl-keys) + "Return the first item whose car satisfies PREDICATE in ALIST. +See `member*' for the meaning of :key. -;;; See compiler macro in cl-macs.el -(defun assoc* (cl-item cl-alist &rest cl-keys) - "Find the first item whose car matches ITEM in LIST. -Keywords supported: :test :test-not :key" - (if cl-keys - (cl-parsing-keywords (:test :test-not :key :if :if-not) () - (while (and cl-alist - (or (not (consp (car cl-alist))) - (not (cl-check-test cl-item (car (car cl-alist)))))) - (setq cl-alist (cdr cl-alist))) - (and cl-alist (car cl-alist))) - (if (and (numberp cl-item) (not (fixnump cl-item))) - (assoc cl-item cl-alist) - (assq cl-item cl-alist)))) +arguments: (PREDICATE ALIST &key (KEY #'identity))" + (apply 'assoc* 'assoc* cl-alist :if cl-predicate cl-keys)) -(defun assoc-if (cl-pred cl-list &rest cl-keys) - "Find the first item whose car satisfies PREDICATE in LIST. -Keywords supported: :key" - (apply 'assoc* nil cl-list :if cl-pred cl-keys)) +(defun assoc-if-not (cl-predicate cl-alist &rest cl-keys) + "Return the first item whose car does not satisfy PREDICATE in ALIST. +See `member*' for the meaning of :key. -(defun assoc-if-not (cl-pred cl-list &rest cl-keys) - "Find the first item whose car does not satisfy PREDICATE in LIST. -Keywords supported: :key" - (apply 'assoc* nil cl-list :if-not cl-pred cl-keys)) +arguments: (PREDICATE ALIST &key (KEY #'identity))" + (apply 'assoc* 'assoc* cl-alist :if-not cl-predicate cl-keys)) -(defun rassoc* (cl-item cl-alist &rest cl-keys) - "Find the first item whose cdr matches ITEM in LIST. -Keywords supported: :test :test-not :key" - (if (or cl-keys (and (numberp cl-item) (not (fixnump cl-item)))) - (cl-parsing-keywords (:test :test-not :key :if :if-not) () - (while (and cl-alist - (or (not (consp (car cl-alist))) - (not (cl-check-test cl-item (cdr (car cl-alist)))))) - (setq cl-alist (cdr cl-alist))) - (and cl-alist (car cl-alist))) - (rassq cl-item cl-alist))) +(defun rassoc-if (cl-predicate cl-alist &rest cl-keys) + "Return the first item whose cdr satisfies PREDICATE in ALIST. +See `member*' for the meaning of :key. + +arguments: (PREDICATE ALIST &key (KEY #'identity))" + (apply 'rassoc* 'rassoc* cl-alist :if cl-predicate cl-keys)) -(defun rassoc-if (cl-pred cl-list &rest cl-keys) - "Find the first item whose cdr satisfies PREDICATE in LIST. -Keywords supported: :key" - (apply 'rassoc* nil cl-list :if cl-pred cl-keys)) +(defun rassoc-if-not (cl-predicate cl-alist &rest cl-keys) + "Return the first item whose cdr does not satisfy PREDICATE in ALIST. +See `member*' for the meaning of :key. -(defun rassoc-if-not (cl-pred cl-list &rest cl-keys) - "Find the first item whose cdr does not satisfy PREDICATE in LIST. -Keywords supported: :key" - (apply 'rassoc* nil cl-list :if-not cl-pred cl-keys)) +arguments: (PREDICATE ALIST &key (KEY #'identity))" + (apply 'rassoc* 'rassoc* cl-alist :if-not cl-predicate cl-keys)) -(defun union (cl-list1 cl-list2 &rest cl-keys) - "Combine LIST1 and LIST2 using a set-union operation. +;; XEmacs addition: NOT IN COMMON LISP. +(defun stable-union (cl-list1 cl-list2 &rest cl-keys) + "Stably combine LIST1 and LIST2 using a set-union operation. The result list contains all items that appear in either LIST1 or LIST2. -This is a non-destructive function; it makes a copy of the data if necessary -to avoid corrupting the original LIST1 and LIST2. -Keywords supported: :test :test-not :key" - (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) - ((equal cl-list1 cl-list2) cl-list1) - (t - (or (>= (length cl-list1) (length cl-list2)) - (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1)))) - (while cl-list2 - (if (or cl-keys (numberp (car cl-list2))) - (setq cl-list1 (apply 'adjoin (car cl-list2) cl-list1 cl-keys)) - (or (memq (car cl-list2) cl-list1) - (push (car cl-list2) cl-list1))) - (pop cl-list2)) - cl-list1))) +The result is \"stable\" in that it preserves the ordering of elements in +LIST1 and LIST2. The result specifically consists of the elements in LIST1 +in order, followed by any elements in LIST2 that are not also in LIST1, in +the order given in LIST2. -(defun nunion (cl-list1 cl-list2 &rest cl-keys) - "Combine LIST1 and LIST2 using a set-union operation. -The result list contains all items that appear in either LIST1 or LIST2. -This is a destructive function; it reuses the storage of LIST1 and LIST2 -whenever possible. -Keywords supported: :test :test-not :key" - (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) - (t (apply 'union cl-list1 cl-list2 cl-keys)))) - -(defun intersection (cl-list1 cl-list2 &rest cl-keys) - "Combine LIST1 and LIST2 using a set-intersection operation. -The result list contains all items that appear in both LIST1 and LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. -Keywords supported: :test :test-not :key" - (and cl-list1 cl-list2 - (if (equal cl-list1 cl-list2) cl-list1 - (cl-parsing-keywords (:key) (:test :test-not) - (let ((cl-res nil)) - (or (>= (length cl-list1) (length cl-list2)) - (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1)))) - (while cl-list2 - (if (if (or cl-keys (numberp (car cl-list2))) - (apply 'member* (cl-check-key (car cl-list2)) - cl-list1 cl-keys) - (memq (car cl-list2) cl-list1)) - (push (car cl-list2) cl-res)) - (pop cl-list2)) - cl-res))))) + +See `union' for the meaning of :test, :test-not and :key. -(defun nintersection (cl-list1 cl-list2 &rest cl-keys) - "Combine LIST1 and LIST2 using a set-intersection operation. -The result list contains all items that appear in both LIST1 and LIST2. -This is a destructive function; it reuses the storage of LIST1 and LIST2 -whenever possible. -Keywords supported: :test :test-not :key" - (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys))) +NOTE: This is *NOT* a function defined by Common Lisp, but an XEmacs +extension. -(defun set-difference (cl-list1 cl-list2 &rest cl-keys) - "Combine LIST1 and LIST2 using a set-difference operation. -The result list contains all items that appear in LIST1 but not LIST2. -This is a non-destructive function; it makes a copy of the data if necessary -to avoid corrupting the original LIST1 and LIST2. -Keywords supported: :test :test-not :key" - (if (or (null cl-list1) (null cl-list2)) cl-list1 - (cl-parsing-keywords (:key) (:test :test-not) - (let ((cl-res nil)) - (while cl-list1 - (or (if (or cl-keys (numberp (car cl-list1))) - (apply 'member* (cl-check-key (car cl-list1)) - cl-list2 cl-keys) - (memq (car cl-list1) cl-list2)) - (push (car cl-list1) cl-res)) - (pop cl-list1)) - cl-res)))) +arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)" + ;; The standard `union' doesn't produce a "stable" union -- + ;; it iterates over the second list instead of the first one, and returns + ;; the values in backwards order. According to the CLTL2 documentation, + ;; `union' is not required to preserve the ordering of elements in + ;; any fashion, so we add a new function rather than changing the + ;; semantics of `union'. + (apply 'union cl-list1 cl-list2 :stable t cl-keys)) -(defun nset-difference (cl-list1 cl-list2 &rest cl-keys) - "Combine LIST1 and LIST2 using a set-difference operation. -The result list contains all items that appear in LIST1 but not LIST2. -This is a destructive function; it reuses the storage of LIST1 and LIST2 -whenever possible. -Keywords supported: :test :test-not :key" - (if (or (null cl-list1) (null cl-list2)) cl-list1 - (apply 'set-difference cl-list1 cl-list2 cl-keys))) +;; XEmacs addition: NOT IN COMMON LISP. +(defun stable-intersection (cl-list1 cl-list2 &rest cl-keys) + "Stably combine LIST1 and LIST2 using a set-intersection operation. -(defun set-exclusive-or (cl-list1 cl-list2 &rest cl-keys) - "Combine LIST1 and LIST2 using a set-exclusive-or operation. -The result list contains all items that appear in exactly one of LIST1, LIST2. +The result list contains all items that appear in both LIST1 and LIST2. +The result is \"stable\" in that it preserves the ordering of elements in +LIST1 that are also in LIST2. + This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. -Keywords supported: :test :test-not :key" - (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) - ((equal cl-list1 cl-list2) nil) - (t (append (apply 'set-difference cl-list1 cl-list2 cl-keys) - (apply 'set-difference cl-list2 cl-list1 cl-keys))))) + +See `union' for the meaning of :test, :test-not and :key. + +NOTE: This is *NOT* a function defined by Common Lisp, but an XEmacs +extension. -(defun nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys) - "Combine LIST1 and LIST2 using a set-exclusive-or operation. -The result list contains all items that appear in exactly one of LIST1, LIST2. -This is a destructive function; it reuses the storage of LIST1 and LIST2 -whenever possible. -Keywords supported: :test :test-not :key" - (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) - ((equal cl-list1 cl-list2) nil) - (t (nconc (apply 'nset-difference cl-list1 cl-list2 cl-keys) - (apply 'nset-difference cl-list2 cl-list1 cl-keys))))) +arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)" + ;; The standard `intersection' doesn't produce a "stable" intersection -- + ;; it iterates over the second list instead of the first one, and returns + ;; the values in backwards order. According to the CLTL2 documentation, + ;; `intersection' is not required to preserve the ordering of elements in + ;; any fashion, but it's trivial to implement a stable ordering in C, + ;; given that the order of arguments to the test function is specified. + (apply 'intersection cl-list1 cl-list2 :stable t cl-keys)) + +(defun subst-if (cl-new cl-predicate cl-tree &rest cl-keys) + "Substitute NEW for elements matching PREDICATE in TREE (non-destructively). -(defun subsetp (cl-list1 cl-list2 &rest cl-keys) - "True if LIST1 is a subset of LIST2. -I.e., if every element of LIST1 also appears in LIST2. -Keywords supported: :test :test-not :key" - (cond ((null cl-list1) t) ((null cl-list2) nil) - ((equal cl-list1 cl-list2) t) - (t (cl-parsing-keywords (:key) (:test :test-not) - (while (and cl-list1 - (apply 'member* (cl-check-key (car cl-list1)) - cl-list2 cl-keys)) - (pop cl-list1)) - (null cl-list1))))) +Return a copy of TREE with all matching elements replaced by NEW. If no +element matches PREDICATE, return tree. + +See `member*' for the meaning of :key. -(defun subst-if (cl-new cl-pred cl-tree &rest cl-keys) - "Substitute NEW for elements matching PREDICATE in TREE (non-destructively). -Return a copy of TREE with all matching elements replaced by NEW. -Keywords supported: :key" - (apply 'sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys)) +arguments: (NEW PREDICATE TREE &key (KEY #'identity))" + (apply 'subst cl-new 'subst cl-tree :if cl-predicate cl-keys)) + +(defun subst-if-not (cl-new cl-predicate cl-tree &rest cl-keys) + "Substitute NEW for elements not matching PREDICATE in TREE. -(defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys) - "Substitute NEW for elts not matching PREDICATE in TREE (non-destructively). -Return a copy of TREE with all non-matching elements replaced by NEW. -Keywords supported: :key" - (apply 'sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys)) +Return a copy of TREE with all matching elements replaced by NEW. If every +element matches PREDICATE, return tree. + +See `member*' for the meaning of :key. -(defun nsubst (cl-new cl-old cl-tree &rest cl-keys) - "Substitute NEW for OLD everywhere in TREE (destructively). -Any element of TREE which is `eql' to OLD is changed to NEW (via a call -to `setcar'). -Keywords supported: :test :test-not :key" - (apply 'nsublis (list (cons cl-old cl-new)) cl-tree cl-keys)) +arguments: (NEW PREDICATE TREE &key (KEY #'identity))" + (apply 'subst cl-new 'subst cl-tree :if-not cl-predicate cl-keys)) -(defun nsubst-if (cl-new cl-pred cl-tree &rest cl-keys) +(defun nsubst-if (cl-new cl-predicate cl-tree &rest cl-keys) "Substitute NEW for elements matching PREDICATE in TREE (destructively). -Any element of TREE which matches is changed to NEW (via a call to `setcar'). -Keywords supported: :key" - (apply 'nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys)) -(defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys) - "Substitute NEW for elements not matching PREDICATE in TREE (destructively). Any element of TREE which matches is changed to NEW (via a call to `setcar'). -Keywords supported: :key" - (apply 'nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys)) -(defun sublis (cl-alist cl-tree &rest cl-keys) - "Perform substitutions indicated by ALIST in TREE (non-destructively). -Return a copy of TREE with all matching elements replaced. -Keywords supported: :test :test-not :key" - (cl-parsing-keywords (:test :test-not :key :if :if-not) () - (cl-sublis-rec cl-tree))) +See `member*' for the meaning of :key. -(defvar cl-alist) -(defun cl-sublis-rec (cl-tree) ; uses cl-alist/key/test*/if* - (let ((cl-temp (cl-check-key cl-tree)) (cl-p cl-alist)) - (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp))) - (setq cl-p (cdr cl-p))) - (if cl-p (cdr (car cl-p)) - (if (consp cl-tree) - (let ((cl-a (cl-sublis-rec (car cl-tree))) - (cl-d (cl-sublis-rec (cdr cl-tree)))) - (if (and (eq cl-a (car cl-tree)) (eq cl-d (cdr cl-tree))) - cl-tree - (cons cl-a cl-d))) - cl-tree)))) +arguments: (NEW PREDICATE TREE &key (KEY #'identity))" + (apply 'nsubst cl-new 'nsubst cl-tree :if cl-predicate cl-keys)) -(defun nsublis (cl-alist cl-tree &rest cl-keys) - "Perform substitutions indicated by ALIST in TREE (destructively). -Any matching element of TREE is changed via a call to `setcar'. -Keywords supported: :test :test-not :key" - (cl-parsing-keywords (:test :test-not :key :if :if-not) () - (let ((cl-hold (list cl-tree))) - (cl-nsublis-rec cl-hold) - (car cl-hold)))) +(defun nsubst-if-not (cl-new cl-predicate cl-tree &rest cl-keys) + "Substitute NEW for elements not matching PREDICATE in TREE (destructively). + +Any element of TREE which matches is changed to NEW (via a call to `setcar'). -(defun cl-nsublis-rec (cl-tree) ; uses cl-alist/temp/p/key/test*/if* - (while (consp cl-tree) - (let ((cl-temp (cl-check-key (car cl-tree))) (cl-p cl-alist)) - (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp))) - (setq cl-p (cdr cl-p))) - (if cl-p (setcar cl-tree (cdr (car cl-p))) - (if (consp (car cl-tree)) (cl-nsublis-rec (car cl-tree)))) - (setq cl-temp (cl-check-key (cdr cl-tree)) cl-p cl-alist) - (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp))) - (setq cl-p (cdr cl-p))) - (if cl-p - (progn (setcdr cl-tree (cdr (car cl-p))) (setq cl-tree nil)) - (setq cl-tree (cdr cl-tree)))))) +See `member*' for the meaning of :key. -(defun tree-equal (cl-x cl-y &rest cl-keys) - "Return t if trees X and Y have `eql' leaves. -Atoms are compared by `eql'; cons cells are compared recursively. -Keywords supported: :test :test-not :key" - (cl-parsing-keywords (:test :test-not :key) () - (cl-tree-equal-rec cl-x cl-y))) - -(defun cl-tree-equal-rec (cl-x cl-y) - (while (and (consp cl-x) (consp cl-y) - (cl-tree-equal-rec (car cl-x) (car cl-y))) - (setq cl-x (cdr cl-x) cl-y (cdr cl-y))) - (and (not (consp cl-x)) (not (consp cl-y)) (cl-check-match cl-x cl-y))) - - -(run-hooks 'cl-seq-load-hook) +arguments: (NEW PREDICATE TREE &key (KEY #'identity))" + (apply 'nsubst cl-new 'nsubst cl-tree :if-not cl-predicate cl-keys)) ;;; arch-tag: ec1cc072-9006-4225-b6ba-d6b07ed1710c ;;; cl-seq.el ends here diff -r 861f2601a38b -r 1f0b15040456 lisp/cl.el --- a/lisp/cl.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/cl.el Sun May 01 18:44:03 2011 +0100 @@ -1,6 +1,7 @@ ;;; cl.el --- Common Lisp extensions for XEmacs Lisp ;; Copyright (C) 1993, 1997 Free Software Foundation, Inc. +;; Copyright (C) 2010 Ben Wing. ;; Author: Dave Gillespie ;; Maintainer: XEmacs Development Team @@ -9,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 21.3. @@ -98,17 +97,9 @@ ;;; Code: -(defvar cl-emacs-type (cond ((or (and (fboundp 'epoch::version) - (symbol-value 'epoch::version)) - (string-lessp emacs-version "19")) 18) - ((string-match "XEmacs" emacs-version) - 'lucid) - (t 19))) - (defvar cl-optimize-speed 1) (defvar cl-optimize-safety 1) - (defvar custom-print-functions nil "This is a list of functions that format user objects for printing. Each function is called in turn with three arguments: the object, the @@ -119,7 +110,6 @@ This variable is not used at present, but it is defined in hopes that a future Emacs interpreter will be able to use it.") - ;;; Predicates. (defun eql (a b) ; See compiler macro in cl-macs.el @@ -179,7 +169,8 @@ "Add NEWELT at the beginning of LISTNAME, unless it's already in LISTNAME. Like (push NEWELT LISTNAME), except that the list is unmodified if NEWELT is `eql' to an element already on the list. -Keywords supported: :test :test-not :key" +Keywords supported: :test :test-not :key +See `member*' for the meaning of :test, :test-not and :key." (if (symbolp listname) (list 'setq listname (list* 'adjoin newelt listname keys)) (list* 'callf2 'adjoin newelt listname keys))) @@ -204,7 +195,6 @@ val (and (< end (length str)) (substring str end)))) - ;;; Control structures. ;; The macros `when' and `unless' are so useful that we want them to @@ -213,20 +203,6 @@ (defalias 'cl-map-extents 'map-extents) - -;;; Blocks and exits. - -;; This used to be #'identity, but that didn't preserve multiple values in -;; interpreted code. #'and isn't great either, there's no error on too many -;; arguments passed to it when interpreted. Fortunately most of the places -;; where cl-block-wrapper is called are generated from old, established -;; macros, so too many arguments resulting from human error is unlikely; and -;; the byte compile handler in cl-macs.el warns if more than one arg is -;; passed to it. -(defalias 'cl-block-wrapper 'and) - -(defalias 'cl-block-throw 'throw) - ;;; XEmacs; multiple values are in eval.c and cl-macs.el. ;;; We no longer support `multiple-value-apply', which was ill-conceived to @@ -251,14 +227,19 @@ The second optional arg ENVIRONMENT specifies an environment of macro definitions to shadow the loaded ones for use in file byte-compilation." - (let ((cl-macro-environment cl-env)) - (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env)) + (let ((cl-macro-environment + (if cl-macro-environment (append cl-env cl-macro-environment) cl-env)) + eq-hash) + (while (progn (setq cl-macro + (macroexpand-internal cl-macro cl-macro-environment)) (and (symbolp cl-macro) - (cdr (assq (symbol-name cl-macro) cl-env)))) - (setq cl-macro (cadr (assq (symbol-name cl-macro) cl-env)))) + (setq eq-hash (eq-hash cl-macro)) + (if (fixnump eq-hash) + (assq eq-hash cl-macro-environment) + (assoc eq-hash cl-macro-environment)))) + (setq cl-macro (cadr (assoc* eq-hash cl-macro-environment)))) cl-macro)) - ;;; Declarations. (defvar cl-compiling-file nil) @@ -287,7 +268,6 @@ (if (cl-compiling-file) (list* 'eval-when '(compile load eval) body) (cons 'progn body)))) ; avoid loading cl-macs.el for eval-when - ;;; Symbols. (defun cl-random-time () @@ -336,11 +316,11 @@ (defun oddp (integer) "Return t if INTEGER is odd." - (eq (logand integer 1) 1)) + (eql (logand integer 1) 1)) (defun evenp (integer) "Return t if INTEGER is even." - (eq (logand integer 1) 0)) + (eql (logand integer 1) 0)) ;; XEmacs addition (defalias 'cl-abs 'abs) @@ -353,20 +333,43 @@ (defconst most-negative-float nil "The float closest in value to negative infinity.") (defconst least-positive-float nil - "The positive float closest in value to 0.") + "The positive float closest in value to zero.") (defconst least-negative-float nil - "The negative float closest in value to 0.") -(defconst least-positive-normalized-float nil) -(defconst least-negative-normalized-float nil) -(defconst float-epsilon nil) -(defconst float-negative-epsilon nil) + "The negative float closest in value to zero.") +(defconst least-positive-normalized-float nil + "The normalized positive float closest in value to zero. + +A float is normalized if the most significant bit of its mantissa is 1. +Use of denormalized (equivalently, subnormal) floats in calculations will +lead to gradual underflow, though they can be more accurate in representing +individual small values. Normal and subnormal floats are as described in +IEEE 754.") + +(defconst least-negative-normalized-float nil + "The normalized negative float closest in value to zero. +See `least-positive-normalized-float' for details of normal and denormalized +numbers.") + +(defconst float-epsilon nil + "The smallest float guaranteed not `eql' to 1.0 when added to 1.0. + +That is, (eql 1.0 (+ 1.0 X)) will always give nil if (<= float-epsilon X) , +but it may give t for smaller values.") + +(defconst float-negative-epsilon nil + "The smallest float guaranteed not `eql' to 1.0 when subtracted from 1.0. + +That is, (eql 1.0 (- 1.0 X)) will always give nil if (<= +float-negative-epsilon X) , but it may give t for smaller values.") ;;; Sequence functions. (defalias 'copy-seq 'copy-sequence) -(defalias 'svref 'aref) +;; XEmacs; #'mapcar* is in C. + +(defalias 'svref 'aref) ;; Compiler macro in cl-macs.el ;;; List functions. @@ -375,7 +378,13 @@ (defalias 'first 'car) (defalias 'rest 'cdr) -(defalias 'endp 'null) + +;; XEmacs change; this needs to error if handed a non-list. +(defun endp (list) + "Return t if LIST is nil, or nil if LIST is a cons. Error otherwise." + (prog1 + (null list) + (and list (atom list) (error 'wrong-type-argument #'listp list)))) ;; XEmacs change: make it a real function (defun second (x) @@ -420,7 +429,7 @@ (car (car x))) (defun cadr (x) - "Return the `car' of the `cdr' of X." + "Return the `car' of the `cdr' of X. Equivalent to `(second X)'." (car (cdr x))) (defun cdar (x) @@ -444,7 +453,8 @@ (car (cdr (car x)))) (defun caddr (x) - "Return the `car' of the `cdr' of the `cdr' of X." + "Return the `car' of the `cdr' of the `cdr' of X. +Equivalent to `(third X)'." (car (cdr (cdr x)))) (defun cdaar (x) @@ -492,7 +502,8 @@ (car (cdr (cdr (car x))))) (defun cadddr (x) - "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X." + "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X. +Equivalent to `(fourth X)'." (car (cdr (cdr (cdr x))))) (defun cdaaar (x) @@ -528,51 +539,32 @@ (cdr (cdr (cdr (cdr x))))) ;;; `last' is implemented as a C primitive, as of 1998-11 -;;(defun last* (x &optional n) -;; "Returns the last link in the list LIST. -;;With optional argument N, returns Nth-to-last link (default 1)." -;; (if n -;; (let ((m 0) (p x)) -;; (while (consp p) (incf m) (pop p)) -;; (if (<= n 0) p -;; (if (< n m) (nthcdr (- m n) x) x))) -;; (while (consp (cdr x)) (pop x)) -;; x)) + +;;; XEmacs: `list*' is in subr.el. + +;; XEmacs; handle dotted lists properly, error on circularity and if LIST is +;; not a list. +(defun ldiff (list sublist) + "Return a copy of LIST with the tail SUBLIST removed. -(defun list* (arg &rest rest) ; See compiler macro in cl-macs.el - "Return a new list with specified args as elements, cons'd to last arg. -Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to -`(cons A (cons B (cons C D)))'." - (cond ((not rest) arg) - ((not (cdr rest)) (cons arg (car rest))) - (t (let* ((n (length rest)) - (copy (copy-sequence rest)) - (last (nthcdr (- n 2) copy))) - (setcdr last (car (cdr last))) - (cons arg copy))))) - -(defun ldiff (list sublist) - "Return a copy of LIST with the tail SUBLIST removed." - (let ((res nil)) - (while (and (consp list) (not (eq list sublist))) - (push (pop list) res)) - (nreverse res))) +If SUBLIST is the same Lisp object as LIST, return nil. If SUBLIST is +not present in the list structure of LIST (that is, it is not the cdr +of some cons making up LIST), this function is equivalent to +`copy-list'. LIST may be dotted." + (check-argument-type #'listp list) + (and list (not (eq list sublist)) + (let ((before list) (evenp t) result) + (prog1 + (setq result (list (car list))) + (while (and (setq list (cdr-safe list)) (not (eql list sublist))) + (setcdr result (if (consp list) (list (car list)) list)) + (setq result (cdr result) + evenp (not evenp)) + (if evenp (setq before (cdr before))) + (if (eq before list) (error 'circular-list list))))))) ;;; `copy-list' is implemented as a C primitive, as of 1998-11 -;(defun copy-list (list) -; "Return a copy of a list, which may be a dotted list. -;The elements of the list are not copied, just the list structure itself." -; (if (consp list) -; (let ((res nil)) -; (while (consp list) (push (pop list) res)) -; (prog1 (nreverse res) (setcdr res list))) -; (car list))) - -(defun cl-maclisp-member (item list) - (while (and list (not (equal item (car list)))) (setq list (cdr list))) - list) - (defalias 'cl-member 'memq) ; for compatibility with old CL package (defalias 'cl-floor 'floor*) (defalias 'cl-ceiling 'ceiling*) @@ -580,46 +572,33 @@ (defalias 'cl-round 'round*) (defalias 'cl-mod 'mod*) -(defun adjoin (cl-item cl-list &rest cl-keys) ; See compiler macro in cl-macs - "Return ITEM consed onto the front of LIST only if it's not already there. -Otherwise, return LIST unmodified. -Keywords supported: :test :test-not :key" - (cond ((or (equal cl-keys '(:test eq)) - (and (null cl-keys) (not (numberp cl-item)))) - (if (memq cl-item cl-list) cl-list (cons cl-item cl-list))) - ((or (equal cl-keys '(:test equal)) (null cl-keys)) - (if (member cl-item cl-list) cl-list (cons cl-item cl-list))) - (t (apply 'cl-adjoin cl-item cl-list cl-keys)))) +;;; XEmacs; #'acons is in C. -(defun subst (cl-new cl-old cl-tree &rest cl-keys) - "Substitute NEW for OLD everywhere in TREE (non-destructively). -Return a copy of TREE with all elements `eql' to OLD replaced by NEW. -Keywords supported: :test :test-not :key" - (if (or cl-keys (and (numberp cl-old) (not (fixnump cl-old)))) - (apply 'sublis (list (cons cl-old cl-new)) cl-tree cl-keys) - (cl-do-subst cl-new cl-old cl-tree))) - -(defun cl-do-subst (cl-new cl-old cl-tree) - (cond ((eq cl-tree cl-old) cl-new) - ((consp cl-tree) - (let ((a (cl-do-subst cl-new cl-old (car cl-tree))) - (d (cl-do-subst cl-new cl-old (cdr cl-tree)))) - (if (and (eq a (car cl-tree)) (eq d (cdr cl-tree))) - cl-tree (cons a d)))) - (t cl-tree))) - -(defun acons (a b c) - "Return a new alist created by adding (KEY . VALUE) to ALIST." - (cons (cons a b) c)) - -(defun pairlis (a b &optional c) (nconc (mapcar* 'cons a b) c)) - +(defun pairlis (keys values &optional alist) + "Make an alist from KEYS and VALUES. +Return a new alist composed by associating KEYS to corresponding VALUES; +the process stops as soon as KEYS or VALUES run out. +If ALIST is non-nil, the new pairs are prepended to it." + (nconc (mapcar* 'cons keys values) alist)) ;;; Miscellaneous. ;; XEmacs change (define-error 'cl-assertion-failed "Assertion failed") +;; XEmacs; provide a milquetoast amount of compatibility in our error symbols. +(define-error 'type-error "Wrong type" 'wrong-type-argument) +(define-error 'program-error "Error in your program" 'invalid-argument) + +(map-plist + #'(lambda (key value) + (mapc #'(lambda (error) + (put error 'error-conditions + (cons key (get error 'error-conditions)))) + value)) + '(program-error (wrong-number-of-arguments invalid-keyword-argument) + type-error (wrong-type-argument malformed-list circular-list))) + ;; XEmacs change: omit the autoload rules; we handle those a different way ;;; Define data for indentation and edebug. @@ -663,10 +642,8 @@ ((loop) defun (&rest &or symbolp form)) ((ignore-errors) 0 (&rest form)))) - ;;; This goes here so that cl-macs can find it if it loads right now. -(provide 'cl-19) ; usage: (require 'cl-19 "cl") - +(provide 'cl-19) ;;; Things to do after byte-compiler is loaded. ;;; As a side effect, we cause cl-macs to be loaded when compiling, so diff -r 861f2601a38b -r 1f0b15040456 lisp/cmdloop.el --- a/lisp/cmdloop.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/cmdloop.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.30. (Some of the stuff below is in FSF's subr.el.) ;;; Some parts synched with FSF 21.2. @@ -148,7 +146,7 @@ (message nil) (ding nil (cond ((eq etype 'undefined-keystroke-sequence) (if (and (vectorp (nth 1 error-object)) - (/= 0 (length (nth 1 error-object))) + (not (eql 0 (length (nth 1 error-object)))) (button-event-p (aref (nth 1 error-object) 0))) 'undefined-click 'undefined-key)) @@ -301,16 +299,32 @@ :group 'keyboard) ;That damn RMS went off and implemented something differently, after -;we had already implemented it. We can't support both properly until -;we have Lisp magic variables. -;(defvar suggest-key-bindings t -; "*FSFmacs equivalent of `teach-extended-commands-*'. -;Provided for compatibility only. -;Non-nil means show the equivalent key-binding when M-x command has one. -;The value can be a length of time to show the message for. -;If the value is non-nil and not a number, we wait 2 seconds.") -; -;(make-obsolete-variable 'suggest-key-bindings 'teach-extended-commands-p) +;we had already implemented it. +(defcustom suggest-key-bindings t + "*FSFmacs equivalent of `teach-extended-commands-p'. +Provided for compatibility only. +Non-nil means show the equivalent key-binding when M-x command has one. +The value can be a length of time to show the message for, in seconds. + +If the value is non-nil and not a number, we wait the number of seconds +specified by `teach-extended-commands-timeout'." + :type '(choice + (const :tag "off" nil) + (integer :tag "time" 2) + (other :tag "on")) + :group 'keyboard) + +(dontusethis-set-symbol-value-handler + 'suggest-key-bindings + 'set-value + #'(lambda (sym args fun harg handler) + (setq args (car args)) + (if (null args) + (setq teach-extended-commands-p nil) + (setq teach-extended-commands-p t + teach-extended-commands-timeout + (or (and (integerp args) args) + (and args teach-extended-commands-timeout)))))) (defun execute-extended-command (prefix-arg) "Read a command name from the minibuffer using 'completing-read'. @@ -455,7 +469,7 @@ (single-key-description event)) (ding nil 'y-or-n-p) (discard-input) - (if (= (length pre) 0) + (if (eql (length pre) 0) (setq pre (gettext "Please answer y or n. "))))))) yn))) @@ -492,7 +506,7 @@ ;; and-fboundp is redundant, since yes-or-no-p-dialog-box is only ;; bound if (featurep 'dialog). But it eliminates a compile-time ;; warning. - (and-fboundp #'yes-or-no-p-dialog-box (yes-or-no-p-dialog-box prompt)) + (and-fboundp 'yes-or-no-p-dialog-box (yes-or-no-p-dialog-box prompt)) (yes-or-no-p-minibuf prompt))) (defun y-or-n-p (prompt) @@ -549,12 +563,7 @@ ;; BEGIN SYNCHED WITH FSF 21.2. -(defvar read-quoted-char-radix 8 - "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'. -Legitimate radix values are 8, 10 and 16.") - -(custom-declare-variable-early - 'read-quoted-char-radix 8 +(defcustom read-quoted-char-radix 8 "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'. Legitimate radix values are 8, 10 and 16." :type '(choice (const 8) (const 10) (const 16)) diff -r 861f2601a38b -r 1f0b15040456 lisp/code-cmds.el --- a/lisp/code-cmds.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/code-cmds.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;; ;; This code defines the keybindings and utility commands for the diff -r 861f2601a38b -r 1f0b15040456 lisp/code-files.el --- a/lisp/code-files.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/code-files.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched. diff -r 861f2601a38b -r 1f0b15040456 lisp/code-init.el --- a/lisp/code-init.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/code-init.el Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/code-process.el --- a/lisp/code-process.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/code-process.el Sun May 01 18:44:03 2011 +0100 @@ -13,20 +13,18 @@ ;; This file is very similar to code-process.el -;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Code: diff -r 861f2601a38b -r 1f0b15040456 lisp/coding.el --- a/lisp/coding.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/coding.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: @@ -248,7 +246,7 @@ ((force-coding-system-equivalency (&rest details-list) "Certain coding-system aliases should correspond to certain variables. -This macro implements that correspondence. This gives us compatiblity with +This macro implements that correspondence. This gives us compatibility with other Mule implementations (which don't use the coding system aliases), and a certain amount of freedom of implementation for XEmacs; using a variable's value in C for every file operation or write to a terminal in C is probably @@ -378,7 +376,7 @@ (< (length result) count)) (push (if stringp (1- begin) begin) result) (incf begin)) - (when (= (length result) count) + (when (eql (length result) count) (return-from worked-it-all-out result))) ranges) (map-range-table @@ -487,6 +485,19 @@ ;; Mule's not available; (fset 'make-coding-system (symbol-function 'make-coding-system-internal)) + (define-compiler-macro make-coding-system (&whole form name type + &optional description props) + (cond + ;; We shouldn't normally see these forms under non-Mule; they're all in + ;; the mule/ subdirectory. + ((equal '(quote fixed-width) type) + form) + ((byte-compile-constp type) + `(funcall (or (and (fboundp 'make-coding-system-internal) + 'make-coding-system-internal) 'make-coding-system) + ,@(cdr form))) + (t form))) + (define-coding-system-alias 'escape-quoted 'binary) ;; These are so that gnus and friends work when not mule: diff -r 861f2601a38b -r 1f0b15040456 lisp/compat.el --- a/lisp/compat.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/compat.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -695,12 +693,7 @@ (setq tmp (cdr tmp))) (setq ovls tmp tmp nil)) - (car-safe - (sort ovls - (function - (lambda (a b) - (< (- (extent-end-position a) (extent-start-position a)) - (- (extent-end-position b) (extent-start-position b))))))))) + (car (sort* ovls #'< :key #'extent-length)))) (defun-compat map-extents (function &optional object from to maparg flags property value) @@ -732,4 +725,5 @@ (fmakunbound 'compat-define-compat-functions) + ) \ No newline at end of file diff -r 861f2601a38b -r 1f0b15040456 lisp/config.el --- a/lisp/config.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/config.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/console.el --- a/lisp/console.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/console.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/cus-dep.el --- a/lisp/cus-dep.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/cus-dep.el Sun May 01 18:44:03 2011 +0100 @@ -11,20 +11,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched with FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/cus-edit.el --- a/lisp/cus-edit.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/cus-edit.el Sun May 01 18:44:03 2011 +0100 @@ -12,20 +12,18 @@ ;; 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. +;; 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 3 of the License, or (at your +;; option) any later version. + +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: ;; @@ -870,7 +868,7 @@ ;; under point: (let ((choice (completing-read "Customize face: (default all) " obarray 'find-face))) - (if (zerop (length choice)) + (if (eql (length choice) 0) nil (list (intern choice)))) (cond ((symbolp faces) @@ -884,7 +882,7 @@ (list (symbol-name face) face)) faces) nil t))) - (if (zerop (length choice)) + (if (eql (length choice) 0) (list faces) (list (intern choice))))))))) @@ -1184,7 +1182,7 @@ (widget-insert "\n") (message "Creating customization items...") (setq custom-options - (if (= (length options) 1) + (if (eql (length options) 1) (mapcar (lambda (entry) (widget-create (nth 1 entry) :documentation-shown t @@ -2445,7 +2443,7 @@ (when (or (get symbol 'saved-value) (get symbol 'saved-variable-comment)) (put symbol 'saved-value nil) (custom-push-theme 'theme-value symbol 'user 'reset 'standard) - ;; As a special optimizations we do not (explictly) + ;; As a special optimization we do not (explicitly) ;; save resets to standard when no theme sets the value. (if (null (cdr (get symbol 'theme-value))) (put symbol 'theme-value nil)) @@ -2910,7 +2908,7 @@ (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment)) (put symbol 'saved-face nil) (custom-push-theme 'theme-face symbol 'user 'reset 'standard) - ;; Do not explictly save resets to standards without themes. + ;; Do not explicitly save resets to standards without themes. (if (null (cdr (get symbol 'theme-face))) (put symbol 'theme-face nil)) (put symbol 'saved-face-comment nil) @@ -2985,7 +2983,7 @@ (face-list)) nil nil nil 'face-history))) - (unless (zerop (length answer)) + (unless (eql (length answer) 0) (widget-value-set widget (intern answer)) (widget-apply widget :notify widget event) (widget-setup)))) @@ -3174,7 +3172,7 @@ (insert " " tag "\n") (widget-put widget :buttons buttons)) ((and (eq custom-buffer-style 'tree) - (zerop (length members))) + (eql (length members) 0)) (custom-browse-insert-prefix prefix) (insert "[ ]-- ") ;; (widget-glyph-insert nil "[ ]" "empty") @@ -3187,7 +3185,7 @@ ((eq custom-buffer-style 'tree) (custom-browse-insert-prefix prefix) (custom-load-widget widget) - (if (zerop (length members)) + (if (eql (length members) 0) (progn (custom-browse-insert-prefix prefix) (insert "[ ]-- ") diff -r 861f2601a38b -r 1f0b15040456 lisp/cus-face.el --- a/lisp/cus-face.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/cus-face.el Sun May 01 18:44:03 2011 +0100 @@ -1,6 +1,7 @@ ;;; cus-face.el -- Support for Custom faces. ;; ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. +;; Copyright (C) 2010 Didier Verna ;; ;; Author: Per Abrahamsen ;; Maintainer: Hrvoje Niksic @@ -8,6 +9,21 @@ ;; Version: 1.9960-x ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ +;; 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 3 of the License, 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. If not, see . + ;;; Synched with: Not synched. ;;; Commentary: @@ -83,7 +99,12 @@ :help-echo "\ Name of background pixmap file.") set-face-background-pixmap custom-face-background-pixmap) - (:dim (toggle :format "%[Dim%]: %v\n" + (:background-placement (choice :tag "Background placement" :value relative + (const :tag "Relative" :value relative) + (const :tag "Absolute" :value absolute)) + set-face-background-placement + face-background-placement) + (:dim (toggle :format "%[Dim%]: %v\n" :help-echo "Control whether the text should be dimmed.") set-face-dim-p face-dim-p) (:bold (toggle :format "%[Bold%]: %v\n" diff -r 861f2601a38b -r 1f0b15040456 lisp/cus-file.el --- a/lisp/cus-file.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/cus-file.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF @@ -33,17 +31,14 @@ ;;; Code: (provide 'cus-file) -;;;###autoload (defconst custom-file-base "custom.el" "Base of file name for storing customization information.") -;;;###autoload (defvar custom-file nil "File used for storing customization information. If you change this from the default you need to explicitly load that file for the settings to take effect.") -;;;###autoload (defun make-custom-file-name (init-file &optional force-new) "Construct the default custom file name from the init file name. If FORCE-NEW is non-nil, force post-migration location." diff -r 861f2601a38b -r 1f0b15040456 lisp/cus-load.el --- a/lisp/cus-load.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/cus-load.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF diff -r 861f2601a38b -r 1f0b15040456 lisp/cus-start.el --- a/lisp/cus-start.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/cus-start.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched with FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/custom.el --- a/lisp/custom.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/custom.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched with: FSF 21.3. @@ -44,12 +42,10 @@ (provide 'custom) (eval-when-compile - (load "cl-macs" nil t) ;; To elude warnings. (require 'cus-face)) (autoload 'custom-declare-face "cus-face") -(autoload 'defun* "cl-macs") (require 'widget) @@ -183,7 +179,7 @@ ((eq keyword :require) (push value requests)) ((eq keyword :type) - (put symbol 'custom-type (purecopy value))) + (put symbol 'custom-type value)) ((eq keyword :options) (if (get symbol 'custom-options) ;; Slow safe code to avoid duplicates. @@ -327,6 +323,9 @@ `class' (the frame's color support) Should be one of `color', `grayscale', or `mono'. +`min-colors' (the minimum number of colors the frame supports) + Should be in integer which is compared to `display-color-cells' + `background' (what color is used for the background text) Should be one of `light' or `dark'. @@ -408,6 +407,9 @@ (defun custom-add-to-group (group option widget) "To existing GROUP add a new OPTION of type WIDGET. If there already is an entry for OPTION and WIDGET, nothing is done." + (or group (display-warning 'custom + (format "custom: widget %s, option %s has no associated group" + widget option))) (let ((members (get group 'custom-group)) (entry (list option widget))) (unless (member entry members) @@ -1056,12 +1058,7 @@ ;;; The End. -;; Process the defcustoms for variables loaded before this file. -;; `custom-declare-variable-list' is defvar'd in subr.el. Utility programs -;; run from temacs that do not load subr.el should defvar it themselves. -;; (As of 21.5.11, make-docfile.el.) -(while custom-declare-variable-list - (apply 'custom-declare-variable (car custom-declare-variable-list)) - (setq custom-declare-variable-list (cdr custom-declare-variable-list))) +;; XEmacs; we order preloaded-file-list such that there's no need for +;; custom-declare-variable-list. ;; custom.el ends here diff -r 861f2601a38b -r 1f0b15040456 lisp/derived.el --- a/lisp/derived.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/derived.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 21.3. diff -r 861f2601a38b -r 1f0b15040456 lisp/descr-text.el --- a/lisp/descr-text.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/descr-text.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with XEmacs. If not, see . ;;; Commentary: @@ -257,14 +255,6 @@ file)) ;; XEmacs additions, from here until `describe-char-unicode-data' -(defcustom describe-char-use-cache t - "Whether `describe-char' should use a DBM or Berkeley DB cache. -This speeds up navigation of `describe-char-unicodedata-file', and makes -navigation of `describe-char-unihan-file' reasonable." - :group 'mule - :type '(choice (const :tag "None" nil) - file)) - (defcustom describe-char-unihan-file nil "Location of Unihan file. This the Unihan.txt file from the Unicode Consortium, used for diagnostics. @@ -290,6 +280,14 @@ (and (featurep 'berkeley-db) 'berkeley-db)) "The DB format to use for the `describe-char' cache, or nil if no cache.") +(defcustom describe-char-use-cache (not (null unidata-database-format)) + "Whether `describe-char' should use a DBM or Berkeley DB cache. +This speeds up navigation of `describe-char-unicodedata-file', and makes +navigation of `describe-char-unihan-file' reasonable." + :group 'mule + :type '(choice (const :tag "None" nil) + file)) + (defvar describe-char-unihan-field-descriptions #s(hash-table :test equal :data ("kAccountingNumeric" @@ -457,98 +455,100 @@ (check-argument-type #'file-readable-p unidata-file-name) (unless unidata-database-format (error 'unimplemented "No (non-SQL) DB support available")) - (let* ((database-format unidata-database-format) - (size (eighth (file-attributes unidata-file-name))) - (database-file-name - (unidata-generate-database-file-name unidata-file-name - size database-format)) - (database-handle (open-database database-file-name database-format - nil "rw+" #o644 'no-conversion-unix)) - (coding-system-for-read 'no-conversion-unix) - (buffer-size 32768) - (offset-start 0) - (offset-end buffer-size) - (range-information (make-range-table 'start-closed-end-closed)) - (range-staging (make-hash-table :test 'equal)) - (message "Initializing UnicodeData database cache: ") - (loop-count 1) - range-startinfo) - (with-temp-buffer - (progress-feedback-with-label 'describe-char-unicodedata-file - "%s" 0 message) - (while (progn - (delete-region (point-min) (point-max)) - (insert-file-contents unidata-file-name nil - offset-start offset-end) - ;; If we've reached the end of the data, pass nil back to - ;; the while loop test. - (not (= (point-min) (point-max)))) + (with-fboundp '(open-database put-database close-database) + (let* ((database-format unidata-database-format) + (size (eighth (file-attributes unidata-file-name))) + (database-file-name + (unidata-generate-database-file-name unidata-file-name + size database-format)) + (database-handle (open-database database-file-name database-format + nil "rw+" #o644 + 'no-conversion-unix)) + (coding-system-for-read 'no-conversion-unix) + (buffer-size 32768) + (offset-start 0) + (offset-end buffer-size) + (range-information (make-range-table 'start-closed-end-closed)) + (range-staging (make-hash-table :test 'equal)) + (message "Initializing UnicodeData database cache: ") + (loop-count 1) + range-startinfo) + (with-temp-buffer + (progress-feedback-with-label 'describe-char-unicodedata-file + "%s" 0 message) + (while (progn + (delete-region (point-min) (point-max)) + (insert-file-contents unidata-file-name nil + offset-start offset-end) + ;; If we've reached the end of the data, pass nil back to + ;; the while loop test. + (not (= (point-min) (point-max)))) - (when (= buffer-size (- (point-max) (point-min))) - ;; If we're in the body of the file, and there's a trailing - ;; incomplete end-line, delete it, and adjust offset-end - ;; appropriately. - (goto-char (point-max)) - (search-backward "\n") - (forward-char) - (delete-region (point) (point-max)) - (setq offset-end (+ offset-start (- (point) (point-min))))) + (when (= buffer-size (- (point-max) (point-min))) + ;; If we're in the body of the file, and there's a trailing + ;; incomplete end-line, delete it, and adjust offset-end + ;; appropriately. + (goto-char (point-max)) + (search-backward "\n") + (forward-char) + (delete-region (point) (point-max)) + (setq offset-end (+ offset-start (- (point) (point-min))))) - (progress-feedback-with-label 'describe-char-unicodedata-file - "%s" (truncate - (* (/ offset-start size) 100)) - (concat message - (make-string - (mod loop-count 39) ?.))) - (incf loop-count) - (goto-char (point-min)) - (while (re-search-forward - #r"^\([0-9A-F]\{4,6\}\);\([^;]*\);.*$" nil t) - (cond - ((and (> (- (match-end 2) (match-beginning 2)) 7) - (equal (substring (match-string 2) -7) - " First>")) - ;; Start of a range. Save the start info in range-staging. - (puthash (substring (match-string 2) 0 -7) - (list (string-to-int (match-string 1) 16) - (+ offset-start (1- (match-beginning 0)))) - range-staging)) - ((and (> (- (match-end 2) (match-beginning 2)) 7) - (equal (substring (match-string 2) -6) - " Last>")) - ;; End of a range. Combine with the start info, save it to the - ;; range-information range table. - (setq range-startinfo - (gethash (substring (match-string 2) 0 -6) range-staging)) - (assert range-startinfo nil - "Unexpected order for range information.") - (put-range-table - (first range-startinfo) - (string-to-int (match-string 1) 16) - (list (second range-startinfo) + (progress-feedback-with-label 'describe-char-unicodedata-file + "%s" (truncate + (* (/ offset-start size) 100)) + (concat message + (make-string + (mod loop-count 39) ?.))) + (incf loop-count) + (goto-char (point-min)) + (while (re-search-forward + #r"^\([0-9A-F]\{4,6\}\);\([^;]*\);.*$" nil t) + (cond + ((and (> (- (match-end 2) (match-beginning 2)) 7) + (equal (substring (match-string 2) -7) + " First>")) + ;; Start of a range. Save the start info in range-staging. + (puthash (substring (match-string 2) 0 -7) + (list (string-to-int (match-string 1) 16) + (+ offset-start (1- (match-beginning 0)))) + range-staging)) + ((and (> (- (match-end 2) (match-beginning 2)) 7) + (equal (substring (match-string 2) -6) + " Last>")) + ;; End of a range. Combine with the start info, save it to the + ;; range-information range table. + (setq range-startinfo + (gethash (substring (match-string 2) 0 -6) range-staging)) + (assert range-startinfo nil + "Unexpected order for range information.") + (put-range-table + (first range-startinfo) + (string-to-int (match-string 1) 16) + (list (second range-startinfo) (+ offset-start (1- (match-end 0)))) - range-information) - (remhash (substring (match-string 2) 0 -6) range-staging)) - (t - ;; Normal character. Save the associated information in the - ;; database directly. - (put-database (match-string 1) - (format "(%d %d)" - (+ offset-start (1- (match-beginning 0))) - (+ offset-start (1- (match-end 0)))) - database-handle)))) - (goto-char (point-min)) - (setq offset-start offset-end - offset-end (+ buffer-size offset-end)))) - ;; Save the range information as such in the database. - (put-database "range-information" - (let ((print-readably t)) - (prin1-to-string range-information)) - database-handle) - (close-database database-handle) - (progress-feedback-with-label 'describe-char-unicodedata-file - "%s" 100 message) - database-file-name)) + range-information) + (remhash (substring (match-string 2) 0 -6) range-staging)) + (t + ;; Normal character. Save the associated information in the + ;; database directly. + (put-database (match-string 1) + (format "(%d %d)" + (+ offset-start (1- (match-beginning 0))) + (+ offset-start (1- (match-end 0)))) + database-handle)))) + (goto-char (point-min)) + (setq offset-start offset-end + offset-end (+ buffer-size offset-end)))) + ;; Save the range information as such in the database. + (put-database "range-information" + (let ((print-readably t)) + (prin1-to-string range-information)) + database-handle) + (close-database database-handle) + (progress-feedback-with-label 'describe-char-unicodedata-file + "%s" 100 message) + database-file-name))) (defun unidata-initialize-unihan-database (unihan-file-name) "Init the berkeley or gdbm lookup table for UNIHAN-FILE-NAME. @@ -562,116 +562,118 @@ (check-argument-type #'file-readable-p unihan-file-name) (unless unidata-database-format (error 'unimplemented "No (non-SQL) DB support available")) - (let* ((database-format unidata-database-format) - (size (eighth (file-attributes unihan-file-name))) - (database-file-name - (unidata-generate-database-file-name unihan-file-name - size database-format)) - (database-handle (open-database database-file-name database-format - nil "rw+" #o644 'no-conversion-unix)) - (coding-system-for-read 'no-conversion-unix) - (buffer-size 65536) - (offset-start 0) - (offset-end buffer-size) - (message "Initializing Unihan database cache: ") - (loop-count 1) - trailing-unicode leading-unicode character-start character-end) - (with-temp-buffer - (progress-feedback-with-label 'describe-char-unihan-file - "%s" 0 message) - (while (progn - (delete-region (point-min) (point-max)) - (insert-file-contents unihan-file-name nil - offset-start offset-end) - ;; If we've reached the end of the data, return nil to the - ;; while. - (not (= (point-min) (point-max)))) + (with-fboundp '(open-database put-database close-database) + (let* ((database-format unidata-database-format) + (size (eighth (file-attributes unihan-file-name))) + (database-file-name + (unidata-generate-database-file-name unihan-file-name + size database-format)) + (database-handle (open-database database-file-name database-format + nil "rw+" #o644 + 'no-conversion-unix)) + (coding-system-for-read 'no-conversion-unix) + (buffer-size 65536) + (offset-start 0) + (offset-end buffer-size) + (message "Initializing Unihan database cache: ") + (loop-count 1) + trailing-unicode leading-unicode character-start character-end) + (with-temp-buffer + (progress-feedback-with-label 'describe-char-unihan-file + "%s" 0 message) + (while (progn + (delete-region (point-min) (point-max)) + (insert-file-contents unihan-file-name nil + offset-start offset-end) + ;; If we've reached the end of the data, return nil to the + ;; while. + (not (= (point-min) (point-max)))) - (incf loop-count) - (progress-feedback-with-label 'describe-char-unihan-file - "%s" (truncate - (* (/ offset-start size) 100)) - (concat message - (make-string - (mod loop-count 44) ?.))) - (block 'dealing-with-chars - (when (= buffer-size (- (point-max) (point-min))) - ;; If we're in the body of the file, we need to delete the - ;; character info for the last character, and set offset-end - ;; appropriately. Otherwise, we may not be able to pick where - ;; the actual description of a character ends and - ;; begins. - ;; - ;; This breaks if any single Unihan character description is - ;; greater than the buffer size in length. - (goto-char (point-max)) - (beginning-of-line) + (incf loop-count) + (progress-feedback-with-label 'describe-char-unihan-file + "%s" (truncate + (* (/ offset-start size) 100)) + (concat message + (make-string + (mod loop-count 44) ?.))) + (block dealing-with-chars + (when (= buffer-size (- (point-max) (point-min))) + ;; If we're in the body of the file, we need to delete the + ;; character info for the last character, and set offset-end + ;; appropriately. Otherwise, we may not be able to pick where + ;; the actual description of a character ends and begins. + ;; + ;; This breaks if any single Unihan character description is + ;; greater than the buffer size in length. + (goto-char (point-max)) + (beginning-of-line) - (when (< (- (point-max) (point)) (eval-when-compile - (length "U+ABCDEF\t"))) - ;; If the character ID of the last line may have been cut off, - ;; we need to delete all of that line here. - (delete-region (point) (point-max)) - (forward-line -1)) + (when (< (- (point-max) (point)) (eval-when-compile + (length "U+ABCDEF\t"))) + ;; If the character ID of the last line may have been cut off, + ;; we need to delete all of that line here. + (delete-region (point) (point-max)) + (forward-line -1)) - (when (looking-at "^\\(U\\+[0-9A-F]\\{4,6\\}\\)\t") - (setq trailing-unicode (match-string 1) - trailing-unicode - (format "^%s\t" (regexp-quote trailing-unicode))) + (when (looking-at "^\\(U\\+[0-9A-F]\\{4,6\\}\\)\t") + (setq trailing-unicode (match-string 1) + trailing-unicode + (format "^%s\t" (regexp-quote trailing-unicode))) - (end-of-line) + (end-of-line) - ;; Go back until we hit a line that doesn't start with this - ;; character info. - (while (re-search-backward trailing-unicode nil t)) + ;; Go back until we hit a line that doesn't start with this + ;; character info. + (while (re-search-backward trailing-unicode nil t)) - ;; The re-search-backward failed, so point is still at the end - ;; of the last match. Move to its beginning. - (beginning-of-line) - (delete-region (point) (point-max)) - (setq offset-end (+ offset-start (- (point) (point-min)))))) - (goto-char (point-min)) - (while t - (when (= (point) (point-max)) - ;; We're at the end of this part of the file. - (return-from 'dealing-with-chars)) + ;; The re-search-backward failed, so point is still at the end + ;; of the last match. Move to its beginning. + (beginning-of-line) + (delete-region (point) (point-max)) + (setq offset-end (+ offset-start (- (point) (point-min)))))) + (goto-char (point-min)) + (while t + (when (= (point) (point-max)) + ;; We're at the end of this part of the file. + (return-from dealing-with-chars)) - (unless (re-search-forward "^\\(U\\+[0-9A-F]\\{4,6\\}\\)\t" - nil t) - ;; We're probably in the comments at the start of the file. No - ;; need to look for character info. - (return-from 'dealing-with-chars)) + (unless (re-search-forward "^\\(U\\+[0-9A-F]\\{4,6\\}\\)\t" + nil t) + ;; We're probably in the comments at the start of the + ;; file. No need to look for character info. + (return-from dealing-with-chars)) - ;; Store where the character started. - (beginning-of-line) - (setq character-start (point)) + ;; Store where the character started. + (beginning-of-line) + (setq character-start (point)) - (setq leading-unicode - (format "^%s\t" (regexp-quote (match-string 1)))) + (setq leading-unicode + (format "^%s\t" (regexp-quote (match-string 1)))) - ;; Loop until we get past this entry. - (while (re-search-forward leading-unicode nil t)) + ;; Loop until we get past this entry. + (while (re-search-forward leading-unicode nil t)) - ;; Now, store the information. - (setq leading-unicode - (string-to-number (substring leading-unicode 3) 16) - leading-unicode (format "%04X" leading-unicode) - character-end (prog2 (end-of-line) (point))) - (put-database leading-unicode - (format "(%d %d)" - (+ offset-start (1- character-start)) - (+ offset-start (1- character-end))) - database-handle) - (forward-line))) - (setq offset-start offset-end - offset-end (+ buffer-size offset-end)))) - (close-database database-handle) - (progress-feedback-with-label 'describe-char-unihan-file - "%s" 100 - message) - database-file-name)) + ;; Now, store the information. + (setq leading-unicode + (string-to-number (substring leading-unicode 3) 16) + leading-unicode (format "%04X" leading-unicode) + character-end (prog2 (end-of-line) (point))) + (put-database leading-unicode + (format "(%d %d)" + (+ offset-start (1- character-start)) + (+ offset-start (1- character-end))) + database-handle) + (forward-line))) + (setq offset-start offset-end + offset-end (+ buffer-size offset-end)))) + (close-database database-handle) + (progress-feedback-with-label 'describe-char-unihan-file + "%s" 100 + message) + database-file-name))) ;; End XEmacs additions. +;;;###autoload (defun describe-char-unicode-data (char) "Return a list of Unicode data for unicode CHAR. Each element is a list of a property description and the property value. @@ -686,52 +688,57 @@ (when (characterp char) (setq char (encode-char char 'ucs))) (with-temp-buffer - (if describe-char-use-cache - ;; Use the database info. - (let ((database-handle (open-database - (unidata-generate-database-file-name - describe-char-unicodedata-file - (eighth (file-attributes - describe-char-unicodedata-file)) - unidata-database-format) - unidata-database-format - nil "r" - #o644 'no-conversion-unix)) - (coding-system-for-read 'no-conversion-unix) - key lookup) - (unless database-handle - (error 'io-error - (format "Could not open %s as a %s database" + (let ((coding-system-for-read coding-system-for-read) + database-handle key lookup) + (with-fboundp '(open-database get-database close-database) + (if (and describe-char-use-cache + (prog1 + (setq database-handle + (open-database + (unidata-generate-database-file-name + describe-char-unicodedata-file + (eighth (file-attributes + describe-char-unicodedata-file)) + unidata-database-format) + unidata-database-format + nil "r" + #o644 'no-conversion-unix)) + (unless database-handle + (warn "Could not open %s as a %s database" (unidata-generate-database-file-name describe-char-unicodedata-file (eighth (file-attributes describe-char-unicodedata-file)) unidata-database-format) - unidata-database-format))) - (setq key (format "%04X" char) - lookup (get-database key database-handle)) - (if lookup - ;; Okay, we have information on that character in particular. - (progn (setq lookup (read lookup)) - (insert-file-contents describe-char-unicodedata-file nil - (first lookup) (second lookup))) - ;; No information on that character in particular. Do we have - ;; range information? If so, load and check for our desired - ;; character. - (setq lookup (get-database "range-information" database-handle) - lookup (if lookup (read lookup)) - lookup (if lookup (get-range-table char lookup))) - (when lookup - (insert-file-contents describe-char-unicodedata-file nil - (first lookup) (second lookup)))) - (close-database database-handle)) - - ;; Otherwise, insert the whole file (the FSF approach). - (set-buffer (get-buffer-create " *Unicode Data*")) - (when (zerop (buffer-size)) - ;; Don't use -literally in case of DOS line endings. - (insert-file-contents describe-char-unicodedata-file))) - + unidata-database-format)))) + (progn + ;; Use the database info. + (setq coding-system-for-read 'no-conversion-unix + key (format "%04X" char) + lookup (get-database key database-handle)) + (if lookup + ;; Okay, we have information on that character in + ;; particular. + (progn (setq lookup (read lookup)) + (insert-file-contents describe-char-unicodedata-file + nil (first lookup) + (second lookup))) + ;; No information on that character in particular. Do we + ;; have range information? If so, load and check for our + ;; desired character. + (setq lookup (get-database "range-information" + database-handle) + lookup (if lookup (read lookup)) + lookup (if lookup (get-range-table char lookup))) + (when lookup + (insert-file-contents describe-char-unicodedata-file nil + (first lookup) (second lookup)))) + (close-database database-handle)) + ;; Otherwise, insert the whole file (the FSF approach). + (set-buffer (get-buffer-create " *Unicode Data*")) + (when (zerop (buffer-size)) + ;; Don't use -literally in case of DOS line endings. + (insert-file-contents describe-char-unicodedata-file))))) (goto-char (point-min)) (let ((hex (format "%04X" char)) found first last unihan-match unihan-info unihan-database-handle @@ -753,17 +760,14 @@ last (<= char last)) (setq found t))) (if found - (let ((fields (mapcar (lambda (elt) - (if (> (length elt) 0) - elt)) - (cdr (split-string - (buffer-substring - (line-beginning-position) - (line-end-position)) - ";"))))) + (let ((fields (cdr (nsubst nil "" (split-string + (buffer-substring + (line-beginning-position) + (line-end-position)) ";") + :test 'equal)))) ;; The length depends on whether the last field was empty. - (unless (or (= 13 (length fields)) - (= 14 (length fields))) + (unless (or (eql 13 (length fields)) + (eql 14 (length fields))) (error 'invalid-argument (format "Invalid contents in %s" describe-char-unicodedata-file))) @@ -917,45 +921,46 @@ (if (and (> (length (nth 0 fields)) 13) (equal " max-width max-unicode-description-width)) (setq max-width max-unicode-description-width) (with-temp-buffer diff -r 861f2601a38b -r 1f0b15040456 lisp/device.el --- a/lisp/device.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/device.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -45,7 +43,7 @@ (defun device-list () "Return a list of all devices." - (apply 'nconc (mapcar 'console-device-list (console-list)))) + (mapcan 'console-device-list (console-list))) (defun device-type (&optional device) "Return the type of the specified device (e.g. `x' or `tty'). diff -r 861f2601a38b -r 1f0b15040456 lisp/diagnose.el --- a/lisp/diagnose.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/diagnose.el Sun May 01 18:44:03 2011 +0100 @@ -1,26 +1,24 @@ ;;; diagnose.el --- routines for debugging problems in XEmacs -;; Copyright (C) 2002 Ben Wing. +;; Copyright (C) 2002, 2010 Ben Wing. ;; Maintainer: XEmacs Development Team ;; Keywords: 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -35,29 +33,42 @@ "Show statistics about memory usage of various sorts in XEmacs." (interactive) (garbage-collect) - (flet ((show-foo-stats (objtypename objlist memfun) + (flet ((show-foo-stats (objtypename statname-plist cleanfun objlist + &optional objnamelen) (let* ((hash (make-hash-table)) (first t) - types fmt - (objnamelen 25) + types origtypes fmt + (objnamelen (or objnamelen 25)) (linelen objnamelen) (totaltotal 0)) - (dolist (obj objlist) + (loop for obj in objlist do (let ((total 0) - (stats (funcall memfun obj))) - (loop for (type . num) in stats while type do + (stats (object-memory-usage obj))) + ;; Pop off the slice describing the object itself's + ;; memory + (while (and stats (not (eq t (pop stats))))) + ;; Pop off the slice describing the associated + ;; non-Lisp-Object memory from the allocation + ;; perspective, so we can get to the slice describing + ;; the memory grouped by type + (while (and stats (pop stats))) + + (loop for (type . num) in (remq t stats) while type do + (if first (push type origtypes)) + (setq type (getf statname-plist type type)) (puthash type (+ num (or (gethash type hash) 0)) hash) (incf total num) (if first (push type types))) (incf totaltotal total) (when first (setq types (nreverse types)) + (setq origtypes (nreverse origtypes)) (setq fmt (concat (format "%%-%ds" objnamelen) (mapconcat #'(lambda (type) (let ((fieldlen - (max 8 (+ 2 (length + (max 7 (+ 2 (length (symbol-name type)))))) (incf linelen fieldlen) (format "%%%ds" fieldlen))) @@ -68,13 +79,13 @@ (append types (list 'total)))) (princ (make-string linelen ?-)) (princ "\n")) - (let ((objname (format "%s" obj))) + (let ((objname (format "%s" (funcall cleanfun obj)))) (princ (apply 'format fmt (substring objname 0 (min (length objname) (1- objnamelen))) (nconc (mapcar #'(lambda (type) (cdr (assq type stats))) - types) + origtypes) (list total))))) (setq first nil))) (princ "\n") @@ -94,8 +105,8 @@ (when-fboundp 'charset-list (setq begin (point)) (incf grandtotal - (show-foo-stats 'charset (charset-list) - #'charset-memory-usage)) + (show-foo-stats 'charset nil 'charset-name + (mapcar 'get-charset (charset-list)))) (when-fboundp 'sort-numeric-fields (sort-numeric-fields -1 (save-excursion @@ -108,7 +119,7 @@ (princ "\n")) (setq begin (point)) (incf grandtotal - (show-foo-stats 'buffer (buffer-list) #'buffer-memory-usage)) + (show-foo-stats 'buffer nil 'buffer-name (buffer-list))) (when-fboundp 'sort-numeric-fields (sort-numeric-fields -1 (save-excursion @@ -121,11 +132,20 @@ (princ "\n") (setq begin (point)) (incf grandtotal - (show-foo-stats 'window (mapcan #'(lambda (fr) - (window-list fr t)) - (frame-list)) - #'window-memory-usage)) - (when-fboundp #'sort-numeric-fields + (show-foo-stats 'window + '(line-start-cache line-st. + face-cache face + glyph-cache glyph + redisplay-structs redisplay + scrollbar-instances scrollbar + window-mirror mirror) + #'(lambda (x) + (buffer-name (window-buffer x))) + (mapcan #'(lambda (fr) + (window-list fr t)) + (frame-list)) + 16)) + (when-fboundp 'sort-numeric-fields (sort-numeric-fields -1 (save-excursion (goto-char begin) @@ -142,21 +162,24 @@ (princ (make-string 40 ?-)) (princ "\n") (map-plist #'(lambda (stat num) - (when (string-match - "\\(.*\\)-storage$" - (symbol-name stat)) + (when (and + (not + (string-match + "\\(.*\\)-ancillary-storage$" + (symbol-name stat))) + (string-match + "\\(.*\\)-storage$" + (symbol-name stat))) (incf total num) (princ (format fmt (match-string 1 (symbol-name stat)) num))) - (when (eq stat 'long-strings-total-length) - (incf total num) - (princ (format fmt stat num)))) + ) (sixth (garbage-collect))) (princ "\n") (princ (format fmt "total" total)) (incf grandtotal total)) - (when-fboundp #'sort-numeric-fields + (when-fboundp 'sort-numeric-fields (sort-numeric-fields -1 (save-excursion (goto-char begin) @@ -176,60 +199,99 @@ (garbage-collect) (let ((buffer "*object memory usage statistics*") (plist (object-memory-usage-stats)) - (fmt "%-30s%10s%10s\n") + (fmt "%-28s%10s%10s%10s%10s%10s\n") (grandtotal 0) begin) (flet ((show-stats (match-string) - (princ (format fmt "object" "count" "storage")) - (princ (make-string 50 ?-)) + (princ (format "%28s%10s%40s\n" "" "" + "--------------storage---------------")) + (princ (format fmt "object" "count" "object" "overhead" + "non-Lisp" "ancillary")) + (princ (make-string 78 ?-)) (princ "\n") (let ((total-use 0) + (total-non-lisp-use 0) (total-use-overhead 0) + (total-use-with-overhead 0) (total-count 0)) (map-plist #'(lambda (stat num) - (when (string-match match-string - (symbol-name stat)) - (let ((storage-use num) - (storage-use-overhead - (plist-get - plist - (intern (concat (match-string 1 (symbol-name stat)) - "-storage-including-overhead")))) - (storage-count - (or (plist-get - plist - (intern - (concat (match-string 1 (symbol-name stat)) - "s-used"))) - (plist-get - plist - (intern - (concat (match-string 1 (symbol-name stat)) - "es-used"))) - (plist-get - plist - (intern - (concat (match-string 1 (symbol-name stat)) - "-used")))))) - (incf total-use storage-use) - (incf total-use-overhead (if storage-use-overhead - storage-use-overhead - storage-use)) - (incf total-count storage-count) - (princ (format fmt - (match-string 1 (symbol-name stat)) - storage-count storage-use))))) + (let ((symmatch + (and (string-match match-string (symbol-name stat)) + (match-string 1 (symbol-name stat))))) + (when (and symmatch + (or (< (length symmatch) 9) + (not (equal (substring symmatch -9) + "-non-lisp"))) + (or (< (length symmatch) 15) + (not (equal (substring symmatch -15) + "-lisp-ancillary")))) + (let* ((storage-use num) + (storage-use-overhead + (or (plist-get + plist + (intern (concat symmatch + "-storage-overhead"))) + 0)) + (storage-use-with-overhead + (or (plist-get + plist + (intern (concat + symmatch + "-storage-including-overhead"))) + (+ storage-use storage-use-overhead))) + (storage-use-overhead + (- storage-use-with-overhead storage-use)) + (non-lisp-storage + (or (plist-get + plist + (intern (concat symmatch + "-non-lisp-storage"))) + 0)) + (lisp-ancillary-storage + (or (plist-get + plist + (intern (concat symmatch + "-lisp-ancillary-storage"))) + 0)) + (storage-count + (or (loop for str in '("s-used" "es-used" "-used") + for val = (plist-get + plist + (intern + (concat symmatch str))) + if val + return val) + (plist-get + plist + (intern + (concat (substring symmatch 0 -1) + "ies-used"))) + ))) + (incf total-use storage-use) + (incf total-use-overhead storage-use-overhead) + (incf total-use-with-overhead storage-use-with-overhead) + (incf total-non-lisp-use non-lisp-storage) + (incf total-count (or storage-count 0)) + (and (> storage-use-with-overhead 0) + (princ (format fmt symmatch + (or storage-count "unknown") + storage-use + storage-use-overhead + non-lisp-storage + lisp-ancillary-storage))))))) plist) (princ "\n") (princ (format fmt "total" - total-count total-use-overhead)) - (incf grandtotal total-use-overhead) - (when-fboundp #'sort-numeric-fields - (sort-numeric-fields -1 + total-count total-use total-use-overhead + total-non-lisp-use "")) + (incf grandtotal total-use-with-overhead) + (incf grandtotal total-non-lisp-use) + (when-fboundp 'sort-numeric-fields + (sort-numeric-fields -4 (save-excursion (goto-char begin) - (forward-line 2) + (forward-line 4) (point)) (save-excursion (forward-line -2) @@ -238,7 +300,7 @@ (save-excursion (set-buffer buffer) (setq begin (point)) - (princ "Allocated with lisp allocator:\n") + (princ "Allocated with lisp allocator or related:\n") (show-stats "\\(.*\\)-storage$") (princ (format "\n\ngrand total: %s\n" grandtotal))) grandtotal)))) @@ -248,7 +310,7 @@ "Show statistics about memory usage of the new allocator." (interactive) (garbage-collect) - (if-fboundp #'mc-alloc-memory-usage + (if-fboundp 'mc-alloc-memory-usage (let* ((stats (mc-alloc-memory-usage)) (page-size (first stats)) (heap-sects (second stats)) @@ -401,7 +463,7 @@ (defun show-gc-stats () "Show statistics about garbage collection cycles." (interactive) - (if-fboundp #'gc-stats + (if-fboundp 'gc-stats (let ((buffer "*garbage collection statistics*") (plist (gc-stats)) (fmt "%-9s %16s %12s %12s %12s %12s\n")) @@ -426,7 +488,7 @@ (princ (make-string 78 ?-)) (princ "\n") (princ (format fmt "stat" "total" "last-gc" "this-gc" - "last-cycle" "this-cylce")) + "last-cycle" "this-cycle")) (princ (make-string 78 ?-)) (princ "\n") (show-stats "n-gc") diff -r 861f2601a38b -r 1f0b15040456 lisp/dialog-gtk.el --- a/lisp/dialog-gtk.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/dialog-gtk.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -256,13 +254,13 @@ (setq length (length button)) (cond - ((= length 1) ; [ "name" ] + ((eql length 1) ; [ "name" ] (setq callback nil activep nil)) - ((= length 2) ; [ "name" callback ] + ((eql length 2) ; [ "name" callback ] (setq callback (aref button 1) activep t)) - ((and (or (= length 3) (= length 4)) + ((and (or (eql length 3) (eql length 4)) (not (keywordp (aref button 2)))) ;; [ "name" callback active-p ] or ;; [ "name" callback active-p suffix ] diff -r 861f2601a38b -r 1f0b15040456 lisp/dialog-items.el --- a/lisp/dialog-items.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/dialog-items.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/dialog.el --- a/lisp/dialog.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/dialog.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -121,7 +119,9 @@ (apply 'message-box fmt args) (apply 'message fmt args))) -(defun make-dialog-box (type &rest cl-keys) +(defun* make-dialog-box (type &rest rest &key (title "XEmacs") + (parent (selected-frame)) modal properties autosize + spec &allow-other-keys) "Pop up a dialog box. TYPE is a symbol, the type of dialog box. Remaining arguments are keyword-value pairs, specifying the particular characteristics of the @@ -570,112 +570,100 @@ (signal 'quit nil))))) (case type (general - (cl-parsing-keywords - ((:title "XEmacs") - (:parent (selected-frame)) - :modal - :properties - :autosize - :spec) - () - (flet ((create-dialog-box-frame () - (let* ((ftop (frame-property cl-parent 'top)) - (fleft (frame-property cl-parent 'left)) - (fwidth (frame-pixel-width cl-parent)) - (fheight (frame-pixel-height cl-parent)) - (fonth (font-height (face-font 'default))) - (fontw (font-width (face-font 'default))) - (cl-properties (append cl-properties - dialog-frame-plist)) - (dfheight (plist-get cl-properties 'height)) - (dfwidth (plist-get cl-properties 'width)) - (unmapped (plist-get cl-properties - 'initially-unmapped)) - (gutter-spec cl-spec) - (name (or (plist-get cl-properties 'name) "XEmacs")) - (frame nil)) - (plist-remprop cl-properties 'initially-unmapped) - ;; allow the user to just provide a glyph - (or (glyphp cl-spec) (setq cl-spec (make-glyph cl-spec))) - (setq gutter-spec (copy-sequence "\n")) - (set-extent-begin-glyph (make-extent 0 1 gutter-spec) - cl-spec) - ;; under FVWM at least, if I don't specify the - ;; initial position, it ends up always at (0, 0). - ;; xwininfo doesn't tell me that there are any - ;; program-specified position hints, so it must be - ;; an FVWM bug. So just be smashing and position in - ;; the center of the selected frame. - (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 - internal-border-width 8 - 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) - ;; resize before mapping - (when cl-autosize - (set-frame-displayable-pixel-size - frame - (image-instance-width - (glyph-image-instance cl-spec - (frame-selected-window frame))) - (image-instance-height - (glyph-image-instance cl-spec - (frame-selected-window frame))))) - ;; somehow, even though the resizing is supposed - ;; to be while the frame is not visible, a - ;; visible resize is perceptible - (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 - (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)) - (create-dialog-box-frame))))) + (flet ((create-dialog-box-frame () + (let* ((ftop (frame-property parent 'top)) + (fleft (frame-property parent 'left)) + (fwidth (frame-pixel-width parent)) + (fheight (frame-pixel-height parent)) + (fonth (font-height (face-font 'default))) + (fontw (font-width (face-font 'default))) + (properties (append properties + dialog-frame-plist)) + (dfheight (plist-get properties 'height)) + (dfwidth (plist-get properties 'width)) + (unmapped (plist-get properties + 'initially-unmapped)) + (gutter-spec spec) + (name (or (plist-get properties 'name) "XEmacs")) + (frame nil)) + (plist-remprop properties 'initially-unmapped) + ;; allow the user to just provide a glyph + (or (glyphp spec) (setq spec (make-glyph spec))) + (setq gutter-spec (copy-sequence "\n")) + (set-extent-begin-glyph (make-extent 0 1 gutter-spec) + spec) + ;; under FVWM at least, if I don't specify the + ;; initial position, it ends up always at (0, 0). + ;; xwininfo doesn't tell me that there are any + ;; program-specified position hints, so it must be + ;; an FVWM bug. So just be smashing and position in + ;; the center of the selected frame. + (setq frame + (make-frame + (append properties + `(popup + ,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 + internal-border-width 8 + 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) + ;; resize before mapping + (when autosize + (set-frame-displayable-pixel-size + frame + (image-instance-width + (glyph-image-instance spec + (frame-selected-window frame))) + (image-instance-height + (glyph-image-instance spec + (frame-selected-window frame))))) + ;; somehow, even though the resizing is supposed + ;; to be while the frame is not visible, a + ;; visible resize is perceptible + (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 + (set (make-local-variable 'frame-title-format) + title) + (add-local-hook 'delete-frame-hook + #'(lambda (frame) + (kill-buffer + (frame-property + frame + 'dialog-box-buffer)))))) + frame))) + (if modal + (dialog-box-modal-loop '(create-dialog-box-frame)) + (create-dialog-box-frame)))) (question - (cl-parsing-keywords - ((:modal nil)) - t - (remf cl-keys :modal) - (if cl-modal - (dialog-box-modal-loop `(make-dialog-box-internal ',type - ',cl-keys)) - (make-dialog-box-internal type cl-keys)))) + (remf rest :modal) + (if modal + (dialog-box-modal-loop `(make-dialog-box-internal ',type ',rest)) + (make-dialog-box-internal type rest))) (t - (make-dialog-box-internal type cl-keys))))) + (make-dialog-box-internal type rest))))) (defun dialog-box-finish (result) "Exit a modal dialog box, returning RESULT. diff -r 861f2601a38b -r 1f0b15040456 lisp/disass.el --- a/lisp/disass.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/disass.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.28. diff -r 861f2601a38b -r 1f0b15040456 lisp/disp-table.el --- a/lisp/disp-table.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/disp-table.el Sun May 01 18:44:03 2011 +0100 @@ -2,34 +2,35 @@ ;; Copyright (C) 1987, 1994, 1997, 2007 Free Software Foundation, Inc. ;; Copyright (C) 1995 Sun Microsystems. +;; Copyright (C) 2005 Ben Wing. -;; Author: Howard Gayle ;; Maintainer: XEmacs Development Team ;; Keywords: i18n, internal ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched with FSF. ;;; Commentary: ;; Rewritten for XEmacs July 1995, Ben Wing. - +;; November 1998?, display tables generalized to char/range tables, Hrvoje +;; Niksic. +;; July 2007, rewrite this file to handle generalized display tables, +;; Aidan Kehoe. ;;; Code: @@ -116,6 +117,9 @@ ;; Let me say one more time how much dynamic scoping sucks. +;; #### Need more thinking about basic primitives for modifying a specifier. +;; cf `modify-specifier-instances'. + ;;;###autoload (defun frob-display-table (fdt-function fdt-locale &optional tag-set) (or fdt-locale (setq fdt-locale 'global)) @@ -184,8 +188,8 @@ ;;;###autoload (defun standard-display-g1 (c sc &optional locale) "Display character C as character SC in the g1 character set. -This function assumes that your terminal uses the SO/SI characters; -it is meaningless for an X frame." +This only has an effect on TTY devices and assumes that your terminal uses +the SO/SI characters." (frob-display-table (lambda (x) (put-char-table c (concat "\016" (char-to-string sc) "\017") x)) @@ -194,8 +198,7 @@ ;;;###autoload (defun standard-display-graphic (c gc &optional locale) "Display character C as character GC in graphics character set. -This function assumes VT100-compatible escapes; it is meaningless for an -X frame." +This only has an effect on TTY devices and assumes VT100-compatible escapes." (frob-display-table (lambda (x) (put-char-table c (concat "\e(0" (char-to-string gc) "\e(B") x)) diff -r 861f2601a38b -r 1f0b15040456 lisp/dragdrop.el --- a/lisp/dragdrop.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/dragdrop.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -214,7 +212,7 @@ ((eq (car object) 'dragdrop-MIME) "MIME") (t "UNKNOWN")) (length (cdr object)) - (if (= (length (cdr object)) 1) "element" "elements"))) + (if (eql (length (cdr object)) 1) "element" "elements"))) (let ((i 1) (data (cdr object))) (while (not (eq data ())) @@ -280,7 +278,7 @@ (while (not (eq ldata ())) (setq data (car ldata)) (if (and (listp data) - (= (length data) 3) + (eql (length data) 3) (listp (car data)) (stringp (caar data)) (string= (caar data) "text/plain") @@ -308,7 +306,7 @@ (and (featurep 'tm-view) (declare-fboundp (mime/viewer-mode buf)))) ((and (listp data) - (= (length data) 3)) + (eql (length data) 3)) ;; change the internal content-type representation to the ;; way tm does it ("content/type" (key . value)*) ;; but for now list will do the job diff -r 861f2601a38b -r 1f0b15040456 lisp/dumped-lisp.el --- a/lisp/dumped-lisp.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/dumped-lisp.el Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,18 @@ +;; 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 3 of the License, 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. If not, see . + (defvar packages-hardcoded-lisp '( ;; Nothing at this time @@ -23,28 +38,19 @@ "backquote" ; needed for defsubst etc. "bytecomp-runtime" ; define defsubst - "find-paths" - "packages" ; Bootstrap run-time lisp environment - "setup-paths" - - ;; use custom-declare-variable-early, not defcustom, in these files - "subr" ; load the most basic Lisp functions + "cl" + "cl-extra" ; also loads cl-macs if we're running interpreted. + "cl-seq" "post-gc" - "replace" ; match-string used in version.el. - "version" - - "cl" - "cl-extra" - "cl-seq" + "custom" ; Before the world so everything can be customized + "cus-start" ; for customization of builtin variables + "find-paths" + "packages" + "setup-paths" + "replace" "widget" - "custom" ; Before the world so everything can be - ; customized - "cus-start" ; for customization of builtin variables - - ;; OK, you can use defcustom from here on - "cmdloop" "keymap" "syntax" @@ -61,7 +67,7 @@ "faces" ; must be loaded before any make-face call ;;(pureload "facemenu") #### not yet ported "glyphs" - "objects" + "fontcolor" "extents" "events" "hash-table" @@ -112,6 +118,7 @@ "easy-mmode" ; Added for 21.5. Used by help. "help" "easymenu" ; Added for 20.3. + "special-mode" "lisp-mode" "text-mode" "fill" @@ -148,10 +155,10 @@ ;; should just be able to assume that, if (featurep 'menubar), ;; the menubar should work and if items are added, they can be ;; seen clearly and usefully. - (when (featurep '(and (not infodock) menubar)) "menubar-items") - (when (featurep '(and gutter)) "gutter-items") - (when (featurep '(and (not infodock) toolbar)) "toolbar-items") - (when (featurep '(and (not infodock) dialog)) "dialog-items") + (when (featurep 'menubar) "menubar-items") + (when (featurep 'gutter) "gutter-items") + (when (featurep 'toolbar) "toolbar-items") + (when (featurep 'dialog) "dialog-items") ;;;;;;;;;;;;;;;;;; Coding-system support "coding" @@ -214,10 +221,7 @@ "mule/lao" ; sucks. "mule/latin" "mule/misc-lang" - ;; "thai" #### merge thai and thai-xtis!!! - ;; #### Even better; take out thai-xtis! It's not even a - ;; standard, and no-one uses it. - "mule/thai-xtis" + "mule/thai" "mule/tibetan" "mule/vietnamese" )) @@ -234,12 +238,6 @@ ;;; mule-load.el ends here -;; preload InfoDock stuff. should almost certainly not be here if -;; id-menus is not here. infodock needs to figure out a clever way to -;; advise this stuff or we need to export a clean way for infodock or -;; others to control this programmatically. - (when (featurep '(and infodock (or x mswindows gtk) menubar)) - "id-menus") ;; preload the X code. (when (featurep '(and x scrollbar)) "x-scrollbar") (when (featurep 'x) @@ -306,7 +304,4 @@ )) (setq preloaded-file-list - (apply #'nconc - (mapcar #'(lambda (x) - (if (listp x) x (list x))) - preloaded-file-list))) + (mapcan #'(lambda (x) (if (listp x) x (list x))) preloaded-file-list)) diff -r 861f2601a38b -r 1f0b15040456 lisp/easy-mmode.el --- a/lisp/easy-mmode.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/easy-mmode.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: GNU Emacs 21.3. diff -r 861f2601a38b -r 1f0b15040456 lisp/easymenu.el --- a/lisp/easymenu.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/easymenu.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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; if not, write to the Free Software -;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched with FSF but coordinated with the FSF ;;; easymenu maintainer for compatibility with FSF 20.4. @@ -194,7 +192,7 @@ ; (default-value 'mode-popup-menu) easy-menu-all-popups) (when (featurep 'menubar) ;; Save the existing mode-popup-menu, if it's been changed. - (when (and (zerop (length easy-menu-all-popups)) + (when (and (eql (length easy-menu-all-popups) 0) (not (equal (default-value 'mode-popup-menu) mode-popup-menu))) (push mode-popup-menu easy-menu-all-popups)) ;; Add the menu to our list of all the popups for the buffer. @@ -202,7 +200,7 @@ ;; If there are multiple popup menus available, make the popup menu ;; normally shown with button-3 a menu of them. If there is just one, ;; make that button show it, and no super-menu. - (setq mode-popup-menu (if (= 1 (length easy-menu-all-popups)) + (setq mode-popup-menu (if (eql 1 (length easy-menu-all-popups)) (car easy-menu-all-popups) (cons (easy-menu-title) (reverse easy-menu-all-popups)))) @@ -229,13 +227,13 @@ ;; If there are multiple popup menus available, make the popup menu ;; normally shown with button-3 a menu of them. If there is just one, ;; make that button show it, and no super-menu. - mode-popup-menu (if (= 1 (length easy-menu-all-popups)) + mode-popup-menu (if (eql 1 (length easy-menu-all-popups)) (car easy-menu-all-popups) (cons (easy-menu-title) (reverse easy-menu-all-popups)))) ;; If we've just set mode-popup-menu to an empty menu, change that menu ;; to its default value (without intervention from easy-menu). - (if (zerop (length easy-menu-all-popups)) + (if (eql (length easy-menu-all-popups) 0) (setq mode-popup-menu (default-value 'mode-popup-menu))) (and current-menubar (assoc (car menu) current-menubar) diff -r 861f2601a38b -r 1f0b15040456 lisp/etags.el --- a/lisp/etags.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/etags.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched with FSF. @@ -243,16 +241,15 @@ (push expression result) (error "Expression in tag-table-alist evaluated to non-string"))))) (setq result - (mapcar + (mapcan (lambda (name) (when (file-directory-p name) (setq name (concat (file-name-as-directory name) "TAGS"))) (and (file-readable-p name) ;; get-tag-table-buffer has side-effects - (symbol-value-in-buffer 'buffer-file-name - (get-tag-table-buffer name)))) + (list (symbol-value-in-buffer 'buffer-file-name + (get-tag-table-buffer name))))) result)) - (setq result (delq nil result)) ;; If no TAGS file has been found, ask the user explicitly. ;; #### tags-file-name is *evil*. (or result tags-file-name @@ -439,8 +436,7 @@ (defun buffer-tag-table-files () "Returns a list of all files referenced by all TAGS tables that this buffer uses." - (apply #'append - (mapcar #'tag-table-files (buffer-tag-table-list)))) + (mapcan #'tag-table-files (buffer-tag-table-list))) ;; Building the completion table @@ -1348,7 +1344,7 @@ ;;;###autoload (defun pop-tag-mark (arg) "Go to last tag position. -`find-tag' maintains a mark-stack seperate from the \\[set-mark-command] mark-stack. +`find-tag' maintains a mark-stack separate from the \\[set-mark-command] mark-stack. This function pops (and moves to) the tag at the top of this stack." (interactive "P") (if (not arg) diff -r 861f2601a38b -r 1f0b15040456 lisp/events.el --- a/lisp/events.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/events.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/extents.el --- a/lisp/extents.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/extents.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -109,7 +107,7 @@ EXTENT, until no more children can be found." (let ((children (extent-children extent))) (if children - (apply 'nconc (mapcar 'extent-descendants children)) + (mapcan 'extent-descendants children) (list extent)))) (defun set-extent-keymap (extent keymap) diff -r 861f2601a38b -r 1f0b15040456 lisp/faces.el --- a/lisp/faces.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/faces.el Sun May 01 18:44:03 2011 +0100 @@ -3,26 +3,25 @@ ;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc. ;; Copyright (C) 1995 Board of Trustees, University of Illinois ;; Copyright (C) 1995, 1996, 2002, 2005 Ben Wing +;; Copyright (C) 2010 Didier Verna ;; Author: Ben Wing ;; Keywords: faces, 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched with FSF. Almost completely divergent. @@ -48,9 +47,7 @@ ;; To elude the warnings for font functions. (Normally autoloaded when ;; font-create-object is called) -(eval-when-compile - (require 'font) - (load "cl-macs")) +(eval-when-compile (require 'font)) (defgroup faces nil "Support for multiple text attributes (fonts, colors, ...) @@ -60,7 +57,7 @@ (defun read-face-name (prompt) (let (face) - (while (= (length face) 0) ; nil or "" + (while (eql (length face) 0) ; nil or "" (setq face (completing-read prompt (mapcar (lambda (x) (list (symbol-name x))) (face-list)) @@ -87,6 +84,8 @@ (color-instance-name default)) ((image-instance-p default) (image-instance-file-name default)) + ((face-background-placement-instance-p default) + (symbol-name default)) (t default)))))) (list face (if (equal value "") nil value)))) @@ -239,16 +238,19 @@ &optional domain default no-fallback) "Return the instance of FACE's PROPERTY matching MATCHSPEC in DOMAIN. -Currently the only useful value for MATCHSPEC is a charset, when used -in conjunction with the face's font; this allows you to retrieve a -font that can be used to display a particular charset, rather than just -any font. +Currently MATCHSPEC is used only for the 'font property, when its value +should be a cons \(CHARSET . STAGE) \(see `specifier-matching-instance' +for a full description of the matching process). This allows you to +retrieve a font that can be used to display a particular charset, rather +than just any font. For backward compatibility, MATCHSPEC may be a +charset, which is interpreted as \(CHARSET . final). -Other than MATCHSPEC, this function is identical to `face-property-instance'. -See also `specifier-matching-instance' for a fuller description of the -matching process." +See `face-property-instance' for usage of the other arguments." (setq face (get-face face)) + ;; For compatibility with 21.4-oriented code, eg, x-symbol-mule.el. + (when (charsetp matchspec) + (setq matchspec (cons matchspec 'final))) (let ((value (get face property))) (when (specifierp value) (setq value (specifier-matching-instance value matchspec domain @@ -333,6 +335,11 @@ Only used by faces on X and MS Windows devices. For valid instantiators, see `make-image-specifier'. + background-placement The placement of the face's background pixmap. + Only used by faces on X devices. + For valid instantiators, + see `make-face-background-placement-specifier'. + underline Underline all text covered by this face. For valid instantiators, see `make-face-boolean-specifier'. @@ -412,7 +419,7 @@ how-to-add)) (set-difference built-in-face-specifiers '(display-table background-pixmap inherit))) - (set-face-background-pixmap face (vector 'inherit ':face parent) + (set-face-background-pixmap face (vector 'inherit :face parent) locale tag-set how-to-add) nil) @@ -472,7 +479,7 @@ (let (matchspec) ;; get-charset signals an error if its argument doesn't have an ;; associated charset. - (setq charset (if-fboundp #'get-charset + (setq charset (if-fboundp 'get-charset (get-charset charset) (error 'unimplemented "Charset support not available")) matchspec (cons charset nil)) @@ -716,6 +723,45 @@ (list face (if (equal file "") nil file)))) (set-face-property face 'background-pixmap file)) +(defun face-background-placement (face &optional domain default no-fallback) + "Return FACE's background placement in DOMAIN. +See `face-property-instance' for the semantics of the DOMAIN argument." + (face-property face 'background-placement domain default no-fallback)) + +(defun set-face-background-placement (face placement &optional locale tag-set + how-to-add) + "Change the background-placement property of FACE to PLACEMENT. +PLACEMENT is normally a background-placement instantiator; see +`make-face-background-placement-specifier'. +See `set-face-property' for the semantics of the LOCALE, TAG-SET, and +HOW-TO-ADD arguments." + (interactive (face-interactive "background placement")) + ;; When called non-interactively (for example via custom), PLACEMENT is + ;; expected to be a symbol. -- dvl + (unless (symbolp placement) + (setq placement (intern placement))) + (set-face-property face 'background-placement placement locale tag-set + how-to-add)) + +(defun face-background-placement-instance (face &optional domain default + no-fallback) + "Return FACE's background-placement instance in DOMAIN. +Return value will be a background-placement instance object. + +FACE may be either a face object or a symbol representing a face. + +Normally DOMAIN will be a window or nil (meaning the selected window), +and an instance object describing the background placement in that particular +window and buffer will be returned. + +See `face-property-instance' for more information." + (face-property-instance face 'background-placement domain default + no-fallback)) + +(defun face-background-placement-instance-p (object) + "Return t if OBJECT is a face-background-placement instance." + (or (eq object 'absolute) (eq object 'relative))) + (defun face-display-table (face &optional locale tag-set exact-p) "Return the display table spec of FACE in LOCALE, or nil if unspecified.. @@ -871,7 +917,7 @@ (let ((device (dfw-device domain)) (common-props '(foreground background font display-table underline dim inherit)) - (win-props '(background-pixmap strikethru)) + (win-props '(background-pixmap background-placement strikethru)) (tty-props '(highlight blinking reverse))) ;; First check the properties which are used in common between the @@ -1669,6 +1715,10 @@ (type (memq type options)) (class (memq class options)) (background (memq background options)) + ;; `display-color-cells' can return nil (eg, TTYs). + ;; If so, assume monochrome. + (min-colors (>= (or (display-color-cells frame) 2) + (car options))) (t (warn "Unknown req `%S' with options `%S'" req options) nil)))) @@ -1943,7 +1993,8 @@ ;; element faces. So take the modeline face information from its ;; fallbacks, themselves ultimately set up in faces.c: (loop - for face-property in '(foreground background background-pixmap) + for face-property in '(foreground background + background-pixmap background-placement) do (when (and (setq face-property (face-property 'modeline face-property)) (null (specifier-instance face-property device nil t)) (specifier-instance face-property device)) @@ -1993,14 +2044,14 @@ '(".xbm" ""))))) (and file `[xbm :file ,file]))) - ((and (listp pixmap) (= (length pixmap) 3)) + ((and (listp pixmap) (eql (length pixmap) 3)) `[xbm :data ,pixmap]) (t nil)))) ;; We're signaling a continuable error; let's make sure the ;; function `stipple-pixmap-p' at least exists. (flet ((stipple-pixmap-p (pixmap) (or (stringp pixmap) - (and (listp pixmap) (= (length pixmap) 3))))) + (and (listp pixmap) (eql (length pixmap) 3))))) (setq pixmap (signal 'wrong-type-argument (list 'stipple-pixmap-p pixmap))))) (check-type frame (or null frame)) diff -r 861f2601a38b -r 1f0b15040456 lisp/files.el --- a/lisp/files.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/files.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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. +;; 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 3 of the License, or (at your +;; option) any later version. + +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc. 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; [[ Synched up with: FSF 20.3 (but diverging) ;;; Warning: Merging this file is tough. Beware.]] @@ -606,15 +604,10 @@ (setq cd-path (or (and trypath (mapcar #'file-name-as-directory trypath)) (list (file-name-as-directory ""))))) - (or (catch 'found - (mapc #'(lambda (x) - (let ((f (expand-file-name (concat x dir)))) - (if (file-directory-p f) - (progn - (cd-absolute f) - (throw 'found t))))) - cd-path) - nil) + (or (some #'(lambda (x) + (let ((f (expand-file-name (concat x dir)))) + (when (file-directory-p f) (cd-absolute f)))) + cd-path) ;; jwz: give a better error message to those of us with the ;; good taste not to use a kludge like $CDPATH. (if (equal cd-path '("./")) @@ -731,7 +724,7 @@ If SUFFIX is non-nil, add that at the end of the file name. -This function is analagous to mkstemp(3) under POSIX, avoiding the race +This function is analogous to mkstemp(3) under POSIX, avoiding the race condition between testing for the existence of the generated filename (under POSIX with mktemp(3), under Emacs Lisp with `make-temp-name') and creating it." @@ -1003,9 +996,9 @@ (read-coding-system "Coding system: ")) t)) (let ((value (find-file filename codesys wildcards))) - (mapcar #'(lambda (buffer) - (set-symbol-value-in-buffer 'buffer-read-only t buffer)) - (if (listp value) value (list value))) + (mapc #'(lambda (buffer) + (set-symbol-value-in-buffer 'buffer-read-only t buffer)) + (if (listp value) value (list value))) value)) (defun find-file-read-only-other-window (filename &optional codesys wildcards) @@ -2044,7 +2037,7 @@ ;; Without this guard, `normal-mode' would potentially run ;; the major mode function twice: once via `set-auto-mode' ;; and once via `hack-local-variables'. - (if (not (eq mode major-mode)) + (if (and (not (eq mode major-mode)) (fboundp mode)) (funcall mode)) )) (set-any-p @@ -2091,8 +2084,9 @@ "\"Set\" one variable in a local variables spec. A few variable names are treated specially." (cond ((eq var 'mode) - (funcall (intern (concat (downcase (symbol-name val)) - "-mode")))) + (and (fboundp (setq val (intern (concat (downcase (symbol-name val)) + "-mode")))) + (funcall val))) ((eq var 'coding) ;; We have already handled coding: tag in set-auto-coding. nil) @@ -3059,6 +3053,122 @@ (basic-save-buffer-1)) 'continue-save-buffer)) +(defun diff-buffer-with-file (&optional buffer) + "View the differences between BUFFER and its associated file. +This requires the external program `diff' to be in your `exec-path'." + (interactive "bBuffer: ") + (with-current-buffer (get-buffer (or buffer (current-buffer))) + (if (and buffer-file-name + (file-exists-p buffer-file-name)) + (let ((tempfile (make-temp-file "buffer-content-"))) + (unwind-protect + (save-restriction + (widen) + (write-region (point-min) (point-max) tempfile nil 'nomessage) + (diff-files-for-recover "File" + buffer-file-name tempfile buffer-file-name tempfile + buffer-file-coding-system) + (sit-for 0)) + (when (file-exists-p tempfile) + (delete-file tempfile)))) + (message "Buffer %s has no associated file on disc" (buffer-name)) + ;; Display that message for 1 second so that user can read it + ;; in the minibuffer. + (sit-for 1))) + ;; return always nil, so that save-buffers-kill-emacs will not move + ;; over to the next unsaved buffer when calling `d'. + nil) + +(defvar save-some-buffers-action-alist + ;;instead of this we just say "yes all", "no all", etc. + ;;"save all the rest" + ;;"save only this buffer" "save no more buffers") + ;; this is rather bogus. --ben + ;; (it makes the dialog box too big, and you get an error + ;; "wrong type argument: framep, nil" when you hit q after + ;; choosing the option from the dialog box) + + ;; We should fix the dialog box rather than disabling + ;; this! --hniksic + (list (list ?\C-r (lambda (buf) + ;; #### FSF has an EXIT-ACTION argument + ;; to `view-buffer'. + (view-buffer buf +; (function +; (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) + "%_Display Buffer") + (list ?d (lambda (buf) + (save-window-excursion (diff-buffer-with-file buf)) + (view-buffer (get-buffer-create "*File Diff*") t) + (with-boundp 'view-exit-action + (setq view-exit-action + (lambda (ignore) + (exit-recursive-edit)))) + (recursive-edit) + ;; Return nil to ask about BUF again. + nil) + "View %_Changes in Buffer"))) + +(defun diff-files-for-recover (purpose file-1 file-2 + failed-file-1 failed-file-2 + coding-system) + "Diff two files for recovering or comparing against the last saved version. +PURPOSE is an informational string used for naming the resulting buffer. +FILE-1 and FILE-2 are the two files to compare. +FAILED-FILE-1 and FAILED-FILE-2 are the names of files for which we should +generate directory listings on failure. +CODING-SYSTEM is the coding system of the resulting buffer." + (with-output-to-temp-buffer (concat "*" purpose " Diff*") + (buffer-disable-undo standard-output) + (let ((coding-system-for-read coding-system)) + (condition-case ferr + (progn + (apply #'call-process + recover-file-diff-program + nil standard-output nil + (append + recover-file-diff-arguments + (list file-1 file-2))) + (if (fboundp 'diff-mode) + (save-excursion + (set-buffer standard-output) + (declare-fboundp (diff-mode))))) + (io-error + (save-excursion + (let ((switches + (declare-boundp + dired-listing-switches))) + (if (file-symlink-p failed-file-2) + (setq switches (concat switches "L"))) + (set-buffer standard-output) + ;; XEmacs had the following line, not in FSF. + (setq default-directory (file-name-directory failed-file-2)) + ;; Use insert-directory-safely, + ;; not insert-directory, because + ;; these files might not exist. + ;; In particular, FAILED-FILE-2 might not + ;; exist if the auto-save file + ;; was for a buffer that didn't + ;; visit a file, such as + ;; "*mail*". The code in v20.x + ;; called `ls' directly, so we + ;; need to emulate what `ls' did + ;; in that case. + (insert-directory-safely failed-file-1 switches) + (insert-directory-safely failed-file-2 switches)) + (terpri) + (princ "Error during diff: ") + (display-error ferr standard-output))))))) + (defcustom save-some-buffers-query-display-buffer t "*Non-nil makes `\\[save-some-buffers]' switch to the buffer offered for saving." :type 'boolean @@ -3137,32 +3247,7 @@ (error nil))) (buffer-list) '("buffer" "buffers" "save") - ;;instead of this we just say "yes all", "no all", etc. - ;;"save all the rest" - ;;"save only this buffer" "save no more buffers") - ;; this is rather bogus. --ben - ;; (it makes the dialog box too big, and you get an error - ;; "wrong type argument: framep, nil" when you hit q after - ;; choosing the option from the dialog box) - - ;; We should fix the dialog box rather than disabling - ;; this! --hniksic - (list (list ?\C-r (lambda (buf) - ;; #### FSF has an EXIT-ACTION argument - ;; to `view-buffer'. - (view-buffer buf -; (function -; (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) - "%_Display Buffer")))) + save-some-buffers-action-alist)) (abbrevs-done (and save-abbrevs abbrevs-changed (progn @@ -3688,44 +3773,7 @@ 'escape-quoted)) (write-region (point-min) (point-max) temp nil 'silent))) - (with-output-to-temp-buffer "*Autosave Diff*" - (buffer-disable-undo standard-output) - (let ((coding-system-for-read - 'escape-quoted)) - (condition-case ferr - (apply #'call-process - recover-file-diff-program - nil standard-output nil - (append - recover-file-diff-arguments - (list temp file-name))) - (io-error - (save-excursion - (let ((switches - (declare-boundp - dired-listing-switches))) - (if (file-symlink-p file) - (setq switches (concat switches "L"))) - (set-buffer standard-output) - ;; XEmacs had the following line, not in FSF. - (setq default-directory (file-name-directory file)) - ;; Use insert-directory-safely, - ;; not insert-directory, because - ;; these files might not exist. - ;; In particular, FILE might not - ;; exist if the auto-save file - ;; was for a buffer that didn't - ;; visit a file, such as - ;; "*mail*". The code in v20.x - ;; called `ls' directly, so we - ;; need to emulate what `ls' did - ;; in that case. - (insert-directory-safely file switches) - (insert-directory-safely file-name switches)) - (terpri) - (princ "Error during diff: ") - (display-error ferr - standard-output))))))) + (diff-files-for-recover "Autosave" temp file-name file file-name 'escape-quoted)) (ignore-errors (kill-buffer buffer)) (ignore-file-errors (delete-file temp))))))))))))))) @@ -4399,9 +4447,10 @@ With prefix arg, silently save all file-visiting buffers, then kill." (interactive "P") (save-some-buffers arg t) - (and (or (not (memq t (mapcar #'(lambda (buf) (and (buffer-file-name buf) - (buffer-modified-p buf))) - (buffer-list)))) + (and (or (not (some #'(lambda (buf) + (and (buffer-file-name buf) + (buffer-modified-p buf))) + (buffer-list))) (yes-or-no-p "Modified buffers exist; exit anyway? ")) (or (not (fboundp 'process-list)) ;; process-list is not defined on VMS. @@ -4504,7 +4553,7 @@ (and (car pair) (string-match "\\`/:" (car pair)) (setcar pair - (if (= (length (car pair)) 2) + (if (eql (length (car pair)) 2) "/" (substring (car pair) 2))))) (setq file-arg-indices (cdr file-arg-indices)))) @@ -4514,17 +4563,8 @@ ;; END SYNC WITH FSF 21.2. -;; XEmacs: -(defvar default-file-system-ignore-case (and - (memq system-type '(windows-nt - cygwin32 - darwin)) - t) - "What `file-system-ignore-case-p' returns by default. -This is in the case that nothing in `file-system-case-alist' matches.") - -;; Question; do any of the Linuxes mount Windows partitions in a fixed -;; place? +;; XEmacs. Question; do any of the Linuxes mount Windows partitions in +;; a fixed place? (defvar file-system-case-alist nil "Alist to decide where file name case is significant. diff -r 861f2601a38b -r 1f0b15040456 lisp/fill.el --- a/lisp/fill.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/fill.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.34. ;;; NOTE: Merging past 19.34 is currently impossible. Later versions diff -r 861f2601a38b -r 1f0b15040456 lisp/find-paths.el --- a/lisp/find-paths.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/find-paths.el Sun May 01 18:44:03 2011 +0100 @@ -11,20 +11,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/finder.el --- a/lisp/finder.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/finder.el Sun May 01 18:44:03 2011 +0100 @@ -19,20 +19,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.34. diff -r 861f2601a38b -r 1f0b15040456 lisp/float-sup.el --- a/lisp/float-sup.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/float-sup.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.34. diff -r 861f2601a38b -r 1f0b15040456 lisp/font-lock.el --- a/lisp/font-lock.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/font-lock.el Sun May 01 18:44:03 2011 +0100 @@ -15,20 +15,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.30 except for the code to initialize the faces. @@ -1477,51 +1475,55 @@ (save-match-data (maphash #'(lambda (buffer dummy) - ;; remove first, to avoid infinite reprocessing if error - (remhash buffer font-lock-pending-buffer-table) - (when (buffer-live-p buffer) - (clear-range-table font-lock-range-table) - (with-current-buffer buffer - (save-excursion - (save-restriction - ;; if we don't widen, then the C code in - ;; syntactically-sectionize will fail to realize that - ;; we're inside a comment. #### We don't actually use - ;; syntactically-sectionize any more. Do we still - ;; need the widen? - (widen) - (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) + (catch 'exit + ;; font-lock-mode may be temporarily unset during `revert-buffer' + (if (not font-lock-mode) + (throw 'exit nil)) + ;; remove first, to avoid infinite reprocessing if error + (remhash buffer font-lock-pending-buffer-table) + (when (buffer-live-p buffer) + (clear-range-table font-lock-range-table) + (with-current-buffer buffer + (save-excursion + (save-restriction + ;; if we don't widen, then the C code in + ;; syntactically-sectionize will fail to realize that + ;; we're inside a comment. #### We don't actually use + ;; syntactically-sectionize any more. Do we still + ;; need the widen? + (widen) + (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. @@ -2259,7 +2261,9 @@ '("\\<:\\sw+\\>" 0 font-lock-reference-face prepend) ;; ;; ELisp and CLisp `&' keywords as types. - '("\\<\\&\\(optional\\|rest\\|whole\\)\\>" . font-lock-type-face) + '("\\<\\&\\(\ +optional\\|rest\\|body\\|whole\\|key\\|allow-other-keys\\|aux\\|environment\ +\\)\\>" . font-lock-type-face) )) "Gaudy level highlighting for Lisp modes.") diff -r 861f2601a38b -r 1f0b15040456 lisp/font-menu.el --- a/lisp/font-menu.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/font-menu.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;; This file contains the device-nospecific font menu stuff @@ -123,7 +121,7 @@ (defcustom font-menu-ignore-scaled-fonts nil "*If non-nil, the font menu shows only bitmap fonts. -Bitmap fonts at their design size are generally noticably higher quality than +Bitmap fonts at their design size are generally noticeably higher quality than scaled fonts, unless the device is capable of interpreting antialiasing hints. In general, setting this option non-`nil' is useful mostly on older X servers. diff -r 861f2601a38b -r 1f0b15040456 lisp/font-mgr.el --- a/lisp/font-mgr.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/font-mgr.el Sun May 01 18:44:03 2011 +0100 @@ -7,10 +7,10 @@ ;; This file is part of XEmacs. -;; XEmacs is free software; you can redistribute it and/or modify it +;; 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. +;; Free Software Foundation, either version 3 of the License, 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 @@ -18,9 +18,7 @@ ;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;; Synched up with: Not in GNU Emacs. diff -r 861f2601a38b -r 1f0b15040456 lisp/font.el --- a/lisp/font.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/font.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,20 @@ ;; Keywords: faces ;; Version: 1.52 -;; 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. +;; This file is part of XEmacs. -;; 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. +;; 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 3 of the License, or (at your +;; option) any later version. + +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF @@ -48,9 +48,6 @@ get-fontset-info mswindows-define-rgb-color cancel-function-timers mswindows-font-regexp mswindows-canonicalize-font-name mswindows-parse-font-style mswindows-construct-font-style - ;; #### perhaps we should rewrite font-warn to avoid the warning - ;; Eh, now I look at the code, we definitely should. - font-warn fc-pattern-get-family fc-pattern-get-size fc-pattern-get-weight fc-font-weight-translate-from-constant make-fc-pattern fc-pattern-add-family fc-pattern-add-size)) @@ -426,7 +423,7 @@ (cond ((null args) (error "Wrong number of arguments to font-combine-fonts")) - ((= (length args) 1) + ((eql (length args) 1) (car args)) (t (let ((retval (font-combine-fonts-internal (nth 0 args) (nth 1 args)))) @@ -988,7 +985,7 @@ ;;; ###autoload (defun font-set-face-font (&optional face font &rest args) (cond - ((and (vectorp font) (= (length font) 12)) + ((and (vectorp font) (eql (length font) 12)) (let ((font-name (font-create-name font))) (set-face-property face 'font-specification font) (cond @@ -1070,24 +1067,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Various color related things ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(cond - ((fboundp 'display-warning) - (fset 'font-warn 'display-warning)) - ((fboundp 'w3-warn) - (fset 'font-warn 'w3-warn)) - ((fboundp 'url-warn) - (fset 'font-warn 'url-warn)) - ((fboundp 'warn) - (defun font-warn (class message &optional level) - (warn "(%s/%s) %s" class (or level 'warning) message))) - (t - (defun font-warn (class message &optional level) - (save-excursion - (set-buffer (get-buffer-create "*W3-WARNINGS*")) - (goto-char (point-max)) - (save-excursion - (insert (format "(%s/%s) %s\n" class (or level 'warning) message))) - (display-buffer (current-buffer)))))) (defun font-lookup-rgb-components (color) "Lookup COLOR (a color name) in rgb.txt and return a list of RGB values. @@ -1142,32 +1121,12 @@ (setq r (* (read (current-buffer)) 256) g (* (read (current-buffer)) 256) b (* (read (current-buffer)) 256))) - (font-warn 'color (format "No such color: %s" color)) + (display-warning 'color (format "No such color: %s" color)) (setq r 0 g 0 b 0)) (list r g b) )))))) -(defun font-hex-string-to-number (string) - "Convert STRING to an integer by parsing it as a hexadecimal number." - (let ((conv-list '((?0 . 0) (?a . 10) (?A . 10) - (?1 . 1) (?b . 11) (?B . 11) - (?2 . 2) (?c . 12) (?C . 12) - (?3 . 3) (?d . 13) (?D . 13) - (?4 . 4) (?e . 14) (?E . 14) - (?5 . 5) (?f . 15) (?F . 15) - (?6 . 6) - (?7 . 7) - (?8 . 8) - (?9 . 9))) - (n 0) - (i 0) - (lim (length string))) - (while (< i lim) - (setq n (+ (* n 16) (or (cdr (assq (aref string i) conv-list)) 0)) - i (1+ i))) - n )) - (defun font-parse-rgb-components (color) "Parse RGB color specification and return a list of integers (R G B). #FEFEFE and rgb:fe/fe/fe style specifications are parsed." @@ -1175,34 +1134,34 @@ r g b str) (cond ((string-match "^#[0-9a-f]+$" color) (cond - ((= (length color) 4) - (setq r (font-hex-string-to-number (substring color 1 2)) - g (font-hex-string-to-number (substring color 2 3)) - b (font-hex-string-to-number (substring color 3 4)) + ((eql (length color) 4) + (setq r (string-to-number (substring color 1 2) 16) + g (string-to-number (substring color 2 3) 16) + b (string-to-number (substring color 3 4) 16) r (* r 4096) g (* g 4096) b (* b 4096))) - ((= (length color) 7) - (setq r (font-hex-string-to-number (substring color 1 3)) - g (font-hex-string-to-number (substring color 3 5)) - b (font-hex-string-to-number (substring color 5 7)) + ((eql (length color) 7) + (setq r (string-to-number (substring color 1 3) 16) + g (string-to-number (substring color 3 5) 16) + b (string-to-number (substring color 5 7) 16) r (* r 256) g (* g 256) b (* b 256))) - ((= (length color) 10) - (setq r (font-hex-string-to-number (substring color 1 4)) - g (font-hex-string-to-number (substring color 4 7)) - b (font-hex-string-to-number (substring color 7 10)) + ((eql (length color) 10) + (setq r (string-to-number (substring color 1 4) 16) + g (string-to-number (substring color 4 7) 16) + b (string-to-number (substring color 7 10) 16) r (* r 16) g (* g 16) b (* b 16))) - ((= (length color) 13) - (setq r (font-hex-string-to-number (substring color 1 5)) - g (font-hex-string-to-number (substring color 5 9)) - b (font-hex-string-to-number (substring color 9 13)))) + ((eql (length color) 13) + (setq r (string-to-number (substring color 1 5) 16) + g (string-to-number (substring color 5 9) 16) + b (string-to-number (substring color 9 13) 16))) (t - (font-warn 'color (format "Invalid RGB color specification: %s" - color)) + (display-warning 'color + (format "Invalid RGB color specification: %s" color)) (setq r 0 g 0 b 0)))) @@ -1213,17 +1172,17 @@ (> (- (match-end 3) (match-beginning 3)) 4)) (error "Invalid RGB color specification: %s" color) (setq str (match-string 1 color) - r (* (font-hex-string-to-number str) + r (* (string-to-number str 16) (expt 16 (- 4 (length str)))) str (match-string 2 color) - g (* (font-hex-string-to-number str) + g (* (string-to-number str 16) (expt 16 (- 4 (length str)))) str (match-string 3 color) - b (* (font-hex-string-to-number str) + b (* (string-to-number str 16) (expt 16 (- 4 (length str))))))) (t - (font-warn 'html (format "Invalid RGB color specification: %s" - color)) + (display-warning 'color (format "Invalid RGB color specification: %s" + color)) (setq r 0 g 0 b 0))) @@ -1231,7 +1190,7 @@ (defun font-rgb-color-p (obj) (or (and (vectorp obj) - (= (length obj) 4) + (eql (length obj) 4) (eq (aref obj 0) 'rgb)))) (defun font-rgb-color-red (obj) (aref obj 1)) @@ -1255,11 +1214,11 @@ (list (font-rgb-color-red color) (font-rgb-color-green color) (font-rgb-color-blue color))) - ((and (vectorp color) (= 3 (length color))) + ((and (vectorp color) (eql 3 (length color))) (list (aref color 0) (aref color 1) (aref color 2))) - ((and (listp color) (= 3 (length color)) (floatp (car color))) + ((and (listp color) (eql 3 (length color)) (floatp (car color))) (mapcar #'(lambda (x) (* x 65535)) color)) - ((and (listp color) (= 3 (length color))) + ((and (listp color) (eql 3 (length color))) color) ((or (string-match "^#" color) (string-match "^rgb:" color)) @@ -1288,7 +1247,7 @@ (defun font-tty-find-closest-color (r g b) ;; This is basically just a lisp copy of allocate_nearest_color - ;; from objects-x.c from Emacs 19 + ;; from fontcolor-x.c from Emacs 19 ;; We really should just check tty-color-list, but unfortunately ;; that does not include any RGB information at all. ;; So for now we just hardwire in the default list and call it diff -r 861f2601a38b -r 1f0b15040456 lisp/fontcolor.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/fontcolor.el Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,210 @@ +;;; fontcolor.el --- Lisp interface to fonts and colors + +;; Copyright (C) 1994, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1995 Ben Wing +;; Copyright (C) 2010 Didier Verna + +;; Author: Chuck Thompson +;; Author: Ben Wing +;; Maintainer: XEmacs Development Team +;; Keywords: faces, 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 3 of the License, 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. If not, see . + +;;; Synched up with: Not in FSF. + +;;; Commentary: + +;; This file is dumped with XEmacs. + +;;; Code: + +(defun fontcolor-property-1 (function object domain &optional matchspec) + (let ((instance (if matchspec + (specifier-matching-instance object matchspec domain) + (specifier-instance object domain)))) + (and instance (funcall function instance)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; font specifiers + +(defun make-font-specifier (spec-list) + "Return a new `font' specifier object with the given specification list. +SPEC-LIST can be a list of specifications (each of which is a cons of a +locale and a list of instantiators), a single instantiator, or a list +of instantiators. See `make-specifier' for more information about +specifiers. + +Valid instantiators for font specifiers are: + +-- a string naming a font; syntax is platform dependent. Some examples for + a 14-point upright medium-weight Courier font: + X11 (and GTK1): \"-*-courier-medium-r-*-*-*-140-*-*-*-*-iso8859-*\" + Xft (and GTK2): \"Courier-14\" + MS-Windows: \"Courier:14:Western\" +-- a font instance (use that instance directly if the device matches, + or use the string that generated it) +-- a vector of no elements (only on TTY's; this means to set no font + at all, thus using the \"natural\" font of the terminal's text) +-- a vector of one element (a face to inherit from) +" + (make-specifier-and-init 'font spec-list)) + +(defun font-name (font &optional domain charset) + "Return the name of the FONT in the specified DOMAIN, if any. +FONT should be a font specifier object and DOMAIN is normally a window +and defaults to the selected window if omitted. This is equivalent +to using `specifier-instance' and applying `font-instance-name' to +the result. See `make-specifier' for more information about specifiers." + (fontcolor-property-1 'font-instance-name font domain charset)) + +(defun font-ascent (font &optional domain charset) + "Return the ascent of the FONT in the specified DOMAIN, if any. +FONT should be a font specifier object and DOMAIN is normally a window +and defaults to the selected window if omitted. This is equivalent +to using `specifier-instance' and applying `font-instance-ascent' to +the result. See `make-specifier' for more information about specifiers." + (fontcolor-property-1 'font-instance-ascent font domain charset)) + +(defun font-descent (font &optional domain charset) + "Return the descent of the FONT in the specified DOMAIN, if any. +FONT should be a font specifier object and DOMAIN is normally a window +and defaults to the selected window if omitted. This is equivalent +to using `specifier-instance' and applying `font-instance-descent' to +the result. See `make-specifier' for more information about specifiers." + (fontcolor-property-1 'font-instance-descent font domain charset)) + +(defun font-width (font &optional domain charset) + "Return the width of the FONT in the specified DOMAIN, if any. +FONT should be a font specifier object and DOMAIN is normally a window +and defaults to the selected window if omitted. This is equivalent +to using `specifier-instance' and applying `font-instance-width' to +the result. See `make-specifier' for more information about specifiers." + (fontcolor-property-1 'font-instance-width font domain charset)) + +(defun font-height (font &optional domain charset) + "Return the height of the FONT in the specified DOMAIN, if any. +FONT should be a font specifier object and DOMAIN is normally a window +and defaults to the selected window if omitted. This is equivalent +to using `specifier-instance' and applying `font-instance-height' to +the result. See `make-specifier' for more information about specifiers." + (fontcolor-property-1 'font-instance-height font domain charset)) + +(defun font-proportional-p (font &optional domain charset) + "Return whether FONT is proportional in the specified DOMAIN, if known. +FONT should be a font specifier object and DOMAIN is normally a window +and defaults to the selected window if omitted. This is equivalent +to using `specifier-instance' and applying `font-instance-proportional-p' to +the result. See `make-specifier' for more information about specifiers." + (fontcolor-property-1 'font-instance-proportional-p font domain charset)) + +(defun font-properties (font &optional domain charset) + "Return the properties of the FONT in the specified DOMAIN, if any. +FONT should be a font specifier object and DOMAIN is normally a window +and defaults to the selected window if omitted. This is equivalent +to using `specifier-instance' and applying `font-instance-properties' +to the result. See `make-specifier' for more information about specifiers." + (fontcolor-property-1 'font-instance-properties font domain charset)) + +(defun font-truename (font &optional domain charset) + "Return the truename of the FONT in the specified DOMAIN, if any. +FONT should be a font specifier object and DOMAIN is normally a window +and defaults to the selected window if omitted. This is equivalent +to using `specifier-instance' and applying `font-instance-truename' +to the result. See `make-specifier' for more information about specifiers." + (fontcolor-property-1 'font-instance-truename font domain charset)) + +(defun font-instance-height (font-instance) + "Return the height in pixels of FONT-INSTANCE. +The returned value is the maximum height for all characters in the font,\n\ +and is equivalent to the sum of the font instance's ascent and descent." + (+ (font-instance-ascent font-instance) + (font-instance-descent font-instance))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; color specifiers + +(defun make-color-specifier (spec-list) + "Return a new `color' specifier object with the given specification list. +SPEC-LIST can be a list of specifications (each of which is a cons of a +locale and a list of instantiators), a single instantiator, or a list +of instantiators. See `make-specifier' for a detailed description of +how specifiers work. + +Valid instantiators for color specifiers are: + +-- a string naming a color (e.g. under X this might be \"lightseagreen2\" + or \"#F534B2\") +-- a color instance (use that instance directly if the device matches, + or use the string that generated it) +-- a vector of no elements (only on TTY's; this means to set no color + at all, thus using the \"natural\" color of the terminal's text) +-- a vector of one or two elements: a face to inherit from, and + optionally a symbol naming which property of that face to inherit, + either `foreground' or `background' (if omitted, defaults to the same + property that this color specifier is used for; if this specifier is + not part of a face, the instantiator would not be valid)." + (make-specifier-and-init 'color spec-list)) + +(defun color-name (color &optional domain) + "Return the name of the COLOR in the specified DOMAIN, if any. +COLOR should be a color specifier object and DOMAIN is normally a window +and defaults to the selected window if omitted. This is equivalent +to using `specifier-instance' and applying `color-instance-name' to +the result. See `make-specifier' for more information about specifiers." + (fontcolor-property-1 'color-instance-name color domain)) + +(defun color-rgb-components (color &optional domain) + "Return the RGB components of the COLOR in the specified DOMAIN, if any. +COLOR should be a color specifier object and DOMAIN is normally a window +and defaults to the selected window if omitted. This is equivalent +to using `specifier-instance' and applying `color-instance-rgb-components' +to the result. See `make-specifier' for more information about specifiers." + (fontcolor-property-1 'color-instance-rgb-components color domain)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; face-boolean specifiers + +(defun make-face-boolean-specifier (spec-list) + "Return a new `face-boolean' specifier object with the given spec list. +SPEC-LIST can be a list of specifications (each of which is a cons of a +locale and a list of instantiators), a single instantiator, or a list +of instantiators. See `make-specifier' for a detailed description of +how specifiers work. + +Valid instantiators for face-boolean specifiers are + +-- t or nil +-- a vector of one, two or three elements: a face to inherit from, + optionally a symbol naming the property of that face to inherit from + (if omitted, defaults to the same property that this face-boolean + specifier is used for; if this specifier is not part of a face, + the instantiator would not be valid), and optionally a value which, + if non-nil, means to invert the sense of the inherited property." + (make-specifier-and-init 'face-boolean spec-list)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; face-background-placement specifiers + +(defun make-face-background-placement-specifier (spec-list) + "Return a new `face-background-placement' specifier object. +SPEC-LIST can be a list of specifications (each of which is a cons of a +locale and a list of instantiators), a single instantiator, or a list +of instantiators. See `make-specifier' for a detailed description of +how specifiers work. + +Valid instantiators for face-background-placement specifiers are: +-- absolute or relative (symbols), +-- a vector of one element: a face to inherit from." + (make-specifier-and-init 'face-background-placement spec-list)) + +;;; fontcolor.el ends here. diff -r 861f2601a38b -r 1f0b15040456 lisp/fontconfig.el --- a/lisp/fontconfig.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/fontconfig.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,20 @@ ;; Updated: 05 Mar 2005 by Stephen J. Turnbull ;; 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 2, or (at your option) -;; any later version. +;; This file is part of XEmacs. -;; 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. +;; 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 3 of the License, or (at your +;; option) any later version. + +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in GNU @@ -352,7 +352,7 @@ (defun fc-pattern-get-or-compute-size (pattern id) "Get the size from `pattern' associated with `id' or try to compute it. -Returns 'fc-result-no-match if unsucessful." +Returns 'fc-result-no-match if unsuccessful." ;; Many font patterns don't have a "size" property, but do have a ;; "dpi" and a "pixelsize" property". (let ((maybe (fc-pattern-get-size pattern id))) diff -r 861f2601a38b -r 1f0b15040456 lisp/fontl-hooks.el --- a/lisp/fontl-hooks.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/fontl-hooks.el Sun May 01 18:44:03 2011 +0100 @@ -6,20 +6,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.30. (font-lock.el) diff -r 861f2601a38b -r 1f0b15040456 lisp/format.el --- a/lisp/format.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/format.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Emacs 20.2. @@ -437,68 +435,6 @@ (match-beginning 0))))) (setq alist (cdr alist))))))) -;;; Some list-manipulation functions that we need. - -(defun format-delq-cons (cons list) - "Remove the given CONS from LIST by side effect, -and return the new LIST. Since CONS could be the first element -of LIST, write `\(setq foo \(format-delq-cons element foo))' to be sure of -changing the value of `foo'." - (if (eq cons list) - (cdr list) - (let ((p list)) - (while (not (eq (cdr p) cons)) - (if (null p) (error "format-delq-cons: not an element.")) - (setq p (cdr p))) - ;; Now (cdr p) is the cons to delete - (setcdr p (cdr cons)) - list))) - -;; XEmacs: this is #'nset-exclusive-or with a :test of #'equal, though we -;; probably don't want to replace it right now. -(defun format-make-relatively-unique (a b) - "Delete common elements of lists A and B, return as pair. -Compares using `equal'." - (let* ((acopy (copy-sequence a)) - (bcopy (copy-sequence b)) - (tail acopy)) - (while tail - (let ((dup (member (car tail) bcopy)) - (next (cdr tail))) - (if dup (setq acopy (format-delq-cons tail acopy) - bcopy (format-delq-cons dup bcopy))) - (setq tail next))) - (cons acopy bcopy))) - -(defun format-common-tail (a b) - "Given two lists that have a common tail, return it. -Compares with `equal', and returns the part of A that is equal to the -equivalent part of B. If even the last items of the two are not equal, -returns nil." - (let ((la (length a)) - (lb (length b))) - ;; Make sure they are the same length - (if (> la lb) - (setq a (nthcdr (- la lb) a)) - (setq b (nthcdr (- lb la) b)))) - (while (not (equal a b)) - (setq a (cdr a) - b (cdr b))) - a) - -(defun format-reorder (items order) - "Arrange ITEMS to following partial ORDER. -Elements of ITEMS equal to elements of ORDER will be rearranged to follow the -ORDER. Unmatched items will go last." - (if order - (let ((item (member (car order) items))) - (if item - (cons (car item) - (format-reorder (format-delq-cons item items) - (cdr order))) - (format-reorder items (cdr order)))) - items)) - (put 'face 'format-list-valued t) ; These text-properties take values (put 'unknown 'format-list-valued t) ; that are lists, the elements of which ; should be considered separately. @@ -604,9 +540,8 @@ (if (member top-name ans) ;; This annotation is listed, but still have to ;; check if multiple annotations are satisfied - (if (member nil (mapcar (lambda (r) - (assoc r open-ans)) - ans)) + (if (notevery (lambda (r) (assoc r open-ans)) + ans) nil ; multiple ans not satisfied ;; If there are multiple annotations going ;; into one text property, split up the other @@ -821,7 +756,11 @@ (< loc to))) (or loc (setq loc from)) (let* ((ans (format-annotate-location loc (= loc from) ignore trans)) - (neg-ans (format-reorder (aref ans 0) open-ans)) + (neg-ans (sort* (aref ans 0) '< + :key #'(lambda (object) + (or + (position object open-ans :test 'equal) + most-positive-fixnum)))) (pos-ans (aref ans 1)) (ignored (aref ans 2))) (setq not-found (append ignored not-found) @@ -930,7 +869,6 @@ (if (or (consp old) (consp new)) (let* ((old (if (listp old) old (list old))) (new (if (listp new) new (list new))) - ;; (tail (format-common-tail old new)) close open) (while old (setq close @@ -944,7 +882,9 @@ prop-alist nil (car new))) open) new (cdr new))) - (format-make-relatively-unique close open)) + (cons + (set-difference close open :stable t) + (set-difference open close :stable t))) (format-annotate-atomic-property-change prop-alist old new))))) (defun format-annotate-atomic-property-change (prop-alist old new) @@ -981,7 +921,9 @@ (let ((close (and old (cdr (assoc old prop-alist)))) (open (and new (cdr (assoc new prop-alist))))) (if (or close open) - (format-make-relatively-unique close open) + (cons + (set-difference close open :stable t) + (set-difference open close :stable t)) ;; Call "Default" function, if any (let ((default (assq nil prop-alist))) (if default diff -r 861f2601a38b -r 1f0b15040456 lisp/frame.el --- a/lisp/frame.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/frame.el Sun May 01 18:44:03 2011 +0100 @@ -3,26 +3,25 @@ ;; Copyright (C) 1993, 1994, 1996, 1997, 2000, 2001, 2003 ;; Free Software Foundation, Inc. ;; Copyright (C) 1995, 1996 Ben Wing. +;; Copyright (C) 2010 Didier Verna ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 21.3. @@ -474,12 +473,13 @@ ;; onto a new frame. The default-minibuffer-frame ;; variable must be handled similarly. (let ((users-of-initial - (filtered-frame-list + (remove-if-not #'(lambda (frame) (and (not (eq frame frame-initial-frame)) (eq (window-frame (minibuffer-window frame)) - frame-initial-frame)))))) + frame-initial-frame))) + (frame-list)))) (if (or users-of-initial (eq default-minibuffer-frame frame-initial-frame)) @@ -487,10 +487,11 @@ ;; are only minibuffers. (let* ((new-surrogate (car - (or (filtered-frame-list + (or (remove-if-not #'(lambda (frame) (eq 'only - (frame-property frame 'minibuffer)))) + (frame-property frame 'minibuffer))) + (frame-list)) (minibuffer-frame-list)))) (new-minibuffer (minibuffer-window new-surrogate))) @@ -673,29 +674,22 @@ ;; XEmacs change: Emacs has make-frame here. We have it in C, so no need for ;; frame-creation-function. -;; XEmacs addition: support optional DEVICE argument. +;; XEmacs addition: support optional DEVICE argument, use delete-if-not. (defun filtered-frame-list (predicate &optional device) "Return a list of all live frames which satisfy PREDICATE. If optional second arg DEVICE is non-nil, restrict the frames returned to that device." - (let ((frames (if device (device-frame-list device) - (frame-list))) - good-frames) - (while (consp frames) - (if (funcall predicate (car frames)) - (setq good-frames (cons (car frames) good-frames))) - (setq frames (cdr frames))) - good-frames)) + (delete-if-not predicate + (if device (device-frame-list device) (frame-list)))) ;; XEmacs addition: support optional DEVICE argument. (defun minibuffer-frame-list (&optional device) "Return a list of all frames with their own minibuffers. If optional second arg DEVICE is non-nil, restrict the frames returned to that device." - (filtered-frame-list - #'(lambda (frame) - (eq frame (window-frame (minibuffer-window frame)))) - device)) + (delete-if-not + #'(lambda (frame) (eq frame (window-frame (minibuffer-window frame)))) + (if device (device-frame-list device) (frame-list)))) ;; XEmacs omission: Emacs has frames-on-display-list here, but that is ;; essentially equivalent to supplying the optional DEVICE argument to @@ -860,7 +854,7 @@ (defun frame-list () "Return a list of all frames on all devices/consoles." ;; Lists are copies, so nconc is safe here. - (apply 'nconc (mapcar 'device-frame-list (device-list)))) + (mapcan #'device-frame-list (device-list))) (defun frame-type (&optional frame) "Return the type of the specified frame (e.g. `x' or `tty'). @@ -1015,6 +1009,28 @@ "Set property PROP of FRAME to VAL. See `set-frame-properties'." (set-frame-properties frame (list prop val))) +(defun set-frame-background-placement (placement) + "Set the background placement of the selected frame to PLACEMENT. +When called interactively, prompt for the placement to use." + (interactive (list (intern (completing-read "Placement: " + '(("absolute" absolute) + ("relative" relative)) + nil t)))) + (set-face-background-placement 'default placement (selected-frame))) + +(defun frame-background-placement () + "Retrieve the selected frame's background placement." + (interactive) + (face-background-placement 'default (selected-frame))) + +(defun frame-background-placement-instance () + "Retrieve the selected frame's background placement instance." + (interactive) + (face-background-placement-instance 'default (selected-frame))) + +;; #### FIXME: misnomers ! The functions below should be called +;; set-frame- -- dvl. + ;; XEmacs change: this function differs significantly from Emacs. (defun set-background-color (color-name) "Set the background color of the selected frame to COLOR-NAME. @@ -1722,9 +1738,10 @@ (or (plist-get default-frame-plist 'name) default-frame-name)) (frames - (sort (filtered-frame-list #'(lambda (x) - (or (frame-visible-p x) - (frame-iconified-p x)))) + (sort (remove-if-not #'(lambda (x) + (or (frame-visible-p x) + (frame-iconified-p x))) + (frame-list)) #'(lambda (s1 s2) (cond ((and (frame-visible-p s1) (not (frame-visible-p s2)))) diff -r 861f2601a38b -r 1f0b15040456 lisp/gdk.el --- a/lisp/gdk.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gdk.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF diff -r 861f2601a38b -r 1f0b15040456 lisp/generic-widgets.el --- a/lisp/generic-widgets.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/generic-widgets.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF diff -r 861f2601a38b -r 1f0b15040456 lisp/glade.el --- a/lisp/glade.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/glade.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF diff -r 861f2601a38b -r 1f0b15040456 lisp/glyphs.el --- a/lisp/glyphs.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/glyphs.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/gnome-widgets.el --- a/lisp/gnome-widgets.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gnome-widgets.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF @@ -469,7 +467,7 @@ (GnomeFontPickerMode . mode)) ;; With GNOME_FONT_PICKER_MODE_FONT_INFO -;; If use_font_in_label is true, font name will be writen using font choosed by user and +;; If use_font_in_label is true, font name will be written using font chosen by user and ;; using size passed to this function (gtk-import-function nil gnome_font_picker_fi_set_use_font_in_label (GnomeFontPicker . gfp) @@ -726,7 +724,7 @@ ;;; const char *subtype, ;;; GnomeStockPixmapEntry *entry); -;; check for the existance of an entry. returns the entry if it +;; check for the existence of an entry. returns the entry if it ;; exists, or NULL otherwise ;;;GnomeStockPixmapEntry *gnome_stock_pixmap_checkfor (const char *icon, ;;; const char *subtype); diff -r 861f2601a38b -r 1f0b15040456 lisp/gnome.el --- a/lisp/gnome.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gnome.el Sun May 01 18:44:03 2011 +0100 @@ -1,19 +1,21 @@ -;; This file is part of XEmacs. +;; gnome.el --- GNOME integration for XEmacs/GTK +;; +;; Copyright (C) 2000, 2001 William M. Perry ;; -;; XEmacs is free software; you can redistribute it and/or modify it +;; 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. -;; +;; Free Software Foundation, either version 3 of the License, or (at your +;; option) any later version. + ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;; for more details. -;; + ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -;; Boston, MA 02111-1301, USA. */ +;; along with XEmacs. If not, see . (globally-declare-fboundp '(gtk-type-from-name diff -r 861f2601a38b -r 1f0b15040456 lisp/gnuserv.el --- a/lisp/gnuserv.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gnuserv.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -468,7 +466,7 @@ (select-frame frame) (setq gnuserv-current-client nil) ;; If the device was created by this client, push it to the list. - (and (/= old-device-num (length (device-list))) + (and (not (eql old-device-num (length (device-list)))) (push device gnuserv-devices)) (and (frame-iconified-p frame) (deiconify-frame frame)) diff -r 861f2601a38b -r 1f0b15040456 lisp/gpm.el --- a/lisp/gpm.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gpm.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . (defvar gpm-enabled-devices (make-hash-table :test 'eq :size 13 diff -r 861f2601a38b -r 1f0b15040456 lisp/gtk-compose.el --- a/lisp/gtk-compose.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gtk-compose.el Sun May 01 18:44:03 2011 +0100 @@ -1,19 +1,21 @@ -;; This file is part of XEmacs. +;; gtk-compose.el --- provide compose-key handling to GTK +;; +;; Copyright (C) 2000, 2001 William M. Perry ;; -;; XEmacs is free software; you can redistribute it and/or modify it +;; 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. -;; +;; Free Software Foundation, either version 3 of the License, or (at your +;; option) any later version. + ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;; for more details. -;; + ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -;; Boston, MA 02111-1301, USA. */ +;; along with XEmacs. If not, see . (require 'x-compose) diff -r 861f2601a38b -r 1f0b15040456 lisp/gtk-extra.el --- a/lisp/gtk-extra.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gtk-extra.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF diff -r 861f2601a38b -r 1f0b15040456 lisp/gtk-faces.el --- a/lisp/gtk-faces.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gtk-faces.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched. @@ -131,36 +129,33 @@ (encoding "[^-]+") ; false! ) (setq gtk-font-regexp - (purecopy - (concat "\\`\\*?[-?*]" - foundry - family - weight\? - slant\? - swidth - adstyle - - pixelsize - pointsize - resx - resy - spacing - avgwidth - - registry - encoding "\\'" - ))) + (concat "\\`\\*?[-?*]" + foundry - family - weight\? - slant\? - swidth - adstyle - + pixelsize - pointsize - resx - resy - spacing - avgwidth - + registry - encoding "\\'" + )) (setq gtk-font-regexp-head - (purecopy - (concat "\\`[-?*]" foundry - family - weight\? - slant\? - "\\([-*?]\\|\\'\\)"))) + (concat "\\`[-?*]" foundry - family - weight\? - slant\? + "\\([-*?]\\|\\'\\)")) (setq gtk-font-regexp-head-2 - (purecopy - (concat "\\`[-?*]" foundry - family - weight\? - slant\? - - swidth - adstyle - pixelsize - pointsize - "\\([-*?]\\|\\'\\)"))) - (setq gtk-font-regexp-slant (purecopy (concat - slant -))) - (setq gtk-font-regexp-weight (purecopy (concat - weight -))) + (concat "\\`[-?*]" foundry - family - weight\? - slant\? + - swidth - adstyle - pixelsize - pointsize + "\\([-*?]\\|\\'\\)")) + (setq gtk-font-regexp-slant (concat - slant -)) + (setq gtk-font-regexp-weight (concat - weight -)) ;; if we can't match any of the more specific regexps (unfortunate) then ;; look for digits; assume 2+ digits is 10ths of points, and 1-2 digits ;; is pixels. Bogus as hell. - (setq gtk-font-regexp-pixel (purecopy "[-?*]\\([0-9][0-9]?\\)[-?*]")) - (setq gtk-font-regexp-point (purecopy "[-?*]\\([0-9][0-9]+\\)[-?*]")) + (setq gtk-font-regexp-pixel "[-?*]\\([0-9][0-9]?\\)[-?*]") + (setq gtk-font-regexp-point "[-?*]\\([0-9][0-9]+\\)[-?*]") ;; the following two are used by x-font-menu.el. (setq gtk-font-regexp-foundry-and-family - (purecopy (concat "\\`[-?*]" foundry - "\\(" family "\\)" -))) + (concat "\\`[-?*]" foundry - "\\(" family "\\)" -)) (setq gtk-font-regexp-registry-and-encoding - (purecopy (concat - "\\(" registry "\\)" - "\\(" encoding "\\)\\'"))) + (concat - "\\(" registry "\\)" - "\\(" encoding "\\)\\'")) (setq gtk-font-regexp-spacing - (purecopy (concat - "\\(" spacing "\\)" - avgwidth - - registry - encoding "\\'"))) + (concat - "\\(" spacing "\\)" - avgwidth + - registry - encoding "\\'")) ) (defvaralias 'x-font-regexp 'gtk-font-regexp) diff -r 861f2601a38b -r 1f0b15040456 lisp/gtk-ffi.el --- a/lisp/gtk-ffi.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gtk-ffi.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF @@ -40,7 +38,7 @@ really part of the object system.") (defvar gtk-ffi-debug nil - "If non-nil, all functions defined wiht `gtk-import-function' will be checked + "If non-nil, all functions defined with `gtk-import-function' will be checked for missing marshallers.") (defun gtk-ffi-check-function (func) diff -r 861f2601a38b -r 1f0b15040456 lisp/gtk-file-dialog.el --- a/lisp/gtk-file-dialog.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gtk-file-dialog.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/gtk-font-menu.el --- a/lisp/gtk-font-menu.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gtk-font-menu.el Sun May 01 18:44:03 2011 +0100 @@ -12,20 +12,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Code: ;; #### - The comment that this file was GTK-ized by Wm Perry is a lie; @@ -92,7 +90,7 @@ ;; #### - this should implement a `menus-only' option, which would ;; recalculate the menus from the cache w/o having to do font-list again. (unless gtk-font-regexp-ascii - (setq gtk-font-regexp-ascii (if-fboundp #'charset-registries + (setq gtk-font-regexp-ascii (if-fboundp 'charset-registries (aref (charset-registries 'ascii) 0) "iso8859-1"))) (setq gtk-font-menu-registry-encoding @@ -168,19 +166,19 @@ (mapcar (lambda (x) (vector x (list 'font-menu-set-font x nil nil) - ':style 'radio ':active nil ':selected nil)) + :style 'radio :active nil :selected nil)) families) (mapcar (lambda (x) (vector (if (/= 0 (% x 10)) (number-to-string (/ x 10.0)) (number-to-string (/ x 10))) (list 'font-menu-set-font nil nil x) - ':style 'radio ':active nil ':selected nil)) + :style 'radio :active nil :selected nil)) sizes) (mapcar (lambda (x) (vector x (list 'font-menu-set-font nil x nil) - ':style 'radio ':active nil ':selected nil)) + :style 'radio :active nil :selected nil)) weights))) (cdr dev-cache))) diff -r 861f2601a38b -r 1f0b15040456 lisp/gtk-glyphs.el --- a/lisp/gtk-glyphs.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gtk-glyphs.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/gtk-init.el --- a/lisp/gtk-init.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gtk-init.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . (globally-declare-boundp '(gtk-initial-argv-list gtk-initial-geometry)) diff -r 861f2601a38b -r 1f0b15040456 lisp/gtk-marshal.el --- a/lisp/gtk-marshal.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gtk-marshal.el Sun May 01 18:44:03 2011 +0100 @@ -1,19 +1,21 @@ -;; This file is part of XEmacs. +;; gtk-marshal.el --- regenerate C wrappers for GTK +;; +;; Copyright (C) 2000, 2001 William M. Perry ;; -;; XEmacs is free software; you can redistribute it and/or modify it +;; 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. -;; +;; Free Software Foundation, either version 3 of the License, or (at your +;; option) any later version. + ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;; for more details. -;; + ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -;; Boston, MA 02111-1301, USA. */ +;; along with XEmacs. If not, see . ;; ;; To regenerate ../src/emacs-marshals.c just load this file. ;; diff -r 861f2601a38b -r 1f0b15040456 lisp/gtk-mouse.el --- a/lisp/gtk-mouse.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gtk-mouse.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched. diff -r 861f2601a38b -r 1f0b15040456 lisp/gtk-package.el --- a/lisp/gtk-package.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gtk-package.el Sun May 01 18:44:03 2011 +0100 @@ -1,20 +1,22 @@ -;; This file is part of XEmacs. +;; gtk-package.el --- GTK version of package-ui +;; +;; Copyright (C) 2000, 2001 William M. Perry ;; -;; XEmacs is free software; you can redistribute it and/or modify it +;; 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. -;; +;; Free Software Foundation, either version 3 of the License, or (at your +;; option) any later version. + ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;; for more details. -;; + ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -;; Boston, MA 02111-1301, USA. */ -;; +;; along with XEmacs. If not, see . + ;; A GTK version of package-ui.el (globally-declare-fboundp diff -r 861f2601a38b -r 1f0b15040456 lisp/gtk-password-dialog.el --- a/lisp/gtk-password-dialog.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gtk-password-dialog.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/gtk-select.el --- a/lisp/gtk-select.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gtk-select.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF diff -r 861f2601a38b -r 1f0b15040456 lisp/gtk-widget-accessors.el --- a/lisp/gtk-widget-accessors.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gtk-widget-accessors.el Sun May 01 18:44:03 2011 +0100 @@ -1,19 +1,21 @@ -;; This file is part of XEmacs. +;; gtk-widget-accessors.el --- GTK wrappers for widgets +;; +;; Copyright (C) 2000, 2001 William M. Perry ;; -;; XEmacs is free software; you can redistribute it and/or modify it +;; 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. -;; +;; Free Software Foundation, either version 3 of the License, or (at your +;; option) any later version. + ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;; for more details. -;; + ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -;; Boston, MA 02111-1301, USA. */ +;; along with XEmacs. If not, see . (globally-declare-fboundp '(gtk-fundamental-type)) diff -r 861f2601a38b -r 1f0b15040456 lisp/gtk-widgets.el --- a/lisp/gtk-widgets.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gtk-widgets.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF @@ -228,8 +226,8 @@ (gtk-import-function nil gtk_clist_set_button_actions GtkCList guint guint) ;; freeze all visual updates of the list, and then thaw the list after -;; you have made a number of changes and the updates wil occure in a -;; more efficent mannor than if you made them on a unfrozen list +;; you have made a number of changes and the updates will occur in a +;; more efficient manner than if you made them on an unfrozen list (gtk-import-function nil gtk_clist_freeze GtkCList) (gtk-import-function nil gtk_clist_thaw GtkCList) @@ -345,8 +343,8 @@ (gtk-import-function GtkStyle gtk_clist_get_row_style GtkCList gint) ;; this sets a horizontal and vertical shift for drawing -;; the contents of a cell; it can be positive or negitive; -;; this is particulary useful for indenting items in a column +;; the contents of a cell; it can be positive or negative; +;; this is particularly useful for indenting items in a column (gtk-import-function nil gtk_clist_set_shift GtkCList gint gint gint gint) ;; set/get selectable flag of a single row diff -r 861f2601a38b -r 1f0b15040456 lisp/gtk.el --- a/lisp/gtk.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gtk.el Sun May 01 18:44:03 2011 +0100 @@ -1,19 +1,21 @@ -;; This file is part of XEmacs. +;; gtk.el --- provide information about GTK wrapping +;; +;; Copyright (C) 2000, 2001 William M. Perry ;; -;; XEmacs is free software; you can redistribute it and/or modify it +;; 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. -;; +;; Free Software Foundation, either version 3 of the License, or (at your +;; option) any later version. + ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;; for more details. -;; + ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -;; Boston, MA 02111-1301, USA. */ +;; along with XEmacs. If not, see . (globally-declare-fboundp '(gtk-import-function-internal diff -r 861f2601a38b -r 1f0b15040456 lisp/gui.el --- a/lisp/gui.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gui.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF diff -r 861f2601a38b -r 1f0b15040456 lisp/gutter-items.el --- a/lisp/gutter-items.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gutter-items.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; 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 Xmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Gutter-specific buffers tab code diff -r 861f2601a38b -r 1f0b15040456 lisp/gutter.el --- a/lisp/gutter.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/gutter.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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 Xmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;; Some of this is taken from the buffer-menu stuff in menubar-items.el ;; and the custom specs in toolbar.el. diff -r 861f2601a38b -r 1f0b15040456 lisp/hash-table.el --- a/lisp/hash-table.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/hash-table.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -37,34 +35,27 @@ (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))) + (let (list) + (maphash #'(lambda (key value) (push key list)) hash-table) + list)) (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))) + (let (list) + (maphash #'(lambda (key value) (push value list)) hash-table) + list)) (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)) + (let (list) + (maphash #'(lambda (key value) (setq list (acons key value list))) hash-table) - (nreverse lis))) + list)) (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)) + (let (list) + (maphash #'(lambda (key value) (setq list (list* key value list))) hash-table) - (nreverse lis))) + list)) diff -r 861f2601a38b -r 1f0b15040456 lisp/help-macro.el --- a/lisp/help-macro.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/help-macro.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/help.el --- a/lisp/help.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/help.el Sun May 01 18:44:03 2011 +0100 @@ -1,27 +1,25 @@ ;; help.el --- help commands for XEmacs. ;; Copyright (C) 1985, 1986, 1992-4, 1997 Free Software Foundation, Inc. -;; Copyright (C) 2001, 2002, 2003 Ben Wing. +;; Copyright (C) 2001, 2002, 2003, 2010 Ben Wing. ;; Maintainer: FSF ;; Keywords: help, 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.30. @@ -350,7 +348,7 @@ ;; If the key typed was really a menu selection, grab the form out ;; of the event object and intuit the function that would be called, ;; and describe that instead. - (if (and (vectorp key) (= 1 (length key)) + (if (and (vectorp key) (eql 1 (length key)) (or (misc-user-event-p (aref key 0)) (eq (car-safe (aref key 0)) 'menu-selection))) (let ((event (aref key 0))) @@ -1182,27 +1180,21 @@ (fndef (if (eq (car-safe fnc) 'macro) (cdr fnc) fnc)) + (args (cdr (function-documentation-1 function t))) (arglist - (cond ((compiled-function-p fndef) - (compiled-function-arglist fndef)) - ((eq (car-safe fndef) 'lambda) - (nth 1 fndef)) - ((or (subrp fndef) (eq 'autoload (car-safe fndef))) - (let* ((doc (documentation function)) - (args (and doc - (string-match - "[\n\t ]*\narguments: ?(\\([^)]*\\))\n?\\'" - doc) - (match-string 1 doc))) - (args (and args (replace-in-string args - "[ ]*\\\\\n[ \t]*" - " " t)))) - ;; If there are no arguments documented for the - ;; subr, rather don't print anything. - (cond ((null args) t) - ((equal args "") nil) - (args)))) - (t t))) + (or args + (cond ((compiled-function-p fndef) + (compiled-function-arglist fndef)) + ((eq (car-safe fndef) 'lambda) + (nth 1 fndef)) + ((or (subrp fndef) (eq 'autoload (car-safe fndef))) + + ;; If there are no arguments documented for the + ;; subr, rather don't print anything. + (cond ((null args) t) + ((equal args "") nil) + (args))) + (t t)))) (print-gensym nil)) (cond ((listp arglist) (prin1-to-string @@ -1215,22 +1207,35 @@ t)) ((stringp arglist) - (format "(%s %s)" function arglist))))) + (if (> (length arglist) 0) + (format "(%s %s)" function arglist) + (format "(%s)" function)))))) + +;; If STRIP-ARGLIST is true, return a cons (DOC . ARGS) of the documentation +;; with any embedded arglist stripped out, and the arglist that was stripped +;; out. If STRIP-ARGLIST is false, the cons will be (FULL-DOC . nil), +;; where FULL-DOC is the full documentation without the embedded arglist +;; stripped out. +(defun function-documentation-1 (function &optional strip-arglist) + (let ((doc (condition-case nil + (or (documentation function) + (gettext "not documented")) + (void-function "(alias for undefined function)") + (error "(unexpected error from `documentation')"))) + args) + (when (and strip-arglist + (string-match "[\n\t ]*\narguments: ?(\\(.*\\))\n?\\'" doc)) + (setq args (match-string 1 doc)) + (setq doc (substring doc 0 (match-beginning 0))) + (and args (setq args (replace-in-string args "[ ]*\\\\\n[ \t]*" " " t))) + (and (eql 0 (length doc)) (setq doc (gettext "not documented")))) + (cons doc args))) (defun function-documentation (function &optional strip-arglist) "Return a string giving the documentation for FUNCTION, if any. If the optional argument STRIP-ARGLIST is non-nil, remove the arglist -part of the documentation of internal subroutines." - (let ((doc (condition-case nil - (or (documentation function) - (gettext "not documented")) - (void-function "(alias for undefined function)") - (error "(unexpected error from `documention')")))) - (when (and strip-arglist - (string-match "[\n\t ]*\narguments: ?(\\([^)]*\\))\n?\\'" doc)) - (setq doc (substring doc 0 (match-beginning 0))) - (and (zerop (length doc)) (setq doc (gettext "not documented")))) - doc)) +part of the documentation of internal subroutines, CL lambda forms, etc." + (car (function-documentation-1 function strip-arglist))) ;; replacement for `princ' that puts the text in the specified face, ;; if possible @@ -1293,14 +1298,14 @@ (defvar help-symbol-function-context-menu '(["View %_Documentation" (help-symbol-run-function 'describe-function)] ["Find %_Function Source" (help-symbol-run-function 'find-function) - (fboundp #'find-function)] + (fboundp 'find-function)] ["Find %_Tag" (help-symbol-run-function 'find-tag)] )) (defvar help-symbol-variable-context-menu '(["View %_Documentation" (help-symbol-run-function 'describe-variable)] ["Find %_Variable Source" (help-symbol-run-function 'find-variable) - (fboundp #'find-variable)] + (fboundp 'find-variable)] ["Find %_Tag" (help-symbol-run-function 'find-tag)] )) @@ -1310,9 +1315,9 @@ ["View Variable D%_ocumentation" (help-symbol-run-function 'describe-variable)] ["Find %_Function Source" (help-symbol-run-function 'find-function) - (fboundp #'find-function)] + (fboundp 'find-function)] ["Find %_Variable Source" (help-symbol-run-function 'find-variable) - (fboundp #'find-variable)] + (fboundp 'find-variable)] ["Find %_Tag" (help-symbol-run-function 'find-tag)] )) @@ -1724,9 +1729,8 @@ The sorting is done by length (shortest bindings first), and the bindings are separated with SEPARATOR (\", \" by default)." (mapconcat 'key-description - (sort keys #'(lambda (x y) - (< (length x) (length y)))) - (or separator ", "))) + (sort* keys #'< :key #'length) + (or separator ", "))) (defun where-is (definition &optional insert) "Print message listing key sequences that invoke specified command. @@ -1852,12 +1856,12 @@ "Follow any cross reference to source code; if none, scroll up. " (interactive "d") (let ((e (extent-at pos nil 'find-function-symbol))) - (if (and-fboundp #'find-function e) - (with-fboundp #'find-function + (if (and-fboundp 'find-function e) + (with-fboundp 'find-function (find-function (extent-property e 'find-function-symbol))) (setq e (extent-at pos nil 'find-variable-symbol)) - (if (and-fboundp #'find-variable e) - (with-fboundp #'find-variable + (if (and-fboundp 'find-variable e) + (with-fboundp 'find-variable (find-variable (extent-property e 'find-variable-symbol))) (scroll-up 1))))) @@ -1867,12 +1871,12 @@ (interactive "e") (mouse-set-point event) (let ((e (extent-at (point) nil 'find-function-symbol))) - (if (and-fboundp #'find-function e) - (with-fboundp #'find-function + (if (and-fboundp 'find-function e) + (with-fboundp 'find-function (find-function (extent-property e 'find-function-symbol))) (setq e (extent-at (point) nil 'find-variable-symbol)) - (if (and-fboundp #'find-variable e) - (with-fboundp #'find-variable + (if (and-fboundp 'find-variable e) + (with-fboundp 'find-variable (find-variable (extent-property e 'find-variable-symbol))) (mouse-track event))))) diff -r 861f2601a38b -r 1f0b15040456 lisp/hyper-apropos.el --- a/lisp/hyper-apropos.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/hyper-apropos.el Sun May 01 18:44:03 2011 +0100 @@ -11,19 +11,18 @@ ;; 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 of the License, 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. -;; +;; 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 3 of the License, 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; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -730,7 +729,7 @@ (local mode-name) global local-str global-str font fore back undl - aliases alias-desc desc) + aliases alias-desc desc arglist) (save-excursion (set-buffer (get-buffer-create hyper-apropos-help-buf)) ;;(setq standard-output (current-buffer)) @@ -764,21 +763,22 @@ (bytecode . "compiled Lisp ") (autoload . "autoloaded Lisp ") (lambda . "Lisp ")))) - desc - (case symtype - ((autoload) (format ",\n(autoloaded from \"%s\")" - (nth 1 newsym))) - ((bytecode) (format ",\n(loaded from \"%s\")" - (symbol-file symbol))))) + desc ",\n(loaded from \"" + (or (symbol-file symbol 'defun) + "[no file information available]") + "\")") local (current-local-map) global (current-global-map) obsolete (get symbol 'byte-obsolete-info) - doc (or (condition-case nil - (documentation symbol) - (void-function - "(alias for undefined function)") - (error "(unexpected error from `documention')")) - "function not documented")) + doc (function-documentation symbol t) + arglist (let ((farglist (function-arglist symbol))) + (if farglist + (replace-in-string + farglist + (format "^(%s " + (regexp-quote (symbol-name symbol))) + "(") + "[not available]"))) (save-excursion (set-buffer hyper-apropos-help-buf) (goto-char (point-max)) @@ -802,32 +802,7 @@ 'hyper-apropos-warning)) (setq beg (point)) (insert-face "arguments: " 'hyper-apropos-heading) - (cond ((eq symtype 'lambda) - (princ (or (nth 1 newsym) "()"))) - ((eq symtype 'bytecode) - (princ (or (compiled-function-arglist newsym) - "()"))) - ((and (or (eq symtype 'subr) (eq symtype 'autoload)) - (string-match - "[\n\t ]*\narguments: ?(\\([^)]*\\))\n?\\'" - doc)) - (insert (substring doc - (match-beginning 1) - (match-end 1))) - (setq doc (substring doc 0 (match-beginning 0)))) - ((and (eq symtype 'subr) - (string-match - "\ -\[\n\t ]*([^\n\t )]+[\t ]*\\([^\n)]+\\)?)\\(:[\t ]*\\|\n?\\'\\)" - doc)) - (insert "(" - (if (match-end 1) - (substring doc - (match-beginning 1) - (match-end 1))) - ")") - (setq doc (substring doc (match-end 0)))) - (t (princ "[not available]"))) + (princ arglist) (insert "\n\n") (hyper-apropos-insert-face doc) (insert "\n") @@ -944,14 +919,14 @@ (progn (setq ok t) (copy-face symbol 'hyper-apropos-temp-face 'global) - (mapcar #'(lambda (property) - (setq symtype (face-property-instance symbol - property)) - (if symtype - (set-face-property 'hyper-apropos-temp-face - property - symtype))) - built-in-face-specifiers) + (mapc #'(lambda (property) + (setq symtype (face-property-instance symbol + property)) + (if symtype + (set-face-property 'hyper-apropos-temp-face + property + symtype))) + built-in-face-specifiers) (setq font (cons (face-property-instance symbol 'font nil 0 t) (face-property-instance symbol 'font)) fore (cons (face-foreground-instance symbol nil 0 t) diff -r 861f2601a38b -r 1f0b15040456 lisp/indent.el --- a/lisp/indent.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/indent.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.30. diff -r 861f2601a38b -r 1f0b15040456 lisp/info.el --- a/lisp/info.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/info.el Sun May 01 18:44:03 2011 +0100 @@ -12,20 +12,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched with FSF. Highly divergent, and with ;;; many new features added for XEmacs. @@ -590,7 +588,7 @@ (equal (nth 1 p) "info") (not Info-standalone) (setq Info-standalone t) - (= (length p) 3) + (eql (length p) 3) (not (string-match "^-" (nth 2 p))) (setq file (nth 2 p)) (setq command-line-args-left nil)) @@ -864,14 +862,13 @@ (if (and Info-dir-contents Info-dir-file-attributes ;; Verify that none of the files we used has changed ;; since we used it. - (eval (cons 'and - (mapcar #'(lambda (elt) - (let ((curr (file-attributes (car elt)))) - ;; Don't compare the access time. - (if curr (setcar (nthcdr 4 curr) 0)) - (setcar (nthcdr 4 (cdr elt)) 0) - (equal (cdr elt) curr))) - Info-dir-file-attributes)))) + (every #'(lambda (elt) + (let ((curr (file-attributes (car elt)))) + ;; Don't compare the access time. + (if curr (setcar (nthcdr 4 curr) 0)) + (setcar (nthcdr 4 (cdr elt)) 0) + (equal (cdr elt) curr))) + Info-dir-file-attributes)) (insert Info-dir-contents) (let ((dirs (reverse Info-directory-list)) buffers lbuffers buffer others nodes dirs-done) @@ -1128,7 +1125,7 @@ (let ((dir-mod-time (nth 5 (file-attributes file))) f-mod-time newer) (setq Info-dir-newer-info-files nil) - (mapcar + (mapc #'(lambda (f) (prog2 (setq f-mod-time (nth 5 (file-attributes f))) @@ -1192,23 +1189,23 @@ (let ((tab-width 8) (description-col 0) len) - (mapcar #'(lambda (e) - (setq e (cdr e)) ; Drop filename - (setq len (length (concat (car e) - (car (cdr e))))) - (if (> len description-col) - (setq description-col len))) - entries) + (mapc #'(lambda (e) + (setq e (cdr e)) ; Drop filename + (setq len (length (concat (car e) + (car (cdr e))))) + (if (> len description-col) + (setq description-col len))) + entries) (setq description-col (+ 5 description-col)) - (mapcar #'(lambda (e) - (setq e (cdr e)) ; Drop filename - (insert "* " (car e) ":" (car (cdr e))) - (setq e (car (cdr (cdr e)))) - (while e - (indent-to-column description-col) - (insert (car e) "\n") - (setq e (cdr e)))) - entries) + (mapc #'(lambda (e) + (setq e (cdr e)) ; Drop filename + (insert "* " (car e) ":" (car (cdr e))) + (setq e (car (cdr (cdr e)))) + (while e + (indent-to-column description-col) + (insert (car e) "\n") + (setq e (cdr e)))) + entries) (insert "\n"))) @@ -1300,7 +1297,7 @@ (narrow-to-region mark next-section) (setq dir-section-contents (nreverse (Info-parse-dir-entries (point-min) (point-max)))) - (mapcar + (mapc #'(lambda (file) (setq dir-entry (assoc (downcase (file-name-sans-extension @@ -1502,7 +1499,7 @@ nil t) (if exact nil - ;; Then, try to match the name independantly of the + ;; Then, try to match the name independently of the ;; characters case. (directory-files dir 'fullname (Info-all-case-regexp diff -r 861f2601a38b -r 1f0b15040456 lisp/isearch-mode.el --- a/lisp/isearch-mode.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/isearch-mode.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 20.4. @@ -239,10 +237,18 @@ (let ((map (make-keymap))) (set-keymap-name map 'isearch-mode-map) - ;; Bind all printing characters to `isearch-printing-char'. - ;; This isn't normally necessary, but if a printing character were - ;; bound to something other than self-insert-command in global-map, - ;; then it would terminate the search and be executed without this. + ;; Bind ASCII printing characters to `isearch-printing-char'. This + ;; isn't normally necessary, but if a printing character were bound to + ;; something other than self-insert-command in global-map, then it would + ;; terminate the search and be executed without this. + + ;; This is also relevant when other modes (notably dired and gnus) call + ;; `suppress-keymap' on their major mode maps; this means that + ;; `isearch-maybe-frob-keyboard-macros' won't pick up that the command + ;; that would normally be executed is `self-insert-command' and do its + ;; thing of transforming that to `isearch-printing-char'. This is less + ;; of an issue for the non-ASCII characters, because they rarely have + ;; specific bindings in major modes. (let ((i 32) (str (make-string 1 0))) (while (< i 127) @@ -713,7 +719,7 @@ nonincremental search instead via `isearch-edit-string'." (interactive) (if (and (or search-nonincremental-instead executing-kbd-macro) - (= 0 (length isearch-string))) + (eql 0 (length isearch-string))) (let ((isearch-nonincremental t) ;; Highlighting only gets in the way of nonincremental ;; search. @@ -827,7 +833,7 @@ isearch-word isearch-new-word)) ;; Empty isearch-string means use default. - (if (= 0 (length isearch-string)) + (if (eql 0 (length isearch-string)) (setq isearch-string (or (car (if isearch-regexp regexp-search-ring search-ring)) @@ -1124,7 +1130,7 @@ (while (and (> idx 0) (eq (aref isearch-string (1- idx)) ?\\)) (setq idx (1- idx))) - (when (= (mod (- (length isearch-string) idx) 2) 0) + (when (eql (mod (- (length isearch-string) idx) 2) 0) (setq isearch-adjusted t) ;; Get the isearch-other-end from before the last search. ;; We want to start from there, @@ -1316,7 +1322,7 @@ ;; isearch-string stays the same t) ((or completion ; not nil, must be a string - (= 0 (length isearch-string))) ; shouldn't have to say this + (eql 0 (length isearch-string))) ; shouldn't have to say this (if (equal completion isearch-string) ;; no extension? (progn (if completion-auto-help @@ -1609,8 +1615,27 @@ last-command-char (and (stringp this-command) (aref this-command 0)) this-command 'isearch-printing-char)) - )) - + ((and (null this-command) + (eq 'key-press (event-type last-command-event)) + (current-local-map) + (let* ((this-command-keys (this-command-keys)) + (this-command-keys (or (lookup-key function-key-map + this-command-keys) + this-command-keys)) + (lookup-key (lookup-key global-map this-command-keys))) + (and (eq 'self-insert-command lookup-key) + ;; The feature here that a modification of + ;; last-command-event is respected is undocumented, and + ;; only applies when this-command is nil. The design + ;; isn't reat, and I welcome suggestions for a better + ;; one. + (setq last-command-event + (find-if 'key-press-event-p this-command-keys + :from-end t) + last-command-char + (event-to-character last-command-event) + this-command 'isearch-printing-char))))))) + ;;;======================================================== ;;; Highlighting diff -r 861f2601a38b -r 1f0b15040456 lisp/iso8859-1.el --- a/lisp/iso8859-1.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/iso8859-1.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -84,6 +82,17 @@ ;; by default. (setq-default ctl-arrow #xA0) +(when (and (compiled-function-p (symbol-function 'char-width)) + (not (featurep 'mule))) + (defalias 'char-width + (let ((constantly (constantly 1))) + (make-byte-code (compiled-function-arglist constantly) + (compiled-function-instructions constantly) + (compiled-function-constants constantly) + (compiled-function-stack-depth constantly) + (compiled-function-doc-string + (symbol-function 'char-width)))))) + ;; Shouldn't be necessary, but one file in the packages uses it: (provide 'iso8859-1) diff -r 861f2601a38b -r 1f0b15040456 lisp/itimer-autosave.el --- a/lisp/itimer-autosave.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/itimer-autosave.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/itimer.el --- a/lisp/itimer.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/itimer.el Sun May 01 18:44:03 2011 +0100 @@ -1,22 +1,20 @@ -;;; Interval timers for XEmacs -;;; Copyright (C) 1988, 1991, 1993, 1997, 1998 Kyle E. Jones -;;; -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; A copy of the GNU General Public License can be obtained from this -;;; program's author (send electronic mail to kyle@uunet.uu.net) or from -;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA -;;; 02139, USA. -;;; -;;; Send bug reports to kyle_jones@wonderworks.com +;; Interval timers for XEmacs +;; Copyright (C) 1988, 1991, 1993, 1997, 1998 Kyle E. Jones +;; +;; 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 3 of the License, 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. If not, see . +;; +;; Send bug reports to kyle_jones@wonderworks.com (provide 'itimer) diff -r 861f2601a38b -r 1f0b15040456 lisp/keydefs.el --- a/lisp/keydefs.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/keydefs.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;; All the global bindings should be here so that one can reload things ;; like files.el without trashing one's personal bindings. diff -r 861f2601a38b -r 1f0b15040456 lisp/keymap.el --- a/lisp/keymap.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/keymap.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.28. diff -r 861f2601a38b -r 1f0b15040456 lisp/ldap.el --- a/lisp/ldap.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/ldap.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: ;; This file provides mid-level and user-level functions to access directory @@ -401,7 +399,7 @@ (defun ldap-encode-country-string (str) ;; We should do something useful here... - (if (not (= 2 (length str))) + (if (not (eql 2 (length str))) (error "Invalid country string: %s" str))) (defun ldap-decode-string (str) diff -r 861f2601a38b -r 1f0b15040456 lisp/lib-complete.el --- a/lisp/lib-complete.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/lib-complete.el Sun May 01 18:44:03 2011 +0100 @@ -11,20 +11,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/lisp-mnt.el --- a/lisp/lisp-mnt.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/lisp-mnt.el Sun May 01 18:44:03 2011 +0100 @@ -12,20 +12,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 20.2. @@ -582,20 +580,18 @@ (defconst lm-standard-permission "\n;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA.\n" +;; along with XEmacs. If not, see .\n" "Standard permissions notice for Lisp files that are part of XEmacs. License version and FSF address are current as of 2009-04-01.") diff -r 861f2601a38b -r 1f0b15040456 lisp/lisp-mode.el --- a/lisp/lisp-mode.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/lisp-mode.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.34 (but starting to diverge). @@ -699,7 +697,7 @@ (defvar lisp-function-and-type-regexp (concat "def\\(" ;; def but not define-. - "\\(un\\|advice\\|alias\\|macro\\*?\\|setf\\|subst\\*?\\|" + "\\(un\\*?\\|advice\\|alias\\|macro\\*?\\|setf\\|subst\\*?\\|" "-edebug-spec\\|" ;; CLOS "method\\|generic\\|" diff -r 861f2601a38b -r 1f0b15040456 lisp/lisp.el --- a/lisp/lisp.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/lisp.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Emacs/Mule zeta. diff -r 861f2601a38b -r 1f0b15040456 lisp/list-mode.el --- a/lisp/list-mode.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/list-mode.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched @@ -276,7 +274,11 @@ This string is inserted at the beginning of the buffer. See `display-completion-list'.") -(defun display-completion-list (completions &rest cl-keys) +(defun* display-completion-list (completions &key user-data reference-buffer + (activate-callback 'default-choose-completion) + (help-string completion-default-help-string) + (completion-string "Possible completions are:") + window-width window-height) "Display the list of completions, COMPLETIONS, using `standard-output'. Each element may be just a symbol or string or may be a list of two strings to be printed as if concatenated. @@ -310,158 +312,148 @@ It can find the completion buffer in `standard-output'. If `completion-highlight-first-word-only' is non-nil, then only the start of the string is highlighted." - ;; #### I18N3 should set standard-output to be (temporarily) - ;; output-translating. - (cl-parsing-keywords - ((:activate-callback 'default-choose-completion) - :user-data - :reference-buffer - (:help-string completion-default-help-string) - (:completion-string "Possible completions are:") - :window-width - :window-height) - () - (let ((old-buffer (current-buffer)) - (bufferp (bufferp standard-output))) - (if bufferp - (set-buffer standard-output)) - (if (null completions) - (princ (gettext - "There are no possible completions of what you have typed.")) - (let ((win-width - (or cl-window-width - (if bufferp - ;; We have to use last-nonminibuf-frame here - ;; and not selected-frame because if a - ;; minibuffer-only frame is being used it will - ;; be the selected-frame at the point this is - ;; run. We keep the selected-frame call around - ;; just in case. - (window-width (get-lru-window (last-nonminibuf-frame))) - 80)))) - (let ((count 0) - (max-width 0) - old-max-width) - ;; Find longest completion - (let ((tail completions)) - (while tail - (let* ((elt (car tail)) - (len (cond ((stringp elt) - (length elt)) - ((and (consp elt) - (stringp (car elt)) - (stringp (car (cdr elt)))) - (+ (length (car elt)) - (length (car (cdr elt))))) - (t - (signal 'wrong-type-argument - (list 'stringp elt)))))) - (if (> len max-width) - (setq max-width len)) - (setq count (1+ count) - tail (cdr tail))))) + ;; #### I18N3 should set standard-output to be (temporarily) + ;; output-translating. + (let ((old-buffer (current-buffer)) (bufferp (bufferp standard-output))) + (if bufferp + (set-buffer standard-output)) + (if (null completions) + (princ (gettext + "There are no possible completions of what you have typed.")) + (let ((win-width + (or window-width + (if bufferp + ;; We have to use last-nonminibuf-frame here + ;; and not selected-frame because if a + ;; minibuffer-only frame is being used it will + ;; be the selected-frame at the point this is + ;; run. We keep the selected-frame call around + ;; just in case. + (window-width (get-lru-window (last-nonminibuf-frame))) + 80)))) + (let ((count 0) + (max-width 0) + old-max-width) + ;; Find longest completion + (let ((tail completions)) + (while tail + (let* ((elt (car tail)) + (len (cond ((stringp elt) + (length elt)) + ((and (consp elt) + (stringp (car elt)) + (stringp (car (cdr elt)))) + (+ (length (car elt)) + (length (car (cdr elt))))) + (t + (signal 'wrong-type-argument + (list 'stringp elt)))))) + (if (> len max-width) + (setq max-width len)) + (setq count (1+ count) + tail (cdr tail))))) - (setq max-width (+ 2 max-width)) ; at least two chars between cols - (setq old-max-width max-width) - (let ((rows (let ((cols (min (/ win-width max-width) count))) - (if (<= cols 1) - count - (progn - ;; re-space the columns - (setq max-width (/ win-width cols)) - (if (/= (% count cols) 0) ; want ceiling... - (1+ (/ count cols)) - (/ count cols))))))) - (when - (and cl-window-height - (> rows cl-window-height)) - (setq max-width old-max-width) - (setq rows cl-window-height)) - (when (and (stringp cl-completion-string) - (> (length cl-completion-string) 0)) - (princ (gettext cl-completion-string)) - (terpri)) - (let ((tail completions) - (r 0) - (regexp-string - (if (eq t - completion-highlight-first-word-only) - "[ \t]" - completion-highlight-first-word-only))) - (while (< r rows) - (and (> r 0) (terpri)) - (let ((indent 0) - (column 0) - (tail2 tail)) - (while tail2 - (let ((elt (car tail2))) - (if (/= indent 0) - (if bufferp - (indent-to indent 2) - (while (progn (write-char ?\ ) - (setq column (1+ column)) - (< column indent))))) - (setq indent (+ indent max-width)) - (let ((start (point)) - end) - ;; Frob some mousable extents in there too! - (if (consp elt) - (progn - (princ (car elt)) - (princ (car (cdr elt))) - (or bufferp - (setq column - (+ column - (length (car elt)) - (length (car (cdr elt))))))) - (progn - (princ elt) - (or bufferp - (setq column (+ column (length - elt)))))) - (add-list-mode-item - start - (progn - (setq end (point)) - (or - (and completion-highlight-first-word-only - (goto-char start) - (re-search-forward regexp-string end t) - (match-beginning 0)) - end)) - nil cl-activate-callback cl-user-data) - (goto-char end))) - (setq tail2 (nthcdr rows tail2))) - (setq tail (cdr tail) - r (1+ r))))))))) - (if bufferp - (set-buffer old-buffer))) - (save-excursion - (let ((mainbuf (or cl-reference-buffer (current-buffer)))) - (set-buffer standard-output) - (completion-list-mode) - (make-local-variable 'completion-reference-buffer) - (setq completion-reference-buffer mainbuf) + (setq max-width (+ 2 max-width)) ; at least two chars between cols + (setq old-max-width max-width) + (let ((rows (let ((cols (min (/ win-width max-width) count))) + (if (<= cols 1) + count + (progn + ;; re-space the columns + (setq max-width (/ win-width cols)) + (if (/= (% count cols) 0) ; want ceiling... + (1+ (/ count cols)) + (/ count cols))))))) + (when + (and window-height + (> rows window-height)) + (setq max-width old-max-width) + (setq rows window-height)) + (when (and (stringp completion-string) + (> (length completion-string) 0)) + (princ (gettext completion-string)) + (terpri)) + (let ((tail completions) + (r 0) + (regexp-string + (if (eq t + completion-highlight-first-word-only) + "[ \t]" + completion-highlight-first-word-only))) + (while (< r rows) + (and (> r 0) (terpri)) + (let ((indent 0) + (column 0) + (tail2 tail)) + (while tail2 + (let ((elt (car tail2))) + (if (/= indent 0) + (if bufferp + (indent-to indent 2) + (while (progn (write-char ?\ ) + (setq column (1+ column)) + (< column indent))))) + (setq indent (+ indent max-width)) + (let ((start (point)) + end) + ;; Frob some mousable extents in there too! + (if (consp elt) + (progn + (princ (car elt)) + (princ (car (cdr elt))) + (or bufferp + (setq column + (+ column + (length (car elt)) + (length (car (cdr elt))))))) + (progn + (princ elt) + (or bufferp + (setq column (+ column (length + elt)))))) + (add-list-mode-item + start + (progn + (setq end (point)) + (or + (and completion-highlight-first-word-only + (goto-char start) + (re-search-forward regexp-string end t) + (match-beginning 0)) + end)) + nil activate-callback user-data) + (goto-char end))) + (setq tail2 (nthcdr rows tail2))) + (setq tail (cdr tail) + r (1+ r))))))))) + (if bufferp + (set-buffer old-buffer))) + (save-excursion + (let ((mainbuf (or reference-buffer (current-buffer)))) + (set-buffer standard-output) + (completion-list-mode) + (make-local-variable 'completion-reference-buffer) + (setq completion-reference-buffer mainbuf) ;;; The value 0 is right in most cases, but not for file name completion. ;;; so this has to be turned off. -;;; (setq completion-base-size 0) - (goto-char (point-min)) - (let ((buffer-read-only nil)) - (insert (eval cl-help-string))) - ;; unnecessary FSFmacs crock - ;;(forward-line 1) - ;;(while (re-search-forward "[^ \t\n]+\\( [^ \t\n]+\\)*" nil t) - ;; (let ((beg (match-beginning 0)) - ;; (end (point))) - ;; (if completion-fixup-function - ;; (funcall completion-fixup-function)) - ;; (put-text-property beg (point) 'mouse-face 'highlight) - ;; (put-text-property beg (point) 'list-mode-item t) - ;; (goto-char end))))) - )) - (save-excursion - (set-buffer standard-output) - (run-hooks 'completion-setup-hook)))) +;;; (setq completion-base-size 0) + (goto-char (point-min)) + (let ((buffer-read-only nil)) + (insert (eval help-string))) + ;; unnecessary FSFmacs crock + ;;(forward-line 1) + ;;(while (re-search-forward "[^ \t\n]+\\( [^ \t\n]+\\)*" nil t) + ;; (let ((beg (match-beginning 0)) + ;; (end (point))) + ;; (if completion-fixup-function + ;; (funcall completion-fixup-function)) + ;; (put-text-property beg (point) 'mouse-face 'highlight) + ;; (put-text-property beg (point) 'list-mode-item t) + ;; (goto-char end))))) + )) + (save-excursion + (set-buffer standard-output) + (run-hooks 'completion-setup-hook))) (defvar completion-display-completion-list-function 'display-completion-list "Function to set up the list of completions in the completion buffer. diff -r 861f2601a38b -r 1f0b15040456 lisp/loaddefs.el --- a/lisp/loaddefs.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/loaddefs.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched with FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/loadhist.el --- a/lisp/loadhist.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/loadhist.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 20.2. @@ -89,7 +87,7 @@ built-in-file ;; This is a bit heuristic, but shouldn't realistically be a ;; problem: - (if (string-match "\.elc?$" built-in-file) + (if (string-match #r"\.elc?$" built-in-file) (concat (if (file-readable-p source-lisp) source-lisp lisp-directory) diff -r 861f2601a38b -r 1f0b15040456 lisp/loadup-el.el --- a/lisp/loadup-el.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/loadup-el.el Sun May 01 18:44:03 2011 +0100 @@ -1,19 +1,17 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/loadup.el --- a/lisp/loadup.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/loadup.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Last synched with FSF 19.30, with wild divergence since. @@ -220,10 +218,22 @@ (load "site-init" t)) ;; Add information from this file to the load history. Delete information -;; for those files in preloaded-file-list; the symbol file information can -;; be taken from DOC, and #'unload-feature makes very little sense for -;; dumped functionality. -(setq load-history (cons (nreverse current-load-list) (last load-history)) +;; that is available from DOC for those files in preloaded-file-list; in +;; practice, this boils down to #'provide and #'require calls, and variables +;; without documentation. Yes, this is a bit ugly. +(setq load-history (cons (nreverse current-load-list) + (delete* + nil + (mapc #'(lambda (element) + (remassq 'defun element) + (delete-if + #'(lambda (elt) + (and + (symbolp elt) + (get elt 'variable-documentation))) + element)) + load-history) + :key #'cdr)) ;; Clear current-load-list; this (and adding information to ;; load-history) is normally done in lread.c after reading the ;; entirety of a file, something which never happens for loadup.el. @@ -252,12 +262,7 @@ load-always-display-messages nil debug-on-error nil) (dump-emacs - (cond - ((featurep 'infodock) "infodock") - ;; #### BILL!!! - ;; If we want to dump under a name other than `xemacs', do that here! - ;; ((featurep 'gtk) "xemacs-gtk") - (t "xemacs")) + "xemacs" "temacs") (kill-emacs)) diff -r 861f2601a38b -r 1f0b15040456 lisp/make-docfile.el --- a/lisp/make-docfile.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/make-docfile.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF @@ -92,7 +90,7 @@ ;; no generate-new-buffer so use its implementation. (let ((buf (get-buffer-create (generate-new-buffer-name "foo")))) (set-buffer buf) - (insert-file-contents-internal (substring arg 1)) + (insert-file-contents-internal (subseq arg 1)) ;; now majorly grind up the response file. ;; backslashes get doubled, quotes around strings, ;; get rid of pesky CR's and NL's, and put parens around @@ -123,8 +121,7 @@ (concat (file-name-nondirectory ;; no match-string so use its implementation. - (substring arg (match-beginning 1) - (match-end 1))) + (subseq arg (match-beginning 1) (match-end 1))) ".c") source-src))) (if (and (null docfile-out-of-date) diff -r 861f2601a38b -r 1f0b15040456 lisp/map-ynp.el --- a/lisp/map-ynp.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/map-ynp.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Emacs/Mule zeta. diff -r 861f2601a38b -r 1f0b15040456 lisp/menubar-items.el --- a/lisp/menubar-items.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/menubar-items.el Sun May 01 18:44:03 2011 +0100 @@ -11,20 +11,18 @@ ;; 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 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 3 of the License, 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. +;; 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 Xmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Authorship: @@ -262,7 +260,7 @@ (submenu-generate-accelerator-spec (mapcar #'(lambda (bmk) `[,bmk (bookmark-delete ',bmk)]) - (bookmark-all-names))))) + (declare-fboundp (bookmark-all-names)))))) ["%_Edit Bookmark List" bookmark-bmenu-list :active (and-boundp 'bookmark-alist bookmark-alist)] "---" diff -r 861f2601a38b -r 1f0b15040456 lisp/menubar.el --- a/lisp/menubar.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/menubar.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. (Completely divergent from FSF menu-bar.el) @@ -568,7 +566,6 @@ accelerator specs -- this works even if the specs have already been added." (menu-split-long-menu (menu-sort-menu menu))) -;;;###autoload (defun menu-split-long-menu (menu) "Split MENU according to `menu-max-items' and add accelerator specs. If MENU already has accelerator specs, they will be removed and new ones diff -r 861f2601a38b -r 1f0b15040456 lisp/minibuf.el --- a/lisp/minibuf.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/minibuf.el Sun May 01 18:44:03 2011 +0100 @@ -11,20 +11,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: all the minibuffer history stuff is synched with ;;; 19.30. Not sure about the rest. @@ -43,7 +41,7 @@ (require 'cl) (defgroup minibuffer nil - "Controling the behavior of the minibuffer." + "Controlling the behavior of the minibuffer." :group 'environment) @@ -1569,12 +1567,13 @@ (defun minibuf-directory-files (dir &optional match-regexp files-only) (let ((want-file (or (eq files-only nil) (eq files-only t))) (want-dirs (or (eq files-only nil) (not (eq files-only t))))) - (delete nil - (mapcar (function (lambda (f) - (if (file-directory-p (expand-file-name f dir)) - (and want-dirs (file-name-as-directory f)) - (and want-file f)))) - (delete "." (directory-files dir nil match-regexp)))))) + (mapcan + #'(lambda (f) + (and (not (equal "." f)) + (if (file-directory-p (expand-file-name f dir)) + (and want-dirs (list (file-name-as-directory f))) + (and want-file (list f))))) + (directory-files dir nil match-regexp)))) (defun read-file-name-2 (history prompt dir default @@ -1820,10 +1819,10 @@ (completion-ignore-case (file-system-ignore-case-p (or dir default-directory))) (env (substring string - (cond ((= start (length string)) + (cond ((eql start (length string)) ;; "...$" start) - ((= (aref string start) ?{) + ((eql (aref string start) ?{) ;; "...${..." (1+ start)) (t @@ -2094,7 +2093,7 @@ ;; any more. --ben (lambda () (mouse-rfn-setup-vars prompt) - (when-boundp #'scrollbar-width + (when-boundp 'scrollbar-width (set-specifier scrollbar-width 0 (current-buffer))) (setq truncate-lines t)))) @@ -2210,7 +2209,7 @@ "Read a non-nil coding-system from the minibuffer. Prompt with string PROMPT." (let ((retval (intern ""))) - (while (= 0 (length (symbol-name retval))) + (while (eql 0 (length (symbol-name retval))) (setq retval (intern (completing-read prompt obarray 'find-coding-system t)))) @@ -2346,7 +2345,7 @@ (single-key-description event)) (ding nil 'y-or-n-p) (discard-input) - (if (= (length pre) 0) + (if (eql (length pre) 0) (setq pre (format "Please answer %s. " ;; 17 parens! a record in ;; our lisp code. diff -r 861f2601a38b -r 1f0b15040456 lisp/misc.el --- a/lisp/misc.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/misc.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.34. diff -r 861f2601a38b -r 1f0b15040456 lisp/mode-motion.el --- a/lisp/mode-motion.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mode-motion.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/modeline.el --- a/lisp/modeline.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/modeline.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -524,35 +522,31 @@ (cons "Minor Mode Toggles" (sort - (delq nil (mapcar - #'(lambda (x) - (let* ((toggle-sym (car x)) - (toggle-fun (or (get toggle-sym - 'modeline-toggle-function) - (and (commandp toggle-sym) - toggle-sym))) - (menu-tag (symbol-name (if (symbolp toggle-fun) - toggle-fun - toggle-sym)) - ;; Here a function should - ;; maybe be invoked to - ;; beautify the symbol's - ;; menu appearance. - )) - (and toggle-fun - (vector menu-tag - toggle-fun - ;; The following two are wrong - ;; because of possible name - ;; clashes. - ;:active (get toggle-sym :active t) - ;:included (get toggle-sym :included t) - :style 'toggle - :selected (and (boundp toggle-sym) - toggle-sym))))) - minor-mode-alist)) - (lambda (e1 e2) - (string< (aref e1 0) (aref e2 0))))) + (mapcan + #'(lambda (x) + (let* ((toggle-sym (car x)) + (toggle-fun (or (get toggle-sym + 'modeline-toggle-function) + (and (commandp toggle-sym) + toggle-sym))) + (menu-tag (symbol-name (if (symbolp toggle-fun) + toggle-fun + toggle-sym)) + ;; Here a function should maybe be invoked to + ;; beautify the symbol's menu appearance. + )) + (and toggle-fun + (list (vector menu-tag + toggle-fun + ;; The following two are wrong because of + ;; possible name clashes. + ;:active (get toggle-sym :active t) + ;:included (get toggle-sym :included t) + :style 'toggle + :selected (and (boundp toggle-sym) + toggle-sym)))))) + minor-mode-alist) + (lambda (e1 e2) (string< (aref e1 0) (aref e2 0))))) event))) (defvar modeline-minor-mode-map (make-sparse-keymap 'modeline-minor-mode-map) diff -r 861f2601a38b -r 1f0b15040456 lisp/mouse.el --- a/lisp/mouse.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mouse.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched with FSF. Almost completely divergent. @@ -1772,7 +1770,8 @@ ;; left window side has slipped (right side cannot be ;; moved any further to the right, so enlarge-window ;; plays bad games with the left edge. - (if (or (/= (count-windows) (length old-edges-all-windows)) + (if (or (not (eql (count-windows) + (length old-edges-all-windows))) (/= old-left (car (window-pixel-edges window))) ;; This check is very hairy. We allow any number ;; of left edges to change, but only to the same @@ -1780,22 +1779,24 @@ (let ((all-that-bad nil) (new-left-ok nil) (new-right-ok nil)) - (mapcar* (lambda (window old-edges) - (let ((new (car (window-pixel-edges window)))) - (if (/= new (car old-edges)) - (if (and new-left-ok - (/= new-left-ok new)) - (setq all-that-bad t) - (setq new-left-ok new))))) - (window-list) old-edges-all-windows) - (mapcar* (lambda (window old-edges) - (let ((new (caddr (window-pixel-edges window)))) - (if (/= new (caddr old-edges)) - (if (and new-right-ok - (/= new-right-ok new)) - (setq all-that-bad t) - (setq new-right-ok new))))) - (window-list) old-edges-all-windows) + (mapc (lambda (window old-edges) + (let ((new + (car (window-pixel-edges window)))) + (if (/= new (car old-edges)) + (if (and new-left-ok + (/= new-left-ok new)) + (setq all-that-bad t) + (setq new-left-ok new))))) + (window-list) old-edges-all-windows) + (mapc (lambda (window old-edges) + (let ((new + (caddr (window-pixel-edges window)))) + (if (/= new (caddr old-edges)) + (if (and new-right-ok + (/= new-right-ok new)) + (setq all-that-bad t) + (setq new-right-ok new))))) + (window-list) old-edges-all-windows) all-that-bad)) (set-window-configuration backup-conf))))))))) diff -r 861f2601a38b -r 1f0b15040456 lisp/movemail.el --- a/lisp/movemail.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/movemail.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/msw-faces.el --- a/lisp/msw-faces.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/msw-faces.el Sun May 01 18:44:03 2011 +0100 @@ -11,20 +11,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;; This file does the magic to parse mswindows font names, and make sure that ;; the default and modeline attributes of new frames are specified enough. @@ -268,12 +266,11 @@ (concat (substring font 0 (match-beginning 3)) (substring font (match-end 3) (match-end 0)))) (sort - (delq nil - (mapcar #'(lambda (name) - (and (string-match mswindows-font-regexp name) - (string-to-int (substring name (match-beginning 3) - (match-end 3))))) - (font-list font device))) + (mapcan #'(lambda (name) + (and (string-match mswindows-font-regexp name) + (list (string-to-int (substring name (match-beginning 3) + (match-end 3)))))) + (font-list font device)) #'<)) (defun mswindows-frob-font-size (font up-p device) diff -r 861f2601a38b -r 1f0b15040456 lisp/msw-font-menu.el --- a/lisp/msw-font-menu.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/msw-font-menu.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Known Problems: ;;; =============== @@ -140,17 +138,17 @@ (mapcar (lambda (x) (vector x (list 'font-menu-set-font x nil nil) - ':style 'radio ':active nil ':selected nil)) + :style 'radio :active nil :selected nil)) families) (mapcar (lambda (x) (vector (int-to-string x) (list 'font-menu-set-font nil nil x) - ':style 'radio ':active nil ':selected nil)) + :style 'radio :active nil :selected nil)) sizes) (mapcar (lambda (x) (vector x (list 'font-menu-set-font nil x nil) - ':style 'radio ':active nil ':selected nil)) + :style 'radio :active nil :selected nil)) weights))) (cdr dev-cache))) diff -r 861f2601a38b -r 1f0b15040456 lisp/msw-glyphs.el --- a/lisp/msw-glyphs.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/msw-glyphs.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/msw-init.el --- a/lisp/msw-init.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/msw-init.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . (defvar make-device-early-mswindows-entry-point-called-p nil "Whether `make-device-early-mswindows-entry-point' has been called") diff -r 861f2601a38b -r 1f0b15040456 lisp/msw-mouse.el --- a/lisp/msw-mouse.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/msw-mouse.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched. diff -r 861f2601a38b -r 1f0b15040456 lisp/msw-select.el --- a/lisp/msw-select.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/msw-select.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/arabic.el --- a/lisp/mule/arabic.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/arabic.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/canna-leim.el --- a/lisp/mule/canna-leim.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/canna-leim.el Sun May 01 18:44:03 2011 +0100 @@ -13,20 +13,20 @@ ;; Keywords: japanese, input method, LEIM ;; Last Modified: 1997/10/27 10:08:49 -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either versions 2, or (at your option) -;; any later version. +;; This file is part of XEmacs. -;; This program is distributed in the hope that it will be useful -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. +;; 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 3 of the License, or (at your +;; option) any later version. + +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs, see the file COPYING. If not, write to the Free -;; Software Foundation Inc., 59 Temple Place - Suite 330, Boston, -;; MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; TODO ;; diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/ccl.el --- a/lisp/mule/ccl.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/ccl.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;; Synched up with: FSF 21.0.90 @@ -473,7 +471,7 @@ ;; If READ-FLAG is non-nil, this statement has the form ;; `(read-if (REG OPERATOR ARG) TRUE-PART FALSE-PART)'. (defun ccl-compile-if (cmd &optional read-flag) - (if (and (/= (length cmd) 3) (/= (length cmd) 4)) + (if (and (not (<= 3 (length cmd) 4))) (error "CCL: Invalid number of arguments: %s" cmd)) (let ((condition (nth 1 cmd)) (true-cmds (nth 2 cmd)) @@ -646,7 +644,7 @@ ;; Compile BREAK statement. (defun ccl-compile-break (cmd) - (if (/= (length cmd) 1) + (if (not (eql (length cmd) 1)) (error "CCL: Invalid number of arguments: %s" cmd)) (if (null ccl-loop-head) (error "CCL: No outer loop: %s" cmd)) @@ -656,7 +654,7 @@ ;; Compile REPEAT statement. (defun ccl-compile-repeat (cmd) - (if (/= (length cmd) 1) + (if (not (eql (length cmd) 1)) (error "CCL: Invalid number of arguments: %s" cmd)) (if (null ccl-loop-head) (error "CCL: No outer loop: %s" cmd)) @@ -665,7 +663,7 @@ ;; Compile WRITE-REPEAT statement. (defun ccl-compile-write-repeat (cmd) - (if (/= (length cmd) 2) + (if (not (eql (length cmd) 2)) (error "CCL: Invalid number of arguments: %s" cmd)) (if (null ccl-loop-head) (error "CCL: No outer loop: %s" cmd)) @@ -783,7 +781,7 @@ ;; Compile CALL statement. (defun ccl-compile-call (cmd) - (if (/= (length cmd) 2) + (if (not (eql (length cmd) 2)) (error "CCL: Invalid number of arguments: %s" cmd)) (if (not (symbolp (nth 1 cmd))) (error "CCL: Subroutine should be a symbol: %s" cmd)) @@ -793,14 +791,14 @@ ;; Compile END statement. (defun ccl-compile-end (cmd) - (if (/= (length cmd) 1) + (if (not (eql (length cmd) 1)) (error "CCL: Invalid number of arguments: %s" cmd)) (ccl-embed-code 'end 0 0) t) ;; Compile read-multibyte-character (defun ccl-compile-read-multibyte-character (cmd) - (if (/= (length cmd) 3) + (if (not (eql (length cmd) 3)) (error "CCL: Invalid number of arguments: %s" cmd)) (let ((RRR (nth 1 cmd)) (rrr (nth 2 cmd))) @@ -811,7 +809,7 @@ ;; Compile write-multibyte-character (defun ccl-compile-write-multibyte-character (cmd) - (if (/= (length cmd) 3) + (if (not (eql (length cmd) 3)) (error "CCL: Invalid number of arguments: %s" cmd)) (let ((RRR (nth 1 cmd)) (rrr (nth 2 cmd))) @@ -822,7 +820,7 @@ ;; Compile translate-character (defun ccl-compile-translate-character (cmd) - (if (/= (length cmd) 4) + (if (not (eql (length cmd) 4)) (error "CCL: Invalid number of arguments: %s" cmd)) (let ((Rrr (nth 1 cmd)) (RRR (nth 2 cmd)) @@ -840,7 +838,7 @@ ;; Compile mule-to-unicode (defun ccl-compile-mule-to-unicode (cmd) - (if (/= (length cmd) 3) + (if (not (eql (length cmd) 3)) (error "CCL: Invalid number of arguments: %s" cmd)) (let ((RRR (nth 1 cmd)) (rrr (nth 2 cmd))) @@ -852,7 +850,7 @@ ;; Given a Unicode code point in register rrr, write the charset ID of the ;; corresponding character in RRR, and the Mule-CCL form of its code in rrr. (defun ccl-compile-unicode-to-mule (cmd) - (if (/= (length cmd) 3) + (if (not (eql (length cmd) 3)) (error "CCL: Invalid number of arguments: %s" cmd)) (let ((rrr (nth 1 cmd)) (RRR (nth 2 cmd))) @@ -863,7 +861,7 @@ ;; Compile lookup-integer (defun ccl-compile-lookup-integer (cmd) - (if (/= (length cmd) 4) + (if (not (eql (length cmd) 4)) (error "CCL: Invalid number of arguments: %s" cmd)) (let ((Rrr (nth 1 cmd)) (RRR (nth 2 cmd)) @@ -883,7 +881,7 @@ ;; Compile lookup-character (defun ccl-compile-lookup-character (cmd) - (if (/= (length cmd) 4) + (if (not (eql (length cmd) 4)) (error "CCL: Invalid number of arguments: %s" cmd)) (let ((Rrr (nth 1 cmd)) (RRR (nth 2 cmd)) @@ -906,7 +904,7 @@ nil) (defun ccl-compile-map-multiple (cmd) - (if (/= (length cmd) 4) + (if (not (eql (length cmd) 4)) (error "CCL: Invalid number of arguments: %s" cmd)) (let (func arg) (setq func @@ -932,7 +930,7 @@ nil) (defun ccl-compile-map-single (cmd) - (if (/= (length cmd) 4) + (if (not (eql (length cmd) 4)) (error "CCL: Invalid number of arguments: %s" cmd)) (let ((RRR (nth 1 cmd)) (rrr (nth 2 cmd)) @@ -1510,7 +1508,7 @@ | de-sjis ;; If ARG_0 and ARG_1 are the first and second code point of - ;; JISX0208 character CHAR, and SJIS is the correponding + ;; JISX0208 character CHAR, and SJIS is the corresponding ;; Shift-JIS code, ;; (REG = ARG_0 en-sjis ARG_1) means: ;; ((REG = HIGH) @@ -1562,4 +1560,4 @@ (provide 'ccl) -;; ccl.el ends here \ No newline at end of file +;; ccl.el ends here diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/china-util.el --- a/lisp/mule/china-util.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/china-util.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Emacs 21.1 (language/china-util.el). diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/chinese.el --- a/lisp/mule/chinese.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/chinese.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/cyrillic.el --- a/lisp/mule/cyrillic.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/cyrillic.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/devan-util.el --- a/lisp/mule/devan-util.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/devan-util.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Emacs 21.1 (language/devan-util.el). @@ -1057,8 +1055,7 @@ (setq ordered-glyphs (append ordered-glyphs (list (assq glyph devanagari-composition-rules)))))) - (sort ordered-glyphs #'(lambda (x y) (< (car (cdr x)) (car (cdr y))))))) - + (sort* ordered-glyphs '< :key 'cadr))) ;;(devanagari-compose-to-one-glyph "$(5"5!X![(B") => "4$(6!Xv#"5t%![0!X"5![1(B" (defun devanagari-compose-to-one-glyph (devanagari-string) @@ -1079,7 +1076,7 @@ ;; Before applying compose-chars, convert glyphs to ;; 1-column width if possible. (setq cmp-glyph-list (devanagari-wide-to-narrow cmp-glyph-list)) - (if (= (length cmp-glyph-list) 1) (char-to-string (car cmp-glyph-list)) + (if (eql (length cmp-glyph-list) 1) (char-to-string (car cmp-glyph-list)) (apply 'compose-chars cmp-glyph-list)))) (defun devanagari-composition-component (string &optional start end) diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/devanagari.el --- a/lisp/mule/devanagari.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/devanagari.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Emacs 21.1 (language/devanagari.el). diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/english.el --- a/lisp/mule/english.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/english.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/ethio-util.el --- a/lisp/mule/ethio-util.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/ethio-util.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Emacs 21.1 (language/ethio-util.el). diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/ethiopic.el --- a/lisp/mule/ethiopic.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/ethiopic.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;; Author: TAKAHASHI Naoto ;; modified by MORIOKA Tomohiko for XEmacs. diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/general-late.el --- a/lisp/mule/general-late.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/general-late.el Sun May 01 18:44:03 2011 +0100 @@ -6,20 +6,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with XEmacs. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/greek.el --- a/lisp/mule/greek.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/greek.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/hebrew.el --- a/lisp/mule/hebrew.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/hebrew.el Sun May 01 18:44:03 2011 +0100 @@ -5,22 +5,20 @@ ;; Keywords: multilingual, Hebrew -;; This file is part of GNU Emacs. +;; This file is part of XEmacs. -;; 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. +;; 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 3 of the License, 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. +;; 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 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. +;; along with XEmacs. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/indian.el --- a/lisp/mule/indian.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/indian.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Emacs 21.1 (language/indian.el). @@ -53,9 +51,9 @@ ;;; Code: -;; Followings are what you see when you refer to the Emacs +;; Following are what you see when you refer to the Emacs ;; representations of IS 13194 charcters. However, this is merely -;; tentative apperance, and you must convert them by +;; tentative appearance, and you must convert them with the ;; indian-to-xxxxxx(specific script) function to use them. ;; Devanagari is not an exception of this rule. diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/iso-with-esc.el --- a/lisp/mule/iso-with-esc.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/iso-with-esc.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with XEmacs. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/japan-util.el --- a/lisp/mule/japan-util.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/japan-util.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Emacs 21.1 (language/japan-util.el). diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/japanese.el --- a/lisp/mule/japanese.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/japanese.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Emacs 20.6 (international/japanese.el). @@ -444,44 +442,38 @@ ;; little helps there.) (set-language-info "Japanese" 'native-coding-system - (list - ;; first, see if an explicit encoding was given. - (lambda (locale) - (let ((case-fold-search t)) - (cond - ;; many unix versions - ((string-match "\\.euc" locale) 'euc-jp) - ((string-match "\\.sjis" locale) 'shift-jis) - - ;; X11R6 (CJKV p. 471) - ((string-match "\\.jis7" locale) 'jis7) - ((string-match "\\.jis8" locale) 'jis8) - ((string-match "\\.mscode" locale) 'shift-jis) - ((string-match "\\.pjis" locale) 'iso-2022-jp) - ((string-match "\\.ujis" locale) 'euc-jp) + ;; first, see if an explicit encoding was given. + (lambda (locale) + (let ((case-fold-search t)) + (cond + ;; many unix versions + ((string-match "\\.euc" locale) 'euc-jp) + ((string-match "\\.sjis" locale) 'shift-jis) - ;; other names in X11R6 locale.alias - ((string-match "\\.ajec" locale) 'euc-jp) - ((string-match "-euc" locale) 'euc-jp) - ((string-match "\\.iso-2022-jp" locale) 'iso-2022-jp) - ((string-match "\\.jis" locale) 'jis7) ;; or just jis? - ))) + ;; X11R6 (CJKV p. 471) + ((string-match "\\.jis7" locale) 'jis7) + ((string-match "\\.jis8" locale) 'jis8) + ((string-match "\\.mscode" locale) 'shift-jis) + ((string-match "\\.pjis" locale) 'iso-2022-jp) + ((string-match "\\.ujis" locale) 'euc-jp) - ;; aix (CJKV p. 465) - (lambda (locale) - (when (eq system-type 'aix) - (cond - ((string-match "^Ja_JP" locale) 'shift-jis) - ((string-match "^ja_JP" locale) 'euc-jp)))) + ;; other names in X11R6 locale.alias + ((string-match "\\.ajec" locale) 'euc-jp) + ((string-match "-euc" locale) 'euc-jp) + ((string-match "\\.iso-2022-jp" locale) 'iso-2022-jp) + ((string-match "\\.jis" locale) 'jis7) ;; or just jis? - ;; other X11R6 locale.alias - (lambda (locale) - (cond + ;; aix (CJKV p. 465) + ((and (eq system-type 'aix) + (string-match "^Ja_JP" locale)) 'shift-jis) + ((and (eq system-type 'aix) + (string-match "^ja_JP" locale)) 'euc-jp) + + ;; other X11R6 locale.alias ((string-match "^Jp_JP" locale) 'euc-jp) ((and (eq system-type 'hpux) (eq locale "japanese")) - 'shift-jis))) - - ;; fallback - 'euc-jp)) + 'shift-jis) + ;; fallback + (t 'euc-jp))))) ;;; japanese.el ends here diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/kinsoku.el --- a/lisp/mule/kinsoku.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/kinsoku.el Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,15 @@ ;; This file is part of Mule (MULtilingual Enhancement of XEmacs). ;; This file contains Japanese and Chinese characters. -;; 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 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 3 of the License, or (at your +;; option) any later version. -;; XEmacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; 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. ;; Written by Jareth Hein (jhod@po.iijnet.or.jp) based off of ;; code by S.Tomura, Electrotechnical Lab. (tomura@etl.go.jp) from @@ -256,13 +251,13 @@ (eol-kin (kinsoku-process-shrink)))))) (defun kinsoku-process-extend () - "Move point forward to a permissable for line-breaking. + "Move point forward to a point permissible for line-breaking. $B9T$r?-$P$7$F6XB'$K?($l$J$$E@$X0\F0$9$k!#(B" (let ((max-column (+ fill-column (if (and (numberp kinsoku-extend-limit) (>= kinsoku-extend-limit 0)) kinsoku-extend-limit - 10000))) ;;; 10000 is deliberatly unreasonably large + 10000))) ;;; 10000 is deliberately unreasonably large ch1 ch2) (while (and (setq ch1 (char-after)) (<= (+ (current-column) @@ -283,7 +278,7 @@ (kinsoku-process-shrink)))) (defun kinsoku-process-shrink () - "Move point backward to a point permissable for line-breaking. + "Move point backward to a point permissible for line-breaking. $B9T$r=L$a$F6XB'$K?($l$J$$E@$X0\F0$9$k!#(B" (let (ch1 ch2) (while (and (not (bolp)) diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/korea-util.el --- a/lisp/mule/korea-util.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/korea-util.el Sun May 01 18:44:03 2011 +0100 @@ -6,20 +6,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Emacs 21.1 (language/korea-util.el). diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/korean.el --- a/lisp/mule/korean.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/korean.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/lao-util.el --- a/lisp/mule/lao-util.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/lao-util.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Emacs 21.1 (language/lao-util.el). @@ -371,8 +369,8 @@ indicate the place to embed a consonant. Optional WITH-MAA-SAKOD-RULE is a rule to re-order and modify VOWEL -follwoing a consonant and preceding a maa-sakod character. If it is -nil, NO-MAA-SAKOD-RULE is used. The maa-sakod character is alwasy +following a consonant and preceding a maa-sakod character. If it is +nil, NO-MAA-SAKOD-RULE is used. The maa-sakod character is always appended at the tail. For instance, rule `(\"(1`WM(B\" (?(1`(B t ?(1W(B ?(1M(B))' tells that this vowel @@ -386,7 +384,7 @@ "Transcribe a Romanized Lao syllable in the region FROM and TO to Lao string. Only the first syllable is transcribed. The value has the form: (START END LAO-STRING), where -START and END are the beggining and end positions of the Roman Lao syllable, +START and END are the beginning and end positions of the Roman Lao syllable, LAO-STRING is the Lao character transcription of it. Optional 3rd arg STR, if non-nil, is a string to search for Roman Lao diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/lao.el --- a/lisp/mule/lao.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/lao.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Emacs 21.1 (language/lao.el). diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/latin.el --- a/lisp/mule/latin.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/latin.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: @@ -1482,7 +1480,7 @@ (string (char-syntax (make-char 'latin-iso8859-1 i))) syntax-table)) -;; Case. The Turkish case idiosyncracy is handled with its language environment. +;; Case. The Turkish case idiosyncrasy is handled with its language environment. (setup-case-pairs 'latin-iso8859-9 '((#xC0 #xE0) ;; A WITH GRAVE diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/make-coding-system.el --- a/lisp/mule/make-coding-system.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/make-coding-system.el Sun May 01 18:44:03 2011 +0100 @@ -7,26 +7,24 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with XEmacs. If not, see . ;;; Commentary: ;;; Code: -(defvar fixed-width-private-use-start (decode-char 'ucs #xE000) +(defvar fixed-width-private-use-start ?\uE000 "Start of a 256 code private use area for fixed-width coding systems. This is used to ensure that distinct octets on disk for a given coding @@ -68,10 +66,7 @@ (repeat)))) nil)) (first-part compiled) (last-part - (member-if-not (lambda (entr) (eq #xBFFE entr)) - (member-if - (lambda (entr) (eq #xBFFE entr)) - first-part)))) + (member* #xBFFE (member* #xBFFE first-part) :test-not 'eql))) (while compiled (when (eq #xBFFE (cadr compiled)) (assert (= vec-len (search '(#xBFFE) (cdr compiled) diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/misc-lang.el --- a/lisp/mule/misc-lang.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/misc-lang.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Code: diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/mule-category.el --- a/lisp/mule/mule-category.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/mule-category.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: @@ -64,11 +62,7 @@ (defun defined-category-list () "Return a list of the currently defined categories. Categories are given by their designators." - (let (list) - (maphash #'(lambda (key value) - (setq list (cons key list))) - defined-category-hashtable) - (nreverse list))) + (hash-table-key-list defined-category-hashtable)) (defun undefined-category-designator () "Return an undefined category designator, or nil if there are none." diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/mule-charset.el --- a/lisp/mule/mule-charset.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/mule-charset.el Sun May 01 18:44:03 2011 +0100 @@ -12,20 +12,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched. API at source level synched with FSF 20.3.9. diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/mule-cmds.el --- a/lisp/mule/mule-cmds.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/mule-cmds.el Sun May 01 18:44:03 2011 +0100 @@ -3,26 +3,24 @@ ;; Copyright (C) 1995,1999 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. ;; Copyright (C) 1997 MORIOKA Tomohiko -;; Copyright (C) 2000, 2001, 2002, 2003 Ben Wing. +;; Copyright (C) 2000, 2001, 2002, 2003, 2010 Ben Wing. ;; Keywords: mule, multilingual ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;; Note: Some of the code here is now in code-cmds.el @@ -779,7 +777,7 @@ #'(lambda (key entry) (setq string (decode-coding-string (string entry) invalid-sequence-coding-system)) - (when (= 1 (length string)) + (when (eql 1 (length string)) ;; Treat Unicode error sequence chars as the octets ;; corresponding to those on disk: (setq unicode-error-lookup @@ -789,8 +787,7 @@ (setq string (format "%c" unicode-error-lookup))) ;; Treat control characters specially: (setq first-char (aref string 0)) - (when (or (and (>= #x00 first-char) (<= first-char #x1f)) - (and (>= #x80 first-char) (<= first-char #x9f))) + (when (or (<= #x00 first-char #x1f) (<= #x80 first-char #x9f)) (setq string (format "^%c" (+ ?@ (aref string 0)))))) (setq glyph (make-glyph (vector 'string :data string))) (set-glyph-face glyph 'unicode-invalid-sequence-warning-face) diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/mule-coding.el --- a/lisp/mule/mule-coding.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/mule-coding.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/mule-composite-stub.el --- a/lisp/mule/mule-composite-stub.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/mule-composite-stub.el Sun May 01 18:44:03 2011 +0100 @@ -6,20 +6,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Emacs 21.1 (src/fontset.c, src/composite.c). diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/mule-composite.el --- a/lisp/mule/mule-composite.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/mule-composite.el Sun May 01 18:44:03 2011 +0100 @@ -5,22 +5,20 @@ ;; Keywords: mule, multilingual, character composition -;; This file is part of GNU Emacs. +;; This file is part of XEmacs. -;; 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. +;; 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 3 of the License, 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. +;; 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 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Emacs 21.1 (lisp/composite.el). @@ -28,7 +26,6 @@ ;;; Code: -;;;###autoload (defconst reference-point-alist '((tl . 0) (tc . 1) (tr . 2) (Bl . 3) (Bc . 4) (Br . 5) @@ -157,7 +154,6 @@ (setq i (+ i 2)))) components) -;;;###autoload (defun compose-region (start end &optional components modification-func) "UNIMPLEMENTED. Compose characters in the current region. @@ -195,7 +191,6 @@ (compose-region-internal start end components modification-func) (set-buffer-modified-p modified-p))) -;;;###autoload (defun decompose-region (start end) "UNIMPLEMENTED. Decompose text in the current region. @@ -208,7 +203,6 @@ (remove-text-properties start end '(composition nil)) (set-buffer-modified-p modified-p))) -;;;###autoload (defun compose-string (string &optional start end components modification-func) "UNIMPLEMENTED. Compose characters in string STRING. @@ -234,14 +228,12 @@ (compose-string-internal string start end components modification-func) string) -;;;###autoload (defun decompose-string (string) "UNIMPLEMENTED. Return STRING where `composition' property is removed." (remove-text-properties 0 (length string) '(composition nil) string) string) -;;;###autoload (defun compose-chars (&rest args) "UNIMPLEMENTED. Return a string from arguments in which all characters are composed. @@ -266,7 +258,6 @@ (setq str (concat args))) (compose-string-internal str 0 (length str) components))) -;;;###autoload (defun find-composition (pos &optional limit string detail-p) "UNIMPLEMENTED. Return information about a composition at or nearest to buffer position POS. @@ -307,7 +298,6 @@ result)) -;;;###autoload (defun compose-chars-after (pos &optional limit object) "UNIMPLEMENTED. Compose characters in current buffer after position POS. @@ -349,7 +339,6 @@ (setq func nil tail (cdr tail))))))) result)) -;;;###autoload (defun compose-last-chars (args) "UNIMPLEMENTED. Compose last characters. @@ -371,13 +360,12 @@ (compose-region (- (point) chars) (point) (nth 2 args)) (compose-chars-after (- (point) chars) (point)))))) -;;;###autoload(global-set-key [compose-last-chars] 'compose-last-chars) +;;;don't ###autoload(global-set-key [compose-last-chars] 'compose-last-chars) ;;; The following codes are only for backward compatibility with Emacs ;;; 20.4 and the earlier. -;;;###autoload (defun decompose-composite-char (char &optional type with-composition-rule) "UNIMPLEMENTED. Convert CHAR to string. diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/mule-msw-init-late.el --- a/lisp/mule/mule-msw-init-late.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/mule-msw-init-late.el Sun May 01 18:44:03 2011 +0100 @@ -3,20 +3,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;; mapping between XEmacs charsets and code pages. something like this ;; will might around once all the Unicode code is written, so we know how diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/mule-tty-init.el --- a/lisp/mule/mule-tty-init.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/mule-tty-init.el Sun May 01 18:44:03 2011 +0100 @@ -7,21 +7,19 @@ ;; Keywords: mule, tty, console, 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. -;; + +;; 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 3 of the License, or (at your +;; option) any later version. + +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. + ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/mule-win32-init.el --- a/lisp/mule/mule-win32-init.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/mule-win32-init.el Sun May 01 18:44:03 2011 +0100 @@ -3,20 +3,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . (make-coding-system 'mswindows-multibyte 'mswindows-multibyte @@ -141,7 +139,7 @@ ("OEM" 865 no-conversion "MS-DOS Nordic") ; ("OEM" 866 no-conversion "MS-DOS Russian") ("OEM" 869 no-conversion "IBM Modern Greek") - ("Ansi/OEM" 874 no-conversion "Thai") + ; ("Ansi/OEM" 874 no-conversion "Thai") ("EBCDIC" 875 no-conversion "EBCDIC") ("Ansi/OEM" 932 shift_jis "Japanese") ("Ansi/OEM" 936 iso_8_2 "Chinese (PRC, Singapore)") diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/mule-x-init.el --- a/lisp/mule/mule-x-init.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/mule-x-init.el Sun May 01 18:44:03 2011 +0100 @@ -6,21 +6,19 @@ ;; Keywords: mule X11 ;; 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. -;; + +;; 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 3 of the License, or (at your +;; option) any later version. + +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. + ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/thai-util.el --- a/lisp/mule/thai-util.el Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,211 +0,0 @@ -;;; thai-util.el --- utilities for Thai -*- coding: iso-2022-7bit; -*- - -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. - -;; Keywords: mule, multilingual, thai - -;; This file is part of XEmacs. - -;; XEmacs is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; XEmacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. - -;;; Synched up with: Emacs 21.1 (language/thai-util.el). - -;;; Commentary: - -;;; Code: - -;; Setting information of Thai characters. - -(defconst thai-category-table (make-category-table)) -(define-category ?c "Thai consonant" thai-category-table) -(define-category ?v "Thai upper/lower vowel" thai-category-table) -(define-category ?t "Thai tone" thai-category-table) - -;; The general composing rules are as follows: -;; -;; T -;; V T V T -;; CV -> C, CT -> C, CVT -> C, Cv -> C, CvT -> C -;; v v -;; -;; where C: consonant, V: vowel upper, v: vowel lower, T: tone mark. - -(defvar thai-composition-pattern "\\cc\\(\\ct\\|\\cv\\ct?\\)" - "Regular expression matching a Thai composite sequence.") - -(let ((l '((?,T!(B consonant "LETTER KO KAI") ; 0xA1 - (?,T"(B consonant "LETTER KHO KHAI") ; 0xA2 - (?,T#(B consonant "LETTER KHO KHUAT") ; 0xA3 - (?,T$(B consonant "LETTER KHO KHWAI") ; 0xA4 - (?,T%(B consonant "LETTER KHO KHON") ; 0xA5 - (?,T&(B consonant "LETTER KHO RAKHANG") ; 0xA6 - (?,T'(B consonant "LETTER NGO NGU") ; 0xA7 - (?,T((B consonant "LETTER CHO CHAN") ; 0xA8 - (?,T)(B consonant "LETTER CHO CHING") ; 0xA9 - (?,T*(B consonant "LETTER CHO CHANG") ; 0xAA - (?,T+(B consonant "LETTER SO SO") ; 0xAB - (?,T,(B consonant "LETTER CHO CHOE") ; 0xAC - (?,T-(B consonant "LETTER YO YING") ; 0xAD - (?,T.(B consonant "LETTER DO CHADA") ; 0xAE - (?,T/(B consonant "LETTER TO PATAK") ; 0xAF - (?,T0(B consonant "LETTER THO THAN") ; 0xB0 - (?,T1(B consonant "LETTER THO NANGMONTHO") ; 0xB1 - (?,T2(B consonant "LETTER THO PHUTHAO") ; 0xB2 - (?,T3(B consonant "LETTER NO NEN") ; 0xB3 - (?,T4(B consonant "LETTER DO DEK") ; 0xB4 - (?,T5(B consonant "LETTER TO TAO") ; 0xB5 - (?,T6(B consonant "LETTER THO THUNG") ; 0xB6 - (?,T7(B consonant "LETTER THO THAHAN") ; 0xB7 - (?,T8(B consonant "LETTER THO THONG") ; 0xB8 - (?,T9(B consonant "LETTER NO NU") ; 0xB9 - (?,T:(B consonant "LETTER BO BAIMAI") ; 0xBA - (?,T;(B consonant "LETTER PO PLA") ; 0xBB - (?,T<(B consonant "LETTER PHO PHUNG") ; 0xBC - (?,T=(B consonant "LETTER FO FA") ; 0xBD - (?,T>(B consonant "LETTER PHO PHAN") ; 0xBE - (?,T?(B consonant "LETTER FO FAN") ; 0xBF - (?,T@(B consonant "LETTER PHO SAMPHAO") ; 0xC0 - (?,TA(B consonant "LETTER MO MA") ; 0xC1 - (?,TB(B consonant "LETTER YO YAK") ; 0xC2 - (?,TC(B consonant "LETTER RO RUA") ; 0xC3 - (?,TD(B vowel-base "LETTER RU (Pali vowel letter)") ; 0xC4 - (?,TE(B consonant "LETTER LO LING") ; 0xC5 - (?,TF(B vowel-base "LETTER LU (Pali vowel letter)") ; 0xC6 - (?,TG(B consonant "LETTER WO WAEN") ; 0xC7 - (?,TH(B consonant "LETTER SO SALA") ; 0xC8 - (?,TI(B consonant "LETTER SO RUSI") ; 0xC9 - (?,TJ(B consonant "LETTER SO SUA") ; 0xCA - (?,TK(B consonant "LETTER HO HIP") ; 0xCB - (?,TL(B consonant "LETTER LO CHULA") ; 0xCC - (?,TM(B consonant "LETTER O ANG") ; 0xCD - (?,TN(B consonant "LETTER HO NOK HUK") ; 0xCE - (?,TO(B special "PAI YAN NOI (abbreviation)") ; 0xCF - (?,TP(B vowel-base "VOWEL SIGN SARA A") ; 0xD0 - (?,TQ(B vowel-upper "VOWEL SIGN MAI HAN-AKAT N/S-T") ; 0xD1 - (?,TR(B vowel-base "VOWEL SIGN SARA AA") ; 0xD2 - (?,TS(B vowel-base "VOWEL SIGN SARA AM") ; 0xD3 - (?,TT(B vowel-upper "VOWEL SIGN SARA I N/S-T") ; 0xD4 - (?,TU(B vowel-upper "VOWEL SIGN SARA II N/S-T") ; 0xD5 - (?,TV(B vowel-upper "VOWEL SIGN SARA UE N/S-T") ; 0xD6 - (?,TW(B vowel-upper "VOWEL SIGN SARA UEE N/S-T") ; 0xD7 - (?,TX(B vowel-lower "VOWEL SIGN SARA U N/S-B") ; 0xD8 - (?,TY(B vowel-lower "VOWEL SIGN SARA UU N/S-B") ; 0xD9 - (?,TZ(B vowel-lower "VOWEL SIGN PHINTHU N/S-B (Pali virama)") ; 0xDA - (?,T[(B invalid nil) ; 0xDA - (?,T\(B invalid nil) ; 0xDC - (?,T](B invalid nil) ; 0xDC - (?,T^(B invalid nil) ; 0xDC - (?,T_(B special "BAHT SIGN (currency symbol)") ; 0xDF - (?,T`(B vowel-base "VOWEL SIGN SARA E") ; 0xE0 - (?,Ta(B vowel-base "VOWEL SIGN SARA AE") ; 0xE1 - (?,Tb(B vowel-base "VOWEL SIGN SARA O") ; 0xE2 - (?,Tc(B vowel-base "VOWEL SIGN SARA MAI MUAN") ; 0xE3 - (?,Td(B vowel-base "VOWEL SIGN SARA MAI MALAI") ; 0xE4 - (?,Te(B vowel-base "LAK KHANG YAO") ; 0xE5 - (?,Tf(B special "MAI YAMOK (repetion)") ; 0xE6 - (?,Tg(B vowel-upper "VOWEL SIGN MAI TAI KHU N/S-T") ; 0xE7 - (?,Th(B tone "TONE MAI EK N/S-T") ; 0xE8 - (?,Ti(B tone "TONE MAI THO N/S-T") ; 0xE9 - (?,Tj(B tone "TONE MAI TRI N/S-T") ; 0xEA - (?,Tk(B tone "TONE MAI CHATTAWA N/S-T") ; 0xEB - (?,Tl(B tone "THANTHAKHAT N/S-T (cancellation mark)") ; 0xEC - (?,Tm(B tone "NIKKHAHIT N/S-T (final nasal)") ; 0xED - (?,Tn(B vowel-upper "YAMAKKAN N/S-T") ; 0xEE - (?,To(B special "FONRMAN") ; 0xEF - (?,Tp(B special "DIGIT ZERO") ; 0xF0 - (?,Tq(B special "DIGIT ONE") ; 0xF1 - (?,Tr(B special "DIGIT TWO") ; 0xF2 - (?,Ts(B special "DIGIT THREE") ; 0xF3 - (?,Tt(B special "DIGIT FOUR") ; 0xF4 - (?,Tu(B special "DIGIT FIVE") ; 0xF5 - (?,Tv(B special "DIGIT SIX") ; 0xF6 - (?,Tw(B special "DIGIT SEVEN") ; 0xF7 - (?,Tx(B special "DIGIT EIGHT") ; 0xF8 - (?,Ty(B special "DIGIT NINE") ; 0xF9 - (?,Tz(B special "ANGKHANKHU (ellipsis)") ; 0xFA - (?,T{(B special "KHOMUT (beginning of religious texts)") ; 0xFB - (?,T|(B invalid nil) ; 0xFC - (?,T}(B invalid nil) ; 0xFD - (?,T~(B invalid nil) ; 0xFE - )) - elm) - (while l - (setq elm (car l) l (cdr l)) - (let ((char (car elm)) - (ptype (nth 1 elm))) - (put-char-code-property char 'phonetic-type ptype) - (cond ((eq ptype 'consonant) - (modify-category-entry char ?c thai-category-table)) - ((memq ptype '(vowel-upper vowel-lower)) - (modify-category-entry char ?v thai-category-table)) - ((eq ptype 'tone) - (modify-category-entry char ?t thai-category-table))) - (put-char-code-property char 'name (nth 2 elm))))) - -;;;###autoload -(defun thai-compose-region (beg end) - "Compose Thai characters in the region. -When called from a program, expects two arguments, -positions (integers or markers) specifying the region." - (interactive "r") - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) - (with-category-table thai-category-table - (while (re-search-forward thai-composition-pattern nil t) - (compose-region (match-beginning 0) (match-end 0)))))) - -;;;###autoload -(defun thai-compose-string (string) - "Compose Thai characters in STRING and return the resulting string." - (with-category-table thai-category-table - (let ((idx 0)) - (while (setq idx (string-match thai-composition-pattern string idx)) - (compose-string string idx (match-end 0)) - (setq idx (match-end 0))))) - string) - -;;;###autoload -(defun thai-compose-buffer () - "Compose Thai characters in the current buffer." - (interactive) - (thai-compose-region (point-min) (point-max))) - -;;;###autoload -(defun thai-post-read-conversion (len) - (thai-compose-region (point) (+ (point) len)) - len) - -;;;###autoload -(defun thai-composition-function (from to pattern &optional string) - "Compose Thai text in the region FROM and TO. -The text matches the regular expression PATTERN. -Optional 4th argument STRING, if non-nil, is a string containing text -to compose. - -The return value is number of composed characters." - (if (< (1+ from) to) - (prog1 (- to from) - (if string - (compose-string string from to) - (compose-region from to)) - (- to from)))) - -;; -(provide 'thai-util) - -;;; thai-util.el ends here diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/thai-xtis.el --- a/lisp/mule/thai-xtis.el Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,370 +0,0 @@ -;;; thai-xtis.el --- Support for Thai (XTIS) -*- coding: iso-2022-7bit; -*- - -;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. - -;; Author: TAKAHASHI Naoto -;; MORIOKA Tomohiko -;; Created: 1998-03-27 for Emacs-20.3 by TAKAHASHI Naoto -;; 1999-03-29 imported and modified for XEmacs by MORIOKA Tomohiko - -;; Keywords: mule, multilingual, Thai, XTIS - -;; This file is part of XEmacs. - -;; XEmacs is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; XEmacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. - -;;; Commentary: - -;; For Thai, the pre-composed character set proposed by -;; Virach Sornlertlamvanich is supported. - -;;; Code: - -(make-charset 'thai-xtis "Precomposed Thai (XTIS by Virach)." - '(registries ["xtis-0"] - dimension 2 - columns 1 - chars 94 - final ?? - graphic 0)) - -(define-category ?x "Precomposed Thai character.") -(modify-category-entry 'thai-xtis ?x) - -(when (featurep 'xemacs) - (let ((deflist '(;; chars syntax - ("$(?!0(B-$(?NxP0R0S0`0(B-$(?e0(B" "w") - ("$(?p0(B-$(?y0(B" "w") - ("$(?O0f0_0o0z0{0(B" "_") - )) - elm chars len syntax to ch i) - (while deflist - (setq elm (car deflist)) - (setq chars (car elm) - len (length chars) - syntax (nth 1 elm) - i 0) - (while (< i len) - (if (= (aref chars i) ?-) - (setq i (1+ i) - to (nth 1 (split-char (aref chars i)))) - (setq ch (nth 1 (split-char (aref chars i))) - to ch)) - (while (<= ch to) - (modify-syntax-entry (vector 'thai-xtis ch) syntax) - (setq ch (1+ ch))) - (setq i (1+ i))) - (setq deflist (cdr deflist)))) - - (put-charset-property 'thai-xtis 'preferred-coding-system 'tis-620) - ) - -;; This is the ccl-decode-thai-xtis automaton. -;; -;; "WRITE x y" == (insert (make-char 'thai-xtis x y)) -;; "write x" == (insert x) -;; rx' == (tis620-to-thai-xtis-second-byte-bitpattern rx) -;; r3 == "no vower nor tone" -;; r4 == (charset-id 'thai-xtis) -;; -;; | input (= r0) -;; state |-------------------------------------------- -;; | consonant | vowel | tone -;; ---------+-------------+-------------+---------------- -;; r1 == 0 | r1 = r0 | WRITE r0,r3 | WRITE r0,r3 -;; r2 == 0 | | | -;; ---------+-------------+-------------+---------------- -;; r1 == C | WRITE r1,r3 | r2 = r0' | WRITE r1,r3|r0' -;; r2 == 0 | r1 = r0 | | r1 = 0 -;; ---------+-------------+-------------+---------------- -;; r1 == C | WRITE r1,r2 | WRITE r1,r2 | WRITE r1,r2|r0' -;; r2 == V | r1 = r0 | WRITE r0,r3 | r1 = r2 = 0 -;; | r2 = 0 | r1 = r2 = 0 | -;; -;; -;; | input (= r0) -;; state |----------------------------------------- -;; | symbol | ASCII | EOF -;; ---------+-------------+-------------+------------- -;; r1 == 0 | WRITE r0,r3 | write r0 | -;; r2 == 0 | | | -;; ---------+-------------+-------------+------------- -;; r1 == C | WRITE r1,r3 | WRITE r1,r3 | WRITE r1,r3 -;; r2 == 0 | WRITE r0,r3 | write r0 | -;; | r1 = 0 | r1 = 0 | -;; ---------+-------------+-------------+------------- -;; r1 == C | WRITE r1,r2 | WRITE r1,r2 | WRITE r1,r2 -;; r2 == V | WRITE r0,r3 | write r0 | -;; | r1 = r2 = 0 | r1 = r2 = 0 | - - -(eval-and-compile - -;; input : r5 = 1st byte, r6 = 2nd byte -;; Their values will be destroyed. -(define-ccl-program ccl-thai-xtis-write - '(0 - ((r5 = ((r5 & #x7F) << 7)) - (r6 = ((r6 & #x7F) | r5)) - (write-multibyte-character r4 r6)))) - -(define-ccl-program ccl-thai-xtis-consonant - '(0 - (if (r1 == 0) - (r1 = r0) - (if (r2 == 0) - ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write) - (r1 = r0)) - ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) - (r1 = r0) - (r2 = 0)))))) - -(define-ccl-program ccl-thai-xtis-vowel - '(0 - ((if (r1 == 0) - ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)) - ((if (r2 == 0) - (r2 = ((r0 - 204) << 3)) - ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) - (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write) - (r1 = 0) - (r2 = 0)))))))) - -(define-ccl-program ccl-thai-xtis-vowel-d1 - '(0 - ((if (r1 == 0) - ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)) - ((if (r2 == 0) - (r2 = #x38) - ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) - (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write) - (r1 = 0) - (r2 = 0)))))))) - -(define-ccl-program ccl-thai-xtis-vowel-ee - '(0 - ((if (r1 == 0) - ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)) - ((if (r2 == 0) - (r2 = #x78) - ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) - (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write) - (r1 = 0) - (r2 = 0)))))))) - -(define-ccl-program ccl-thai-xtis-tone - '(0 - (if (r1 == 0) - ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)) - (if (r2 == 0) - ((r5 = r1) (r6 = ((r0 - #xE6) | r3)) (call ccl-thai-xtis-write) - (r1 = 0)) - ((r5 = r1) (r6 = ((r0 - #xE6) | r2)) (call ccl-thai-xtis-write) - (r1 = 0) - (r2 = 0)))))) - -(define-ccl-program ccl-thai-xtis-symbol - '(0 - (if (r1 == 0) - ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)) - (if (r2 == 0) - ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write) - (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write) - (r1 = 0)) - ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) - (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write) - (r1 = 0) - (r2 = 0)))))) - -(define-ccl-program ccl-thai-xtis-ascii - '(0 - (if (r1 == 0) - (write r0) - (if (r2 == 0) - ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write) - (write r0) - (r1 = 0)) - ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) - (write r0) - (r1 = 0) - (r2 = 0)))))) - -(define-ccl-program ccl-thai-xtis-eof - '(0 - (if (r1 != 0) - (if (r2 == 0) - ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write)) - ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)))))) - -(define-ccl-program ccl-decode-thai-xtis - `(4 - ((read r0) - (r1 = 0) - (r2 = 0) - (r3 = #x30) - (r4 = ,(charset-id 'thai-xtis)) - (loop - (if (r0 < 161) - (call ccl-thai-xtis-ascii) - (branch (r0 - 161) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-vowel-d1) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-vowel) - (call ccl-thai-xtis-vowel) - (call ccl-thai-xtis-vowel) - (call ccl-thai-xtis-vowel) - (call ccl-thai-xtis-vowel) - (call ccl-thai-xtis-vowel) - (call ccl-thai-xtis-vowel) - nil - nil - nil - nil - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-tone) - (call ccl-thai-xtis-tone) - (call ccl-thai-xtis-tone) - (call ccl-thai-xtis-tone) - (call ccl-thai-xtis-tone) - (call ccl-thai-xtis-tone) - (call ccl-thai-xtis-tone) - (call ccl-thai-xtis-vowel-ee) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - nil - nil - nil)) - (read r0) - (repeat))) - - (call ccl-thai-xtis-eof))) - -) - -(defconst leading-code-private-21 #x9F) - -(define-ccl-program ccl-encode-thai-xtis - `(1 - ((read r0) - (loop - (if (r0 == ,leading-code-private-21) - ((read r1) - (if (r1 == ,(charset-id 'thai-xtis)) - ((read r0) - (write r0) - (read r0) - (r1 = (r0 & 7)) - (r0 = ((r0 - #xB0) >> 3)) - (if (r0 != 0) - (write r0 [0 209 212 213 214 215 216 217 218 238])) - (if (r1 != 0) - (write r1 [0 231 232 233 234 235 236 237])) - (read r0) - (repeat)) - ((write r0 r1) - (read r0) - (repeat)))) - (write-read-repeat r0)))))) - -(make-coding-system - 'tis-620 'ccl - "TIS620 (Thai)" - `(mnemonic "TIS620" - decode ccl-decode-thai-xtis - encode ccl-encode-thai-xtis - safe-charsets (ascii thai-xtis) - documentation "external=tis620, internal=thai-xtis")) -(coding-system-put 'tis-620 'category 'iso-8-1) - -(set-language-info-alist - "Thai-XTIS" - '((charset thai-xtis) - (coding-system tis-620 iso-2022-7bit) - (tutorial . "TUTORIAL.th") - (tutorial-coding-system . tis-620) - (coding-priority tis-620 iso-2022-7bit) - (sample-text . "$(?!:(B") - (documentation . t))) - -;; thai-xtis.el ends here. diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/thai.el --- a/lisp/mule/thai.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/thai.el Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,4 @@ -;;; thai.el --- support for Thai -*- coding: iso-2022-7bit; -*- +;;; thai.el --- support for Thai -*- coding: utf-8; -*- ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. @@ -7,87 +7,263 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Emacs 21.1 (language/thai.el). ;;; Commentary: -;; For Thai, the character set TIS620 is supported. - -;; #### I don't know how this differs from the existing thai-xtis.el so -;; I'm leaving it commented out. - -;;; Code: - -; (make-charset 'thai-tis620 -; "Right-Hand Part of TIS620.2533 (Thai): ISO-IR-166" -; '(dimension -; 1 -; registry "TIS620" -; chars 96 -; columns 1 -; direction l2r -; final ?T -; graphic 1 -; short-name "RHP of TIS620" -; long-name "RHP of Thai (TIS620): ISO-IR-166" -; )) - -; ; (make-coding-system -; ; 'thai-tis620 2 ?T -; ; "8-bit encoding for ASCII (MSB=0) and Thai TIS620 (MSB=1)" -; ; '(ascii thai-tis620 nil nil -; ; nil ascii-eol) -; ; '((safe-charsets ascii thai-tis620) -; ; (post-read-conversion . thai-post-read-conversion))) +(make-coding-system + 'tis-620 'fixed-width + "TIS620 (Thai)" + '(mnemonic "TIS620" + unicode-map + ((#x80 ?\u0080) ;; + (#x81 ?\u0081) ;; + (#x82 ?\u0082) ;; + (#x83 ?\u0083) ;; + (#x84 ?\u0084) ;; + (#x85 ?\u0085) ;; + (#x86 ?\u0086) ;; + (#x87 ?\u0087) ;; + (#x88 ?\u0088) ;; + (#x89 ?\u0089) ;; + (#x8A ?\u008A) ;; + (#x8B ?\u008B) ;; + (#x8C ?\u008C) ;; + (#x8D ?\u008D) ;; + (#x8E ?\u008E) ;; + (#x8F ?\u008F) ;; + (#x90 ?\u0090) ;; + (#x91 ?\u0091) ;; + (#x92 ?\u0092) ;; + (#x93 ?\u0093) ;; + (#x94 ?\u0094) ;; + (#x95 ?\u0095) ;; + (#x96 ?\u0096) ;; + (#x97 ?\u0097) ;; + (#x98 ?\u0098) ;; + (#x99 ?\u0099) ;; + (#x9A ?\u009A) ;; + (#x9B ?\u009B) ;; + (#x9C ?\u009C) ;; + (#x9D ?\u009D) ;; + (#x9E ?\u009E) ;; + (#x9F ?\u009F) ;; + (#xA0 ?\u00A0) ;; NO-BREAK SPACE + (#xA1 ?\u0E01) ;; THAI CHARACTER KO KAI + (#xA2 ?\u0E02) ;; THAI CHARACTER KHO KHAI + (#xA3 ?\u0E03) ;; THAI CHARACTER KHO KHUAT + (#xA4 ?\u0E04) ;; THAI CHARACTER KHO KHWAI + (#xA5 ?\u0E05) ;; THAI CHARACTER KHO KHON + (#xA6 ?\u0E06) ;; THAI CHARACTER KHO RAKHANG + (#xA7 ?\u0E07) ;; THAI CHARACTER NGO NGU + (#xA8 ?\u0E08) ;; THAI CHARACTER CHO CHAN + (#xA9 ?\u0E09) ;; THAI CHARACTER CHO CHING + (#xAA ?\u0E0A) ;; THAI CHARACTER CHO CHANG + (#xAB ?\u0E0B) ;; THAI CHARACTER SO SO + (#xAC ?\u0E0C) ;; THAI CHARACTER CHO CHOE + (#xAD ?\u0E0D) ;; THAI CHARACTER YO YING + (#xAE ?\u0E0E) ;; THAI CHARACTER DO CHADA + (#xAF ?\u0E0F) ;; THAI CHARACTER TO PATAK + (#xB0 ?\u0E10) ;; THAI CHARACTER THO THAN + (#xB1 ?\u0E11) ;; THAI CHARACTER THO NANGMONTHO + (#xB2 ?\u0E12) ;; THAI CHARACTER THO PHUTHAO + (#xB3 ?\u0E13) ;; THAI CHARACTER NO NEN + (#xB4 ?\u0E14) ;; THAI CHARACTER DO DEK + (#xB5 ?\u0E15) ;; THAI CHARACTER TO TAO + (#xB6 ?\u0E16) ;; THAI CHARACTER THO THUNG + (#xB7 ?\u0E17) ;; THAI CHARACTER THO THAHAN + (#xB8 ?\u0E18) ;; THAI CHARACTER THO THONG + (#xB9 ?\u0E19) ;; THAI CHARACTER NO NU + (#xBA ?\u0E1A) ;; THAI CHARACTER BO BAIMAI + (#xBB ?\u0E1B) ;; THAI CHARACTER PO PLA + (#xBC ?\u0E1C) ;; THAI CHARACTER PHO PHUNG + (#xBD ?\u0E1D) ;; THAI CHARACTER FO FA + (#xBE ?\u0E1E) ;; THAI CHARACTER PHO PHAN + (#xBF ?\u0E1F) ;; THAI CHARACTER FO FAN + (#xC0 ?\u0E20) ;; THAI CHARACTER PHO SAMPHAO + (#xC1 ?\u0E21) ;; THAI CHARACTER MO MA + (#xC2 ?\u0E22) ;; THAI CHARACTER YO YAK + (#xC3 ?\u0E23) ;; THAI CHARACTER RO RUA + (#xC4 ?\u0E24) ;; THAI CHARACTER RU + (#xC5 ?\u0E25) ;; THAI CHARACTER LO LING + (#xC6 ?\u0E26) ;; THAI CHARACTER LU + (#xC7 ?\u0E27) ;; THAI CHARACTER WO WAEN + (#xC8 ?\u0E28) ;; THAI CHARACTER SO SALA + (#xC9 ?\u0E29) ;; THAI CHARACTER SO RUSI + (#xCA ?\u0E2A) ;; THAI CHARACTER SO SUA + (#xCB ?\u0E2B) ;; THAI CHARACTER HO HIP + (#xCC ?\u0E2C) ;; THAI CHARACTER LO CHULA + (#xCD ?\u0E2D) ;; THAI CHARACTER O ANG + (#xCE ?\u0E2E) ;; THAI CHARACTER HO NOKHUK + (#xCF ?\u0E2F) ;; THAI CHARACTER PAIYANNOI + (#xD0 ?\u0E30) ;; THAI CHARACTER SARA A + (#xD1 ?\u0E31) ;; THAI CHARACTER MAI HAN-AKAT + (#xD2 ?\u0E32) ;; THAI CHARACTER SARA AA + (#xD3 ?\u0E33) ;; THAI CHARACTER SARA AM + (#xD4 ?\u0E34) ;; THAI CHARACTER SARA I + (#xD5 ?\u0E35) ;; THAI CHARACTER SARA II + (#xD6 ?\u0E36) ;; THAI CHARACTER SARA UE + (#xD7 ?\u0E37) ;; THAI CHARACTER SARA UEE + (#xD8 ?\u0E38) ;; THAI CHARACTER SARA U + (#xD9 ?\u0E39) ;; THAI CHARACTER SARA UU + (#xDA ?\u0E3A) ;; THAI CHARACTER PHINTHU + (#xDF ?\u0E3F) ;; THAI CURRENCY SYMBOL BAHT + (#xE0 ?\u0E40) ;; THAI CHARACTER SARA E + (#xE1 ?\u0E41) ;; THAI CHARACTER SARA AE + (#xE2 ?\u0E42) ;; THAI CHARACTER SARA O + (#xE3 ?\u0E43) ;; THAI CHARACTER SARA AI MAIMUAN + (#xE4 ?\u0E44) ;; THAI CHARACTER SARA AI MAIMALAI + (#xE5 ?\u0E45) ;; THAI CHARACTER LAKKHANGYAO + (#xE6 ?\u0E46) ;; THAI CHARACTER MAIYAMOK + (#xE7 ?\u0E47) ;; THAI CHARACTER MAITAIKHU + (#xE8 ?\u0E48) ;; THAI CHARACTER MAI EK + (#xE9 ?\u0E49) ;; THAI CHARACTER MAI THO + (#xEA ?\u0E4A) ;; THAI CHARACTER MAI TRI + (#xEB ?\u0E4B) ;; THAI CHARACTER MAI CHATTAWA + (#xEC ?\u0E4C) ;; THAI CHARACTER THANTHAKHAT + (#xED ?\u0E4D) ;; THAI CHARACTER NIKHAHIT + (#xEE ?\u0E4E) ;; THAI CHARACTER YAMAKKAN + (#xEF ?\u0E4F) ;; THAI CHARACTER FONGMAN + (#xF0 ?\u0E50) ;; THAI DIGIT ZERO + (#xF1 ?\u0E51) ;; THAI DIGIT ONE + (#xF2 ?\u0E52) ;; THAI DIGIT TWO + (#xF3 ?\u0E53) ;; THAI DIGIT THREE + (#xF4 ?\u0E54) ;; THAI DIGIT FOUR + (#xF5 ?\u0E55) ;; THAI DIGIT FIVE + (#xF6 ?\u0E56) ;; THAI DIGIT SIX + (#xF7 ?\u0E57) ;; THAI DIGIT SEVEN + (#xF8 ?\u0E58) ;; THAI DIGIT EIGHT + (#xF9 ?\u0E59) ;; THAI DIGIT NINE + (#xFA ?\u0E5A) ;; THAI CHARACTER ANGKHANKHU + (#xFB ?\u0E5B));; THAI CHARACTER KHOMUT + documentation "Non-composed Thai" + aliases (iso-8859-11))) -; (make-coding-system -; 'thai-tis620 'iso2022 "Thai/TIS620" -; '(charset-g0 ascii -; charset-g1 thai-tis620 -; mnemonic "Thai" -; safe-charsets (ascii thai-tis620) -; post-read-conversion thai-post-read-conversion -; documentation "8-bit encoding for ASCII (MSB=0) and Thai TIS620 (MSB=1)")) - -; (define-coding-system-alias 'th-tis620 'thai-tis620) -; (define-coding-system-alias 'tis620 'thai-tis620) -; (define-coding-system-alias 'tis-620 'thai-tis620) +(make-coding-system + 'windows-874 'fixed-width "Microsoft's CP874" + '(mnemonic "CP874" + unicode-map + ((#x80 ?\u20AC) ;; EURO SIGN + (#x85 ?\u2026) ;; HORIZONTAL ELLIPSIS + (#x91 ?\u2018) ;; LEFT SINGLE QUOTATION MARK + (#x92 ?\u2019) ;; RIGHT SINGLE QUOTATION MARK + (#x93 ?\u201C) ;; LEFT DOUBLE QUOTATION MARK + (#x94 ?\u201D) ;; RIGHT DOUBLE QUOTATION MARK + (#x95 ?\u2022) ;; BULLET + (#x96 ?\u2013) ;; EN DASH + (#x97 ?\u2014) ;; EM DASH + (#xA0 ?\u00A0) ;; NO-BREAK SPACE + (#xA1 ?\u0E01) ;; THAI CHARACTER KO KAI + (#xA2 ?\u0E02) ;; THAI CHARACTER KHO KHAI + (#xA3 ?\u0E03) ;; THAI CHARACTER KHO KHUAT + (#xA4 ?\u0E04) ;; THAI CHARACTER KHO KHWAI + (#xA5 ?\u0E05) ;; THAI CHARACTER KHO KHON + (#xA6 ?\u0E06) ;; THAI CHARACTER KHO RAKHANG + (#xA7 ?\u0E07) ;; THAI CHARACTER NGO NGU + (#xA8 ?\u0E08) ;; THAI CHARACTER CHO CHAN + (#xA9 ?\u0E09) ;; THAI CHARACTER CHO CHING + (#xAA ?\u0E0A) ;; THAI CHARACTER CHO CHANG + (#xAB ?\u0E0B) ;; THAI CHARACTER SO SO + (#xAC ?\u0E0C) ;; THAI CHARACTER CHO CHOE + (#xAD ?\u0E0D) ;; THAI CHARACTER YO YING + (#xAE ?\u0E0E) ;; THAI CHARACTER DO CHADA + (#xAF ?\u0E0F) ;; THAI CHARACTER TO PATAK + (#xB0 ?\u0E10) ;; THAI CHARACTER THO THAN + (#xB1 ?\u0E11) ;; THAI CHARACTER THO NANGMONTHO + (#xB2 ?\u0E12) ;; THAI CHARACTER THO PHUTHAO + (#xB3 ?\u0E13) ;; THAI CHARACTER NO NEN + (#xB4 ?\u0E14) ;; THAI CHARACTER DO DEK + (#xB5 ?\u0E15) ;; THAI CHARACTER TO TAO + (#xB6 ?\u0E16) ;; THAI CHARACTER THO THUNG + (#xB7 ?\u0E17) ;; THAI CHARACTER THO THAHAN + (#xB8 ?\u0E18) ;; THAI CHARACTER THO THONG + (#xB9 ?\u0E19) ;; THAI CHARACTER NO NU + (#xBA ?\u0E1A) ;; THAI CHARACTER BO BAIMAI + (#xBB ?\u0E1B) ;; THAI CHARACTER PO PLA + (#xBC ?\u0E1C) ;; THAI CHARACTER PHO PHUNG + (#xBD ?\u0E1D) ;; THAI CHARACTER FO FA + (#xBE ?\u0E1E) ;; THAI CHARACTER PHO PHAN + (#xBF ?\u0E1F) ;; THAI CHARACTER FO FAN + (#xC0 ?\u0E20) ;; THAI CHARACTER PHO SAMPHAO + (#xC1 ?\u0E21) ;; THAI CHARACTER MO MA + (#xC2 ?\u0E22) ;; THAI CHARACTER YO YAK + (#xC3 ?\u0E23) ;; THAI CHARACTER RO RUA + (#xC4 ?\u0E24) ;; THAI CHARACTER RU + (#xC5 ?\u0E25) ;; THAI CHARACTER LO LING + (#xC6 ?\u0E26) ;; THAI CHARACTER LU + (#xC7 ?\u0E27) ;; THAI CHARACTER WO WAEN + (#xC8 ?\u0E28) ;; THAI CHARACTER SO SALA + (#xC9 ?\u0E29) ;; THAI CHARACTER SO RUSI + (#xCA ?\u0E2A) ;; THAI CHARACTER SO SUA + (#xCB ?\u0E2B) ;; THAI CHARACTER HO HIP + (#xCC ?\u0E2C) ;; THAI CHARACTER LO CHULA + (#xCD ?\u0E2D) ;; THAI CHARACTER O ANG + (#xCE ?\u0E2E) ;; THAI CHARACTER HO NOKHUK + (#xCF ?\u0E2F) ;; THAI CHARACTER PAIYANNOI + (#xD0 ?\u0E30) ;; THAI CHARACTER SARA A + (#xD1 ?\u0E31) ;; THAI CHARACTER MAI HAN-AKAT + (#xD2 ?\u0E32) ;; THAI CHARACTER SARA AA + (#xD3 ?\u0E33) ;; THAI CHARACTER SARA AM + (#xD4 ?\u0E34) ;; THAI CHARACTER SARA I + (#xD5 ?\u0E35) ;; THAI CHARACTER SARA II + (#xD6 ?\u0E36) ;; THAI CHARACTER SARA UE + (#xD7 ?\u0E37) ;; THAI CHARACTER SARA UEE + (#xD8 ?\u0E38) ;; THAI CHARACTER SARA U + (#xD9 ?\u0E39) ;; THAI CHARACTER SARA UU + (#xDA ?\u0E3A) ;; THAI CHARACTER PHINTHU + (#xDF ?\u0E3F) ;; THAI CURRENCY SYMBOL BAHT + (#xE0 ?\u0E40) ;; THAI CHARACTER SARA E + (#xE1 ?\u0E41) ;; THAI CHARACTER SARA AE + (#xE2 ?\u0E42) ;; THAI CHARACTER SARA O + (#xE3 ?\u0E43) ;; THAI CHARACTER SARA AI MAIMUAN + (#xE4 ?\u0E44) ;; THAI CHARACTER SARA AI MAIMALAI + (#xE5 ?\u0E45) ;; THAI CHARACTER LAKKHANGYAO + (#xE6 ?\u0E46) ;; THAI CHARACTER MAIYAMOK + (#xE7 ?\u0E47) ;; THAI CHARACTER MAITAIKHU + (#xE8 ?\u0E48) ;; THAI CHARACTER MAI EK + (#xE9 ?\u0E49) ;; THAI CHARACTER MAI THO + (#xEA ?\u0E4A) ;; THAI CHARACTER MAI TRI + (#xEB ?\u0E4B) ;; THAI CHARACTER MAI CHATTAWA + (#xEC ?\u0E4C) ;; THAI CHARACTER THANTHAKHAT + (#xED ?\u0E4D) ;; THAI CHARACTER NIKHAHIT + (#xEE ?\u0E4E) ;; THAI CHARACTER YAMAKKAN + (#xEF ?\u0E4F) ;; THAI CHARACTER FONGMAN + (#xF0 ?\u0E50) ;; THAI DIGIT ZERO + (#xF1 ?\u0E51) ;; THAI DIGIT ONE + (#xF2 ?\u0E52) ;; THAI DIGIT TWO + (#xF3 ?\u0E53) ;; THAI DIGIT THREE + (#xF4 ?\u0E54) ;; THAI DIGIT FOUR + (#xF5 ?\u0E55) ;; THAI DIGIT FIVE + (#xF6 ?\u0E56) ;; THAI DIGIT SIX + (#xF7 ?\u0E57) ;; THAI DIGIT SEVEN + (#xF8 ?\u0E58) ;; THAI DIGIT EIGHT + (#xF9 ?\u0E59) ;; THAI DIGIT NINE + (#xFA ?\u0E5A) ;; THAI CHARACTER ANGKHANKHU + (#xFB ?\u0E5B));; THAI CHARACTER KHOMUT + documentation "Microsoft's encoding for Thai." + aliases (cp874))) -; (set-language-info-alist -; "Thai" '((tutorial . "TUTORIAL.th") -; (charset thai-tis620) -; (coding-system thai-tis620) -; (coding-priority thai-tis620) -; (nonascii-translation . thai-tis620) -; (input-method . "thai-kesmanee") -; (unibyte-display . thai-tis620) -; (features thai-util) -; (sample-text -; . (thai-compose-string -; (copy-sequence "Thai (,T@RIRd7B(B) ,TJ0GQ1J04U1$0CQ1:(B, ,TJ0GQ1J04U10$h1P(B"))) -; (documentation . t))) - - -;; Register a function to compose Thai characters. -; (put-char-table 'thai-tis620 -; '(("\\c0\\c4\\|\\c0\\(\\c2\\|\\c3\\)\\c4?" . -; thai-composition-function)) -; composition-function-table) +(set-language-info-alist + "Thai" + '((coding-system tis-620 utf-8) + (tutorial . "TUTORIAL.th") + (tutorial-coding-system . tis-620) + (coding-priority tis-620 utf-8 iso-2022-7bit) + (sample-text . "àžªàž§àž±àžªàž”àžµàž„àž£àž±àžš, àžªàž§àž±àžªàž”àžµàž„à¹ˆàž°") + (documentation . t))) (provide 'thai) diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/tibet-util.el --- a/lisp/mule/tibet-util.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/tibet-util.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Emacs 21.1 (language/tibet-util.el). diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/tibetan.el --- a/lisp/mule/tibetan.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/tibetan.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Emacs 21.1 (language/tibetan.el). diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/viet-util.el --- a/lisp/mule/viet-util.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/viet-util.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Emacs 21.1 (language/viet-util.el). @@ -45,8 +43,8 @@ (if (eq char ?~) char (setq char (encode-coding-string char 'viscii)) - (if (and (= 1 (length char)) - (not (eq (aref char 0) ?~))) + (if (and (eql 1 (length char)) + (not (eql (aref char 0) ?~))) (aref char 0)))) ;; VIQR is a menmonic encoding specification for Vietnamese. diff -r 861f2601a38b -r 1f0b15040456 lisp/mule/vietnamese.el --- a/lisp/mule/vietnamese.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mule/vietnamese.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/multicast.el --- a/lisp/multicast.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/multicast.el Sun May 01 18:44:03 2011 +0100 @@ -12,20 +12,18 @@ ;; 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 of the License, or -;; (at your option) any later version. +;; 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 3 of the License, 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. +;; 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 this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - +;; along with XEmacs. If not, see . ;;; Commentary: @@ -87,8 +85,8 @@ ;; We check only the general form of the multicast address. ;; The rest will be handled by the internal function. (string-match "^\\([0-9\\.]+\\)/\\([0-9]+\\)/\\([0-9]+\\)$" address) - (and (not (and (= (match-beginning 0) 0) - (= (match-end 0) (length address)))) + (and (not (and (eql (match-beginning 0) 0) + (eql (match-end 0) (length address)))) (error "malformed multicast address: %s" address)) (and (not (setq dest (match-string 1 address))) (error "invalid destination specification.")) diff -r 861f2601a38b -r 1f0b15040456 lisp/mwheel.el --- a/lisp/mwheel.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/mwheel.el Sun May 01 18:44:03 2011 +0100 @@ -6,20 +6,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched. diff -r 861f2601a38b -r 1f0b15040456 lisp/newcomment.el --- a/lisp/newcomment.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/newcomment.el Sun May 01 18:44:03 2011 +0100 @@ -6,22 +6,20 @@ ;; Maintainer: Stefan Monnier ;; Keywords: comment uncomment -;; This file is part of GNU Emacs. +;; This file is part of XEmacs. -;; 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. +;; 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 3 of the License, 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. +;; 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 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. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 21.3. @@ -66,13 +64,9 @@ ;;; Code: -;;;###autoload (defalias 'indent-for-comment 'comment-indent) -;;;###autoload (defalias 'set-comment-column 'comment-set-column) -;;;###autoload (defalias 'kill-comment 'comment-kill) -;;;###autoload (defalias 'indent-new-comment-line 'comment-indent-new-line) (defgroup comment nil @@ -92,7 +86,6 @@ "Column to use for `comment-indent'. If nil, use `fill-column' instead." :type '(choice (const nil) integer)) -;;;###autoload (defcustom comment-column 32 "*Column to indent right-margin comments to. Each mode establishes a different default value for this variable; you @@ -102,26 +95,21 @@ :type 'integer) (make-variable-buffer-local 'comment-column) -;;;###autoload (defvar comment-start nil "*String to insert to start a new comment, or nil if no comment syntax.") -;;;###autoload (defvar comment-start-skip nil "*Regexp to match the start of a comment plus everything up to its body. If there are any \\(...\\) pairs, the comment delimiter text is held to begin at the place matched by the close of the first pair.") -;;;###autoload (defvar comment-end-skip nil "Regexp to match the end of a comment plus everything up to its body.") -;;;###autoload (defvar comment-end "" "*String to insert to end a new comment. Should be an empty string if comments are terminated by end-of-line.") -;;;###autoload (defvar comment-indent-function 'comment-indent-default "Function to compute desired indentation for a comment. This function is called with no args with point at the beginning of @@ -170,7 +158,6 @@ INDENT specifies that the `comment-start' markers should not be put at the left margin but at the current indentation of the region to comment.") -;;;###autoload (defcustom comment-style 'plain "*Style to be used for `comment-region'. See `comment-styles' for a list of available styles." @@ -178,7 +165,6 @@ `(choice ,@(mapcar (lambda (s) `(const ,(car s))) comment-styles)) 'symbol)) -;;;###autoload (defcustom comment-padding " " "Padding string that `comment-region' puts between comment chars and text. Can also be an integer which will be automatically turned into a string @@ -188,7 +174,6 @@ makes the comment easier to read. Default is 1. nil means 0." :type '(choice string integer (const nil))) -;;;###autoload (defcustom comment-multi-line t ; XEmacs - this works well with adaptive fill "*Non-nil means \\[indent-new-comment-line] should continue same comment on new line, with no new terminator or starter. @@ -210,7 +195,6 @@ "Return the mirror image of string S, without any trailing space." (comment-string-strip (concat (nreverse (string-to-list s))) nil t)) -;;;###autoload (defun comment-normalize-vars (&optional noerror) (if (not comment-start) (or noerror (error "No comment syntax is defined")) ;; comment-use-syntax @@ -284,7 +268,7 @@ (goto-char (match-beginning 0)) (forward-char 1) (if unp (delete-char 1) (insert "\\")) - (when (= (length ce) 1) + (when (eql (length ce) 1) ;; If the comment-end is a single char, adding a \ after that ;; "first" char won't deactivate it, so we turn such a CE ;; into !CS. I.e. for pascal, we turn } into !{ @@ -433,7 +417,6 @@ ;;;; Commands ;;;; -;;;###autoload ;; #### XEmacs had this: in place of just (current-column) ; (defconst comment-indent-function @@ -462,7 +445,6 @@ (and (> comment-add 0) (looking-at "\\s<\\S<"))) comment-column))) -;;;###autoload (defun comment-indent (&optional continue) "Indent this line's comment to comment column, or insert an empty comment. If CONTINUE is non-nil, use the `comment-continue' markers if any. @@ -527,7 +509,6 @@ (goto-char cpos) (set-marker cpos nil)))) -;;;###autoload (defun comment-set-column (arg) "Set the comment column based on point. With no ARG, set the comment column to the current column. @@ -549,7 +530,6 @@ (t (setq comment-column (current-column)) (lmessage 'command "Comment column set to %d" comment-column)))) -;;;###autoload (defun comment-kill (arg) "Kill the comment on this line, if any. With prefix ARG, kill comments on that many lines starting with this one." @@ -641,7 +621,6 @@ (if multi (concat (regexp-quote (string c)) "*")) (regexp-quote s)))))) -;;;###autoload (defun uncomment-region (beg end &optional arg) "Uncomment each line in the BEG .. END region. The numeric prefix ARG can specify a number of chars to remove from the @@ -872,7 +851,6 @@ (end-of-line) (not (or (eobp) (progn (forward-line) nil)))))))))) -;;;###autoload (defun comment-region (beg end &optional arg) "Comment or uncomment each line in the region. With just \\[universal-argument] prefix arg, uncomment each line in region BEG .. END. @@ -922,7 +900,7 @@ ((consp arg) (uncomment-region beg end)) ((< numarg 0) (uncomment-region beg end (- numarg))) (t - (setq numarg (if (and (null arg) (= (length comment-start) 1)) + (setq numarg (if (and (null arg) (eql (length comment-start) 1)) add (1- numarg))) (comment-region-internal beg end @@ -948,7 +926,6 @@ (comment-region beg end (+ comment-add arg)))) -;;;###autoload (defun comment-or-uncomment-region (beg end &optional arg) "Call `comment-region', unless the region only consists of comments, in which case call `uncomment-region'. If a prefix arg is given, it @@ -961,7 +938,6 @@ 'uncomment-region 'comment-region) beg end arg)) -;;;###autoload (defun comment-dwim (arg) "Call the comment command you want (Do What I Mean). If the region is active and `transient-mark-mode' is on, call @@ -979,7 +955,7 @@ ;; specified, calling comment-kill is not very clever. (if arg (comment-kill (and (integerp arg) arg)) (comment-indent)) (let ((add (if arg (prefix-numeric-value arg) - (if (= (length comment-start) 1) comment-add 0)))) + (if (eql (length comment-start) 1) comment-add 0)))) ;; Some modes insist on keeping column 0 comment in column 0 ;; so we need to move away from it before inserting the comment. (indent-according-to-mode) @@ -1002,7 +978,6 @@ (string-match (concat "\\`[ \t]*\\(?:" comment-start-skip "\\)") fill-prefix))) -;;;###autoload (defun comment-indent-new-line (&optional soft) "Break line at point and indent, continuing comment if within one. This indents the body of the continued comment diff -r 861f2601a38b -r 1f0b15040456 lisp/next-error.el --- a/lisp/next-error.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/next-error.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 22.0.50.1 (CVS) ;;; Some functions renamed with the next-error-framework prefix to avoid diff -r 861f2601a38b -r 1f0b15040456 lisp/objects.el --- a/lisp/objects.el Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,197 +0,0 @@ -;;; objects.el --- Lisp interface to C window-system objects - -;; Copyright (C) 1994, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Ben Wing - -;; Author: Chuck Thompson -;; Author: Ben Wing -;; Maintainer: XEmacs Development Team -;; Keywords: faces, 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. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;;; Code: - -(defun ws-object-property-1 (function object domain &optional matchspec) - (let ((instance (if matchspec - (specifier-matching-instance object matchspec domain) - (specifier-instance object domain)))) - (and instance (funcall function instance)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; font specifiers - -(defun make-font-specifier (spec-list) - "Return a new `font' specifier object with the given specification list. -SPEC-LIST can be a list of specifications (each of which is a cons of a -locale and a list of instantiators), a single instantiator, or a list -of instantiators. See `make-specifier' for more information about -specifiers. - -Valid instantiators for font specifiers are: - --- a string naming a font; syntax is platform dependent. Some examples for - a 14-point upright medium-weight Courier font: - X11 (and GTK1): \"-*-courier-medium-r-*-*-*-140-*-*-*-*-iso8859-*\" - Xft (and GTK2): \"Courier-14\" - MS-Windows: \"Courier:14:Western\" --- a font instance (use that instance directly if the device matches, - or use the string that generated it) --- a vector of no elements (only on TTY's; this means to set no font - at all, thus using the \"natural\" font of the terminal's text) --- a vector of one element (a face to inherit from) -" - (make-specifier-and-init 'font spec-list)) - -(defun font-name (font &optional domain charset) - "Return the name of the FONT in the specified DOMAIN, if any. -FONT should be a font specifier object and DOMAIN is normally a window -and defaults to the selected window if omitted. This is equivalent -to using `specifier-instance' and applying `font-instance-name' to -the result. See `make-specifier' for more information about specifiers." - (ws-object-property-1 'font-instance-name font domain charset)) - -(defun font-ascent (font &optional domain charset) - "Return the ascent of the FONT in the specified DOMAIN, if any. -FONT should be a font specifier object and DOMAIN is normally a window -and defaults to the selected window if omitted. This is equivalent -to using `specifier-instance' and applying `font-instance-ascent' to -the result. See `make-specifier' for more information about specifiers." - (ws-object-property-1 'font-instance-ascent font domain charset)) - -(defun font-descent (font &optional domain charset) - "Return the descent of the FONT in the specified DOMAIN, if any. -FONT should be a font specifier object and DOMAIN is normally a window -and defaults to the selected window if omitted. This is equivalent -to using `specifier-instance' and applying `font-instance-descent' to -the result. See `make-specifier' for more information about specifiers." - (ws-object-property-1 'font-instance-descent font domain charset)) - -(defun font-width (font &optional domain charset) - "Return the width of the FONT in the specified DOMAIN, if any. -FONT should be a font specifier object and DOMAIN is normally a window -and defaults to the selected window if omitted. This is equivalent -to using `specifier-instance' and applying `font-instance-width' to -the result. See `make-specifier' for more information about specifiers." - (ws-object-property-1 'font-instance-width font domain charset)) - -(defun font-height (font &optional domain charset) - "Return the height of the FONT in the specified DOMAIN, if any. -FONT should be a font specifier object and DOMAIN is normally a window -and defaults to the selected window if omitted. This is equivalent -to using `specifier-instance' and applying `font-instance-height' to -the result. See `make-specifier' for more information about specifiers." - (ws-object-property-1 'font-instance-height font domain charset)) - -(defun font-proportional-p (font &optional domain charset) - "Return whether FONT is proportional in the specified DOMAIN, if known. -FONT should be a font specifier object and DOMAIN is normally a window -and defaults to the selected window if omitted. This is equivalent -to using `specifier-instance' and applying `font-instance-proportional-p' to -the result. See `make-specifier' for more information about specifiers." - (ws-object-property-1 'font-instance-proportional-p font domain charset)) - -(defun font-properties (font &optional domain charset) - "Return the properties of the FONT in the specified DOMAIN, if any. -FONT should be a font specifier object and DOMAIN is normally a window -and defaults to the selected window if omitted. This is equivalent -to using `specifier-instance' and applying `font-instance-properties' -to the result. See `make-specifier' for more information about specifiers." - (ws-object-property-1 'font-instance-properties font domain charset)) - -(defun font-truename (font &optional domain charset) - "Return the truename of the FONT in the specified DOMAIN, if any. -FONT should be a font specifier object and DOMAIN is normally a window -and defaults to the selected window if omitted. This is equivalent -to using `specifier-instance' and applying `font-instance-truename' -to the result. See `make-specifier' for more information about specifiers." - (ws-object-property-1 'font-instance-truename font domain charset)) - -(defun font-instance-height (font-instance) - "Return the height in pixels of FONT-INSTANCE. -The returned value is the maximum height for all characters in the font,\n\ -and is equivalent to the sum of the font instance's ascent and descent." - (+ (font-instance-ascent font-instance) - (font-instance-descent font-instance))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; color specifiers - -(defun make-color-specifier (spec-list) - "Return a new `color' specifier object with the given specification list. -SPEC-LIST can be a list of specifications (each of which is a cons of a -locale and a list of instantiators), a single instantiator, or a list -of instantiators. See `make-specifier' for a detailed description of -how specifiers work. - -Valid instantiators for color specifiers are: - --- a string naming a color (e.g. under X this might be \"lightseagreen2\" - or \"#F534B2\") --- a color instance (use that instance directly if the device matches, - or use the string that generated it) --- a vector of no elements (only on TTY's; this means to set no color - at all, thus using the \"natural\" color of the terminal's text) --- a vector of one or two elements: a face to inherit from, and - optionally a symbol naming which property of that face to inherit, - either `foreground' or `background' (if omitted, defaults to the same - property that this color specifier is used for; if this specifier is - not part of a face, the instantiator would not be valid)." - (make-specifier-and-init 'color spec-list)) - -(defun color-name (color &optional domain) - "Return the name of the COLOR in the specified DOMAIN, if any. -COLOR should be a color specifier object and DOMAIN is normally a window -and defaults to the selected window if omitted. This is equivalent -to using `specifier-instance' and applying `color-instance-name' to -the result. See `make-specifier' for more information about specifiers." - (ws-object-property-1 'color-instance-name color domain)) - -(defun color-rgb-components (color &optional domain) - "Return the RGB components of the COLOR in the specified DOMAIN, if any. -COLOR should be a color specifier object and DOMAIN is normally a window -and defaults to the selected window if omitted. This is equivalent -to using `specifier-instance' and applying `color-instance-rgb-components' -to the result. See `make-specifier' for more information about specifiers." - (ws-object-property-1 'color-instance-rgb-components color domain)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; face-boolean specifiers - -(defun make-face-boolean-specifier (spec-list) - "Return a new `face-boolean' specifier object with the given spec list. -SPEC-LIST can be a list of specifications (each of which is a cons of a -locale and a list of instantiators), a single instantiator, or a list -of instantiators. See `make-specifier' for a detailed description of -how specifiers work. - -Valid instantiators for face-boolean specifiers are - --- t or nil --- a vector of one, two or three elements: a face to inherit from, - optionally a symbol naming the property of that face to inherit from - (if omitted, defaults to the same property that this face-boolean - specifier is used for; if this specifier is not part of a face, - the instantiator would not be valid), and optionally a value which, - if non-nil, means to invert the sense of the inherited property." - (make-specifier-and-init 'face-boolean spec-list)) - -;;; objects.el ends here. diff -r 861f2601a38b -r 1f0b15040456 lisp/obsolete.el --- a/lisp/obsolete.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/obsolete.el Sun May 01 18:44:03 2011 +0100 @@ -3,27 +3,25 @@ ;; Copyright (C) 1985-1994, 1997 Free Software Foundation, Inc. ;; Copyright (C) 1994, 1995 Amdahl Corporation. ;; Copyright (C) 1995 Sun Microsystems. -;; Copyright (C) 2002, 2004 Ben Wing. +;; Copyright (C) 2002, 2004, 2010 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -72,6 +70,19 @@ (defvaralias oldvar newvar) (make-compatible-variable oldvar newvar)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;; buffers + +(define-obsolete-function-alias 'show-buffer 'set-window-buffer) +(define-obsolete-function-alias 'buffer-flush-undo 'buffer-disable-undo) +(make-compatible 'eval-current-buffer 'eval-buffer) + +(defun buffer-local-value (variable buffer) + "Return the value of VARIABLE in BUFFER. +If VARIABLE does not have a buffer-local binding in BUFFER, the value +is the default binding of variable." + (symbol-value-in-buffer variable buffer)) +(make-compatible 'buffer-local-value 'symbol-value-in-buffer) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;; device stuff (make-compatible-variable 'window-system "use (console-type)") @@ -111,6 +122,7 @@ 'lookup-syntax-properties) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; frames + (defun frame-first-window (frame) "Return the topmost, leftmost window of FRAME. If omitted, FRAME defaults to the currently selected frame." @@ -172,20 +184,21 @@ (define-obsolete-function-alias 'list-faces-display 'edit-faces) (define-obsolete-function-alias 'list-faces 'face-list) -;;;;;;;;;;;;;;;;;;;;;;;;;;;; paths +;;;;;;;;;;;;;;;;;;;;;;;;;;;; fonts and colors -(defvar Info-default-directory-list nil - "This used to be the initial value of Info-directory-list. -If you want to change the locations where XEmacs looks for info files, -set Info-directory-list.") -(make-obsolete-variable 'Info-default-directory-list 'Info-directory-list) +(defun x-color-values (color &optional frame) + "Return a description of the color named COLOR on frame FRAME. +The value is a list of integer RGB values--(RED GREEN BLUE). +These values appear to range from 0 to 65280 or 65535, depending +on the system; white is (65280 65280 65280) or (65535 65535 65535). +If FRAME is omitted or nil, use the selected frame." + (color-instance-rgb-components (make-color-instance color))) +(make-compatible 'x-color-values 'color-instance-rgb-components) -(defvar init-file-user nil - "This used to be the name of the user whose init file was read at startup.") -(make-obsolete-variable 'init-file-user 'load-user-init-file-p) +(make-obsolete 'mswindows-color-list 'color-list) +(make-obsolete 'tty-color-list 'color-list) +(make-compatible 'list-fonts 'font-list) -(define-obsolete-function-alias 'pui-add-install-directory - 'pui-set-local-package-get-directory) ; misleading name ;;;;;;;;;;;;;;;;;;;;;;;;;;;; hooks (make-compatible-variable 'lisp-indent-hook 'lisp-indent-function) @@ -201,13 +214,66 @@ (make-obsolete-variable 'after-change-function "use after-change-functions; which is a list of functions rather than a single function.") -;;;;;;;;;;;;;;;;;;;;;;;;;;;; insertion and deletion +;;;;;;;;;;;;;;;;;;;;;;;;;;;; insertion, deletion, movement (define-compatible-function-alias 'insert-and-inherit 'insert) (define-compatible-function-alias 'insert-before-markers-and-inherit 'insert-before-markers) -;;;;;;;;;;;;;;;;;;;;;;;;;;;; keymaps +(define-compatible-function-alias 'line-beginning-position 'point-at-bol) +(define-compatible-function-alias 'line-end-position 'point-at-eol) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;; Lisp engine, basic Lisp stuff + +(make-obsolete 'function-called-at-point 'function-at-point) + +;; As of 21.5, #'throw is a special operator. This makes bytecode using it +;; compiled for 21.4 fail; making this function available works around that. +(defun obsolete-throw (tag value) + "Ugly compatibility hack. + +See the implementation of #'funcall in eval.c. This should be removed once +we no longer encounter bytecode from 21.4." + (throw tag value)) + +(make-obsolete + 'obsolete-throw + "it says `obsolete' in the name, you know you shouldn't be using this.") + +(define-compatible-function-alias 'cl-mapc 'mapc) + +;; Various non-XEmacs code can call this, because it used not be +;; called automatically at dump time. +(define-function 'cl-float-limits 'ignore) +(make-obsolete 'cl-float-limits "this is called at dump time in 21.5 and \ +later, no need to call it in user code.") + +;; XEmacs; old compiler macros meant that this was called directly +;; from compiled code, and we need to provide a version of it for a +;; couple of years at least because of that. Aidan Kehoe, Mon Oct 4 +;; 12:06:41 IST 2010 +(defun cl-delete-duplicates (cl-seq cl-keys cl-copy) + (apply (if cl-copy #'remove-duplicates #'delete-duplicates) cl-seq cl-keys)) + +(make-obsolete 'cl-delete-duplicates 'delete-duplicates) + +; old names +(define-compatible-function-alias 'byte-code-function-p + 'compiled-function-p) ;FSFmacs + +(define-compatible-function-alias 'interactive-form + 'function-interactive) ;GNU 21.1 +(define-compatible-function-alias 'assq-delete-all + 'remassq) ;GNU 21.1 + +(defun makehash (&optional test) + "Create a new hash table. +Optional first argument TEST specifies how to compare keys in the table. +Predefined tests are `eq', `eql', and `equal'. Default is `eql'." + (make-hash-table :test test)) +(make-compatible 'makehash 'make-hash-table) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;; keys, keymaps (defun keymap-parent (keymap) "Return the first parent of the given keymap." @@ -220,6 +286,17 @@ parent) (make-compatible 'set-keymap-parent 'set-keymap-parents) +(make-compatible-variable 'suggest-key-bindings 'teach-extended-commands-p) + +;; too bad there's not a way to check for aref, assq, and nconc +;; being called on the values of functions known to return keymaps, +;; or known to return vectors of events instead of strings... + +;;; Yes there is; make compiler macros for aref, assq, nconc, checking that +;;; the car of the relevant argument is sane. + +(make-obsolete-variable 'executing-macro 'executing-kbd-macro) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;; menu stuff (defun add-menu-item (menu-path item-name function enabled-p &optional before) @@ -251,57 +328,6 @@ 'read-expression) ; misleading name (define-compatible-function-alias 'read-input 'read-string) -;;;;;;;;;;;;;;;;;;;;;;;;;;;; misc - -;; (defun user-original-login-name () -;; "Return user's login name from original login. -;; This tries to remain unaffected by `su', by looking in environment variables." -;; (or (getenv "LOGNAME") (getenv "USER") (user-login-name))) -(define-obsolete-function-alias 'user-original-login-name 'user-login-name) - -; old names -(define-obsolete-function-alias 'show-buffer 'set-window-buffer) -(define-obsolete-function-alias 'buffer-flush-undo 'buffer-disable-undo) -(make-compatible 'eval-current-buffer 'eval-buffer) -(define-compatible-function-alias 'byte-code-function-p - 'compiled-function-p) ;FSFmacs - -(define-obsolete-function-alias 'isearch-yank-x-selection - 'isearch-yank-selection) -(define-obsolete-function-alias 'isearch-yank-x-clipboard - 'isearch-yank-clipboard) - -;; too bad there's not a way to check for aref, assq, and nconc -;; being called on the values of functions known to return keymaps, -;; or known to return vectors of events instead of strings... - -;;; Yes there is; make compiler macros for aref, assq, nconc, checking that -;;; the car of the relevant argument is sane. - -(make-obsolete-variable 'executing-macro 'executing-kbd-macro) - -(define-compatible-function-alias 'interactive-form - 'function-interactive) ;GNU 21.1 -(define-compatible-function-alias 'assq-delete-all - 'remassq) ;GNU 21.1 - -(defun makehash (&optional test) - "Create a new hash table. -Optional first argument TEST specifies how to compare keys in the table. -Predefined tests are `eq', `eql', and `equal'. Default is `eql'." - (make-hash-table :test test)) -(make-compatible 'makehash 'make-hash-table) - -(defun buffer-local-value (variable buffer) - "Return the value of VARIABLE in BUFFER. -If VARIABLE does not have a buffer-local binding in BUFFER, the value -is the default binding of variable." - (symbol-value-in-buffer variable buffer)) -(make-compatible 'buffer-local-value 'symbol-value-in-buffer) - -(define-compatible-function-alias 'line-beginning-position 'point-at-bol) -(define-compatible-function-alias 'line-end-position 'point-at-eol) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;; modeline (define-compatible-function-alias 'redraw-mode-line 'redraw-modeline) @@ -333,6 +359,21 @@ (cdr (mouse-position (frame-device frame)))) (make-obsolete 'read-mouse-position 'mouse-position) +;;;;;;;;;;;;;;;;;;;;;;;;;;;; paths + +(defvar Info-default-directory-list nil + "This used to be the initial value of Info-directory-list. +If you want to change the locations where XEmacs looks for info files, +set Info-directory-list.") +(make-obsolete-variable 'Info-default-directory-list 'Info-directory-list) + +(defvar init-file-user nil + "This used to be the name of the user whose init file was read at startup.") +(make-obsolete-variable 'init-file-user 'load-user-init-file-p) + +(define-obsolete-function-alias 'pui-add-install-directory + 'pui-set-local-package-get-directory) ; misleading name + ;;;;;;;;;;;;;;;;;;;;;;;;;;;; redisplay (defun redraw-display (&optional device) @@ -340,7 +381,18 @@ (mapcar 'redisplay-device (device-list)) (redisplay-device device))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;; strings +;; the functionality of column.el has been moved into C +;; Function obsoleted for XEmacs 20.0/February 1997. +(defalias 'display-column-mode 'column-number-mode) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;; selections + +(define-obsolete-function-alias 'isearch-yank-x-selection + 'isearch-yank-selection) +(define-obsolete-function-alias 'isearch-yank-x-clipboard + 'isearch-yank-clipboard) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;; text and strings (define-obsolete-function-alias 'sref 'aref) @@ -354,7 +406,7 @@ "Return a list of charsets in the STRING except ascii. It might be available for compatibility with Mule 2.3, because its `find-charset-string' ignores ASCII charset." - (delq 'ascii (and-fboundp #'charsets-in-string (charsets-in-string string)))) + (delq 'ascii (and-fboundp 'charsets-in-string (charsets-in-string string)))) (make-obsolete 'find-non-ascii-charset-string "use (delq 'ascii (charsets-in-string STRING)) instead.") @@ -362,7 +414,7 @@ "Return a list of charsets except ascii in the region between START and END. It might be available for compatibility with Mule 2.3, because its `find-charset-string' ignores ASCII charset." - (delq 'ascii (and-fboundp #'charsets-in-region + (delq 'ascii (and-fboundp 'charsets-in-region (charsets-in-region start end)))) (make-obsolete 'find-non-ascii-charset-region "use (delq 'ascii (charsets-in-region START END)) instead.") @@ -370,48 +422,32 @@ ;; < 21.5 compatibility, eg. https://bugzilla.redhat.com/201524#c2 (define-obsolete-function-alias 'string-to-char-list 'string-to-list) -;;;;;;;;;;;;;;;;;;;;;;;;;;;; window-system objects - -;; the functionality of column.el has been moved into C -;; Function obsoleted for XEmacs 20.0/February 1997. -(defalias 'display-column-mode 'column-number-mode) - -(defun x-color-values (color &optional frame) - "Return a description of the color named COLOR on frame FRAME. -The value is a list of integer RGB values--(RED GREEN BLUE). -These values appear to range from 0 to 65280 or 65535, depending -on the system; white is (65280 65280 65280) or (65535 65535 65535). -If FRAME is omitted or nil, use the selected frame." - (color-instance-rgb-components (make-color-instance color))) -(make-compatible 'x-color-values 'color-instance-rgb-components) - -(make-obsolete 'mswindows-color-list 'color-list) -(make-obsolete 'tty-color-list 'color-list) -(make-compatible 'list-fonts 'font-list) - ;; Two loser functions which shouldn't be used. (make-obsolete 'following-char 'char-after) (make-obsolete 'preceding-char 'char-before) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;; misc + +;; (defun user-original-login-name () +;; "Return user's login name from original login. +;; This tries to remain unaffected by `su', by looking in environment variables." +;; (or (getenv "LOGNAME") (getenv "USER") (user-login-name))) +(define-obsolete-function-alias 'user-original-login-name 'user-login-name) + ;; Keywords already do The Right Thing in XEmacs (make-compatible 'define-widget-keywords "Just use them") -(make-obsolete 'function-called-at-point 'function-at-point) - -;; As of 21.5, #'throw is a special operator. This makes bytecode using it -;; compiled for 21.4 fail; making this function available works around that. -(defun obsolete-throw (tag value) - "Ugly compatibility hack. +(define-function 'purecopy 'identity) +(make-obsolete 'purecopy "purespace is not available in XEmacs.") -See the implementation of #'funcall in eval.c. This should be removed once -we no longer encounter bytecode from 21.4." - (throw tag value)) +(define-compatible-function-alias 'process-get 'get) +(define-compatible-function-alias 'process-put 'put) +(define-compatible-function-alias 'process-plist 'object-plist) +(define-compatible-function-alias 'set-process-plist 'object-setplist) -(make-obsolete - 'obsolete-throw - "it says `obsolete' in the name, you know you shouldn't be using this.") - -(define-compatible-function-alias 'cl-mapc 'mapc) +(define-function 'memql 'member*) +(make-compatible 'memql "use the more full-featured `member*' instead.") (provide 'obsolete) ;;; obsolete.el ends here diff -r 861f2601a38b -r 1f0b15040456 lisp/occur.el --- a/lisp/occur.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/occur.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 22.0.50.1 (CVS) @@ -469,7 +467,7 @@ (if (and keep-props (if-boundp 'jit-lock-mode jit-lock-mode) (text-property-not-all begpt endpt 'fontified t)) - (if-fboundp #'jit-lock-fontify-now + (if-fboundp 'jit-lock-fontify-now (jit-lock-fontify-now begpt endpt))) (setq curstring (buffer-substring begpt endpt)) ;; Depropertize the string, and maybe diff -r 861f2601a38b -r 1f0b15040456 lisp/package-admin.el --- a/lisp/package-admin.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/package-admin.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF diff -r 861f2601a38b -r 1f0b15040456 lisp/package-get.el --- a/lisp/package-get.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/package-get.el Sun May 01 18:44:03 2011 +0100 @@ -12,20 +12,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF @@ -418,7 +416,7 @@ from a location in `package-get-remote'. Otherwise a local copy is used if available and remote access is never done. -Please use FORCE-CURRENT only when the user is explictly dealing with packages +Please use FORCE-CURRENT only when the user is explicitly dealing with packages and remote access is likely in the near future." (setq force-current (or force-current package-get-always-update)) (unless (and (boundp 'package-get-base) @@ -1240,7 +1238,7 @@ ;; Use packages-package-list which contains name and version (equal (plist-get (package-get-info-find-package packages-package-list - package) ':version) + package) :version) (if (floatp version) version (string-to-number version)))) diff -r 861f2601a38b -r 1f0b15040456 lisp/package-info.el --- a/lisp/package-info.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/package-info.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF diff -r 861f2601a38b -r 1f0b15040456 lisp/package-net.el --- a/lisp/package-net.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/package-net.el Sun May 01 18:44:03 2011 +0100 @@ -6,20 +6,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF diff -r 861f2601a38b -r 1f0b15040456 lisp/package-ui.el --- a/lisp/package-ui.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/package-ui.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF @@ -408,26 +406,25 @@ (let ((tmpbuf "*Required-Packages*") do-select) (if pui-selected-packages (let ((dependencies - (delq nil (mapcar - (lambda (pkg) - (let ((installed - (package-get-key pkg :version)) - (current - (package-get-info-prop - (package-get-info-version - (package-get-info-find-package - package-get-base pkg) nil) - 'version))) - (if (or (null installed) - (< (if (stringp installed) - (string-to-number installed) - installed) - (if (stringp current) - (string-to-number current) - current))) - pkg - nil))) - (package-get-dependencies pui-selected-packages))))) + (mapcan + (lambda (pkg) + (let ((installed + (package-get-key pkg :version)) + (current + (package-get-info-prop + (package-get-info-version + (package-get-info-find-package + package-get-base pkg) nil) + 'version))) + (if (or (null installed) + (< (if (stringp installed) + (string-to-number installed) + installed) + (if (stringp current) + (string-to-number current) + current))) + (list pkg)))) + (package-get-dependencies pui-selected-packages)))) ;; Don't change window config when asking the user if he really ;; wants to add the packages. We do this to avoid messing up ;; the window configuration if errors occur (we don't want to @@ -436,9 +433,7 @@ (save-window-excursion (with-output-to-temp-buffer tmpbuf (display-completion-list (sort - (mapcar #'(lambda (pkg) - (symbol-name pkg)) - dependencies) + (mapcar #'symbol-name dependencies) 'string<) :activate-callback nil :help-string "Required packages:\n" @@ -664,10 +659,7 @@ (set-extent-property extent 'pui-info info) (set-extent-property extent 'help-echo 'pui-help-echo) (set-extent-property extent 'keymap pui-package-keymap))) - (sort (copy-sequence package-get-base) - #'(lambda (a b) - (string< (symbol-name (car a)) - (symbol-name (car b)))))) + (sort* (copy-sequence package-get-base) #'string< :key #'car)) (insert sep-string) (insert (documentation 'list-packages-mode)) (set-buffer-modified-p nil) diff -r 861f2601a38b -r 1f0b15040456 lisp/packages.el --- a/lisp/packages.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/packages.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF @@ -31,23 +29,7 @@ ;; This file is dumped with XEmacs. ;; This file provides low level facilities for XEmacs startup -- -;; particularly regarding the package setup. This code has to run in -;; what we call "bare temacs" -- i.e. XEmacs without the usual Lisp -;; environment. Pay special attention: - -;; - not to use the `lambda' macro. Use #'(lambda ...) instead. -;; (this goes for any package loaded before `subr.el'.) -;; -;; - not to use macros, because they are not yet available (and this -;; file must be loadable uncompiled.) Built in macros, such as -;; `when' and `unless' are fine, of course. -;; -;; - not to use `defcustom'. If you must add user-customizable -;; variables here, use `defvar', and add the variable to -;; `cus-start.el'. - -;; Because of all this, make sure that the stuff you put here really -;; belongs here. +;; particularly regarding the package setup. ;; This file requires find-paths.el. @@ -107,7 +89,6 @@ These are the valid immediate directory names of package directories, directories with higher priority first" (delq nil `("site-packages" - ,(when (featurep 'infodock) "infodock-packages") ,(when (featurep 'mule) "mule-packages") "xemacs-packages"))) @@ -468,13 +449,11 @@ PACKAGE-HIERARCHIES is a list of package hierarchies. SUFFIXES is a list of names of hierarchy subdirectories to look for." (let ((directories - (apply - #'nconc - (mapcar #'(lambda (hierarchy) - (mapcar #'(lambda (suffix) - (file-name-as-directory (concat hierarchy suffix))) - suffixes)) - package-hierarchies)))) + (mapcan #'(lambda (hierarchy) + (mapcar #'(lambda (suffix) + (file-name-as-directory (concat hierarchy suffix))) + suffixes)) + package-hierarchies))) (paths-directories-which-exist directories))) (defun packages-find-package-load-path (package-hierarchies) @@ -500,7 +479,7 @@ (defun packages-find-package-data-path (package-hierarchies) "Construct the data-path component for packages. -PACKAGE-HIERARCHIES is a list of package hierachies." +PACKAGE-HIERARCHIES is a list of package hierarchies." (paths-find-recursive-load-path (packages-find-package-library-path package-hierarchies '("etc")) @@ -536,9 +515,7 @@ (load file-name) ;; dumped-lisp.el could have set this ... (if package-lisp - (mapcar #'(lambda (base) - (funcall handle base)) - package-lisp)))))) + (mapcar handle package-lisp)))))) package-load-path)) (defun packages-load-package-dumped-lisps (package-load-path) diff -r 861f2601a38b -r 1f0b15040456 lisp/page.el --- a/lisp/page.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/page.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 21.3. diff -r 861f2601a38b -r 1f0b15040456 lisp/paragraphs.el --- a/lisp/paragraphs.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/paragraphs.el Sun May 01 18:44:03 2011 +0100 @@ -8,7 +8,7 @@ ;; This file is part of XEmacs. -;; GNU Emacs is free software: you can redistribute it and/or modify +;; 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 3 of the License, or ;; (at your option) any later version. @@ -19,7 +19,7 @@ ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . +;; along with XEmacs. If not, see . ;;; Synced up with: FSF 23.1.92. ;;; Synced by: Ben Wing, 2-17-10. @@ -364,7 +364,7 @@ (forward-char 1)) (if (< (point) (point-max)) (goto-char start)))) - (if-fboundp #'constrain-to-field + (if-fboundp 'constrain-to-field (constrain-to-field nil opoint t) (error 'void-function @@ -490,7 +490,7 @@ (skip-chars-backward " \t\n") (goto-char par-end))) (setq arg (1- arg))) - (if-fboundp #'constrain-to-field + (if-fboundp 'constrain-to-field (constrain-to-field nil opoint t) (error 'void-function diff -r 861f2601a38b -r 1f0b15040456 lisp/paths.el --- a/lisp/paths.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/paths.el Sun May 01 18:44:03 2011 +0100 @@ -7,19 +7,18 @@ ;; 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 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 3 of the License, 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. +;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.30. diff -r 861f2601a38b -r 1f0b15040456 lisp/picture.el --- a/lisp/picture.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/picture.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.30. diff -r 861f2601a38b -r 1f0b15040456 lisp/post-gc.el --- a/lisp/post-gc.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/post-gc.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -56,15 +54,8 @@ (defun cleanup-simple-finalizers (alist) "Clean up `simple-finalizer-ephemerons'." - ;; We have to do this by hand because DELETE-IF isn't defined yet. - (let ((current simple-finalizer-ephemerons) - (prev nil)) - (while (not (null current)) - (if (not (ephemeron-ref (car current))) - (if (null prev) - (setq simple-finalizer-ephemerons (cdr current)) - (setcdr prev (cdr current))) - (setq prev current)) - (setq current (cdr current))))) + (and simple-finalizer-ephemerons + (setq simple-finalizer-ephemerons + (delete-if-not #'ephemeron-ref simple-finalizer-ephemerons)))) (add-hook 'post-gc-hook 'cleanup-simple-finalizers) diff -r 861f2601a38b -r 1f0b15040456 lisp/printer.el --- a/lisp/printer.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/printer.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/process.el --- a/lisp/process.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/process.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.30, except for setenv/getenv (synched with FSF ;;; 21.2.1). diff -r 861f2601a38b -r 1f0b15040456 lisp/raw-process.el --- a/lisp/raw-process.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/raw-process.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF diff -r 861f2601a38b -r 1f0b15040456 lisp/rect.el --- a/lisp/rect.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/rect.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: to be incorporated in a forthcoming GNU Emacs diff -r 861f2601a38b -r 1f0b15040456 lisp/regexp-opt.el --- a/lisp/regexp-opt.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/regexp-opt.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: GNU Emacs 21.3 + paren-in-char-set fix from CVS ;;; revision 1.25. Some implementation differences in @@ -175,23 +173,23 @@ (cond ;; ;; If there are no strings, just return the empty string. - ((= (length strings) 0) + ((eql (length strings) 0) "") ;; ;; If there is only one string, just return it. - ((= (length strings) 1) - (if (= (length (car strings)) 1) + ((eql (length strings) 1) + (if (eql (length (car strings)) 1) (concat open-charset (regexp-quote (car strings)) close-charset) (concat open-group (regexp-quote (car strings)) close-group))) ;; ;; If there is an empty string, remove it and recurse on the rest. - ((= (length (car strings)) 0) + ((eql (length (car strings)) 0) (concat open-charset (regexp-opt-group (cdr strings) t t) "?" close-charset)) ;; ;; If all are one-character strings, just return a character set. - ((= (length strings) (apply '+ (mapcar 'length strings))) + ((eql (length strings) (apply '+ (mapcar 'length strings))) (concat open-charset (regexp-opt-charset strings) close-charset)) diff -r 861f2601a38b -r 1f0b15040456 lisp/register.el --- a/lisp/register.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/register.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 21.3 @@ -175,7 +173,7 @@ "Display a list of nonempty registers saying briefly what they contain." (interactive) (let ((list (copy-sequence register-alist))) - (setq list (sort list (lambda (a b) (< (car a) (car b))))) + (setq list (sort* list #'< :key #'car)) (with-output-to-temp-buffer "*Output*" (dolist (elt list) (when (get-register (car elt)) diff -r 861f2601a38b -r 1f0b15040456 lisp/replace.el --- a/lisp/replace.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/replace.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.34 [Partially]. @@ -153,7 +151,7 @@ (let (replacements) (if (listp to-strings) (setq replacements to-strings) - (while (/= (length to-strings) 0) + (while (not (eql (length to-strings) 0)) (if (string-match " " to-strings) (setq replacements (append replacements diff -r 861f2601a38b -r 1f0b15040456 lisp/resize-minibuffer.el --- a/lisp/resize-minibuffer.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/resize-minibuffer.el Sun May 01 18:44:03 2011 +0100 @@ -11,21 +11,18 @@ ;; 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 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 3 of the License, 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. +;; 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, you can either -;; send email to this program's maintainer or write to: The Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched. Copied from rsz-minibuf.el to ;;; resize-minibuffer.el to avoid current problems where, when there's a diff -r 861f2601a38b -r 1f0b15040456 lisp/scrollbar.el --- a/lisp/scrollbar.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/scrollbar.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. (Completely divergent from FSF scroll-bar.el) diff -r 861f2601a38b -r 1f0b15040456 lisp/select.el --- a/lisp/select.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/select.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF @@ -38,10 +36,11 @@ ;; Mozilla will happily give us broken COMPOUND_TEXT where a non-broken ;; UTF8_STRING is available. (defvar selection-preferred-types - (let ((res '(UTF8_STRING COMPOUND_TEXT STRING image/png image/gif - image/jpeg image/tiff image/xpm image/xbm))) - (unless (featurep 'mule) (delq 'COMPOUND_TEXT res)) - res) + `(UTF8_STRING ,@(and (featurep 'mule) '(COMPOUND_TEXT)) STRING + ,@(mapcan #'(lambda (format) + (and (featurep format) + (list (intern (format "image/%s" format))))) + '(png gif jpeg tiff xpm xbm))) "An ordered list of X11 type atoms for selections we want to receive. We prefer UTF8_STRING over COMPOUND_TEXT, for compatibility with a certain widely-used browser suite, and COMPOUND_TEXT over STRING. (COMPOUND_TEXT @@ -276,7 +275,7 @@ ;; application asserts the selection. This is probably not a big deal. (defun activate-region-as-selection () - (cond ((and-fboundp #'mouse-track-rectangle-p + (cond ((and-fboundp 'mouse-track-rectangle-p (mouse-track-rectangle-p (mouse-track-activate-rectangular-selection)))) ((marker-buffer (mark-marker t)) @@ -348,7 +347,7 @@ (set-extent-property previous-extent 'end-open nil) (cond - ((and-fboundp #'mouse-track-rectangle-p + ((and-fboundp 'mouse-track-rectangle-p (mouse-track-rectangle-p (setq previous-extent (list previous-extent)) (default-mouse-track-next-move-rect start end previous-extent) @@ -379,7 +378,7 @@ (buffer-live-p (marker-buffer (cdr data)))))) (defun cut-copy-clear-internal (mode) - (or (memq mode '(cut copy clear)) (error "unkown mode %S" mode)) + (or (memq mode '(cut copy clear)) (error "unknown mode %S" mode)) (or (selection-owner-p) (error "XEmacs does not own the primary selection")) (setq last-command nil) @@ -767,7 +766,7 @@ corresponding to that data as an end-glyph extent property of that space. " (let* ((str (make-string 1 ?\ )) (extent (make-extent 0 1 str)) - (glyph (make-glyph (vector image-type ':data value)))) + (glyph (make-glyph (vector image-type :data value)))) (when glyph (set-extent-property extent 'invisible t) (set-extent-property extent 'start-open t) @@ -777,26 +776,19 @@ (set-extent-end-glyph extent glyph) str))) -;; Could automate defining these functions these with a macro, but damned if -;; I can get that to work. Anyway, this is more readable. - -(defun select-convert-from-image/gif (selection type value) - (if (featurep 'gif) (select-convert-from-image-data 'gif value))) - -(defun select-convert-from-image/jpeg (selection type value) - (if (featurep 'jpeg) (select-convert-from-image-data 'jpeg value))) - -(defun select-convert-from-image/png (selection type value) - (if (featurep 'png) (select-convert-from-image-data 'png value))) - -(defun select-convert-from-image/tiff (selection type value) - (if (featurep 'tiff) (select-convert-from-image-data 'tiff value))) - -(defun select-convert-from-image/xpm (selection type value) - (if (featurep 'xpm) (select-convert-from-image-data 'xpm value))) - -(defun select-convert-from-image/xbm (selection type value) - (if (featurep 'xbm) (select-convert-from-image-data 'xbm value))) +(macrolet + ((create-image-functions (&rest formats) + (cons + 'progn + (mapcar + #'(lambda (format) + `(if (featurep ',format) + (defalias (intern (concat "select-convert-from-image/" + ,(symbol-name format))) + #'(lambda (selection type value) + (select-convert-from-image-data ',format + value))))) formats)))) + (create-image-functions gif jpeg png tiff xpm xbm)) ;;; CF_xxx conversions (defun select-convert-from-cf-text (selection type value) @@ -931,7 +923,7 @@ ;; Types listed here can be selections foreign to XEmacs (setq selection-converter-in-alist - '(; Specific types that get handled by generic converters + `(; Specific types that get handled by generic converters (INTEGER . select-convert-from-integer) (TIMESTAMP . select-convert-from-integer) (LENGTH . select-convert-from-integer) @@ -948,13 +940,12 @@ (text/html . select-convert-from-utf-16-le-text) ; Mozilla (text/_moz_htmlcontext . select-convert-from-utf-16-le-text) (text/_moz_htmlinfo . select-convert-from-utf-16-le-text) - (image/png . select-convert-from-image/png) - (image/gif . select-convert-from-image/gif) - (image/jpeg . select-convert-from-image/jpeg ) - (image/tiff . select-convert-from-image/tiff ) - (image/xpm . select-convert-from-image/xpm) - (image/xbm . select-convert-from-image/xbm) - )) + ,@(loop + for format in '(gif jpeg png tiff xpm xbm) + nconc (if (featurep format) + (list (cons (intern (format "image/%s" format)) + (intern (format "select-convert-from-image/%s" + format)))))))) ;; Types listed here have special coercion functions that can munge ;; other types. This can also be used to add special features - e.g. diff -r 861f2601a38b -r 1f0b15040456 lisp/setup-paths.el --- a/lisp/setup-paths.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/setup-paths.el Sun May 01 18:44:03 2011 +0100 @@ -11,20 +11,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -150,11 +148,11 @@ (and configure-prefix-directory (list (file-name-as-directory configure-prefix-directory)))) - :test #'equal)) + :test #'equal :from-end t)) (installation-roots (remove-if-not root-p potential-installation-roots))) (delete-duplicates (nconc invocation-roots installation-roots) - :test #'equal))) + :test #'equal :from-end t))) (defun paths-find-site-lisp-directory (roots) "Find the site Lisp directory of the XEmacs hierarchy. @@ -281,8 +279,8 @@ (nconc (paths-directories-which-exist configure-info-path) (paths-directories-which-exist paths-default-info-directories)) - :test #'equal))) - :test #'equal))) + :test #'equal :from-end t))) + :test #'equal :from-end t))) (defun paths-find-doc-directory (roots) "Find the documentation directory. diff -r 861f2601a38b -r 1f0b15040456 lisp/shadow.el --- a/lisp/shadow.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/shadow.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/simple.el --- a/lisp/simple.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/simple.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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. +;; 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 3 of the License, or (at your +;; option) any later version. + +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.34 [But not very closely]. ;;; Occasional synching to FSF 21.2 and FSF 22.0, as marked. Comment stuff @@ -3332,11 +3330,6 @@ ;; keyboard-quit ;; buffer-quit-function ;; keyboard-escape-quit - -(defun assoc-ignore-case (key alist) - "Like `assoc', but assumes KEY is a string and ignores case when comparing." - (assoc* key alist :test #'equalp)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; mail composition code ;; @@ -3986,7 +3979,7 @@ (cond (zmacs-region-rectangular-p (setq zmacs-region-extent (list zmacs-region-extent)) - (when-fboundp #'default-mouse-track-next-move-rect + (when-fboundp 'default-mouse-track-next-move-rect (default-mouse-track-next-move-rect start end zmacs-region-extent)) )) @@ -4681,8 +4674,7 @@ (or level (setq level 'warning)) (or (listp class) (setq class (list class))) (check-argument-type 'warning-level-p level) - (if (and (not (featurep 'infodock)) - (not init-file-loaded)) + (if (not init-file-loaded) (push (list class message level) before-init-deferred-warnings) (catch 'ignored (let ((display-p t) @@ -4772,8 +4764,7 @@ (defun emacs-name () "Return the printable name of this instance of Emacs." - (cond ((featurep 'infodock) "InfoDock") - ((featurep 'xemacs) "XEmacs") + (cond ((featurep 'xemacs) "XEmacs") (t "Emacs"))) (defun debug-print-1 (&rest args) diff -r 861f2601a38b -r 1f0b15040456 lisp/site-load.el --- a/lisp/site-load.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/site-load.el Sun May 01 18:44:03 2011 +0100 @@ -6,6 +6,19 @@ ;; 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 3 of the License, 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. If not, see . + ;;; Commentary: ;; This is a prototype site-load.el file. diff -r 861f2601a38b -r 1f0b15040456 lisp/sound.el --- a/lisp/sound.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/sound.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -181,8 +179,8 @@ (setq sound-alist (cons (nconc (list sound-name) (if (and volume (not (eq 0 volume))) - (list ':volume volume)) - (list ':sound data)) + (list :volume volume)) + (list :sound data)) sound-alist))) sound-name) diff -r 861f2601a38b -r 1f0b15040456 lisp/special-mode.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/special-mode.el Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,50 @@ +;;; special-mode.el --- Special major mode to view specially formatted data + +;; Copyright (C) 2011 Didier Verna + +;; Maintainer: Didier Verna +;; Keywords: 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 3 of the License, 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. If not, see . + +;;; Commentary: + +;; This file is dumped with XEmacs. + + +;;; Code: + +;; This code is imported from GNU Emacs 23.3.1 -- dvl + +(defvar special-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map "q" 'quit-window) + (define-key map " " 'scroll-up) + (define-key map "\C-?" 'scroll-down) + (define-key map "?" 'describe-mode) + (define-key map ">" 'end-of-buffer) + (define-key map "<" 'beginning-of-buffer) + (define-key map "g" 'revert-buffer) + map)) + +(put 'special-mode 'mode-class 'special) +(define-derived-mode special-mode nil "Special" + "Parent major mode from which special major modes should inherit." + (setq buffer-read-only t)) + + +;;; special-mode.el ends here diff -r 861f2601a38b -r 1f0b15040456 lisp/specifier.el --- a/lisp/specifier.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/specifier.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Commentary: @@ -105,20 +103,23 @@ ;; this will signal an appropriate error. (check-valid-instantiator inst-pair specifier-type))) - ((and (valid-specifier-tag-p (car inst-pair)) - (valid-instantiator-p (cdr inst-pair) specifier-type)) + ((not (valid-instantiator-p (cdr inst-pair) specifier-type)) + (if noerror + t + (check-valid-instantiator (cdr inst-pair) specifier-type))) + + ((valid-specifier-tag-p (car inst-pair)) ;; case (b) (cons (list (car inst-pair)) (cdr inst-pair))) - ((and (valid-specifier-tag-set-p (car inst-pair)) - (valid-instantiator-p (cdr inst-pair) specifier-type)) + ((valid-specifier-tag-set-p (car inst-pair)) ;; case (c) inst-pair) (t (if noerror t - (signal 'error (list "Invalid specifier tag set" - (car inst-pair))))))) + (error 'invalid-argument "Invalid specifier tag set" + (car inst-pair)))))) (defun canonicalize-inst-list (inst-list specifier-type &optional noerror) "Canonicalize the given INST-LIST (a list of inst-pairs). @@ -199,9 +200,14 @@ (if (not (valid-specifier-locale-p (car spec))) ;; invalid locale. - (if noerror t - (signal 'error (list "Invalid specifier locale" (car spec)))) - + (if noerror + t + (if (consp (car spec)) + ;; If it's a cons, they're probably not passing a locale + (error 'invalid-argument + "Not a valid instantiator list" spec) + (error 'invalid-argument + "Invalid specifier locale" (car spec)))) ;; case (b) (let ((result (canonicalize-inst-list (cdr spec) specifier-type noerror))) @@ -513,10 +519,9 @@ varlist))) ;; Bind the appropriate variables. `(let* (,@(mapcan #'(lambda (varel) - (delq nil (mapcar - #'(lambda (varcons) - (and (cdr varcons) varcons)) - varel))) + (mapcan #'(lambda (varcons) + (and (cdr varcons) (list varcons))) + varel)) varlist) ,@oldvallist) (unwind-protect @@ -887,7 +892,7 @@ current-device))) (and dev (device-type dev)))) (t devtype-spec)))) - (cond ((= 1 (length okdevs)) (car okdevs)) + (cond ((eql 1 (length okdevs)) (car okdevs)) ((< try-stages 3) nil) ((null okdevs) devtype) ((memq devtype okdevs) devtype) @@ -999,7 +1004,7 @@ ;; initialised; that's why this is here, and not in x-init.el, these days. (set-specifier current-display-table - #s(char-table type generic data (?\xA0 ?\x20)) + #s(char-table :type generic :data (?\xA0 ?\x20)) 'global) ;;; specifier.el ends here diff -r 861f2601a38b -r 1f0b15040456 lisp/startup.el --- a/lisp/startup.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/startup.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.34. @@ -722,9 +720,7 @@ (declare-fboundp (init-mule-at-startup))) (if (featurep 'toolbar) - (if (featurep 'infodock) - (require 'id-x-toolbar) - (init-toolbar))) + (init-toolbar)) ;; Create the initial device (which may be the already-created stdio ;; device, if we're noninteractive). @@ -773,7 +769,7 @@ ;; various other places. We could make *scratch* honour the user's ;; choice of whether font-locking is in place by adding a call to ;; font-lock-set-defaults in `lisp-interaction-mode'; but that'll - ;; break if `intial-major-mode' is anything else. + ;; break if `initial-major-mode' is anything else. ;; ;; So, despite what `font-lock-set-defaults'' docstring says, this ;; *is* where we should call it to have the user's choice of font-lock diff -r 861f2601a38b -r 1f0b15040456 lisp/subr.el --- a/lisp/subr.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/subr.el Sun May 01 18:44:03 2011 +0100 @@ -11,20 +11,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.34. Some things synched up with later versions. @@ -39,18 +37,9 @@ ;; BEGIN SYNCHED WITH FSF 21.2 -;;; Code: -(defvar custom-declare-variable-list nil - "Record `defcustom' calls made before `custom.el' is loaded to handle them. -Each element of this list holds the arguments to one call to `defcustom'.") +;; XEmacs; no need for custom-declare-variable-list, preloaded-file-list is +;; ordered to make it unnecessary. -;; Use this, rather than defcustom, in subr.el and other files loaded -;; before custom.el. See dumped-lisp.el. -(defun custom-declare-variable-early (&rest arguments) - (setq custom-declare-variable-list - (cons arguments custom-declare-variable-list))) - - (defun macro-declaration-function (macro decl) "Process a declaration found in a macro definition. This is set as the value of the variable `macro-declaration-function'. @@ -66,7 +55,20 @@ (message "Unknown declaration %s" d))))) (setq macro-declaration-function 'macro-declaration-function) - + +;; XEmacs; this is here because we use it in backquote.el, so it needs to be +;; available the first time a `(...) form is expanded. +(defun list* (first &rest rest) ; See compiler macro in cl-macs.el + "Return a new list with specified args as elements, cons'd to last arg. +Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to +`(cons A (cons B (cons C D)))'." + (cond ((not rest) first) + ((not (cdr rest)) (cons first (car rest))) + (t (let* ((n (length rest)) + (copy (copy-sequence rest)) + (last (nthcdr (- n 2) copy))) + (setcdr last (car (cdr last))) + (cons first copy))))) ;;;; Lisp language features. @@ -144,6 +146,40 @@ (define-function ,@args))) +(defun delete (item sequence) + "Delete by side effect any occurrences of ITEM as a member of SEQUENCE. + +The modified SEQUENCE is returned. Comparison is done with `equal'. + +If the first member of a list SEQUENCE is ITEM, there is no way to remove it +by side effect; therefore, write `(setq foo (delete element foo))' to be +sure of changing the value of `foo'. Also see: `remove'." + (delete* item sequence :test #'equal)) + +(defun delq (item sequence) + "Delete by side effect any occurrences of ITEM as a member of SEQUENCE. + +The modified SEQUENCE is returned. Comparison is done with `eq'. If +SEQUENCE is a list and its first member is ITEM, there is no way to remove +it by side effect; therefore, write `(setq foo (delq element foo))' to be +sure of changing the value of `foo'." + (delete* item sequence :test #'eq)) + +(defun remove (item sequence) + "Remove all occurrences of ITEM in SEQUENCE, testing with `equal'. + +This is a non-destructive function; it makes a copy of SEQUENCE if necessary +to avoid corrupting the original SEQUENCE. +Also see: `remove*', `delete', `delete*'" + (remove* item sequence :test #'equal)) + +(defun remq (item sequence) + "Remove all occurrences of ITEM in SEQUENCE, comparing with `eq'. + +This is a non-destructive function; it makes a copy of SEQUENCE to avoid +corrupting the original SEQUENCE. See also the more general `remove*'." + (remove* item sequence :test #'eq)) + (defun assoc-default (key alist &optional test default) "Find object KEY in a pseudo-alist ALIST. ALIST is a list of conses or objects. Each element (or the element's car, @@ -220,6 +256,12 @@ (define-function 'send-string-to-terminal 'external-debugging-output) (define-function 'special-form-p 'special-operator-p) +;; XEmacs; this is in Lisp, its bytecode now taken by subseq. +(define-function 'substring 'subseq) + +(define-function 'sort 'sort*) +(define-function 'fillarray 'fill) + ;; XEmacs: (defun local-variable-if-set-p (sym buffer) "Return t if SYM would be local to BUFFER after it is set. @@ -690,6 +732,38 @@ (buffer-substring-no-properties (match-beginning num) (match-end num))))) +;; Imported from GNU Emacs 23.3.1 -- dvl +(defun looking-back (regexp &optional limit greedy) + "Return non-nil if text before point matches regular expression REGEXP. +Like `looking-at' except matches before point, and is slower. +LIMIT if non-nil speeds up the search by specifying a minimum +starting position, to avoid checking matches that would start +before LIMIT. + +If GREEDY is non-nil, extend the match backwards as far as +possible, stopping when a single additional previous character +cannot be part of a match for REGEXP. When the match is +extended, its starting position is allowed to occur before +LIMIT." + (let ((start (point)) + (pos + (save-excursion + (and (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t) + (point))))) + (if (and greedy pos) + (save-restriction + (narrow-to-region (point-min) start) + (while (and (> pos (point-min)) + (save-excursion + (goto-char pos) + (backward-char 1) + (looking-at (concat "\\(?:" regexp "\\)\\'")))) + (setq pos (1- pos))) + (save-excursion + (goto-char pos) + (looking-at (concat "\\(?:" regexp "\\)\\'"))))) + (not (null pos)))) + (defconst split-string-default-separators "[ \f\t\n\r\v]+" "The default value of separators for `split-string'. @@ -758,14 +832,8 @@ (defun subst-char-in-string (fromchar tochar string &optional inplace) "Replace FROMCHAR with TOCHAR in STRING each time it occurs. Unless optional argument INPLACE is non-nil, return a new string." - (let ((i (length string)) - (newstr (if inplace string (copy-sequence string)))) - (while (> i 0) - (setq i (1- i)) - (if (eq (aref newstr i) fromchar) - (aset newstr i tochar))) - newstr)) - + (funcall (if inplace #'nsubstitute #'substitute) tochar fromchar + (the string string) :test #'eq)) ;; XEmacs addition: (defun replace-in-string (str regexp newtext &optional literal) @@ -954,23 +1022,11 @@ the characters in STRING, which may not accurately represent the actual display width when using a window system. With no international support, simply returns the length of the string." - (if (featurep 'mule) - (let ((col 0) - (len (length string)) - (i 0)) - (with-fboundp '(charset-width char-charset) - (while (< i len) - (setq col (+ col (charset-width (char-charset (aref string i))))) - (setq i (1+ i)))) - col) - (length string))) + (reduce #'+ (the string string) :initial-value 0 :key #'char-width)) (defun char-width (character) "Return number of columns a CHARACTER occupies when displayed." - (if (featurep 'mule) - (with-fboundp '(charset-width char-charset) - (charset-width (char-charset character))) - 1)) + (charset-width (char-charset character))) ;; The following several functions are useful in GNU Emacs 20 because ;; of the multibyte "characters" the internal representation of which @@ -996,18 +1052,9 @@ (defun store-substring (string idx obj) "Embed OBJ (string or character) at index IDX of STRING." - (let* ((str (cond ((stringp obj) obj) - ((characterp obj) (char-to-string obj)) - (t (error - "Invalid argument (should be string or character): %s" - obj)))) - (string-len (length string)) - (len (length str)) - (i 0)) - (while (and (< i len) (< idx string-len)) - (aset string idx (aref str i)) - (setq idx (1+ idx) i (1+ i))) - string)) + (if (stringp obj) + (replace (the string string) obj :start1 idx) + (prog1 string (aset string idx obj)))) ;; From FSF 21.1; ELLIPSES is XEmacs addition. @@ -1124,13 +1171,13 @@ "Replace the variable names in MAP-PLIST-DEFINITION with uninterned symbols, avoiding the risk of interference with variables in other functions introduced by dynamic scope." - (if-fboundp 'nsublis - (nsublis - '((mp-function . #:function) - (plist . #:plist) - (result . #:result)) - map-plist-definition) - map-plist-definition))) + (nsublis '((mp-function . #:function) + (plist . #:plist) + (result . #:result)) + ;; Need to specify #'eq as the test, otherwise we have a + ;; bootstrap issue, since #'eql is in cl.el, loaded after + ;; this file. + map-plist-definition :test #'eq))) (defun map-plist (mp-function plist) "Map FUNCTION (a function of two args) over each key/value pair in PLIST. Return a list of the results." @@ -1570,19 +1617,6 @@ (define-function 'eval-in-buffer 'with-current-buffer) (make-obsolete 'eval-in-buffer 'with-current-buffer) -;;; The real defn is in abbrev.el but some early callers -;;; (eg lisp-mode-abbrev-table) want this before abbrev.el is loaded... - -(if (not (fboundp 'define-abbrev-table)) - (progn - (setq abbrev-table-name-list '()) - (fset 'define-abbrev-table - (function (lambda (name defs) - ;; These are fixed-up when abbrev.el loads. - (setq abbrev-table-name-list - (cons (cons name defs) - abbrev-table-name-list))))))) - ;;; `functionp' has been moved into C. ;;(defun functionp (object) @@ -1746,8 +1780,9 @@ Ranges and carets are not treated specially. This implementation is in Lisp; do not use it in performance-critical code." (let ((list (delete-duplicates (string-to-list string) :test #'=))) - (when (/= 1 (length list)) ;; No quoting needed in a string of length 1. - (when (eq ?^ (car list)) + (when (not (eql 1 (length list))) ;; No quoting needed in a string of + ;; length 1. + (when (eql ?^ (car list)) (setq list (nconc (cdr list) '(?^)))) (when (memq ?\\ list) (setq list (delq ?\\ list) @@ -1781,8 +1816,7 @@ ;; they're used reasonably often, since they've been around for a long time ;; and they're portable to GNU. -;; Used in fileio.c if format-annotate-function has a function binding -;; (which it won't have before this file is loaded): +;; No longer used in C, now list_merge() accepts a KEY argument. (defun car-less-than-car (a b) "Return t if the car of A is numerically less than the car of B." (< (car a) (car b))) @@ -1792,4 +1826,23 @@ "Return t if (cdr A) is numerically less than (cdr B)." (< (cdr a) (cdr b))) +;; XEmacs; this is in editfns.c in GNU. +(defun float-time (&optional specified-time) + "Convert time value SPECIFIED-TIME to a floating point number. + +See `current-time'. Since the result is a floating-point number, this may +not have the same accuracy as does the result of `current-time'. + +If not supplied, SPECIFIED-TIME defaults to the result of `current-time'." + (or specified-time (setq specified-time (current-time))) + (+ (* (pop specified-time) (+ #x10000 0.0)) + (if (consp specified-time) + (pop specified-time) + (prog1 + specified-time + (setq specified-time nil))) + (or (and specified-time + (/ (car specified-time) 1000000.0)) + 0.0))) + ;;; subr.el ends here diff -r 861f2601a38b -r 1f0b15040456 lisp/symbol-syntax.el --- a/lisp/symbol-syntax.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/symbol-syntax.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/symbols.el --- a/lisp/symbols.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/symbols.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/syntax.el --- a/lisp/syntax.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/syntax.el Sun May 01 18:44:03 2011 +0100 @@ -6,20 +6,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.28. diff -r 861f2601a38b -r 1f0b15040456 lisp/term/AT386.el --- a/lisp/term/AT386.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/term/AT386.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/term/README --- a/lisp/term/README Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/term/README Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,48 @@ +Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 + Free Software Foundation, Inc. +See the end of the file for license conditions. + + This directory contains files of elisp that customize Emacs for certain terminal types. - When Emacs starts, it checks the TERM environment variable to see what type -of terminal the user is running on, checks for an elisp file named -"term/${TERM}.el", and if one exists, loads it. If that doesn't yield a file -that exists, the last hyphen and what follows it is stripped. If that doesn't -yield a file that exists, the previous hyphen is stripped, and so on until all -hyphens are gone. For example, if the terminal type is `aaa-48-foo', Emacs -will try first `term/aaa-48-foo.el', then `term/aaa-48.el' and finally -`term/aaa.el'. + When Emacs opens a new terminal, it checks the TERM environment variable to +see what type of terminal the user is running on, searches for an elisp file +named "term/${TERM}.el", and if one exists, loads it. If Emacs finds no +suitable file, then it strips the last hyphen and what follows it from TERM, +and tries again. If that still doesn't yield a file, then the previous hyphen +is stripped, and so on until all hyphens are gone. For example, if the +terminal type is `aaa-48-foo', Emacs will try first `term/aaa-48-foo.el', then +`term/aaa-48.el' and finally `term/aaa.el'. Emacs stops searching at the +first file found, and will not load more than one file for any terminal. Note +that it is not an error if Emacs is unable to find a terminal initialization +file; in that case, it will simply proceed with the next step without loading +any files. + + Once the file has been loaded (or the search failed), Emacs tries to call a +function named `terminal-init-TERMINALNAME' (eg `terminal-init-aaa-48' for the +`aaa-48' terminal) in order to initialize the terminal. Once again, if the +function is not found, Emacs strips the last component of the name and tries +again using the shorter name. This search is independent of the previous file +search, so that you can have terminal initialization functions for a family of +terminals collected in a single file named after the family name, and users +may put terminal initialization functions directly in their .emacs files. + + Note that an individual terminal file is loaded only once in an Emacs +session; if the same terminal type is opened again, Emacs will simply call the +initialization function without reloading the file. Therefore, all the actual +initialization actions should be collected in terminal-init-* functions; the +file should not contain any top-level form that is not a function or variable +declaration. Simply loading the file should not have any side effect. + + Similarly, the terminal initialization function is called only once on any +given terminal, when the first frame is created on it. The function is not +called for subsequent frames on the same terminal. Therefore, terminal-init-* +functions should only modify terminal-local variables (such as +`local-function-key-map') and terminal parameters. For example, it is not +correct to modify frame parameters, since the modifications will only be +applied for the first frame opened on the terminal. + When writing terminal packages, there are some things it is good to keep in mind. @@ -36,7 +70,7 @@ else someday. For example, if your terminal has a `find' key, observe that terminfo -supports a key_find capability and call your cookie [key-find]. +supports a key_find capability and call your cookie [find]. Here is a complete list, with corresponding X keysyms. @@ -212,3 +246,19 @@ Before writing a terminal-support package, it's a good idea to read the existing ones and learn the common conventions. + + +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 3 of the License, 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. If not, see . diff -r 861f2601a38b -r 1f0b15040456 lisp/term/apollo.el --- a/lisp/term/apollo.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/term/apollo.el Sun May 01 18:44:03 2011 +0100 @@ -2,20 +2,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 21.0.103. diff -r 861f2601a38b -r 1f0b15040456 lisp/term/bg-mouse.el --- a/lisp/term/bg-mouse.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/term/bg-mouse.el Sun May 01 18:44:03 2011 +0100 @@ -7,21 +7,20 @@ ;; Maintainer: FSF ;; Keywords: hardware -;; This file is part of GNU Emacs. +;; This file is part of XEmacs. -;; 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. +;; 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 3 of the License, 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. +;; 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 GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with XEmacs. If not, see . ;;; Code: diff -r 861f2601a38b -r 1f0b15040456 lisp/term/cygwin.el --- a/lisp/term/cygwin.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/term/cygwin.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/term/keyswap.el --- a/lisp/term/keyswap.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/term/keyswap.el Sun May 01 18:44:03 2011 +0100 @@ -5,21 +5,20 @@ ;; Copyright (C) 1992 Free Software Foundation, Inc. -;; This file is part of GNU Emacs. +;; This file is part of XEmacs. -;; 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. +;; 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 3 of the License, 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. +;; 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 GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with XEmacs. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/term/linux.el --- a/lisp/term/linux.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/term/linux.el Sun May 01 18:44:03 2011 +0100 @@ -6,20 +6,18 @@ ;; Copyright (C) 1996 Ben Wing. ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 21.0.103. ;;; (All the define-keys are our own.) diff -r 861f2601a38b -r 1f0b15040456 lisp/term/lk201.el --- a/lisp/term/lk201.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/term/lk201.el Sun May 01 18:44:03 2011 +0100 @@ -2,20 +2,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 21.0.103. diff -r 861f2601a38b -r 1f0b15040456 lisp/term/news.el --- a/lisp/term/news.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/term/news.el Sun May 01 18:44:03 2011 +0100 @@ -5,22 +5,20 @@ ;; Copyright (C) 1989, 1993 Free Software Foundation, Inc. -;;; This file is part of XEmacs. -;;; -;;; XEmacs is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your -;;; option) any later version. -;;; -;;; XEmacs is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with XEmacs; see the file COPYING. If not, write to the -;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;;; Boston, MA 02111-1307, USA. +;; 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 3 of the License, 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. If not, see . ;;; Synched up with: FSF 21.0.103. diff -r 861f2601a38b -r 1f0b15040456 lisp/term/scoansi.el --- a/lisp/term/scoansi.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/term/scoansi.el Sun May 01 18:44:03 2011 +0100 @@ -4,21 +4,20 @@ ;; Author: Kean Johnston -;; This file is part of GNU Emacs. +;; This file is part of XEmacs. -;; 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. +;; 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 3 of the License, 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. +;; 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 GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with XEmacs. If not, see . ;; HISTORY ;; jkj - Jan 18, 1993: Created. diff -r 861f2601a38b -r 1f0b15040456 lisp/term/sup-mouse.el --- a/lisp/term/sup-mouse.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/term/sup-mouse.el Sun May 01 18:44:03 2011 +0100 @@ -9,21 +9,20 @@ ;; (from code originally written by John Robinson@bbn for the bitgraph) -;; This file is part of GNU Emacs. +;; This file is part of XEmacs. -;; 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. +;; 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 3 of the License, 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. +;; 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 GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with XEmacs. If not, see . ;;; Code: diff -r 861f2601a38b -r 1f0b15040456 lisp/term/tvi970.el --- a/lisp/term/tvi970.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/term/tvi970.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/term/vt-control.el --- a/lisp/term/vt-control.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/term/vt-control.el Sun May 01 18:44:03 2011 +0100 @@ -6,21 +6,20 @@ ;; Maintainer: Rob Riepel ;; Keywords: terminals -;; This file is part of GNU Emacs. +;; This file is part of XEmacs. -;; 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. +;; 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 3 of the License, 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. +;; 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 GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with XEmacs. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/term/vt100-led.el --- a/lisp/term/vt100-led.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/term/vt100-led.el Sun May 01 18:44:03 2011 +0100 @@ -8,19 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with XEmacs. If not, see . ;;; Code: diff -r 861f2601a38b -r 1f0b15040456 lisp/term/vt100.el --- a/lisp/term/vt100.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/term/vt100.el Sun May 01 18:44:03 2011 +0100 @@ -5,21 +5,20 @@ ;; Author: FSF ;; Keywords: terminals -;;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. +;; 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 3 of the License, 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. If not, see . ;;; Synched up with: FSF 21.0.103. diff -r 861f2601a38b -r 1f0b15040456 lisp/term/wyse50.el --- a/lisp/term/wyse50.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/term/wyse50.el Sun May 01 18:44:03 2011 +0100 @@ -6,21 +6,20 @@ ;; Jim Blandy ;; Keywords: terminals -;;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. +;; 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 3 of the License, 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. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/term/xterm.el --- a/lisp/term/xterm.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/term/xterm.el Sun May 01 18:44:03 2011 +0100 @@ -7,19 +7,18 @@ ;; 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 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 3 of the License, 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. +;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with XEmacs. If not, see . ;;;; Code: diff -r 861f2601a38b -r 1f0b15040456 lisp/test-harness.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/test-harness.el Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,773 @@ +;; test-harness.el --- Run Emacs Lisp test suites. + +;;; Copyright (C) 1998, 2002, 2003 Free Software Foundation, Inc. +;;; Copyright (C) 2002, 2010 Ben Wing. + +;; Author: Martin Buchholz +;; Maintainer: Stephen J. Turnbull +;; Keywords: testing + +;; 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 3 of the License, 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. If not, see . + +;;; Synched up with: Not in FSF. + +;;; Commentary: + +;;; A test suite harness for testing XEmacs. +;;; The actual tests are in other files in this directory. +;;; Basically you just create files of emacs-lisp, and use the +;;; Assert, Check-Error, Check-Message, and Check-Error-Message functions +;;; to create tests. See `test-harness-from-buffer' below. +;;; Don't suppress tests just because they're due to known bugs not yet +;;; fixed -- use the Known-Bug-Expect-Failure and +;;; Implementation-Incomplete-Expect-Failure wrapper macros to mark them. +;;; A lot of the tests we run push limits; suppress Ebola message with the +;;; Ignore-Ebola wrapper macro. +;;; Some noisy code will call `message'. Output from `message' can be +;;; suppressed with the Silence-Message macro. Functions that are known to +;;; issue messages include `write-region', `find-tag', `tag-loop-continue', +;;; `insert', and `mark-whole-buffer'. N.B. The Silence-Message macro +;;; currently does not suppress the newlines printed by `message'. +;;; Definitely do not use Silence-Message with Check-Message. +;;; In general it should probably only be used on code that prepares for a +;;; test, not on tests. +;;; +;;; You run the tests using M-x test-emacs-test-file, +;;; or $(EMACS) -batch -l test-harness -f batch-test-emacs file ... +;;; which is run for you by the `make check' target in the top-level Makefile. + +(require 'bytecomp) + +(defvar unexpected-test-suite-failures 0 + "Cumulative number of unexpected failures since test-harness was loaded. + +\"Unexpected failures\" are those caught by a generic handler established +outside of the test context. As such they involve an abort of the test +suite for the file being tested. + +They often occur during preparation of a test or recording of the results. +For example, an executable used to generate test data might not be present +on the system, or a system error might occur while reading a data file.") + +(defvar unexpected-test-suite-failure-files nil + "List of test files causing unexpected failures.") + +;; Declared for dynamic scope; _do not_ initialize here. +(defvar unexpected-test-file-failures) + +(defvar test-harness-bug-expected nil + "Non-nil means a bug is expected; backtracing/debugging should not happen.") + +(defvar test-harness-test-compiled nil + "Non-nil means the test code was compiled before execution. + +You probably should not make tests depend on compilation. +However, it can be useful to conditionally change messages based on whether +the code was compiled or not. For example, the case that motivated the +implementation of this variable: + +\(when test-harness-test-compiled + ;; this ha-a-ack depends on the failing compiled test coming last + \(setq test-harness-failure-tag + \"KNOWN BUG - fix reverted; after 2003-10-31 notify stephen\n\"))") + +(defvar test-harness-verbose + (and (not noninteractive) (> (device-baud-rate) search-slow-speed)) + "*Non-nil means print messages describing progress of emacs-tester.") + +(defvar test-harness-unexpected-error-enter-debugger debug-on-error + "*Non-nil means enter debugger when an unexpected error occurs. +Only applies interactively. Normally true if `debug-on-error' has been set. +See also `test-harness-assertion-failure-enter-debugger' and +`test-harness-unexpected-error-show-backtrace'.") + +(defvar test-harness-assertion-failure-enter-debugger debug-on-error + "*Non-nil means enter debugger when an assertion failure occurs. +Only applies interactively. Normally true if `debug-on-error' has been set. +See also `test-harness-unexpected-error-enter-debugger' and +`test-harness-assertion-failure-show-backtrace'.") + +(defvar test-harness-unexpected-error-show-backtrace t + "*Non-nil means show backtrace upon unexpected error. +Only applies when debugger is not entered. Normally true by default. See also +`test-harness-unexpected-error-enter-debugger' and +`test-harness-assertion-failure-show-backtrace'.") + +(defvar test-harness-assertion-failure-show-backtrace stack-trace-on-error + "*Non-nil means show backtrace upon assertion failure. +Only applies when debugger is not entered. Normally true if +`stack-trace-on-error' has been set. See also +`test-harness-assertion-failure-enter-debugger' and +`test-harness-unexpected-error-show-backtrace'.") + +(defvar test-harness-file-results-alist nil + "Each element is a list (FILE SUCCESSES TESTS). +The order is the reverse of the order in which tests are run. + +FILE is a string naming the test file. +SUCCESSES is a non-negative integer, the number of successes. +TESTS is a non-negative integer, the number of tests run.") + +(defvar test-harness-risk-infloops nil + "*Non-nil to run tests that may loop infinitely in buggy implementations.") + +(defvar test-harness-current-file nil) + +(defvar emacs-lisp-file-regexp "\\.el\\'" + "*Regexp which matches Emacs Lisp source files.") + +(defconst test-harness-file-summary-template + (format "%%-%ds %%%dd of %%%dd tests successful (%%3d%%%%)." + (length "byte-compiler-tests.el:") ; use the longest file name + 5 + 5) + "Format for summary lines printed after each file is run.") + +(defconst test-harness-null-summary-template + (format "%%-%ds No tests run." + (length "byte-compiler-tests.el:")) ; use the longest file name + "Format for \"No tests\" lines printed after a file is run.") + +(defconst test-harness-aborted-summary-template + (format "%%-%ds %%%dd tests completed (aborted)." + (length "byte-compiler-tests.el:") ; use the longest file name + 5) + "Format for summary lines printed after a test run on a file was aborted.") + +;;;###autoload +(defun test-emacs-test-file (filename) + "Test a file of Lisp code named FILENAME. +The output file's name is made by appending `c' to the end of FILENAME." + (interactive + (let ((file buffer-file-name) + (file-name nil) + (file-dir nil)) + (and file + (eq (cdr (assq 'major-mode (buffer-local-variables))) + 'emacs-lisp-mode) + (setq file-name (file-name-nondirectory file) + file-dir (file-name-directory file))) + (list (read-file-name "Test file: " file-dir nil nil file-name)))) + ;; Expand now so we get the current buffer's defaults + (setq filename (expand-file-name filename)) + + ;; If we're testing a file that's in a buffer and is modified, offer + ;; to save it first. + (or noninteractive + (let ((b (get-file-buffer (expand-file-name filename)))) + (if (and b (buffer-modified-p b) + (y-or-n-p (format "save buffer %s first? " (buffer-name b)))) + (save-excursion (set-buffer b) (save-buffer))))) + + (if (or noninteractive test-harness-verbose) + (message "Testing %s..." filename)) + (let ((test-harness-current-file filename) + input-buffer) + (save-excursion + (setq input-buffer (get-buffer-create " *Test Input*")) + (set-buffer input-buffer) + (erase-buffer) + (insert-file-contents filename) + ;; Run hooks including the uncompression hook. + ;; If they change the file name, then change it for the output also. + (let ((buffer-file-name filename) + (default-major-mode 'emacs-lisp-mode) + (enable-local-eval nil)) + (normal-mode) + (setq filename buffer-file-name))) + (test-harness-from-buffer input-buffer filename) + (kill-buffer input-buffer) + )) + +(defsubst test-harness-backtrace () + "Display a reasonable-size backtrace." + (let ((print-escape-newlines t) + (print-length 50)) + (backtrace nil t))) + +(defsubst test-harness-assertion-failure-do-debug (error-info) + "Maybe enter debugger or display a backtrace on assertion failure. +ERROR-INFO is a cons of the args (SIG . DATA) that were passed to `signal'. +The debugger will be entered if noninteractive and +`test-harness-unexpected-error-enter-debugger' is non-nil; else, a +backtrace will be displayed if `test-harness-unexpected-error-show-backtrace' +is non-nil." + (when (not test-harness-bug-expected) + (cond ((and (not noninteractive) + test-harness-assertion-failure-enter-debugger) + (funcall debugger 'error error-info)) + (test-harness-assertion-failure-show-backtrace + (test-harness-backtrace))))) + +(defsubst test-harness-unexpected-error-do-debug (error-info) + "Maybe enter debugger or display a backtrace on unexpected error. +ERROR-INFO is a cons of the args (SIG . DATA) that were passed to `signal'. +The debugger will be entered if noninteractive and +`test-harness-unexpected-error-enter-debugger' is non-nil; else, a +backtrace will be displayed if `test-harness-unexpected-error-show-backtrace' +is non-nil." + (when (not test-harness-bug-expected) + (cond ((and (not noninteractive) + test-harness-unexpected-error-enter-debugger) + (funcall debugger 'error error-info)) + (test-harness-unexpected-error-show-backtrace + (test-harness-backtrace))))) + +(defsubst test-harness-unexpected-error-condition-handler (error-info context-msg) + "Condition handler for when unexpected errors occur. +Useful in conjunction with `call-with-condition-handler'. ERROR-INFO is the +value passed to the condition handler. CONTEXT-MSG is a string indicating +the context in which the unexpected error occurred. A message is outputted +including CONTEXT-MSG in it, `unexpected-test-file-failures' is incremented, +and `test-harness-unexpected-error-do-debug' is called, which may enter the +debugger or output a backtrace, depending on the settings of +`test-harness-unexpected-error-enter-debugger' and +`test-harness-unexpected-error-show-backtrace'. + +The function returns normally, which causes error-handling processing to +continue; if you want to catch the error, you also need to wrap everything +in `condition-case'. See also `test-harness-error-wrap', which does this +wrapping." + (incf unexpected-test-file-failures) + (princ (format "Unexpected error %S while %s\n" + error-info context-msg)) + (message "Unexpected error %S while %s." error-info context-msg) + (test-harness-unexpected-error-do-debug error-info)) + +(defmacro test-harness-error-wrap (context-msg abort-msg &rest body) + "Wrap BODY so that unexpected errors are caught. +The debugger will be entered if noninteractive and +`test-harness-unexpected-error-enter-debugger' is non-nil; else, a backtrace +will be displayed if `test-harness-unexpected-error-show-backtrace' is +non-nil. CONTEXT-MSG is displayed as part of a message shown before entering +the debugger or showing a backtrace, and ABORT-MSG, if non-nil, is displayed +afterwards. See " + `(condition-case nil + (call-with-condition-handler + #'(lambda (error-info) + (test-harness-unexpected-error-condition-handler + error-info ,context-msg)) + #'(lambda () + ,@body)) + (error ,(if abort-msg `(message ,abort-msg) nil)))) + +(defun test-harness-read-from-buffer (buffer) + "Read forms from BUFFER, and turn it into a lambda test form." + (let ((body nil)) + (goto-char (point-min) buffer) + (condition-case nil + (call-with-condition-handler + #'(lambda (error-info) + ;; end-of-file is expected, so don't output error or backtrace + ;; or enter debugger in this case. + (unless (eq 'end-of-file (car error-info)) + (test-harness-unexpected-error-condition-handler + error-info "reading forms from buffer"))) + #'(lambda () + (while t + (setq body (cons (read buffer) body))))) + (error nil)) + `(lambda () + (defvar passes) + (defvar assertion-failures) + (defvar no-error-failures) + (defvar wrong-error-failures) + (defvar missing-message-failures) + (defvar other-failures) + + (defvar trick-optimizer) + + ,@(nreverse body)))) + +(defun test-harness-from-buffer (inbuffer filename) + "Run tests in buffer INBUFFER, visiting FILENAME." + (defvar trick-optimizer) + (let ((passes 0) + (assertion-failures 0) + (no-error-failures 0) + (wrong-error-failures 0) + (missing-message-failures 0) + (other-failures 0) + (unexpected-test-file-failures 0) + + ;; #### perhaps this should be a defvar, and output at the very end + ;; OTOH, this way AC types can use a null EMACSPACKAGEPATH to find + ;; what stuff is needed, and ways to avoid using them + (skipped-test-reasons (make-hash-table :test 'equal)) + + (trick-optimizer nil) + (debug-on-error t) + ) + (with-output-to-temp-buffer "*Test-Log*" + (princ (format "Testing %s...\n\n" filename)) + + (defconst test-harness-failure-tag "FAIL") + (defconst test-harness-success-tag "PASS") + +;;;;; BEGIN DEFINITION OF MACROS USEFUL IN TEST CODE + + (defmacro Known-Bug-Expect-Failure (&rest body) + "Wrap a BODY that consists of tests that are known to fail. +This causes messages to be printed on failure indicating that this is expected, +and on success indicating that this is unexpected." + `(let ((test-harness-bug-expected t) + (test-harness-failure-tag "KNOWN BUG") + (test-harness-success-tag "PASS (FAILURE EXPECTED)")) + ,@body)) + + (defmacro Known-Bug-Expect-Error (expected-error &rest body) + "Wrap a BODY that consists of tests that are known to trigger an error. +This causes messages to be printed on failure indicating that this is expected, +and on success indicating that this is unexpected." + (let ((quoted-body (if (eql 1 (length body)) + `(quote ,(car body)) `(quote (progn ,@body))))) + `(let ((test-harness-bug-expected t) + (test-harness-failure-tag "KNOWN BUG") + (test-harness-success-tag "PASS (FAILURE EXPECTED)")) + (condition-case error-info + (progn + (setq trick-optimizer (progn ,@body)) + (Print-Pass + "%S executed successfully, but expected error %S" + ,quoted-body + ',expected-error) + (incf passes)) + (,expected-error + (Print-Failure "%S ==> error %S, as expected" + ,quoted-body ',expected-error) + (incf no-error-failures)) + (error + (Print-Failure "%S ==> expected error %S, got error %S instead" + ,quoted-body ',expected-error error-info) + (incf wrong-error-failures)))))) + + (defmacro Implementation-Incomplete-Expect-Failure (&rest body) + "Wrap a BODY containing tests that are known to fail due to incomplete code. +This causes messages to be printed on failure indicating that the +implementation is incomplete (and hence the failure is expected); and on +success indicating that this is unexpected." + `(let ((test-harness-bug-expected t) + (test-harness-failure-tag "IMPLEMENTATION INCOMPLETE") + (test-harness-success-tag "PASS (FAILURE EXPECTED)")) + ,@body)) + + (defun Print-Failure (fmt &rest args) + (setq fmt (format "%s: %s" test-harness-failure-tag fmt)) + (if (noninteractive) (apply #'message fmt args)) + (princ (concat (apply #'format fmt args) "\n"))) + + (defun Print-Pass (fmt &rest args) + (setq fmt (format "%s: %s" test-harness-success-tag fmt)) + (and test-harness-verbose + (princ (concat (apply #'format fmt args) "\n")))) + + (defun Print-Skip (test reason &optional fmt &rest args) + (setq fmt (concat "SKIP: %S BECAUSE %S" fmt)) + (princ (concat (apply #'format fmt test reason args) "\n"))) + + (defmacro Skip-Test-Unless (condition reason description &rest body) + "Unless CONDITION is satisfied, skip test BODY. +REASON is a description of the condition failure, and must be unique (it +is used as a hash key). DESCRIPTION describes the tests that were skipped. +BODY is a sequence of expressions and may contain several tests." + `(if (not ,condition) + (let ((count (gethash ,reason skipped-test-reasons))) + (puthash ,reason (if (null count) 1 (1+ count)) + skipped-test-reasons) + (Print-Skip ,description ,reason)) + ,@body)) + + (defmacro Assert (assertion &optional failing-case description) + "Test passes if ASSERTION is true. +Optional FAILING-CASE describes the particular failure. Optional +DESCRIPTION describes the assertion; by default, the unevalated assertion +expression is given. FAILING-CASE and DESCRIPTION are useful when Assert +is used in a loop." + (let ((test-assertion assertion) + (negated nil)) + (when (and (listp test-assertion) + (eql 2 (length test-assertion)) + (memq (car test-assertion) '(not null))) + (setq test-assertion (cadr test-assertion)) + (setq negated t)) + (when (and (listp test-assertion) + (eql 3 (length test-assertion)) + (member (car test-assertion) + '(eq eql equal equalp = string= < <= > >=))) + (let* ((test (car test-assertion)) + (testval (second test-assertion)) + (expected (third test-assertion)) + (failmsg `(format ,(if negated + "%S shouldn't be `%s' to %S but is" + "%S should be `%s' to %S but isn't") + ,testval ',test ,expected))) + (setq failing-case (if failing-case + `(concat + (format "%S, " ,failing-case) + ,failmsg) + failmsg))))) + (let ((description + (or description `(quote ,assertion)))) + `(condition-case nil + (call-with-condition-handler + #'(lambda (error-info) + (if (eq 'cl-assertion-failed (car error-info)) + (progn + (Print-Failure + (if ,failing-case + "Assertion failed: %S; failing case = %S" + "Assertion failed: %S") + ,description ,failing-case) + (incf assertion-failures) + (test-harness-assertion-failure-do-debug error-info)) + (Print-Failure + (if ,failing-case + "%S ==> error: %S; failing case = %S" + "%S ==> error: %S") + ,description error-info ,failing-case) + (incf other-failures) + (test-harness-unexpected-error-do-debug error-info))) + #'(lambda () + (assert ,assertion) + (Print-Pass "%S" ,description) + (incf passes))) + (cl-assertion-failed nil)))) + + (defmacro Check-Error (expected-error &rest body) + (let ((quoted-body (if (eql 1 (length body)) + `(quote ,(car body)) `(quote (progn ,@body))))) + `(condition-case error-info + (progn + (setq trick-optimizer (progn ,@body)) + (Print-Failure "%S executed successfully, but expected error %S" + ,quoted-body + ',expected-error) + (incf no-error-failures)) + (,expected-error + (Print-Pass "%S ==> error %S, as expected" + ,quoted-body ',expected-error) + (incf passes)) + (error + (Print-Failure "%S ==> expected error %S, got error %S instead" + ,quoted-body ',expected-error error-info) + (incf wrong-error-failures))))) + + (defmacro Check-Error-Message (expected-error expected-error-regexp + &rest body) + (let ((quoted-body (if (eql 1 (length body)) + `(quote ,(car body)) `(quote (progn ,@body))))) + `(condition-case error-info + (progn + (setq trick-optimizer (progn ,@body)) + (Print-Failure "%S executed successfully, but expected error %S" + ,quoted-body ',expected-error) + (incf no-error-failures)) + (,expected-error + ;; #### Damn, this binding doesn't capture frobs, eg, for + ;; invalid_argument() ... you only get the REASON. And for + ;; wrong_type_argument(), there's no reason only FROBs. + ;; If this gets fixed, fix tests in regexp-tests.el. + (let ((error-message (second error-info))) + (if (string-match ,expected-error-regexp error-message) + (progn + (Print-Pass "%S ==> error %S %S, as expected" + ,quoted-body error-message ',expected-error) + (incf passes)) + (Print-Failure "%S ==> got error %S as expected, but error message %S did not match regexp %S" + ,quoted-body ',expected-error error-message ,expected-error-regexp) + (incf wrong-error-failures)))) + (error + (Print-Failure "%S ==> expected error %S, got error %S instead" + ,quoted-body ',expected-error error-info) + (incf wrong-error-failures))))) + + ;; Do not use this with Silence-Message. + (defmacro Check-Message (expected-message-regexp &rest body) + (let ((quoted-body (if (eql 1 (length body)) + `(quote ,(car body)) + `(quote (progn ,@body))))) + `(Skip-Test-Unless (fboundp 'defadvice) "can't defadvice" + ,expected-message-regexp + (let ((messages "")) + (defadvice message (around collect activate) + (defvar messages) + (let ((msg-string (apply 'format (ad-get-args 0)))) + (setq messages (concat messages msg-string)) + msg-string)) + (ignore-errors + (call-with-condition-handler + #'(lambda (error-info) + (Print-Failure "%S ==> unexpected error %S" + ,quoted-body error-info) + (incf other-failures) + (test-harness-unexpected-error-do-debug error-info)) + #'(lambda () + (setq trick-optimizer (progn ,@body)) + (if (string-match ,expected-message-regexp messages) + (progn + (Print-Pass + "%S ==> value %S, message %S, matching %S, as expected" + ,quoted-body trick-optimizer messages + ',expected-message-regexp) + (incf passes)) + (Print-Failure + "%S ==> value %S, message %S, NOT matching expected %S" + ,quoted-body trick-optimizer messages + ',expected-message-regexp) + (incf missing-message-failures))))) + (ad-unadvise 'message))))) + + ;; #### Perhaps this should override `message' itself, too? + (defmacro Silence-Message (&rest body) + `(flet ((append-message (&rest args) ()) + (clear-message (&rest args) ())) + ,@body)) + + (defmacro Ignore-Ebola (&rest body) + `(let ((debug-issue-ebola-notices -42)) ,@body)) + + (defun Int-to-Marker (pos) + (save-excursion + (set-buffer standard-output) + (save-excursion + (goto-char pos) + (point-marker)))) + + (princ "Testing Interpreted Lisp\n\n") + + (test-harness-error-wrap + "executing interpreted code" + "Test suite execution aborted." + (funcall (test-harness-read-from-buffer inbuffer))) + + (princ "\nTesting Compiled Lisp\n\n") + + (let (code + (test-harness-test-compiled t)) + (test-harness-error-wrap + "byte-compiling code" nil + (setq code + ;; our lisp code is often intentionally dubious, + ;; so throw away _all_ the byte compiler warnings. + (letf (((symbol-function 'byte-compile-warn) + 'ignore)) + (byte-compile (test-harness-read-from-buffer + inbuffer)))) + ) + + (test-harness-error-wrap "executing byte-compiled code" + "Test suite execution aborted." + (if code (funcall code))) + ) + (princ (format "\nSUMMARY for %s:\n" filename)) + (princ (format "\t%5d passes\n" passes)) + (princ (format "\t%5d assertion failures\n" assertion-failures)) + (princ (format "\t%5d errors that should have been generated, but weren't\n" no-error-failures)) + (princ (format "\t%5d wrong-error failures\n" wrong-error-failures)) + (princ (format "\t%5d missing-message failures\n" missing-message-failures)) + (princ (format "\t%5d other failures\n" other-failures)) + (let* ((total (+ passes + assertion-failures + no-error-failures + wrong-error-failures + missing-message-failures + other-failures)) + (basename (file-name-nondirectory filename)) + (summary-msg + (cond ((> unexpected-test-file-failures 0) + (format test-harness-aborted-summary-template + (concat basename ":") total)) + ((> total 0) + (format test-harness-file-summary-template + (concat basename ":") + passes total (/ (* 100 passes) total))) + (t + (format test-harness-null-summary-template + (concat basename ":"))))) + (reasons "")) + (maphash (lambda (key value) + (setq reasons + (concat reasons + (format "\n %d tests skipped because %s." + value key)))) + skipped-test-reasons) + (when (> (length reasons) 1) + (setq summary-msg (concat summary-msg reasons " + It may be that XEmacs cannot find your installed packages. Set + EMACSPACKAGEPATH to the package hierarchy root or configure with + --package-path to enable the skipped tests."))) + (setq test-harness-file-results-alist + (cons (list filename passes total) + test-harness-file-results-alist)) + (message "%s" summary-msg)) + (when (> unexpected-test-file-failures 0) + (setq unexpected-test-suite-failure-files + (cons filename unexpected-test-suite-failure-files)) + (setq unexpected-test-suite-failures + (+ unexpected-test-suite-failures unexpected-test-file-failures)) + (message "Test suite execution failed unexpectedly.")) + (fmakunbound 'Assert) + (fmakunbound 'Check-Error) + (fmakunbound 'Check-Message) + (fmakunbound 'Check-Error-Message) + (fmakunbound 'Ignore-Ebola) + (fmakunbound 'Int-to-Marker) + (and noninteractive + (message "%s" (buffer-substring-no-properties + nil nil "*Test-Log*"))) + ))) + +(defvar test-harness-results-point-max nil) +(defmacro displaying-emacs-test-results (&rest body) + `(let ((test-harness-results-point-max test-harness-results-point-max)) + ;; Log the file name. + (test-harness-log-file) + ;; Record how much is logged now. + ;; We will display the log buffer if anything more is logged + ;; before the end of BODY. + (or test-harness-results-point-max + (save-excursion + (set-buffer (get-buffer-create "*Test-Log*")) + (setq test-harness-results-point-max (point-max)))) + (unwind-protect + (condition-case error-info + (progn ,@body) + (error + (test-harness-report-error error-info))) + (save-excursion + ;; If there were compilation warnings, display them. + (set-buffer "*Test-Log*") + (if (= test-harness-results-point-max (point-max)) + nil + (if temp-buffer-show-function + (let ((show-buffer (get-buffer-create "*Test-Log-Show*"))) + (save-excursion + (set-buffer show-buffer) + (setq buffer-read-only nil) + (erase-buffer)) + (copy-to-buffer show-buffer + (save-excursion + (goto-char test-harness-results-point-max) + (forward-line -1) + (point)) + (point-max)) + (funcall temp-buffer-show-function show-buffer)) + (select-window + (prog1 (selected-window) + (select-window (display-buffer (current-buffer))) + (goto-char test-harness-results-point-max) + (recenter 1))))))))) + +(defun batch-test-emacs-1 (file) + (condition-case error-info + (progn (test-emacs-test-file file) t) + (error + (princ ">>Error occurred processing ") + (princ file) + (princ ": ") + (display-error error-info nil) + (terpri) + nil))) + +(defun batch-test-emacs () + "Run `test-harness' on the files remaining on the command line. +Use this from the command line, with `-batch'; +it won't work in an interactive Emacs. +Each file is processed even if an error occurred previously. +A directory can be given as well, and all files will be processed. +For example, invoke \"xemacs -batch -f batch-test-emacs tests\"" + ;; command-line-args-left is what is left of the command line (from + ;; startup.el) + (defvar command-line-args-left) ;Avoid 'free variable' warning + (defvar debug-issue-ebola-notices) + (if (not noninteractive) + (error "`batch-test-emacs' is to be used only with -batch")) + (let ((error nil)) + (dolist (file command-line-args-left) + (if (file-directory-p file) + (dolist (file-in-dir (directory-files file t)) + (when (and (string-match emacs-lisp-file-regexp file-in-dir) + (not (or (auto-save-file-name-p file-in-dir) + (backup-file-name-p file-in-dir)))) + (or (batch-test-emacs-1 file-in-dir) + (setq error t)))) + (or (batch-test-emacs-1 file) + (setq error t)))) + (let ((namelen 0) + (succlen 0) + (testlen 0) + (results test-harness-file-results-alist)) + ;; compute maximum lengths of variable components of report + ;; probably should just use (length "byte-compiler-tests.el") + ;; and 5-place sizes -- this will also work for the file-by-file + ;; printing when Adrian's kludge gets reverted + (flet ((print-width (i) + (let ((x 10) (y 1)) + (while (>= i x) + (setq x (* 10 x) y (1+ y))) + y))) + (while results + (let* ((head (car results)) + (nn (length (file-name-nondirectory (first head)))) + (ss (print-width (second head))) + (tt (print-width (third head)))) + (when (> nn namelen) (setq namelen nn)) + (when (> ss succlen) (setq succlen ss)) + (when (> tt testlen) (setq testlen tt))) + (setq results (cdr results)))) + ;; create format and print + (let ((results (reverse test-harness-file-results-alist))) + (while results + (let* ((head (car results)) + (basename (file-name-nondirectory (first head))) + (nsucc (second head)) + (ntest (third head))) + (cond ((member (first head) unexpected-test-suite-failure-files) + (message test-harness-aborted-summary-template + (concat basename ":") + ntest)) + ((> ntest 0) + (message test-harness-file-summary-template + (concat basename ":") + nsucc + ntest + (/ (* 100 nsucc) ntest))) + (t + (message test-harness-null-summary-template + (concat basename ":")))) + (setq results (cdr results))))) + (when (> unexpected-test-suite-failures 0) + (message "\n***** There %s %d unexpected test suite %s in %s:" + (if (= unexpected-test-suite-failures 1) "was" "were") + unexpected-test-suite-failures + (if (= unexpected-test-suite-failures 1) "failure" "failures") + (if (eql (length unexpected-test-suite-failure-files) 1) + "file" + "files")) + (while unexpected-test-suite-failure-files + (let ((line (pop unexpected-test-suite-failure-files))) + (while (and (< (length line) 61) + unexpected-test-suite-failure-files) + (setq line + (concat line " " + (pop unexpected-test-suite-failure-files)))) + (message line))))) + (message "\nDone") + (kill-emacs (if error 1 0)))) + +(provide 'test-harness) + +;;; test-harness.el ends here diff -r 861f2601a38b -r 1f0b15040456 lisp/text-mode.el --- a/lisp/text-mode.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/text-mode.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 20.2. diff -r 861f2601a38b -r 1f0b15040456 lisp/text-props.el --- a/lisp/text-props.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/text-props.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/toolbar-items.el --- a/lisp/toolbar-items.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/toolbar-items.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up: Not in FSF @@ -403,7 +401,7 @@ (let ((command (cdr-safe (assq toolbar-news-reader toolbar-news-commands-alist)))) (or command - (error "Unkown news reader %s" toolbar-news-reader)) + (error "Unknown news reader %s" toolbar-news-reader)) (if (symbolp command) (call-interactively command) (eval command)))) diff -r 861f2601a38b -r 1f0b15040456 lisp/toolbar.el --- a/lisp/toolbar.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/toolbar.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -117,7 +115,6 @@ ;; called from toolbar.c during device and frame initialization (defun init-toolbar-from-resources (locale) (if (and (featurep 'x) - (not (featurep 'infodock)) (or (eq locale 'global) (eq 'x (device-or-frame-type locale)))) (declare-fboundp (x-init-toolbar-from-resources locale)))) diff -r 861f2601a38b -r 1f0b15040456 lisp/tty-init.el --- a/lisp/tty-init.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/tty-init.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched. diff -r 861f2601a38b -r 1f0b15040456 lisp/undo-stack.el --- a/lisp/undo-stack.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/undo-stack.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/unicode.el --- a/lisp/unicode.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/unicode.el Sun May 01 18:44:03 2011 +0100 @@ -6,20 +6,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -161,7 +159,7 @@ indian-is13194 korean-ksc5601 chinese-cns11643-1 chinese-cns11643-2 chinese-isoir165 composite ethiopic indian-1-column indian-2-column jit-ucs-charset-0 - katakana-jisx0201 lao thai-tis620 thai-xtis tibetan tibetan-1-column + katakana-jisx0201 lao thai-tis620 tibetan tibetan-1-column latin-jisx0201 chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5 chinese-cns11643-6 chinese-cns11643-7))))) diff -r 861f2601a38b -r 1f0b15040456 lisp/update-elc-2.el --- a/lisp/update-elc-2.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/update-elc-2.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF diff -r 861f2601a38b -r 1f0b15040456 lisp/update-elc.el --- a/lisp/update-elc.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/update-elc.el Sun May 01 18:44:03 2011 +0100 @@ -11,20 +11,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -102,6 +100,7 @@ ;; .elc's. (defvar lisp-files-needed-for-byte-compilation '("bytecomp" + "cl-macs" "byte-optimize")) ;; Lisp files not in `lisp-files-needed-for-byte-compilation' that need @@ -110,8 +109,7 @@ (defvar lisp-files-needing-early-byte-compilation '("easy-mmode" "autoload" - "shadow" - "cl-macs")) + "shadow")) (defvar unbytecompiled-lisp-files '("paths.el" @@ -137,7 +135,7 @@ (defun update-elc-chop-extension (file) (if (string-match "\\.elc?$" file) - (substring file 0 (match-beginning 0)) + (subseq file 0 (match-beginning 0)) file)) ;; we used to call packages-list-autoloads here, but it's false generality. @@ -367,25 +365,26 @@ ;; load-ignore-elc-files because byte-optimize gets autoloaded ;; from bytecomp. (let ((recompile-bc-bootstrap - (apply #'nconc - (mapcar - #'(lambda (arg) - (when (member arg update-elc-files-to-compile) - (append '("-f" "batch-byte-compile-one-file") - (list arg)))) - bc-bootstrap))) + (mapcan + #'(lambda (arg) + (when (member arg update-elc-files-to-compile) + (append '("-f" "batch-byte-compile-one-file") + (list arg)))) + bc-bootstrap)) (recompile-bootstrap-other - (apply #'nconc - (mapcar - #'(lambda (arg) - (when (member arg update-elc-files-to-compile) - (append '("-f" "batch-byte-compile-one-file") - (list arg)))) - bootstrap-other)))) + (mapcan + #'(lambda (arg) + (when (member arg update-elc-files-to-compile) + (append '("-f" "batch-byte-compile-one-file") + (list arg)))) + bootstrap-other))) (mapc #'(lambda (arg) (setq update-elc-files-to-compile - (delete arg update-elc-files-to-compile))) + (delete* arg update-elc-files-to-compile + :test (if default-file-system-ignore-case + #'equalp + #'equal)))) (append bc-bootstrap bootstrap-other)) (setq command-line-args (append diff -r 861f2601a38b -r 1f0b15040456 lisp/userlock.el --- a/lisp/userlock.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/userlock.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.34. diff -r 861f2601a38b -r 1f0b15040456 lisp/version.el --- a/lisp/version.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/version.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.34. @@ -56,9 +54,6 @@ " XEmacs Lucid") "Version numbers of this version of XEmacs.") -(if (featurep 'infodock) - (require 'id-vers)) - ;; Moved to C code as of XEmacs 20.3 ;(defconst emacs-major-version ; (progn (or (string-match "^[0-9]+" emacs-version) @@ -95,9 +90,7 @@ (format "XEmacs %s %s(%s%s) of %s %s on %s" (substring emacs-version 0 (string-match " XEmacs" emacs-version)) - (if (not (featurep 'infodock)) - "[Lucid] " - "") + "[Lucid] " system-configuration (cond ((or (and (fboundp 'featurep) (featurep 'mule)) diff -r 861f2601a38b -r 1f0b15040456 lisp/view-less.el --- a/lisp/view-less.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/view-less.el Sun May 01 18:44:03 2011 +0100 @@ -8,19 +8,18 @@ ;; 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 of the License, 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. -;; +;; 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 3 of the License, 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; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/wid-browse.el --- a/lisp/wid-browse.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/wid-browse.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: ;; diff -r 861f2601a38b -r 1f0b15040456 lisp/wid-edit.el --- a/lisp/wid-edit.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/wid-edit.el Sun May 01 18:44:03 2011 +0100 @@ -11,20 +11,18 @@ ;; 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. +;; 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 3 of the License, or (at your +;; option) any later version. + +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: ;; @@ -2487,12 +2485,12 @@ (widget-put old :value internal))) ;; Find new choice. (setq current - (cond ((= (length args) 0) + (cond ((eql (length args) 0) nil) - ((= (length args) 1) + ((eql (length args) 1) (nth 0 args)) ((and widget-choice-toggle - (= (length args) 2) + (eql (length args) 2) (memq old args)) (if (eq old (nth 0 args)) (nth 1 args) @@ -3639,7 +3637,7 @@ (widget-get widget :prompt-match) nil initial history))) (if (and (stringp answer) - (not (zerop (length answer)))) + (not (eql (length answer) 0))) answer (error "No value")))) @@ -4031,7 +4029,7 @@ "Prompt for a color." (let* ((tag (widget-apply widget :menu-tag-get)) (answer (read-color (concat tag ": ")))) - (unless (zerop (length answer)) + (unless (eql (length answer) 0) (widget-value-set widget answer) (widget-setup) (widget-apply widget :notify widget event)))) diff -r 861f2601a38b -r 1f0b15040456 lisp/widget.el --- a/lisp/widget.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/widget.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: diff -r 861f2601a38b -r 1f0b15040456 lisp/widgets-gtk.el --- a/lisp/widgets-gtk.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/widgets-gtk.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 lisp/win32-native.el --- a/lisp/win32-native.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/win32-native.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. ;;; (FSF has stuff in w32-fns.el and term/w32-win.el.) diff -r 861f2601a38b -r 1f0b15040456 lisp/window-xemacs.el --- a/lisp/window-xemacs.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/window-xemacs.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched. @@ -551,7 +549,7 @@ (interactive) (let ((wc (or config (current-window-configuration))) (stack (window-config-stack))) - (if (or (= 0 (undoable-stack-a-length stack)) + (if (or (eql 0 (undoable-stack-a-length stack)) (not (equal (undoable-stack-a-top stack) wc))) (undoable-stack-push stack wc)))) diff -r 861f2601a38b -r 1f0b15040456 lisp/window.el --- a/lisp/window.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/window.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Emacs/Mule zeta. @@ -585,7 +583,7 @@ (delq frame (visible-frame-list)) window-solitary (if (and (eq default-minibuffer-frame frame) - (= 1 (length (minibuffer-frame-list)))) + (eql 1 (length (minibuffer-frame-list)))) (setq window nil) (delete-frame frame) (setq window-handled t))) diff -r 861f2601a38b -r 1f0b15040456 lisp/x-compose.el --- a/lisp/x-compose.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/x-compose.el Sun May 01 18:44:03 2011 +0100 @@ -12,20 +12,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -156,7 +154,7 @@ compose-cedilla-map compose-diaeresis-map compose-circumflex-map compose-tilde-map compose-ring-map compose-caron-map compose-macron-map compose-breve-map compose-dot-map compose-doubleacute-map - compose-ogonek-map compose-hook-map compose-horn-map)) + compose-ogonek-map compose-hook-map compose-horn-map compose-stroke-map)) (define-key compose-map 'acute compose-acute-map) (define-key compose-map 'grave compose-grave-map) @@ -171,6 +169,7 @@ (define-key compose-map 'ogonek compose-ogonek-map) (define-key compose-map 'breve compose-breve-map) (define-key compose-map 'abovedot compose-dot-map) +(define-key compose-map 'stroke compose-stroke-map) ;;(define-key function-key-map [multi-key] compose-map) @@ -195,6 +194,7 @@ (define-key compose-map [~] compose-tilde-map) (define-key compose-map [degree] compose-ring-map) (define-key compose-map [?*] compose-ring-map) +(define-key compose-map [stroke] compose-stroke-map) (loop for (keysym character-code map) @@ -564,7 +564,42 @@ (compose-horn-map [?O] #x01A0) ;; CAPITAL O WITH HORN (compose-horn-map [?U] #x01AF) ;; CAPITAL U WITH HORN (compose-horn-map [?o] #x01A1) ;; SMALL O WITH HORN - (compose-horn-map [?u] #x01B0))) ;; SMALL U WITH HORN + (compose-horn-map [?u] #x01B0) ;; SMALL U WITH HORN + (compose-stroke-map [?A] #x023a) ;; CAPITAL A WITH STROKE + (compose-stroke-map [?a] #x2c65) ;; SMALL A WITH STROKE + (compose-stroke-map [?B] #x0243) ;; CAPITAL B WITH STROKE + (compose-stroke-map [?b] #x0180) ;; SMALL B WITH STROKE + (compose-stroke-map [?C] #x023b) ;; CAPITAL C WITH STROKE + (compose-stroke-map [?c] #x023c) ;; SMALL C WITH STROKE + (compose-stroke-map [?D] #x0110) ;; CAPITAL D WITH STROKE + (compose-stroke-map [?d] #x0111) ;; SMALL D WITH STROKE + (compose-stroke-map [?E] #x0246) ;; CAPITAL E WITH STROKE + (compose-stroke-map [?e] #x0247) ;; SMALL E WITH STROKE + (compose-stroke-map [?G] #x01e4) ;; CAPITAL G WITH STROKE + (compose-stroke-map [?g] #x01e5) ;; SMALL G WITH STROKE + (compose-stroke-map [?H] #x0126) ;; CAPITAL H WITH STROKE + (compose-stroke-map [?h] #x0127) ;; SMALL H WITH STROKE + (compose-stroke-map [?I] #x0197) ;; CAPITAL I WITH STROKE + (compose-stroke-map [?i] #x0268) ;; SMALL I WITH STROKE + (compose-stroke-map [?J] #x0248) ;; CAPITAL J WITH STROKE + (compose-stroke-map [?j] #x0249) ;; SMALL J WITH STROKE + (compose-stroke-map [?K] #xa740) ;; CAPITAL K WITH STROKE + (compose-stroke-map [?k] #xa741) ;; SMALL K WITH STROKE + (compose-stroke-map [?L] #x0141) ;; CAPITAL L WITH STROKE + (compose-stroke-map [?l] #x0142) ;; SMALL L WITH STROKE + (compose-stroke-map [?O] #x00d8) ;; CAPITAL O WITH STROKE + (compose-stroke-map [?o] #x00f8) ;; SMALL O WITH STROKE + (compose-stroke-map [?P] #x2c63) ;; CAPITAL P WITH STROKE + (compose-stroke-map [?p] #x1d7d) ;; SMALL P WITH STROKE + (compose-stroke-map [?R] #x024c) ;; CAPITAL R WITH STROKE + (compose-stroke-map [?r] #x024d) ;; SMALL R WITH STROKE + (compose-stroke-map [?T] #x0166) ;; CAPITAL T WITH STROKE + (compose-stroke-map [?t] #x0167) ;; SMALL T WITH STROKE + (compose-stroke-map [?Y] #x024e) ;; CAPITAL Y WITH STROKE + (compose-stroke-map [?y] #x024f) ;; SMALL Y WITH STROKE + (compose-stroke-map [?Z] #x01b5) ;; CAPITAL Z WITH STROKE + (compose-stroke-map [?z] #x01b6) ;; SMALL Z WITH STROKE +)) ;;; The rest of the compose-map. These are the composed characters @@ -881,9 +916,9 @@ (mod-char (and (>= (downcase base-char) ?a) ; only do alphabetics? (<= (downcase base-char) ?z) (lookup-key map (make-string 1 base-char))))) - (when (and (vectorp mod-char) (= (length mod-char) 1)) + (when (and (vectorp mod-char) (eql (length mod-char) 1)) (setq mod-char (aref mod-char 0)) - (if (and (consp mod-char) (= (length mod-char) 1) + (if (and (consp mod-char) (eql (length mod-char) 1) (characterp (car mod-char))) (setq mod-char (car mod-char)))) (if (and mod-char (symbolp mod-char)) diff -r 861f2601a38b -r 1f0b15040456 lisp/x-faces.el --- a/lisp/x-faces.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/x-faces.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched. @@ -434,17 +432,17 @@ (concat (substring font 0 (match-beginning 1)) "*" (substring font (match-end 1) (match-end 0)))))) (sort - (delq nil - (mapcar (function - (lambda (name) - (and (string-match x-font-regexp name) - (list - (string-to-int (substring name (match-beginning 5) - (match-end 5))) - (string-to-int (substring name (match-beginning 6) - (match-end 6))) - name)))) - (font-list font device))) + (mapcan (function + (lambda (name) + (and (string-match x-font-regexp name) + (list + (list + (string-to-int (substring name (match-beginning 5) + (match-end 5))) + (string-to-int (substring name (match-beginning 6) + (match-end 6))) + name))))) + (font-list font device)) (function (lambda (x y) (if (= (nth 1 x) (nth 1 y)) (< (nth 0 x) (nth 0 y)) (< (nth 1 x) (nth 1 y))))))) @@ -611,7 +609,7 @@ ;; -- sjt 2007-10-06 ;; This function is probably also used by the GTK platform. Cf. -;; gtk_color_list in src/objects-gtk.c. +;; gtk_color_list in src/fontcolor-gtk.c. (defun x-color-list-internal () (if (boundp 'x-color-list-internal-cache) x-color-list-internal-cache diff -r 861f2601a38b -r 1f0b15040456 lisp/x-font-menu.el --- a/lisp/x-font-menu.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/x-font-menu.el Sun May 01 18:44:03 2011 +0100 @@ -11,20 +11,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Code: ;; #### - implement these... @@ -253,21 +251,21 @@ (vector cache (mapcar (lambda (x) - (vector x + (vector x (list 'font-menu-set-font x nil nil) - ':style 'radio ':active nil ':selected nil)) + :style 'radio :active nil :selected nil)) families) (mapcar (lambda (x) (vector (if (/= 0 (% x 10)) (number-to-string (/ x 10.0)) (number-to-string (/ x 10))) (list 'font-menu-set-font nil nil x) - ':style 'radio ':active nil ':selected nil)) + :style 'radio :active nil :selected nil)) sizes) (mapcar (lambda (x) (vector x (list 'font-menu-set-font nil x nil) - ':style 'radio ':active nil ':selected nil)) + :style 'radio :active nil :selected nil)) weights))) (cdr dev-cache))) diff -r 861f2601a38b -r 1f0b15040456 lisp/x-init.el --- a/lisp/x-init.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/x-init.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched. @@ -92,7 +90,7 @@ compose-ring-map compose-caron-map compose-macron-map compose-breve-map compose-dot-map compose-doubleacute-map compose-ogonek-map - compose-hook-map compose-horn-map) + compose-hook-map compose-horn-map compose-stroke-map) do (autoload map "x-compose" nil t 'keymap)) (loop @@ -208,7 +206,8 @@ (dead-doubleacute compose-doubleacute-map) (dead-ogonek compose-ogonek-map) (dead-hook compose-hook-map) - (dead-horn compose-horn-map)) + (dead-horn compose-horn-map) + (dead-stroke compose-stroke-map)) ;; Get the correct value for function-key-map with function-key-map = (symbol-value-in-console 'function-key-map diff -r 861f2601a38b -r 1f0b15040456 lisp/x-misc.el --- a/lisp/x-misc.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/x-misc.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Commentary: @@ -86,4 +84,10 @@ (x-bogosity-check-resource name class type)) (x-get-resource name class type locale nil 'warn)) +(defun device-x-display (&optional device) + "If DEVICE is an X11 device, return its DISPLAY. + +DEVICE defaults to the selected device." + (and (eq 'x (device-type device)) (device-connection device))) + ;;; x-misc.el ends here diff -r 861f2601a38b -r 1f0b15040456 lisp/x-mouse.el --- a/lisp/x-mouse.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/x-mouse.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched. diff -r 861f2601a38b -r 1f0b15040456 lisp/x-scrollbar.el --- a/lisp/x-scrollbar.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/x-scrollbar.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not synched. diff -r 861f2601a38b -r 1f0b15040456 lisp/x-select.el --- a/lisp/x-select.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/x-select.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: FSF 19.30 (select.el). diff -r 861f2601a38b -r 1f0b15040456 lisp/x-win-sun.el --- a/lisp/x-win-sun.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/x-win-sun.el Sun May 01 18:44:03 2011 +0100 @@ -6,20 +6,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: @@ -67,7 +65,6 @@ (globally-declare-fboundp '(x-keysym-on-keyboard-sans-modifiers-p)) -;;;###autoload (defun x-win-init-sun (device) ;; help is ok diff -r 861f2601a38b -r 1f0b15040456 lisp/x-win-xfree86.el --- a/lisp/x-win-xfree86.el Sat Feb 20 06:03:00 2010 -0600 +++ b/lisp/x-win-xfree86.el Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Commentary: @@ -44,7 +42,6 @@ (globally-declare-fboundp '(x-keysym-on-keyboard-p x-keysym-on-keyboard-sans-modifiers-p)) -;;;###autoload (defun x-win-init-xfree86 (device) ;; We know this keyboard is an XFree86 keyboard. As such, we can predict @@ -77,6 +74,9 @@ nil nil nil nil nil ?/ nil nil nil nil nil nil nil nil nil nil nil nil nil ?=]) + (when (x-keysym-on-keyboard-p 'iso-left-tab device) + (define-key function-key-map 'iso-left-tab [(shift tab)])) + (loop for (key sane-key) in '((f13 f1) (f14 f2) diff -r 861f2601a38b -r 1f0b15040456 lwlib/ChangeLog --- a/lwlib/ChangeLog Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/ChangeLog Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,27 @@ +2011-04-29 Stephen J. Turnbull + + * XEmacs 21.5.31 "ginger" is released. + +2011-04-26 Stephen J. Turnbull + + * XEmacs 21.5.30 "garlic" is released. + +2011-01-11 Aidan Kehoe + + * lwlib-fonts.c (xft_open_font_by_name): + Replace the POSIX index(3), not universally available even today, + with the C89 strchr(3), hopefully fixing a few of the buildbots' + problems. + +2010-06-13 Stephen J. Turnbull + + * lwlib-internal.h: Correct FSF address in permission notice. + +2010-02-22 Ben Wing + + * lwlib-colors.h: + objects*.h -> fontcolor*.h. + 2010-02-08 Ben Wing * xt-wrappers.h: @@ -1431,3 +1455,23 @@ * lwlib/xlwmenu.c (massage_resource_name): Fix compiler warning - Have to toupper ((int) (unsigned char) x) to be portable. + + +ChangeLog entries synched from GNU Emacs are the property of the FSF. +Other ChangeLog entries are usually the property of the author of the +change. + +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 3 of the License, 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. If not, see . diff -r 861f2601a38b -r 1f0b15040456 lwlib/Makefile.in.in --- a/lwlib/Makefile.in.in Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/Makefile.in.in Sun May 01 18:44:03 2011 +0100 @@ -5,22 +5,21 @@ ## Copyright (C) 1996, 1997 Sun Microsystems, Inc. ## Copyright (C) 2005 Ben Wing. -## This file is part of the Lucid Widget Library. +## This file is part of Lucid Widget Library. -## The Lucid Widget Library 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. +## The Lucid Widget Library 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 3 of +## the License, or (at your option) any later version. -## The Lucid Widget Library 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 +## The Lucid Widget Library is distributed in the hope that it will be +## useful, but WITHOUT ANY WARRANTY; without even the implied warranty +## of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## You should have received a copy of the GNU General Public License -## along with XEmacs; see the file COPYING. If not, write to -## the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -## Boston, MA 02111-1307, USA. +## along with the Lucid Widget Library. If not, see +## . ## For performance and consistency, no built-in rules .SUFFIXES: diff -r 861f2601a38b -r 1f0b15040456 lwlib/config.h.in --- a/lwlib/config.h.in Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/config.h.in Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 lwlib/lwlib-Xaw.c --- a/lwlib/lwlib-Xaw.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/lwlib-Xaw.c Sun May 01 18:44:03 2011 +0100 @@ -3,20 +3,20 @@ This file is part of the Lucid Widget Library. -The Lucid Widget Library 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. +The Lucid Widget Library 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 3 of the +License, or (at your option) any later version. -The Lucid Widget Library 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. +The Lucid Widget Library is distributed in the hope that it will be +useful, but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with the Lucid Widget Library. If not, see +. +*/ #include #include diff -r 861f2601a38b -r 1f0b15040456 lwlib/lwlib-Xaw.h --- a/lwlib/lwlib-Xaw.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/lwlib-Xaw.h Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,22 @@ +/* The lwlib interface to Athena widgets. + Copyright (C) 1993, 1994 Free Software Foundation, Inc. + +This file is part of the Lucid Widget Library. + +The Lucid Widget Library 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 3 of the +License, or (at your option) any later version. + +The Lucid Widget Library 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 the Lucid Widget Library. If not, see +. */ + #ifndef INCLUDED_lwlib_Xaw_h_ #define INCLUDED_lwlib_Xaw_h_ diff -r 861f2601a38b -r 1f0b15040456 lwlib/lwlib-Xlw.c --- a/lwlib/lwlib-Xlw.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/lwlib-Xlw.c Sun May 01 18:44:03 2011 +0100 @@ -3,20 +3,19 @@ This file is part of the Lucid Widget Library. -The Lucid Widget Library 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. +The Lucid Widget Library 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 3 of the +License, or (at your option) any later version. -The Lucid Widget Library 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. +The Lucid Widget Library is distributed in the hope that it will be +useful, but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with the Lucid Widget Library. If not, see +. */ #include #include /* for abort () */ diff -r 861f2601a38b -r 1f0b15040456 lwlib/lwlib-Xlw.h --- a/lwlib/lwlib-Xlw.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/lwlib-Xlw.h Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,22 @@ +/* The lwlib interface to "xlwmenu" menus. + Copyright (C) 1992, 1994 Lucid, Inc. + +This file is part of the Lucid Widget Library. + +The Lucid Widget Library 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 3 of the +License, or (at your option) any later version. + +The Lucid Widget Library 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 the Lucid Widget Library. If not, see +. */ + #ifndef LWLIB_XLW_H #define LWLIB_XLW_H diff -r 861f2601a38b -r 1f0b15040456 lwlib/lwlib-Xm.c --- a/lwlib/lwlib-Xm.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/lwlib-Xm.c Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,19 @@ This file is part of the Lucid Widget Library. -The Lucid Widget Library 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. +The Lucid Widget Library 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 3 of the +License, or (at your option) any later version. -The Lucid Widget Library 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. +The Lucid Widget Library is distributed in the hope that it will be +useful, but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with the Lucid Widget Library. If not, see +. */ #include #include diff -r 861f2601a38b -r 1f0b15040456 lwlib/lwlib-Xm.h --- a/lwlib/lwlib-Xm.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/lwlib-Xm.h Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,23 @@ +/* The lwlib interface to Motif widgets. + Copyright (C) 1992, 1993, 1994 Lucid, Inc. + Copyright (C) 1995 Tinker Systems and INS Engineering Corp. + +This file is part of the Lucid Widget Library. + +The Lucid Widget Library 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 3 of the +License, or (at your option) any later version. + +The Lucid Widget Library 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 the Lucid Widget Library. If not, see +. */ + #ifndef INCLUDED_lwlib_Xm_h_ #define INCLUDED_lwlib_Xm_h_ diff -r 861f2601a38b -r 1f0b15040456 lwlib/lwlib-colors.c --- a/lwlib/lwlib-colors.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/lwlib-colors.c Sun May 01 18:44:03 2011 +0100 @@ -7,10 +7,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -18,9 +18,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in GNU Emacs. */ diff -r 861f2601a38b -r 1f0b15040456 lwlib/lwlib-colors.h --- a/lwlib/lwlib-colors.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/lwlib-colors.h Sun May 01 18:44:03 2011 +0100 @@ -7,10 +7,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -18,9 +18,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in GNU Emacs. */ @@ -35,7 +33,7 @@ /* basic version from xlwmenu.c */ int FIXME_allocate_nearest_color (Display *display, Colormap screen_colormap, XColor *color_def); -/* haired-up version from ../src/objects-x.c */ +/* haired-up version from ../src/fontcolor-x.c */ int x_allocate_nearest_color (Display *display, Colormap screen_colormap, Visual *visual, XColor *color_def); diff -r 861f2601a38b -r 1f0b15040456 lwlib/lwlib-fonts.c --- a/lwlib/lwlib-fonts.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/lwlib-fonts.c Sun May 01 18:44:03 2011 +0100 @@ -8,10 +8,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -19,9 +19,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in GNU Emacs. */ @@ -76,7 +74,7 @@ int count = 0; char *pos = name; /* extra parens shut up gcc */ - while ((pos = index (pos, '-'))) + while ((pos = strchr (pos, '-'))) { count++; pos++; @@ -86,7 +84,7 @@ if (count == 14 /* fully-qualified XLFD */ || (count < 14 /* heuristic for wildcarded XLFD */ && count >= 5 - && index (name, '*'))) + && strchr (name, '*'))) res = XftFontOpenXlfd (dpy, DefaultScreen (dpy), name); else res = XftFontOpenName (dpy, DefaultScreen (dpy), name); diff -r 861f2601a38b -r 1f0b15040456 lwlib/lwlib-fonts.h --- a/lwlib/lwlib-fonts.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/lwlib-fonts.h Sun May 01 18:44:03 2011 +0100 @@ -7,10 +7,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -18,9 +18,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in GNU Emacs. */ diff -r 861f2601a38b -r 1f0b15040456 lwlib/lwlib-internal.h --- a/lwlib/lwlib-internal.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/lwlib-internal.h Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,19 @@ This file is part of the Lucid Widget Library. -The Lucid Widget Library 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. +The Lucid Widget Library 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 3 of the +License, or (at your option) any later version. -The Lucid Widget Library 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. +The Lucid Widget Library is distributed in the hope that it will be +useful, but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin St - Fifth Floor, -Boston, MA 02110-1301, USA. */ +along with the Lucid Widget Library. If not, see +. */ #ifndef INCLUDED_lwlib_internal_h_ #define INCLUDED_lwlib_internal_h_ diff -r 861f2601a38b -r 1f0b15040456 lwlib/lwlib-utils.c --- a/lwlib/lwlib-utils.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/lwlib-utils.c Sun May 01 18:44:03 2011 +0100 @@ -3,20 +3,19 @@ This file is part of the Lucid Widget Library. -The Lucid Widget Library 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. +The Lucid Widget Library 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 3 of the +License, or (at your option) any later version. -The Lucid Widget Library 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. +The Lucid Widget Library is distributed in the hope that it will be +useful, but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with the Lucid Widget Library. If not, see +. */ #include #include diff -r 861f2601a38b -r 1f0b15040456 lwlib/lwlib-utils.h --- a/lwlib/lwlib-utils.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/lwlib-utils.h Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,22 @@ +/* Defines some widget utility functions. + Copyright (C) 1992 Lucid, Inc. + +This file is part of the Lucid Widget Library. + +The Lucid Widget Library 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 3 of the +License, or (at your option) any later version. + +The Lucid Widget Library 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 the Lucid Widget Library. If not, see +. */ + #ifndef INCLUDED_lwlib_utils_h_ #define INCLUDED_lwlib_utils_h_ diff -r 861f2601a38b -r 1f0b15040456 lwlib/lwlib.c --- a/lwlib/lwlib.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/lwlib.c Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,19 @@ This file is part of the Lucid Widget Library. -The Lucid Widget Library 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. +The Lucid Widget Library 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 3 of the +License, or (at your option) any later version. -The Lucid Widget Library 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. +The Lucid Widget Library is distributed in the hope that it will be +useful, but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with the Lucid Widget Library. If not, see +. */ #include #include diff -r 861f2601a38b -r 1f0b15040456 lwlib/lwlib.h --- a/lwlib/lwlib.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/lwlib.h Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,23 @@ +/* A general interface to the widgets of different toolkits. + Copyright (C) 1992, 1993, 1994 Lucid, Inc. + Copyright (C) 1995 Tinker Systems and INS Engineering Corp. + +This file is part of the Lucid Widget Library. + +The Lucid Widget Library 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 3 of the +License, or (at your option) any later version. + +The Lucid Widget Library 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 the Lucid Widget Library. If not, see +. */ + #ifndef INCLUDED_lwlib_h_ #define INCLUDED_lwlib_h_ diff -r 861f2601a38b -r 1f0b15040456 lwlib/xlwcheckbox.c --- a/lwlib/xlwcheckbox.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/xlwcheckbox.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Checkbox.c 1.1 */ diff -r 861f2601a38b -r 1f0b15040456 lwlib/xlwcheckbox.h --- a/lwlib/xlwcheckbox.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/xlwcheckbox.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Checkbox.h 1.1 */ diff -r 861f2601a38b -r 1f0b15040456 lwlib/xlwcheckboxP.h --- a/lwlib/xlwcheckboxP.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/xlwcheckboxP.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* * CheckboxP.h - Private definitions for Checkbox widget diff -r 861f2601a38b -r 1f0b15040456 lwlib/xlwgauge.c --- a/lwlib/xlwgauge.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/xlwgauge.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Gauge.c 1.2 */ diff -r 861f2601a38b -r 1f0b15040456 lwlib/xlwgauge.h --- a/lwlib/xlwgauge.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/xlwgauge.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Gauge.h 1.1 */ diff -r 861f2601a38b -r 1f0b15040456 lwlib/xlwgaugeP.h --- a/lwlib/xlwgaugeP.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/xlwgaugeP.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* * GaugeP.h - Gauge widget diff -r 861f2601a38b -r 1f0b15040456 lwlib/xlwgcs.c --- a/lwlib/xlwgcs.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/xlwgcs.c Sun May 01 18:44:03 2011 +0100 @@ -3,20 +3,18 @@ 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. - You should have received a copy of the GNU General Public License - along with XEmacs; see the file COPYING. If not, write to - the Free Software Foundation, Inc., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ +You should have received a copy of the GNU General Public License +along with XEmacs. If not, see . */ /* Synched up with: Gcs.c 1.7 */ diff -r 861f2601a38b -r 1f0b15040456 lwlib/xlwgcs.h --- a/lwlib/xlwgcs.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/xlwgcs.h Sun May 01 18:44:03 2011 +0100 @@ -3,20 +3,18 @@ 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. - You should have received a copy of the GNU General Public License - along with XEmacs; see the file COPYING. If not, write to - the Free Software Foundation, Inc., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ +You should have received a copy of the GNU General Public License +along with XEmacs. If not, see . */ /* Synched up with: Gcs 1.7 */ diff -r 861f2601a38b -r 1f0b15040456 lwlib/xlwmenu.c --- a/lwlib/xlwmenu.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/xlwmenu.c Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,19 @@ This file is part of the Lucid Widget Library. -The Lucid Widget Library 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. - -The Lucid Widget Library 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. +The Lucid Widget Library 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 3 of the +License, or (at your option) any later version. + +The Lucid Widget Library is distributed in the hope that it will be +useful, but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with the Lucid Widget Library. If not, see +. */ /* Created by devin@lucid.com */ diff -r 861f2601a38b -r 1f0b15040456 lwlib/xlwmenu.h --- a/lwlib/xlwmenu.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/xlwmenu.h Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,23 @@ +/* Implements a lightweight menubar widget. + Copyright (C) 1992, 1993, 1994 Lucid, Inc. + Copyright (C) 1995 Tinker Systems and INS Engineering Corp. + +This file is part of the Lucid Widget Library. + +The Lucid Widget Library 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 3 of the +License, or (at your option) any later version. + +The Lucid Widget Library 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 the Lucid Widget Library. If not, see +. */ + #ifndef INCLUDED_xlwmenu_h_ #define INCLUDED_xlwmenu_h_ diff -r 861f2601a38b -r 1f0b15040456 lwlib/xlwmenuP.h --- a/lwlib/xlwmenuP.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/xlwmenuP.h Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,23 @@ +/* Implements a lightweight menubar widget. + Copyright (C) 1992, 1993, 1994 Lucid, Inc. + Copyright (C) 1995 Tinker Systems and INS Engineering Corp. + +This file is part of the Lucid Widget Library. + +The Lucid Widget Library 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 3 of the +License, or (at your option) any later version. + +The Lucid Widget Library 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 the Lucid Widget Library. If not, see +. */ + #ifndef INCLUDED_xlwmenuP_h_ #define INCLUDED_xlwmenuP_h_ diff -r 861f2601a38b -r 1f0b15040456 lwlib/xlwradio.c --- a/lwlib/xlwradio.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/xlwradio.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Radio.c 1.1 */ diff -r 861f2601a38b -r 1f0b15040456 lwlib/xlwradio.h --- a/lwlib/xlwradio.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/xlwradio.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Radio.h 1.1 */ diff -r 861f2601a38b -r 1f0b15040456 lwlib/xlwradioP.h --- a/lwlib/xlwradioP.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/xlwradioP.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* * RadioP.h - Private definitions for Radio widget diff -r 861f2601a38b -r 1f0b15040456 lwlib/xlwscrollbar.c --- a/lwlib/xlwscrollbar.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/xlwscrollbar.c Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,19 @@ This file is part of the Lucid Widget Library. -The Lucid Widget Library 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. +The Lucid Widget Library 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 3 of the +License, or (at your option) any later version. -The Lucid Widget Library 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. +The Lucid Widget Library is distributed in the hope that it will be +useful, but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with the Lucid Widget Library. If not, see +. */ /* Created by Douglas Keller */ /* Lots of hacking by Martin Buchholz */ diff -r 861f2601a38b -r 1f0b15040456 lwlib/xlwscrollbar.h --- a/lwlib/xlwscrollbar.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/xlwscrollbar.h Sun May 01 18:44:03 2011 +0100 @@ -3,20 +3,19 @@ This file is part of the Lucid Widget Library. -The Lucid Widget Library 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. +The Lucid Widget Library 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 3 of the +License, or (at your option) any later version. -The Lucid Widget Library 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. +The Lucid Widget Library is distributed in the hope that it will be +useful, but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with the Lucid Widget Library. If not, see +. */ /* Created by Douglas Keller */ diff -r 861f2601a38b -r 1f0b15040456 lwlib/xlwscrollbarP.h --- a/lwlib/xlwscrollbarP.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/xlwscrollbarP.h Sun May 01 18:44:03 2011 +0100 @@ -1,22 +1,21 @@ -/* Implements a lightweight scrollbar widget. +/* Implements a lightweight scrollbar widget. Copyright (C) 1992, 1993, 1994 Lucid, Inc. This file is part of the Lucid Widget Library. -The Lucid Widget Library 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. +The Lucid Widget Library 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 3 of the +License, or (at your option) any later version. -The Lucid Widget Library 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. +The Lucid Widget Library is distributed in the hope that it will be +useful, but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with the Lucid Widget Library. If not, see +. */ /* Created by Douglas Keller */ diff -r 861f2601a38b -r 1f0b15040456 lwlib/xlwtabs.c --- a/lwlib/xlwtabs.c Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/xlwtabs.c Sun May 01 18:44:03 2011 +0100 @@ -3,20 +3,18 @@ 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. - You should have received a copy of the GNU General Public License - along with XEmacs; see the file COPYING. If not, write to - the Free Software Foundation, Inc., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ +You should have received a copy of the GNU General Public License +along with XEmacs. If not, see . */ /* * Tabs.c - Index Tabs composite widget diff -r 861f2601a38b -r 1f0b15040456 lwlib/xlwtabs.h --- a/lwlib/xlwtabs.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/xlwtabs.h Sun May 01 18:44:03 2011 +0100 @@ -1,22 +1,20 @@ -/* Tabs Widget for XEmacs. + /* Tabs Widget for XEmacs. Copyright (C) 1999 Edward A. Falk - + This file is part of XEmacs. - - XEmacs is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by the - Free Software Foundation; either version 2, or (at your option) any - later version. - - XEmacs is distributed in the hope that it will be useful, but WITHOUT - ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or - FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License - for more details. - - You should have received a copy of the GNU General Public License - along with XEmacs; see the file COPYING. If not, write to - the Free Software Foundation, Inc., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ + +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 3 of the License, 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. If not, see . */ /* * This widget manages one or more child widgets, exactly one of which is diff -r 861f2601a38b -r 1f0b15040456 lwlib/xlwtabsP.h --- a/lwlib/xlwtabsP.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/xlwtabsP.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: TabsP.h 1.8 */ diff -r 861f2601a38b -r 1f0b15040456 lwlib/xt-wrappers.h --- a/lwlib/xt-wrappers.h Sat Feb 20 06:03:00 2010 -0600 +++ b/lwlib/xt-wrappers.h Sun May 01 18:44:03 2011 +0100 @@ -4,19 +4,18 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, or (at your +option) any later version. XEmacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 man/ChangeLog --- a/man/ChangeLog Sat Feb 20 06:03:00 2010 -0600 +++ b/man/ChangeLog Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,359 @@ +2011-04-29 Stephen J. Turnbull + + * XEmacs 21.5.31 "ginger" is released. + +2011-04-26 Stephen J. Turnbull + + * XEmacs 21.5.30 "garlic" is released. + +2011-04-02 Stephen J. Turnbull + + * xemacs-faq.texi (Q2.5.7): + New node on troubleshooting duplicate auto-autoloads. + (Top): + (Installation): + (Q2.5.6): + Update menus and node links for Q2.5.7. + +2011-03-24 Jerry James + + * internals/internals.texi (Creating a Window-System Type): + "desireable" -> "desirable", "neglible" -> "negligible". + (The Non-Client Area): "negotation" -> "negotiation". + (Better Rendering Support -- Modern Font Support): "anomolies" -> + "anomalies". + (Discussion -- Switching to C++): "reliablity" -> "reliability". + * lispref/mule.texi (Theory of Operation): "noticable" -> "noticeable". + * lispref/strings.texi (Creating Strings): "occurances" -> + "occurrences". + * xemacs-faq.texi (Q1.0.3: How do you pronounce XEmacs?): + "pronounciation" -> "pronunciation". + (Q1.7.2: Which external packages are there?): "withing" -> "within". + (Q2.4.3: XEmacs crashes and I compiled it myself.): "ealier" -> + "earlier". + (hg diff gives bizarre output.): "occured" -> "occurred", "relevent" + -> "relevant". + (How do I recover from a bad commit? (I already pushed.)): + "inadvertantly" -> "inadvertently". + +2011-03-19 Stephen J. Turnbull + + * lispref/customize.texi (Face Definitions): New node. + (Customization): Add entry to menu. + (Variable Definitions): Add cross-ref for `defface'. + (Customization Types): Fixup Previous link. + + * lispref/faces.texi (Faces): + Clarify that built-in properties of faces are computed at runtime. + +2011-03-15 Aidan Kehoe + + * lispref/objects.texi (Character Type): + * lispref/objects.texi (Equality Predicates): + No longer document `old-eq', `old-equal', they haven't been used + in years. + +2011-03-14 Jeff Sparkes + + * lispref/faces.texi (Faces): Mention `min-colors' as a + face specifier. + +2011-03-01 Aidan Kehoe + + * lispref/commands.texi (Using Interactive): + * lispref/compile.texi (Eval During Compile): + * lispref/compile.texi (Compiled-Function Objects): + * lispref/control.texi (Sequencing): + * lispref/control.texi (Conditionals): + * lispref/control.texi (Combining Conditions): + * lispref/control.texi (Iteration): + * lispref/control.texi (Catch and Throw): + * lispref/control.texi (Handling Errors): + * lispref/control.texi (Cleanups): + * lispref/display.texi (Temporary Displays): + * lispref/eval.texi (Quoting): + * lispref/eval.texi (Multiple values): + * lispref/frames.texi (Input Focus): + * lispref/functions.texi (Argument List): + * lispref/functions.texi (Defining Functions): + * lispref/functions.texi (Anonymous Functions): + * lispref/internationalization.texi (Level 3 Primitives): + * lispref/internationalization.texi (Domain Specification): + * lispref/intro.texi (A Sample Function Description): + * lispref/intro.texi (A Sample Variable Description): + * lispref/lists.texi (Sets And Lists): + * lispref/macros.texi (Defining Macros): + * lispref/macros.texi (Backquote): + * lispref/positions.texi (Excursions): + * lispref/positions.texi (Narrowing): + * lispref/searching.texi (Saving Match Data): + * lispref/sequences.texi (Sequence Functions): + * lispref/sequences.texi (Array Functions): + * lispref/specifiers.texi (Adding Specifications): + * lispref/variables.texi (Local Variables): + * lispref/variables.texi (Defining Variables): + * lispref/variables.texi (Setting Variables): + * lispref/variables.texi (Default Value): + * lispref/windows.texi (Selecting Windows): + * lispref/windows.texi (Window Configurations): + No longer use @defspec, since we no longer use the term "special + form"; instead use @deffn {Special Operator}. Unfortunately + there's no way in texinfo to redefine @defspec in one place. + +2011-03-01 Aidan Kehoe + + * cl.texi (Argument Lists): + * cl.texi (Time of Evaluation): + * cl.texi (Type Predicates): + * cl.texi (Assignment): + * cl.texi (Basic Setf): + * cl.texi (Modify Macros): + * cl.texi (Customizing Setf): + * cl.texi (Dynamic Bindings): + * cl.texi (Lexical Bindings): + * cl.texi (Function Bindings): + * cl.texi (Macro Bindings): + * cl.texi (Conditionals): + * cl.texi (Blocks and Exits): + * cl.texi (Iteration): + * cl.texi (Loop Basics): + * cl.texi (Macros): + * cl.texi (Declarations): + * cl.texi (Property Lists): + * cl.texi (Structures): + * cl.texi (Assertions): + * cl.texi (Efficiency Concerns): + +2011-02-19 Aidan Kehoe + + * lispref/lists.texi (Sets And Lists): + Document #'member*, #'remove*, #'delete* in this file. Document + #'memq, #'member, #'remq, #'remove, #'delq, #'delete in terms of + the former functions. + Document #'subsetp, #'union, #'intersection, #'set-difference, + #'set-exclusive-or and their destructive analogues in this file. + * lispref/lists.texi (Association Lists): + Document #'assoc*, #'rassoc* in this file. Document #'assq, + #'assoc, #'rassq, #'rassoc in terms of the first two functions. + * lispref/objects.texi (Equality Predicates): + Document #'eql here, don't leave it to cl.texi. + +2010-11-06 Aidan Kehoe + + * lispref/lists.texi (Rearrangement, Building Lists): + Document that #'nreverse and #'reverse now accept sequences, not + just lists, in this file. + +2010-09-02 Aidan Kehoe + + * lispref/os.texi (Time Conversion): + Document the new #'format-time-string flags for Roman month + numbers. + +2010-08-30 Aidan Kehoe + + * lispref/eval.texi (Evaluation, Multiple values): + Document our implementation of multiple values; point the reader + to the CLTL or the Hyperspec for details of exactly when values + are discarded. + + * lispref/numbers.texi (Numeric Conversions): Document the + optional DIVISOR arguments to the rounding functions, and + document that they all return multiple values. + (Rounding Operations): Ditto. + + * cl.texi (Multiple Values): + Document that we've moved the multiple values implementation to + core code, and cross-reference to the Lispref. + (Numerical Functions): The various rounding functions are now + identical to the built-in rounding functions, with the exception + that they return lists, not multiple values; document this. + +2010-08-21 Aidan Kehoe + + * lispref/objects.texi (Character Type): + Go into more detail here on the specific type of error provoked on + overlong hex character escapes and non-Latin-1 octal character + escapes; give details of why the latter may be encountered, and + what to do with such code. + +2010-06-13 Stephen J. Turnbull + + * external-widget.texi: Correct FSF address in permission notice. + +2010-05-28 Aidan Kehoe + + * lispref/windows.texi (Buffers and Windows): + Reword the documentation of `buffer-display-count'; + `buffer-display-time's documentation was taken from a version of + the GNU elisp manuwal with a compatible licence, + `buffer-display-count' was not. + +2010-05-17 Jeff Sparkes + + * lispref/windows.texi (Buffers and Windows): + Document buffer-display-count and buffer-display-time with + descriptions from GNU emacs lispref. + + * lispref/locals.texi (Standard Buffer-Local Variables): + Add buffer-display-count and buffer-display-time. + +2010-04-03 Aidan Kehoe + + * lispref/hash-tables.texi (Introduction to Hash Tables): + Document that we now support #'equalp as a hash table test by + default, and mention #'define-hash-table-test. + (Working With Hash Tables): Document #'define-hash-table-test. + +2010-04-01 Aidan Kehoe + + * lispref/lists.texi (Rearrangement): + Update the documentation of #'sort here, now that it accepts any + type of sequence and the KEY keyword argument. (Though this is + probably now the wrong place for this function, given that.) + +2010-02-22 Ben Wing + + * internals/internals.texi (A Summary of the Various XEmacs Modules): + * internals/internals.texi (Modules for other Display-Related Lisp Objects): + objects*.[ch] -> fontcolor*.[ch]. + +2010-03-18 Mike Sperber + + * xemacs/startup.texi (Startup Paths): Reflect the (long-ago) + change from `lib' to `share' for the architecture-independent + directories. + +2010-03-13 Ben Wing + + * internals/internals.texi (Working with Lisp Objects): + * internals/internals.texi (Writing Macros): + * internals/internals.texi (lrecords): + More rewriting to correspond with changes from + *LRECORD* to *LISP_OBJECT*. + +2010-03-05 Ben Wing + + * internals/internals.texi (Introduction to Allocation): + * internals/internals.texi (Integers and Characters): + * internals/internals.texi (Allocation from Frob Blocks): + * internals/internals.texi (lrecords): + * internals/internals.texi (Low-level allocation): + Rewrite section on allocation of Lisp objects to reflect the new + reality. Remove references to nonexistent XSETINT and XSETCHAR. + +2010-03-04 Ben Wing + + * internals/internals.texi (Top): + * internals/internals.texi (list-to-texinfo): Removed. + * internals/internals.texi (convert-list-to-texinfo): New. + * internals/internals.texi (table-to-texinfo): Removed. + * internals/internals.texi (convert-table-to-texinfo): New. + Update Lisp functions at top to newest versions. + + * internals/internals.texi (A History of Emacs): + * internals/internals.texi (Through Version 18): + * internals/internals.texi (Lucid Emacs): + * internals/internals.texi (XEmacs): + * internals/internals.texi (The XEmacs Split): + * internals/internals.texi (Modules for Other Aspects of the Lisp Interpreter and Object System): + * internals/internals.texi (Introduction to Writing C Code): + * internals/internals.texi (Writing Good Comments): + * internals/internals.texi (Writing Macros): + * internals/internals.texi (Major Textual Changes): + * internals/internals.texi (Great Integral Type Renaming): + * internals/internals.texi (How to Regression-Test): + * internals/internals.texi (Creating a Branch): + * internals/internals.texi (Dynamic Arrays): + * internals/internals.texi (Allocation by Blocks): + * internals/internals.texi (mark_object): + * internals/internals.texi (gc_sweep): + * internals/internals.texi (Byte-Char Position Conversion): + * internals/internals.texi (Searching and Matching): + * internals/internals.texi (Introduction to Multilingual Issues #3): + * internals/internals.texi (Byte Types): + * internals/internals.texi (Different Ways of Seeing Internal Text): + * internals/internals.texi (Buffer Positions): + * internals/internals.texi (Basic internal-format APIs): + * internals/internals.texi (The DFC API): + * internals/internals.texi (General Guidelines for Writing Mule-Aware Code): + * internals/internals.texi (Mule-izing Code): + * internals/internals.texi (Locales): + * internals/internals.texi (More about code pages): + * internals/internals.texi (More about locales): + * internals/internals.texi (Unicode support under Windows): + * internals/internals.texi (The Frame): + * internals/internals.texi (The Non-Client Area): + * internals/internals.texi (The Client Area): + * internals/internals.texi (The Paned Area): + * internals/internals.texi (Text Areas): + * internals/internals.texi (The Displayable Area): + * internals/internals.texi (Event Queues): + * internals/internals.texi (Event Stream Callback Routines): + * internals/internals.texi (Focus Handling): + * internals/internals.texi (Future Work -- Autodetection): + Replace " with ``, '' (not complete, maybe about halfway through). + +2010-03-03 Ben Wing + + * internals/internals.texi (Intro to Window and Frame Geometry): + * internals/internals.texi (The Paned Area): + * internals/internals.texi (The Displayable Area): + Update to make note of e.g. the fact that the bottom gutter is + actually above the minibuffer. + +2010-03-02 Jerry James + + * custom.texi: Delete, redundant with xemacs/custom.texi and + lispref/customize.texi. + * Makefile: Remove all rules relating to custom.texi. + +2010-03-03 Aidan Kehoe + + * lispref/tips.texi (Comment Tips): + * lispref/text.texi (Text Properties): + * lispref/strings.texi (Creating Strings): + * lispref/processes.texi (Input to Processes): + * lispref/functions.texi (Argument List): + * lispref/extents.texi (Duplicable Extents): + Move examples that used substring to using subseq; in + strings.texi, do not change the examples, but document that in + this XEmacs, it is an alias for subseq, and that there may be some + incompatibilities if you depend on that. + +2010-02-25 Didier Verna + + The background-placement face property. + * xemacs/custom.texi (Faces): Document it. + +2010-02-20 Ben Wing + + * internals/internals.texi (Intro to Window and Frame Geometry): + Shrink diagram to fit when offset by five spaces as a result of + quoting. + +2010-02-16 Ben Wing + + * internals/internals.texi (Top): + * internals/internals.texi (Modules for the Basic Displayable Lisp Objects): + * internals/internals.texi (Creating a Window-System Type): + * internals/internals.texi (Window and Frame Geometry): + * internals/internals.texi (Intro to Window and Frame Geometry): + * internals/internals.texi (The Frame): + * internals/internals.texi (The Non-Client Area): + * internals/internals.texi (The Client Area): + * internals/internals.texi (The Paned Area): + * internals/internals.texi (Text Areas): + * internals/internals.texi (The Displayable Area): + * internals/internals.texi (Which Functions Use Which?): + * internals/internals.texi (The Redisplay Mechanism): + Integrate the long comment in frame.c into the internals manual. + +2010-02-17 Jerry James + + * term.texi: Move to the eterm package. + * Makefile: Remove all rules relating to term.texi. + 2010-02-19 Ben Wing * widget.texi: @@ -6589,3 +6945,23 @@ * emacs.tex: Update information for obtaining TeX distribution from the University of Washington. + + +ChangeLog entries synched from GNU Emacs are the property of the FSF. +Other ChangeLog entries are usually the property of the author of the +change. + +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 3 of the License, 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. If not, see . diff -r 861f2601a38b -r 1f0b15040456 man/beta.texi --- a/man/beta.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/beta.texi Sun May 01 18:44:03 2011 +0100 @@ -23,10 +23,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -34,10 +34,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. -@end ifinfo +along with XEmacs. If not, see .@end ifinfo @c Combine indices. @syncodeindex fn cp diff -r 861f2601a38b -r 1f0b15040456 man/cl.texi --- a/man/cl.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/cl.texi Sun May 01 18:44:03 2011 +0100 @@ -381,14 +381,14 @@ Instead, this package defines alternates for several Lisp forms which you must use if you need Common Lisp argument lists. -@defspec defun* name arglist body... +@deffn {Special Operator} defun* name arglist body... This form is identical to the regular @code{defun} form, except that @var{arglist} is allowed to be a full Common Lisp argument list. Also, the function body is enclosed in an implicit block called @var{name}; @pxref{Blocks and Exits}. -@end defspec - -@defspec defsubst* name arglist body... +@end deffn + +@deffn {Special Operator} defsubst* name arglist body... This is just like @code{defun*}, except that the function that is defined is automatically proclaimed @code{inline}, i.e., calls to it may be expanded into in-line code by the byte compiler. @@ -398,9 +398,9 @@ efficient inline expansions. In particular, @code{defsubst*} arranges for the processing of keyword arguments, default values, etc., to be done at compile-time whenever possible. -@end defspec - -@defspec defmacro* name arglist body... +@end deffn + +@deffn {Special Operator} defmacro* name arglist body... This is identical to the regular @code{defmacro} form, except that @var{arglist} is allowed to be a full Common Lisp argument list. The @code{&environment} keyword is supported as @@ -409,13 +409,13 @@ cannot be implemented with the current Emacs Lisp interpreter. The macro expander body is enclosed in an implicit block called @var{name}. -@end defspec - -@defspec function* symbol-or-lambda +@end deffn + +@deffn {Special Operator} function* symbol-or-lambda This is identical to the regular @code{function} form, except that if the argument is a @code{lambda} form then that form may use a full Common Lisp argument list. -@end defspec +@end deffn Also, all forms (such as @code{defsetf} and @code{flet}) defined in this package that include @var{arglist}s in their syntax allow @@ -606,7 +606,7 @@ at compile-time so that later parts of the file can refer to the macros that are defined. -@defspec eval-when (situations...) forms... +@deffn {Special Operator} eval-when (situations...) forms... This form controls when the body @var{forms} are evaluated. The @var{situations} list may contain any set of the symbols @code{compile}, @code{load}, and @code{eval} (or their long-winded @@ -678,7 +678,7 @@ certain top-level forms, like @code{defmacro} (sort-of) and @code{require}, as if they were wrapped in @code{(eval-when (compile load eval) @dots{})}. -@end defspec +@end deffn Emacs 19 includes two special operators related to @code{eval-when}. One of these, @code{eval-when-compile}, is not quite equivalent to @@ -690,7 +690,7 @@ equivalent to @samp{(eval-when (compile load eval) @dots{})} and so is not itself defined by this package. -@defspec eval-when-compile forms... +@deffn {Special Operator} eval-when-compile forms... The @var{forms} are evaluated at compile-time; at execution time, this form acts like a quoted constant of the resulting value. Used at top-level, @code{eval-when-compile} is just like @samp{eval-when @@ -699,9 +699,9 @@ or other reasons. This form is similar to the @samp{#.} syntax of true Common Lisp. -@end defspec - -@defspec load-time-value form +@end deffn + +@deffn {Special Operator} load-time-value form The @var{form} is evaluated at load-time; at execution time, this form acts like a quoted constant of the resulting value. @@ -742,7 +742,7 @@ ", and loaded on: " --temp--)) @end example -@end defspec +@end deffn @node Function Aliases, , Time of Evaluation, Program Structure @section Function Aliases @@ -869,7 +869,7 @@ error. @end defun -@defspec deftype name arglist forms... +@deffn {Special Operator} deftype name arglist forms... This macro defines a new type called @var{name}. It is similar to @code{defmacro} in many ways; when @var{name} is encountered as a type name, the body @var{forms} are evaluated and should @@ -897,7 +897,7 @@ The last example shows how the Common Lisp @code{unsigned-byte} type specifier could be implemented if desired; this package does not implement @code{unsigned-byte} by default. -@end defspec +@end deffn The @code{typecase} and @code{check-type} macros also use type names. @xref{Conditionals}. @xref{Assertions}. The @code{map}, @@ -989,7 +989,7 @@ The @code{psetq} form is just like @code{setq}, except that multiple assignments are done in parallel rather than sequentially. -@defspec psetq [symbol form]@dots{} +@deffn {Special Operator} psetq [symbol form]@dots{} This macro is used to assign to several variables simultaneously. Given only one @var{symbol} and @var{form}, it has the same effect as @code{setq}. Given several @var{symbol} @@ -1017,7 +1017,7 @@ @pxref{Modify Macros}.) @code{psetq} always returns @code{nil}. -@end defspec +@end deffn @node Generalized Variables, Variable Bindings, Assignment, Control Structure @section Generalized Variables @@ -1055,7 +1055,7 @@ The @code{setf} macro is the most basic way to operate on generalized variables. -@defspec setf [place form]@dots{} +@deffn {Special Operator} setf [place form]@dots{} This macro evaluates @var{form} and stores it in @var{place}, which must be a valid generalized variable form. If there are several @var{place} and @var{form} pairs, the assignments are done sequentially @@ -1218,7 +1218,7 @@ the form @code{(setf (wrong-order @var{a} @var{b}) 17)} will evaluate @var{b} first, then @var{a}, just as in an actual call to @code{wrong-order}. -@end defspec +@end deffn @node Modify Macros, Customizing Setf, Basic Setf, Generalized Variables @subsection Modify Macros @@ -1228,15 +1228,15 @@ that operate on generalized variables. Many are interesting and useful even when the @var{place} is just a variable name. -@defspec psetf [place form]@dots{} +@deffn {Special Operator} psetf [place form]@dots{} This macro is to @code{setf} what @code{psetq} is to @code{setq}: When several @var{place}s and @var{form}s are involved, the assignments take place in parallel rather than sequentially. Specifically, all subforms are evaluated from left to right, then all the assignments are done (in an undefined order). -@end defspec - -@defspec incf place &optional x +@end deffn + +@deffn {Special Operator} incf place &optional x This macro increments the number stored in @var{place} by one, or by @var{x} if specified. The incremented value is returned. For example, @code{(incf i)} is equivalent to @code{(setq i (1+ i))}, and @@ -1274,35 +1274,35 @@ As a more Emacs-specific example of @code{incf}, the expression @code{(incf (point) @var{n})} is essentially equivalent to @code{(forward-char @var{n})}. -@end defspec - -@defspec decf place &optional x +@end deffn + +@deffn {Special Operator} decf place &optional x This macro decrements the number stored in @var{place} by one, or by @var{x} if specified. -@end defspec - -@defspec pop place +@end deffn + +@deffn {Special Operator} pop place This macro removes and returns the first element of the list stored in @var{place}. It is analogous to @code{(prog1 (car @var{place}) (setf @var{place} (cdr @var{place})))}, except that it takes care to evaluate all subforms only once. -@end defspec - -@defspec push x place +@end deffn + +@deffn {Special Operator} push x place This macro inserts @var{x} at the front of the list stored in @var{place}. It is analogous to @code{(setf @var{place} (cons @var{x} @var{place}))}, except for evaluation of the subforms. -@end defspec - -@defspec pushnew x place @t{&key :test :test-not :key} +@end deffn + +@deffn {Special Operator} pushnew x place @t{&key :test :test-not :key} This macro inserts @var{x} at the front of the list stored in @var{place}, but only if @var{x} was not @code{eql} to any existing element of the list. The optional keyword arguments are interpreted in the same way as for @code{adjoin}. @xref{Lists as Sets}. -@end defspec - -@defspec shiftf place@dots{} newvalue +@end deffn + +@deffn {Special Operator} shiftf place@dots{} newvalue This macro shifts the @var{place}s left by one, shifting in the value of @var{newvalue} (which may be any Lisp expression, not just a generalized variable), and returning the value shifted out of @@ -1320,9 +1320,9 @@ @noindent except that the subforms of @var{a}, @var{b}, and @var{c} are actually evaluated only once each and in the apparent order. -@end defspec - -@defspec rotatef place@dots{} +@end deffn + +@deffn {Special Operator} rotatef place@dots{} This macro rotates the @var{place}s left by one in circular fashion. Thus, @code{(rotatef @var{a} @var{b} @var{c} @var{d})} is equivalent to @@ -1337,12 +1337,12 @@ except for the evaluation of subforms. @code{rotatef} always returns @code{nil}. Note that @code{(rotatef @var{a} @var{b})} conveniently exchanges @var{a} and @var{b}. -@end defspec +@end deffn The following macros were invented for this package; they have no analogues in Common Lisp. -@defspec letf (bindings@dots{}) forms@dots{} +@deffn {Special Operator} letf (bindings@dots{}) forms@dots{} This macro is analogous to @code{let}, but for generalized variables rather than just symbols. Each @var{binding} should be of the form @code{(@var{place} @var{value})}; the original contents of the @@ -1392,14 +1392,14 @@ variables and calls to @code{symbol-value} and @code{symbol-function}. If the symbol is not bound on entry, it is simply made unbound by @code{makunbound} or @code{fmakunbound} on exit. -@end defspec - -@defspec letf* (bindings@dots{}) forms@dots{} +@end deffn + +@deffn {Special Operator} letf* (bindings@dots{}) forms@dots{} This macro is to @code{letf} what @code{let*} is to @code{let}: It does the bindings in sequential rather than parallel order. -@end defspec - -@defspec callf @var{function} @var{place} @var{args}@dots{} +@end deffn + +@deffn {Special Operator} callf @var{function} @var{place} @var{args}@dots{} This is the ``generic'' modify macro. It calls @var{function}, which should be an unquoted function name, macro name, or lambda. It passes @var{place} and @var{args} as arguments, and assigns the @@ -1416,14 +1416,14 @@ @xref{Customizing Setf}, for @code{define-modify-macro}, a way to create even more concise notations for modify macros. Note again that @code{callf} is an extension to standard Common Lisp. -@end defspec - -@defspec callf2 @var{function} @var{arg1} @var{place} @var{args}@dots{} +@end deffn + +@deffn {Special Operator} callf2 @var{function} @var{arg1} @var{place} @var{args}@dots{} This macro is like @code{callf}, except that @var{place} is the @emph{second} argument of @var{function} rather than the first. For example, @code{(push @var{x} @var{place})} is equivalent to @code{(callf2 cons @var{x} @var{place})}. -@end defspec +@end deffn The @code{callf} and @code{callf2} macros serve as building blocks for other macros like @code{incf}, @code{pushnew}, and @@ -1439,7 +1439,7 @@ @code{defsetf}, and @code{define-setf-method}, that allow the user to extend generalized variables in various ways. -@defspec define-modify-macro name arglist function [doc-string] +@deffn {Special Operator} define-modify-macro name arglist function [doc-string] This macro defines a ``read-modify-write'' macro similar to @code{incf} and @code{decf}. The macro @var{name} is defined to take a @var{place} argument followed by additional arguments @@ -1480,9 +1480,9 @@ using @code{get-setf-method}, or consult the source file @file{cl-macs.el} to see how to use the internal @code{setf} building blocks. -@end defspec - -@defspec defsetf access-fn update-fn +@end deffn + +@deffn {Special Operator} defsetf access-fn update-fn This is the simpler of two @code{defsetf} forms. Where @var{access-fn} is the name of a function which accesses a place, this declares @var{update-fn} to be the corresponding store @@ -1525,9 +1525,9 @@ (defsetf symbol-value set) (defsetf buffer-name rename-buffer t) @end example -@end defspec - -@defspec defsetf access-fn arglist (store-var) forms@dots{} +@end deffn + +@deffn {Special Operator} defsetf access-fn arglist (store-var) forms@dots{} This is the second, more complex, form of @code{defsetf}. It is rather like @code{defmacro} except for the additional @var{store-var} argument. The @var{forms} should return a Lisp form which stores @@ -1556,9 +1556,9 @@ (defsetf nth (n x) (store) (list 'setcar (list 'nthcdr n x) store)) @end example -@end defspec - -@defspec define-setf-method access-fn arglist forms@dots{} +@end deffn + +@deffn {Special Operator} define-setf-method access-fn arglist forms@dots{} This is the most general way to create new place forms. When a @code{setf} to @var{access-fn} with arguments described by @var{arglist} is expanded, the @var{forms} are evaluated and @@ -1603,7 +1603,7 @@ use this setf-method will optimize away most temporaries that turn out to be unnecessary, so there is little reason for the setf-method itself to optimize. -@end defspec +@end deffn @defun get-setf-method place &optional env This function returns the setf-method for @var{place}, by @@ -1669,7 +1669,7 @@ at compile-time. The @code{progv} form provides an easy way to bind variables whose names are computed at run-time. -@defspec progv symbols values forms@dots{} +@deffn {Special Operator} progv symbols values forms@dots{} This form establishes @code{let}-style variable bindings on a set of variables computed at run-time. The expressions @var{symbols} and @var{values} are evaluated, and must return lists @@ -1679,7 +1679,7 @@ are made unbound (as if by @code{makunbound}) inside the body. If @var{symbols} is shorter than @var{values}, the excess values are ignored. -@end defspec +@end deffn @node Lexical Bindings, Function Bindings, Dynamic Bindings, Variable Bindings @subsection Lexical Bindings @@ -1688,7 +1688,7 @@ The @dfn{CL} package defines the following macro which more closely follows the Common Lisp @code{let} form: -@defspec lexical-let (bindings@dots{}) forms@dots{} +@deffn {Special Operator} lexical-let (bindings@dots{}) forms@dots{} This form is exactly like @code{let} except that the bindings it establishes are purely lexical. Lexical bindings are similar to local variables in a language like C: Only the code physically @@ -1788,12 +1788,12 @@ The @code{lexical-let} form is an extension to Common Lisp. In true Common Lisp, all bindings are lexical unless declared otherwise. -@end defspec - -@defspec lexical-let* (bindings@dots{}) forms@dots{} +@end deffn + +@deffn {Special Operator} lexical-let* (bindings@dots{}) forms@dots{} This form is just like @code{lexical-let}, except that the bindings are made sequentially in the manner of @code{let*}. -@end defspec +@end deffn @node Function Bindings, Macro Bindings, Lexical Bindings, Variable Bindings @subsection Function Bindings @@ -1802,7 +1802,7 @@ These forms make @code{let}-like bindings to functions instead of variables. -@defspec flet (bindings@dots{}) forms@dots{} +@deffn {Special Operator} flet (bindings@dots{}) forms@dots{} This form establishes @code{let}-style bindings on the function cells of symbols rather than on the value cells. Each @var{binding} must be a list of the form @samp{(@var{name} @var{arglist} @@ -1841,14 +1841,14 @@ argument notation supported by @code{defun*}; also, the function body is enclosed in an implicit block as if by @code{defun*}. @xref{Program Structure}. -@end defspec - -@defspec labels (bindings@dots{}) forms@dots{} +@end deffn + +@deffn {Special Operator} labels (bindings@dots{}) forms@dots{} The @code{labels} form is a synonym for @code{flet}. (In Common Lisp, @code{labels} and @code{flet} differ in ways that depend on their lexical scoping; these distinctions vanish in dynamically scoped Emacs Lisp.) -@end defspec +@end deffn @node Macro Bindings, , Function Bindings, Variable Bindings @subsection Macro Bindings @@ -1856,7 +1856,7 @@ @noindent These forms create local macros and ``symbol macros.'' -@defspec macrolet (bindings@dots{}) forms@dots{} +@deffn {Special Operator} macrolet (bindings@dots{}) forms@dots{} This form is analogous to @code{flet}, but for macros instead of functions. Each @var{binding} is a list of the same form as the arguments to @code{defmacro*} (i.e., a macro name, argument list, @@ -1868,9 +1868,9 @@ affect only calls that appear physically within the body @var{forms}, possibly after expansion of other macros in the body. -@end defspec - -@defspec symbol-macrolet (bindings@dots{}) forms@dots{} +@end deffn + +@deffn {Special Operator} symbol-macrolet (bindings@dots{}) forms@dots{} This form creates @dfn{symbol macros}, which are macros that look like variable references rather than function calls. Each @var{binding} is a list @samp{(@var{var} @var{expansion})}; @@ -1935,7 +1935,7 @@ @xref{Loop Facility}, for a description of the @code{loop} macro. This package defines a nonstandard @code{in-ref} loop clause that works much like @code{my-dolist}. -@end defspec +@end deffn @node Conditionals, Blocks and Exits, Variable Bindings, Control Structure @section Conditionals @@ -1944,7 +1944,7 @@ These conditional forms augment Emacs Lisp's simple @code{if}, @code{and}, @code{or}, and @code{cond} forms. -@defspec when test forms@dots{} +@deffn {Special Operator} when test forms@dots{} This is a variant of @code{if} where there are no ``else'' forms, and possibly several ``then'' forms. In particular, @@ -1958,9 +1958,9 @@ @example (if @var{test} (progn @var{a} @var{b} @var{c}) nil) @end example -@end defspec - -@defspec unless test forms@dots{} +@end deffn + +@deffn {Special Operator} unless test forms@dots{} This is a variant of @code{if} where there are no ``then'' forms, and possibly several ``else'' forms: @@ -1974,9 +1974,9 @@ @example (when (not @var{test}) @var{a} @var{b} @var{c}) @end example -@end defspec - -@defspec case keyform clause@dots{} +@end deffn + +@deffn {Special Operator} case keyform clause@dots{} This macro evaluates @var{keyform}, then compares it with the key values listed in the various @var{clause}s. Whichever clause matches the key is executed; comparison is done by @code{eql}. If no clause @@ -2010,15 +2010,15 @@ ((?\r ?\n) (do-ret-thing)) (t (do-other-thing))) @end example -@end defspec - -@defspec ecase keyform clause@dots{} +@end deffn + +@deffn {Special Operator} ecase keyform clause@dots{} This macro is just like @code{case}, except that if the key does not match any of the clauses, an error is signalled rather than simply returning @code{nil}. -@end defspec - -@defspec typecase keyform clause@dots{} +@end deffn + +@deffn {Special Operator} typecase keyform clause@dots{} This macro is a version of @code{case} that checks for types rather than values. Each @var{clause} is of the form @samp{(@var{type} @var{body}...)}. @xref{Type Predicates}, @@ -2035,13 +2035,13 @@ The type specifier @code{t} matches any type of object; the word @code{otherwise} is also allowed. To make one clause match any of several types, use an @code{(or ...)} type specifier. -@end defspec - -@defspec etypecase keyform clause@dots{} +@end deffn + +@deffn {Special Operator} etypecase keyform clause@dots{} This macro is just like @code{typecase}, except that if the key does not match any of the clauses, an error is signalled rather than simply returning @code{nil}. -@end defspec +@end deffn @node Blocks and Exits, Iteration, Conditionals, Control Structure @section Blocks and Exits @@ -2054,7 +2054,7 @@ optimizing byte-compiler to omit the costly @code{catch} step if the body of the block does not actually @code{return-from} the block. -@defspec block name forms@dots{} +@deffn {Special Operator} block name forms@dots{} The @var{forms} are evaluated as if by a @code{progn}. However, if any of the @var{forms} execute @code{(return-from @var{name})}, they will jump out and return directly from the @code{block} form. @@ -2093,20 +2093,20 @@ that jump to it. This means that @code{do} loops and @code{defun*} functions which don't use @code{return} don't pay the overhead to support it. -@end defspec - -@defspec return-from name [result] +@end deffn + +@deffn {Special Operator} return-from name [result] This macro returns from the block named @var{name}, which must be an (unevaluated) symbol. If a @var{result} form is specified, it is evaluated to produce the result returned from the @code{block}. Otherwise, @code{nil} is returned. -@end defspec - -@defspec return [result] +@end deffn + +@deffn {Special Operator} return [result] This macro is exactly like @code{(return-from nil @var{result})}. Common Lisp loops like @code{do} and @code{dolist} implicitly enclose themselves in @code{nil} blocks. -@end defspec +@end deffn @node Iteration, Loop Facility, Blocks and Exits, Control Structure @section Iteration @@ -2116,7 +2116,7 @@ looping constructs to complement Emacs Lisp's basic @code{while} loop. -@defspec loop forms@dots{} +@deffn {Special Operator} loop forms@dots{} The @dfn{CL} package supports both the simple, old-style meaning of @code{loop} and the extremely powerful and flexible feature known as the @dfn{Loop Facility} or @dfn{Loop Macro}. This more advanced @@ -2144,9 +2144,9 @@ (This is not a restriction in practice, since a plain symbol in the above notation would simply access and throw away the value of a variable.) -@end defspec - -@defspec do (spec@dots{}) (end-test [result@dots{}]) forms@dots{} +@end deffn + +@deffn {Special Operator} do (spec@dots{}) (end-test [result@dots{}]) forms@dots{} This macro creates a general iterative loop. Each @var{spec} is of the form @@ -2192,9 +2192,9 @@ ((or (null x) (null y)) (nreverse z))) @end example -@end defspec - -@defspec do* (spec@dots{}) (end-test [result@dots{}]) forms@dots{} +@end deffn + +@deffn {Special Operator} do* (spec@dots{}) (end-test [result@dots{}]) forms@dots{} This is to @code{do} what @code{let*} is to @code{let}. In particular, the initial values are bound as if by @code{let*} rather than @code{let}, and the steps are assigned as if by @@ -2212,18 +2212,18 @@ (nreverse z)) (push (f x y) z)) @end example -@end defspec - -@defspec dolist (var list [result]) forms@dots{} +@end deffn + +@deffn {Special Operator} dolist (var list [result]) forms@dots{} This is a more specialized loop which iterates across the elements of a list. @var{list} should evaluate to a list; the body @var{forms} are executed with @var{var} bound to each element of the list in turn. Finally, the @var{result} form (or @code{nil}) is evaluated with @var{var} bound to @code{nil} to produce the result returned by the loop. The loop is surrounded by an implicit @code{nil} block. -@end defspec - -@defspec dotimes (var count [result]) forms@dots{} +@end deffn + +@deffn {Special Operator} dotimes (var count [result]) forms@dots{} This is a more specialized loop which iterates a specified number of times. The body is executed with @var{var} bound to the integers from zero (inclusive) to @var{count} (exclusive), in turn. Then @@ -2231,9 +2231,9 @@ number of iterations that were done (i.e., @code{(max 0 @var{count})}) to get the return value for the loop form. The loop is surrounded by an implicit @code{nil} block. -@end defspec - -@defspec do-symbols (var [obarray [result]]) forms@dots{} +@end deffn + +@deffn {Special Operator} do-symbols (var [obarray [result]]) forms@dots{} This loop iterates over all interned symbols. If @var{obarray} is specified and is not @code{nil}, it loops over all symbols in that obarray. For each symbol, the body @var{forms} are evaluated @@ -2241,12 +2241,12 @@ an unspecified order. Afterward the @var{result} form, if any, is evaluated (with @var{var} bound to @code{nil}) to get the return value. The loop is surrounded by an implicit @code{nil} block. -@end defspec - -@defspec do-all-symbols (var [result]) forms@dots{} +@end deffn + +@deffn {Special Operator} do-all-symbols (var [result]) forms@dots{} This is identical to @code{do-symbols} except that the @var{obarray} argument is omitted; it always iterates over the default obarray. -@end defspec +@end deffn @xref{Mapping over Sequences}, for some more functions for iterating over vectors or lists. @@ -2286,7 +2286,7 @@ takes place at byte-compile time; compiled @code{loop}s are just as efficient as the equivalent @code{while} loops written longhand. -@defspec loop clauses@dots{} +@deffn {Special Operator} loop clauses@dots{} A loop construct consists of a series of @var{clause}s, each introduced by a symbol like @code{for} or @code{do}. Clauses are simply strung together in the argument list of @code{loop}, @@ -2325,7 +2325,7 @@ (Because the loop body is enclosed in an implicit block, you can also use regular Lisp @code{return} or @code{return-from} to break out of the loop.) -@end defspec +@end deffn The following sections give some examples of the Loop Macro in action, and describe the particular loop clauses in great detail. @@ -2987,44 +2987,8 @@ @node Multiple Values, , Loop Facility, Control Structure @section Multiple Values -@noindent -Common Lisp functions can return zero or more results. Emacs Lisp -functions, by contrast, always return exactly one result. This -package makes no attempt to emulate Common Lisp multiple return -values; Emacs versions of Common Lisp functions that return more -than one value either return just the first value (as in -@code{compiler-macroexpand}) or return a list of values (as in -@code{get-setf-method}). This package @emph{does} define placeholders -for the Common Lisp functions that work with multiple values, but -in Emacs Lisp these functions simply operate on lists instead. -The @code{values} form, for example, is a synonym for @code{list} -in Emacs. - -@defspec multiple-value-bind (var@dots{}) values-form forms@dots{} -This form evaluates @var{values-form}, which must return a list of -values. It then binds the @var{var}s to these respective values, -as if by @code{let}, and then executes the body @var{forms}. -If there are more @var{var}s than values, the extra @var{var}s -are bound to @code{nil}. If there are fewer @var{var}s than -values, the excess values are ignored. -@end defspec - -@defspec multiple-value-setq (var@dots{}) form -This form evaluates @var{form}, which must return a list of values. -It then sets the @var{var}s to these respective values, as if by -@code{setq}. Extra @var{var}s or values are treated the same as -in @code{multiple-value-bind}. -@end defspec - -The older Quiroz package attempted a more faithful (but still -imperfect) emulation of Common Lisp multiple values. The old -method ``usually'' simulated true multiple values quite well, -but under certain circumstances would leave spurious return -values in memory where a later, unrelated @code{multiple-value-bind} -form would see them. - -Since a perfect emulation is not feasible in Emacs Lisp, this -package opts to keep it as simple and predictable as possible. +This functionality has been moved to core XEmacs, and is documented in +the XEmacs Lisp reference, @pxref{(lispref.info)Multiple values}. @node Macros, Declarations, Control Structure, Top @chapter Macros @@ -3039,7 +3003,7 @@ Destructuring is made available to the user by way of the following macro: -@defspec destructuring-bind arglist expr forms@dots{} +@deffn {Special Operator} destructuring-bind arglist expr forms@dots{} This macro expands to code which executes @var{forms}, with the variables in @var{arglist} bound to the list of values returned by @var{expr}. The @var{arglist} can include all @@ -3048,13 +3012,13 @@ is not allowed.) The macro expansion will signal an error if @var{expr} returns a list of the wrong number of arguments or with incorrect keyword arguments. -@end defspec +@end deffn This package also includes the Common Lisp @code{define-compiler-macro} facility, which allows you to define compile-time expansions and optimizations for your functions. -@defspec define-compiler-macro name arglist forms@dots{} +@deffn {Special Operator} define-compiler-macro name arglist forms@dots{} This form is similar to @code{defmacro}, except that it only expands calls to @var{name} at compile-time; calls processed by the Lisp interpreter are not expanded, nor are they expanded by the @@ -3088,7 +3052,7 @@ @code{member*} call is left intact. (The actual compiler macro for @code{member*} optimizes a number of other cases, including common @code{:test} predicates.) -@end defspec +@end deffn @defun compiler-macroexpand form This function is analogous to @code{macroexpand}, except that it @@ -3130,7 +3094,7 @@ is evaluated and thus should normally be quoted. @end defun -@defspec declaim decl-specs@dots{} +@deffn {Special Operator} declaim decl-specs@dots{} This macro is like @code{proclaim}, except that it takes any number of @var{decl-spec} arguments, and the arguments are unevaluated and unquoted. The @code{declaim} macro also puts an @code{(eval-when @@ -3139,22 +3103,22 @@ since normally the declarations are meant to influence the way the compiler treats the rest of the file that contains the @code{declaim} form.) -@end defspec - -@defspec declare decl-specs@dots{} +@end deffn + +@deffn {Special Operator} declare decl-specs@dots{} This macro is used to make declarations within functions and other code. Common Lisp allows declarations in various locations, generally at the beginning of any of the many ``implicit @code{progn}s'' throughout Lisp syntax, such as function bodies, @code{let} bodies, etc. Currently the only declaration understood by @code{declare} is @code{special}. -@end defspec - -@defspec locally declarations@dots{} forms@dots{} +@end deffn + +@deffn {Special Operator} locally declarations@dots{} forms@dots{} In this package, @code{locally} is no different from @code{progn}. -@end defspec - -@defspec the type form +@end deffn + +@deffn {Special Operator} the type form Type information provided by @code{the} is ignored in this package; in other words, @code{(the @var{type} @var{form})} is equivalent to @var{form}. Future versions of the optimizing byte-compiler may @@ -3167,7 +3131,7 @@ compiler would have enough information to expand the loop in-line. For now, Emacs Lisp will treat the above code as exactly equivalent to @code{(mapcar 'car foo)}. -@end defspec +@end deffn Each @var{decl-spec} in a @code{proclaim}, @code{declaim}, or @code{declare} should be a list beginning with a symbol that says @@ -3349,7 +3313,7 @@ expression. @end defun -@defspec remf place property +@deffn {Special Operator} remf place property This macro removes the property-value pair for @var{property} from the property list stored at @var{place}, which is any @code{setf}-able place expression. It returns true if the property was found. Note @@ -3357,7 +3321,7 @@ effectively do a @code{(setf @var{place} (cddr @var{place}))}, whereas if it occurs later, this simply uses @code{setcdr} to splice out the property and value cells. -@end defspec +@end deffn @iftex @secno=2 @@ -3506,58 +3470,6 @@ square root of the argument. @end defun -@defun floor* number &optional divisor -This function implements the Common Lisp @code{floor} function. -It is called @code{floor*} to avoid name conflicts with the -simpler @code{floor} function built-in to Emacs 19. - -With one argument, @code{floor*} returns a list of two numbers: -The argument rounded down (toward minus infinity) to an integer, -and the ``remainder'' which would have to be added back to the -first return value to yield the argument again. If the argument -is an integer @var{x}, the result is always the list @code{(@var{x} 0)}. -If the argument is an Emacs 19 floating-point number, the first -result is a Lisp integer and the second is a Lisp float between -0 (inclusive) and 1 (exclusive). - -With two arguments, @code{floor*} divides @var{number} by -@var{divisor}, and returns the floor of the quotient and the -corresponding remainder as a list of two numbers. If -@code{(floor* @var{x} @var{y})} returns @code{(@var{q} @var{r})}, -then @code{@var{q}*@var{y} + @var{r} = @var{x}}, with @var{r} -between 0 (inclusive) and @var{r} (exclusive). Also, note -that @code{(floor* @var{x})} is exactly equivalent to -@code{(floor* @var{x} 1)}. - -This function is entirely compatible with Common Lisp's @code{floor} -function, except that it returns the two results in a list since -Emacs Lisp does not support multiple-valued functions. -@end defun - -@defun ceiling* number &optional divisor -This function implements the Common Lisp @code{ceiling} function, -which is analogous to @code{floor} except that it rounds the -argument or quotient of the arguments up toward plus infinity. -The remainder will be between 0 and minus @var{r}. -@end defun - -@defun truncate* number &optional divisor -This function implements the Common Lisp @code{truncate} function, -which is analogous to @code{floor} except that it rounds the -argument or quotient of the arguments toward zero. Thus it is -equivalent to @code{floor*} if the argument or quotient is -positive, or to @code{ceiling*} otherwise. The remainder has -the same sign as @var{number}. -@end defun - -@defun round* number &optional divisor -This function implements the Common Lisp @code{round} function, -which is analogous to @code{floor} except that it rounds the -argument or quotient of the arguments to the nearest integer. -In the case of a tie (the argument or quotient is exactly -halfway between two integers), it rounds to the even integer. -@end defun - @defun mod* number divisor This function returns the same value as the second return value of @code{floor}. @@ -3568,7 +3480,24 @@ of @code{truncate}. @end defun -These definitions are compatible with those in the Quiroz +@noindent +The following functions are identical to their built-in counterparts, +without the trailing @code{*} in their names, but they return lists +instead of multiple values. @pxref{(lispref.info)Rounding Operations} + +@defun floor* number &optional divisor +@end defun + +@defun ceiling* number &optional divisor +@end defun + +@defun truncate* number &optional divisor +@end defun + +@defun round* number &optional divisor +@end defun + +All the above definitions are compatible with those in the Quiroz @file{cl.el} package, except that this package appends @samp{*} to certain function names to avoid conflicts with existing Emacs 19 functions, and that the mechanism for returning @@ -4748,7 +4677,7 @@ implements structures as vectors (or lists upon request) with a special ``tag'' symbol to identify them. -@defspec defstruct name slots@dots{} +@deffn {Special Operator} defstruct name slots@dots{} The @code{defstruct} form defines a new structure type called @var{name}, with the specified @var{slots}. (The @var{slots} may begin with a string which documents the structure type.) @@ -5055,7 +4984,7 @@ specifies a number of slots to be skipped between the last slot of the included type and the first new slot. @end table -@end defspec +@end deffn Except as noted, the @code{defstruct} facility of this package is entirely compatible with that of Common Lisp. @@ -5078,7 +5007,7 @@ away the following assertions. Because assertions might be optimized away, it is a bad idea for them to include side-effects. -@defspec assert test-form [show-args string args@dots{}] +@deffn {Special Operator} assert test-form [show-args string args@dots{}] This form verifies that @var{test-form} is true (i.e., evaluates to a non-@code{nil} value). If so, it returns @code{nil}. If the test is not satisfied, @code{assert} signals an error. @@ -5101,9 +5030,9 @@ true Common Lisp, the second argument gives a list of @var{places} which can be @code{setf}'d by the user before continuing from the error. -@end defspec - -@defspec check-type place type &optional string +@end deffn + +@deffn {Special Operator} check-type place type &optional string This form verifies that @var{place} evaluates to a value of type @var{type}. If so, it returns @code{nil}. If not, @code{check-type} signals a continuable @code{wrong-type-argument} error. The default @@ -5122,18 +5051,18 @@ should be a @var{place} suitable for use by @code{setf}, because @code{check-type} signals a continuable error that allows the user to modify @var{place}, most simply by returning a value from the debugger. -@end defspec +@end deffn The following error-related macro is also defined: -@defspec ignore-errors forms@dots{} +@deffn {Special Operator} ignore-errors forms@dots{} This executes @var{forms} exactly like a @code{progn}, except that errors are ignored during the @var{forms}. More precisely, if an error is signalled then @code{ignore-errors} immediately aborts execution of the @var{forms} and returns @code{nil}. If the @var{forms} complete successfully, @code{ignore-errors} returns the result of the last @var{form}. -@end defspec +@end deffn @node Efficiency Concerns, Common Lisp Compatibility, Assertions, Top @appendix Efficiency Concerns diff -r 861f2601a38b -r 1f0b15040456 man/custom.texi --- a/man/custom.texi Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,438 +0,0 @@ -\input texinfo.tex - -@c %**start of header -@setfilename ../info/custom.info -@settitle The Customization Library -@iftex -@afourpaper -@headings double -@end iftex -@c %**end of header - -@ifinfo -@dircategory XEmacs Editor -@direntry -* Customizations: (custom). Customization Library. -@end direntry -@end ifinfo - -@node Top, Declaring Groups, (dir), (dir) -@comment node-name, next, previous, up -@top The Customization Library - -This manual describes how to declare customization groups, variables, -and faces. It doesn't contain any examples, but please look at the file -@file{cus-edit.el} which contains many declarations you can learn from. - -@menu -* Declaring Groups:: -* Declaring Variables:: -* Declaring Faces:: -* Usage for Package Authors:: -* Utilities:: -* The Init File:: -* Wishlist:: -@end menu - -All the customization declarations can be changes by keyword arguments. -Groups, variables, and faces all share these common keywords: - -@table @code -@item :group -@var{value} should be a customization group. -Add @var{symbol} to that group. -@item :link -@var{value} should be a widget type. -Add @var{value} to the external links for this customization option. -Useful widget types include @code{custom-manual}, @code{info-link}, and -@code{url-link}. -@item :load -Add @var{value} to the files that should be loaded before displaying -this customization option. The value should be either a string, which -should be a string which will be loaded with @code{load-library} unless -present in @code{load-history}, or a symbol which will be loaded with -@code{require}. -@item :tag -@var{Value} should be a short string used for identifying the option in -customization menus and buffers. By default the tag will be -automatically created from the options name. -@end table - -@node Declaring Groups, Declaring Variables, Top, Top -@comment node-name, next, previous, up -@section Declaring Groups - -Use @code{defgroup} to declare new customization groups. - -@defun defgroup symbol members doc [keyword value]... -Declare @var{symbol} as a customization group containing @var{members}. -@var{symbol} does not need to be quoted. - -@var{doc} is the group documentation. - -@var{members} should be an alist of the form ((@var{name} -@var{widget})...) where @var{name} is a symbol and @var{widget} is a -widget for editing that symbol. Useful widgets are -@code{custom-variable} for editing variables, @code{custom-face} for -editing faces, and @code{custom-group} for editing groups.@refill - -Internally, custom uses the symbol property @code{custom-group} to keep -track of the group members, and @code{group-documentation} for the -documentation string. - -The following additional @var{keyword}'s are defined: - -@table @code -@item :prefix -@var{value} should be a string. If the string is a prefix for the name -of a member of the group, that prefix will be ignored when creating a -tag for that member. -@end table -@end defun - -@node Declaring Variables, Declaring Faces, Declaring Groups, Top -@comment node-name, next, previous, up -@section Declaring Variables - -Use @code{defcustom} to declare user editable variables. - -@defun defcustom symbol value doc [keyword value]... -Declare @var{symbol} as a customizable variable that defaults to @var{value}. -Neither @var{symbol} nor @var{value} needs to be quoted. -If @var{symbol} is not already bound, initialize it to @var{value}. - -@var{doc} is the variable documentation. - -The following additional @var{keyword}'s are defined: - -@table @code -@item :type -@var{value} should be a widget type. - -@item :options -@var{value} should be a list of possible members of the specified type. -For hooks, this is a list of function names. - -@item :initialize -@var{value} should be a function used to initialize the variable. It -takes two arguments, the symbol and value given in the @code{defcustom} call. -Some predefined functions are: - -@table @code -@item custom-initialize-set -Use the @code{:set} method to initialize the variable. Do not -initialize it if already bound. This is the default @code{:initialize} -method. - -@item custom-initialize-default -Always use @code{set-default} to initialize the variable, even if a -@code{:set} method has been specified. - -@item custom-initialize-reset -If the variable is already bound, reset it by calling the @code{:set} -method with the value returned by the @code{:get} method. - -@item custom-initialize-changed -Like @code{custom-initialize-reset}, but use @code{set-default} to -initialize the variable if it is not bound and has not been set -already. -@end table - -@item :set -@var{value} should be a function to set the value of the symbol. It -takes two arguments, the symbol to set and the value to give it. The -default is @code{set-default}. - -@item :get -@var{value} should be a function to extract the value of symbol. The -function takes one argument, a symbol, and should return the current -value for that symbol. The default is @code{default-value}. - -@item :require -@var{value} should be a feature symbol. Each feature will be required -when the `defcustom' is evaluated, or when Emacs is started if the user -has saved this option. - -@end table - -@xref{Sexp Types,,,widget,The Widget Library}, for information about -widgets to use together with the @code{:type} keyword. -@end defun - -Internally, custom uses the symbol property @code{custom-type} to keep -track of the variables type, @code{standard-value} for the program -specified default value, @code{saved-value} for a value saved by the -user, and @code{variable-documentation} for the documentation string. - -Use @code{custom-add-option} to specify that a specific function is -useful as a member of a hook. - -@defun custom-add-option symbol option -To the variable @var{symbol} add @var{option}. - -If @var{symbol} is a hook variable, @var{option} should be a hook -member. For other types of variables, the effect is undefined." -@end defun - -@node Declaring Faces, Usage for Package Authors, Declaring Variables, Top -@comment node-name, next, previous, up -@section Declaring Faces - -Faces are declared with @code{defface}. - -@defun defface face spec doc [keyword value]... - -Declare @var{face} as a customizable face that defaults to @var{spec}. -@var{face} does not need to be quoted. - -If @var{face} has been set with `custom-set-face', set the face attributes -as specified by that function, otherwise set the face attributes -according to @var{spec}. - -@var{doc} is the face documentation. - -@var{spec} should be an alist of the form @samp{((@var{display} @var{atts})...)}. - -@var{atts} is a list of face attributes and their values. The possible -attributes are defined in the variable `custom-face-attributes'. - -The @var{atts} of the first entry in @var{spec} where the @var{display} -matches the frame should take effect in that frame. @var{display} can -either be the symbol `t', which will match all frames, or an alist of -the form @samp{((@var{req} @var{item}...)...)}@refill - -For the @var{display} to match a FRAME, the @var{req} property of the -frame must match one of the @var{item}. The following @var{req} are -defined:@refill - -@table @code -@item type -(the value of (window-system))@* -Should be one of @code{x} or @code{tty}. - -@item class -(the frame's color support)@* -Should be one of @code{color}, @code{grayscale}, or @code{mono}. - -@item background -(what color is used for the background text)@* -Should be one of @code{light} or @code{dark}. -@end table - -Internally, custom uses the symbol property @code{face-defface-spec} for -the program specified default face properties, @code{saved-face} for -properties saved by the user, and @code{face-documentation} for the -documentation string.@refill - -@end defun - -@node Usage for Package Authors, Utilities, Declaring Faces, Top -@comment node-name, next, previous, up -@section Usage for Package Authors - -The recommended usage for the author of a typical emacs lisp package is -to create one group identifying the package, and make all user options -and faces members of that group. If the package has more than around 20 -such options, they should be divided into a number of subgroups, with -each subgroup being member of the top level group. - -The top level group for the package should itself be member of one or -more of the standard customization groups. There exists a group for -each @emph{finder} keyword. Press @kbd{C-h p} to see a list of finder -keywords, and add you group to each of them, using the @code{:group} -keyword. - -@node Utilities, The Init File, Usage for Package Authors, Top -@comment node-name, next, previous, up -@section Utilities - -These utilities can come in handy when adding customization support. - -@deffn Widget custom-manual -Widget type for specifying the info manual entry for a customization -option. It takes one argument, an info address. -@end deffn - -@defun custom-add-to-group group member widget -To existing @var{group} add a new @var{member} of type @var{widget}, -If there already is an entry for that member, overwrite it. -@end defun - -@defun custom-add-link symbol widget -To the custom option @var{symbol} add the link @var{widget}. -@end defun - -@defun custom-add-load symbol load -To the custom option @var{symbol} add the dependency @var{load}. -@var{load} should be either a library file name, or a feature name. -@end defun - -@defun customize-menu-create symbol &optional name -Create menu for customization group @var{symbol}. -If optional @var{name} is given, use that as the name of the menu. -Otherwise the menu will be named `Customize'. -The menu is in a format applicable to @code{easy-menu-define}. -@end defun - -@node The Init File, Wishlist, Utilities, Top -@comment node-name, next, previous, up -@section The Init File - -Customizations are saved to the file specified by @code{custom-file}, as -calls to @code{custom-set-variables} and @code{custom-set-faces}. - -When you save customizations, the current implementation removes the -calls to @code{custom-set-variables} and @code{custom-set-faces}, and -replaces them with code generated on the basis of the current -customization state in Emacs. - -By default @code{custom-file} is your @file{.emacs} file (for GNU Emacs -and older XEmacs) and is @file{custom.el} in the same directory as -@file{init.el} (in XEmacs 21.4 and later). If you use another file, you -must explicitly load it yourself. - -As of XEmacs 21.4.7, when @code{custom-file} is present, it is loaded -@emph{after} @file{init.el}. This is likely to change in the future, -because (1) actions in @file{init.el} often would like to depend on -customizations for consistent appearance and (2) Custom is quite brutal -about enforcing its idea of the correct values at initialization. - -@node Wishlist, , The Init File, Top -@comment node-name, next, previous, up -@section Wishlist - -@itemize @bullet -@item -Better support for keyboard operations in the customize buffer. - -@item -Integrate with @file{w3} so you can get customization buffers with much -better formatting. I'm thinking about adding a name -tag. The latest w3 have some support for this, so come up with a -convincing example. - -@item -Add an `examples' section, with explained examples of custom type -definitions. - -@item -Support selectable color themes. I.e., change many faces by setting one -variable. - -@item -Support undo using lmi's @file{gnus-undo.el}. - - -@item -Make it possible to append to `choice', `radio', and `set' options. - -@item -Ask whether set or modified variables should be saved in -@code{kill-buffer-hook}. - -Ditto for @code{kill-emacs-query-functions}. - -@item -Command to check if there are any customization options that -does not belong to an existing group. - -@item -Optionally disable the point-cursor and instead highlight the selected -item in XEmacs. This is like the *Completions* buffer in XEmacs. -Suggested by Jens Lautenbacher -@samp{}.@refill - -@item -Explain why it is necessary that all choices have different default -values. - -@item -Add some direct support for meta variables, i.e. make it possible to -specify that this variable should be reset when that variable is -changed. - -@item -Add tutorial. - -@item -Describe the @code{:type} syntax in this manual. - -@item -Find a place is this manual for the following text: - -@strong{Radio vs. Buttons} - -Use a radio if you can't find a good way to describe the item in the -choice menu text. I.e. it is better to use a radio if you expect the -user would otherwise manually select each item from the choice menu in -turn to see what it expands too. - -Avoid radios if some of the items expands to complex structures. - -I mostly use radios when most of the items are of type -@code{function-item} or @code{variable-item}. - -@item -Update customize buffers when @code{custom-set-variable} or -@code{custom-save-customized} is called. - -@item -Better handling of saved but uninitialized items. - -@item -Detect when faces have been changed outside customize. - -@item -Enable mouse help in Emacs by default. - -@item -Add an easy way to display the standard settings when an item is modified. - -@item -See if it is feasible to scan files for customization information -instead of loading them, - -@item -Add hint message when user push a non-pushable tag. - -Suggest that the user unhide if hidden, and edit the value directly -otherwise. - -@item -Use checkboxes and radio buttons in the state menus. - -@item -Add option to hide @samp{[hide]} for short options. Default, on. - -@item -Add option to hide @samp{[state]} for options with their standard -settings. - -@item -There should be a way to specify site defaults for user options. - -@item -There should be more buffer styles. The default `nested style, the old -`outline' style, a `numeric' style with numbers instead of stars, an -`empty' style with just the group name, and `compact' with only one line -per item. - -@item -Newline and tab should be displayed as @samp{^J} and @samp{^I} in the -@code{regexp} and @code{file} widgets. I think this can be done in -XEmacs by adding a display table to the face. - -@item -Use glyphs to draw the @code{customize-browse} tree. - -Add echo and balloon help. You should be able to read the documentation -simply by moving the mouse pointer above the name. - -Add parent links. - -Add colors. - -@end itemize - -@contents -@bye diff -r 861f2601a38b -r 1f0b15040456 man/external-widget.texi --- a/man/external-widget.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/external-widget.texi Sun May 01 18:44:03 2011 +0100 @@ -26,7 +26,7 @@ You should have received a copy of the GNU General Public License along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin St - Fifth Floor, +the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA. @end ifinfo diff -r 861f2601a38b -r 1f0b15040456 man/internals/internals.texi --- a/man/internals/internals.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/internals/internals.texi Sun May 01 18:44:03 2011 +0100 @@ -161,13 +161,13 @@ Note: to define these routines, put point after the end of the definition and type C-x C-e. -(defun list-to-texinfo (b e) +(defun convert-list-to-texinfo (b e) "Convert the selected region from an ASCII list to a Texinfo list." (interactive "r") (save-restriction (narrow-to-region b e) (goto-char (point-min)) - (let ((dash-type "^ *-+ +") + (let ((dash-type "^ *\\(-+\\|o\\) +") ;; allow single-letter numbering or roman numerals (letter-type "^ *[[(]?\\([a-zA-Z]\\|[IVXivx]+\\)[]).] +") (num-type "^ *[[(]?[0-9]+[]).] +") @@ -239,7 +239,7 @@ (forward-char min)) (kill-rectangle b (point)))))) -(defun table-to-texinfo (b e) +(defun convert-table-to-texinfo (b e) "Convert the selected region from an ASCII table to a Texinfo table. Assumes entries are separated by a blank line, and the first sexp in each entry is the table heading." @@ -283,20 +283,24 @@ in text: @code{} surrounded by ` and ' or followed by a (); @strong{} surrounded by *'s; @file{} something that looks like a file name." (interactive) - (if (and (not no-narrow) (region-active-p)) - (save-restriction - (narrow-to-region (region-beginning) (region-end)) - (convert-text-to-texinfo t)) - (let ((p (point)) - (case-replace nil)) - (query-replace-regexp "`\\([^']+\\)'\\([^']\\)" "@code{\\1}\\2" nil) - (goto-char p) - (query-replace-regexp "\\(\\Sw\\)\\*\\(\\(?:\\s_\\|\\sw\\)+\\)\\*\\([^A-Za-z.}]\\)" "\\1@strong{\\2}\\3" nil) - (goto-char p) - (query-replace-regexp "\\(\\(\\s_\\|\\sw\\)+()\\)\\([^}]\\)" "@code{\\1}\\3" nil) - (goto-char p) - (query-replace-regexp "\\(\\(\\s_\\|\\sw\\)+\\.[A-Za-z]+\\)\\([^A-Za-z.}]\\)" "@file{\\1}\\3" nil) - ))) + (save-excursion + (if (and (not no-narrow) (region-active-p)) + (save-restriction + (narrow-to-region (region-beginning) (region-end)) + (goto-char (region-beginning)) + (zmacs-deactivate-region) + (convert-text-to-texinfo t)) + (let ((p (point)) + (case-replace nil)) + (message "Point is %d" (point)) + (query-replace-regexp "`\\([^']+\\)'\\([^']\\)" "@code{\\1}\\2" nil) + (goto-char p) + (query-replace-regexp "\\(\\Sw\\)\\*\\(\\(?:\\s_\\|\\sw\\)+\\)\\*\\([^A-Za-z.}]\\)" "\\1@strong{\\2}\\3" nil) + (goto-char p) + (query-replace-regexp "\\(\\(\\s_\\|\\sw\\)+()\\)\\([^}]\\)" "@code{\\1}\\3" nil) + (goto-char p) + (query-replace-regexp "\\(\\(\\s_\\|\\sw\\)+\\.[A-Za-z]+\\)\\([^A-Za-z.}]\\)" "@file{\\1}\\3" nil) + )))) 4. Adding new sections: ----------------------- @@ -360,6 +364,7 @@ * Multilingual Support:: * Consoles; Devices; Frames; Windows:: * Window-System Support:: +* Window and Frame Geometry:: * The Redisplay Mechanism:: * Extents:: * Faces:: @@ -596,6 +601,17 @@ * Creating a Window-System Type:: +Window and Frame Geometry + +* Intro to Window and Frame Geometry:: +* The Frame:: +* The Non-Client Area:: +* The Client Area:: +* The Paned Area:: +* Text Areas:: +* The Displayable Area:: +* Which Functions Use Which?:: + The Redisplay Mechanism * Critical Redisplay Sections:: @@ -1226,7 +1242,7 @@ derived from GNU Emacs, a program written by Richard Stallman of the Free Software Foundation. GNU Emacs dates back to 1985 and was modelled after Unipress Emacs, an editor written by James Gosling in -1981 and based on a series of other "Emacs"-like editors, including +1981 and based on a series of other ``Emacs''-like editors, including EINE (EINE Is Not EMACS), c. 1976, by Dan Weinreb, which run on the MIT Lisp Machine and was the first Emacs written in Lisp; ZWEI (ZWEI Was EINE Initially), c. 1978, by Dan Weinreb and Mike McMahon; Multics @@ -1236,7 +1252,7 @@ later, TI Explorer (1983-1989). These in turn were inspired by the first Emacs, a package called EMACS, written in 1976 by Richard Stallman, Guy Steele, and Dave Moon. This was a merger of TECMAC and -TMACS, a pair of "TECO-macro realtime editors" written by Guy Steele, +TMACS, a pair of ``TECO-macro realtime editors'' written by Guy Steele, Dave Moon, Richard Greenblatt, Charles Frankston, et al., and added a dynamic loader and Meta-key cmds. It ran under ITS (the Incompatible Timesharing System) on a DEC PDP 10 and under TWENEX on a Tops-20 and @@ -1274,7 +1290,7 @@ the basis for the early versions of GNU Emacs and also for Gosling's Unipress Emacs, a commercial product. Because of bad blood between the two over the issue of commercialism, RMS pretty much disowned this -collaboration, referring to it as "Gosling Emacs". +collaboration, referring to it as ``Gosling Emacs''. At this point we pick up with a time line of events. (A broader timeline is available at @uref{http://www.jwz.org/doc/emacs-timeline.html, @@ -1565,9 +1581,9 @@ @item Version 19.9 released January 12, 1994. (Scrollbars, Athena.) @item -Version 19.10 released May 27, 1994. (Uses `configure'; code merged +Version 19.10 released May 27, 1994. (Uses @code{configure}; code merged from GNU Emacs 19.23 beta and further merging with Epoch 4.0) Known as -"Lucid Emacs" when shipped by Lucid, and as "XEmacs" when shipped by +``Lucid Emacs'' when shipped by Lucid, and as ``XEmacs'' when shipped by Sun; but Lucid went out of business a few days later and it's unclear very many copies of 19.10 were released by Lucid. (Last release by Jamie Zawinski.) @@ -1877,7 +1893,7 @@ Lucid scrollbar widget, 3-d modeline, stay-up Lucid menus, resizable minibuffer, echo area is a true buffer, MD5 hashing support, expanded menubar, redone menu specification format (including menu filters), -rewritten extents, renamed "screen" to "frame", misc-user events, +rewritten extents, renamed ``screen'' to ``frame'', misc-user events, rewritten face code, rewritten mouse code, warnings system, CL backquote syntax, critical C-g, code merging with GNU Emacs 19.28. New packages Hyperbole, OOBR, hm--html-menus, viper, lazy-lock, @@ -1925,9 +1941,9 @@ version 21.0.60 released December 10, 1998. (The version naming scheme was changed at this point: [a] the second version number is odd for stable versions, even for beta versions; [b] a third version number is added, -replacing the "beta xxx" ending for beta versions and allowing for +replacing the ``beta xxx'' ending for beta versions and allowing for periodic maintenance releases for stable versions. Therefore, 21.0 was -never "officially" released; similarly for 21.2, etc.) +never ``officially'' released; similarly for 21.2, etc.) @item version 21.0.61 released January 4, 1999. @item @@ -1943,7 +1959,7 @@ @item version 21.1.2 released May 14, 1999. (This is the followup to 21.0.67. The second version number was bumped to indicate the beginning of the -"stable" series.) +``stable'' series.) @item version 21.1.3 released June 26, 1999. @item @@ -2033,91 +2049,91 @@ @item version 21.2.40 released January 8, 2001. @item -version 21.2.41 "Polyhymnia" released January 17, 2001. -@item -version 21.2.42 "Poseidon" released January 20, 2001. -@item -version 21.2.43 "Terspichore" released January 26, 2001. -@item -version 21.2.44 "Thalia" released February 8, 2001. -@item -version 21.2.45 "Thelxepeia" released February 23, 2001. -@item -version 21.2.46 "Urania" released March 21, 2001. -@item -version 21.2.47 "Zephir" released April 14, 2001. -@item -XEmacs 21.4.0 "Solid Vapor" released April 16, 2001. -@item -XEmacs 21.4.1 "Copyleft" released April 19, 2001. -@item -XEmacs 21.4.2 "Developer-Friendly Unix APIs" released May 10, 2001. -@item -XEmacs 21.4.3 "Academic Rigor" released May 17, 2001. -@item -XEmacs 21.4.4 "Artificial Intelligence" released July 28, 2001. -@item -XEmacs 21.4.5 "Civil Service" released October 23, 2001. -@item -XEmacs 21.4.6 "Common Lisp" released December 17, 2001. -@item -XEmacs 21.4.7 "Economic Science" released May 4, 2002. -@item -XEmacs 21.4.8 "Honest Recruiter" released May 9, 2002. -@item -XEmacs 21.4.9 "Informed Management" released August 23, 2002. -@item -XEmacs 21.4.10 "Military Intelligence" released November 2, 2002. -@item -XEmacs 21.4.11 "Native Windows TTY Support" released January 3, 2003. -@item -XEmacs 21.4.12 "Portable Code" released January 15, 2003. -@item -XEmacs 21.4.13 "Rational FORTRAN" released May 25, 2003. -@item -XEmacs 21.4.14 "Reasonable Discussion" released September 3, 2003. -@item -XEmacs 21.4.15 "Security Through Obscurity" released February 2, 2004. -@item -XEmacs 21.4.16 "Successful IPO" released December 5, 2004. -@item -version 21.5.0 "alfalfa" released April 18, 2001. -@item -version 21.5.1 "anise" released May 9, 2001. -@item -version 21.5.2 "artichoke" released July 28, 2001. -@item -version 21.5.3 "asparagus" released September 7, 2001. -@item -version 21.5.4 "bamboo" released January 8, 2002. -@item -version 21.5.5 "beets" released March 5, 2002. -@item -version 21.5.6 "bok choi" released April 5, 2002. -@item -version 21.5.7 "broccoflower" released July 2, 2002. -@item -version 21.5.8 "broccoli" released July 27, 2002. -@item -version 21.5.9 "brussels sprouts" released August 30, 2002. -@item -version 21.5.10 "burdock" released January 4, 2003. -@item -version 21.5.11 "cabbage" released February 16, 2003. -@item -version 21.5.12 "carrot" released April 24, 2003. -@item -version 21.5.13 "cauliflower" released May 10, 2003. -@item -version 21.5.14 "cassava" released June 1, 2003. -@item -version 21.5.15 "celery" released September 3, 2003. -@item -version 21.5.16 "celeriac" released September 26, 2003. -@item -version 21.5.17 "chayote" released March 22, 2004. -@item -version 21.5.18 "chestnut" released October 22, 2004. +version 21.2.41 ``Polyhymnia'' released January 17, 2001. +@item +version 21.2.42 ``Poseidon'' released January 20, 2001. +@item +version 21.2.43 ``Terspichore'' released January 26, 2001. +@item +version 21.2.44 ``Thalia'' released February 8, 2001. +@item +version 21.2.45 ``Thelxepeia'' released February 23, 2001. +@item +version 21.2.46 ``Urania'' released March 21, 2001. +@item +version 21.2.47 ``Zephir'' released April 14, 2001. +@item +XEmacs 21.4.0 ``Solid Vapor'' released April 16, 2001. +@item +XEmacs 21.4.1 ``Copyleft'' released April 19, 2001. +@item +XEmacs 21.4.2 ``Developer-Friendly Unix APIs'' released May 10, 2001. +@item +XEmacs 21.4.3 ``Academic Rigor'' released May 17, 2001. +@item +XEmacs 21.4.4 ``Artificial Intelligence'' released July 28, 2001. +@item +XEmacs 21.4.5 ``Civil Service'' released October 23, 2001. +@item +XEmacs 21.4.6 ``Common Lisp'' released December 17, 2001. +@item +XEmacs 21.4.7 ``Economic Science'' released May 4, 2002. +@item +XEmacs 21.4.8 ``Honest Recruiter'' released May 9, 2002. +@item +XEmacs 21.4.9 ``Informed Management'' released August 23, 2002. +@item +XEmacs 21.4.10 ``Military Intelligence'' released November 2, 2002. +@item +XEmacs 21.4.11 ``Native Windows TTY Support'' released January 3, 2003. +@item +XEmacs 21.4.12 ``Portable Code'' released January 15, 2003. +@item +XEmacs 21.4.13 ``Rational FORTRAN'' released May 25, 2003. +@item +XEmacs 21.4.14 ``Reasonable Discussion'' released September 3, 2003. +@item +XEmacs 21.4.15 ``Security Through Obscurity'' released February 2, 2004. +@item +XEmacs 21.4.16 ``Successful IPO'' released December 5, 2004. +@item +version 21.5.0 ``alfalfa'' released April 18, 2001. +@item +version 21.5.1 ``anise'' released May 9, 2001. +@item +version 21.5.2 ``artichoke'' released July 28, 2001. +@item +version 21.5.3 ``asparagus'' released September 7, 2001. +@item +version 21.5.4 ``bamboo'' released January 8, 2002. +@item +version 21.5.5 ``beets'' released March 5, 2002. +@item +version 21.5.6 ``bok choi'' released April 5, 2002. +@item +version 21.5.7 ``broccoflower'' released July 2, 2002. +@item +version 21.5.8 ``broccoli'' released July 27, 2002. +@item +version 21.5.9 ``brussels sprouts'' released August 30, 2002. +@item +version 21.5.10 ``burdock'' released January 4, 2003. +@item +version 21.5.11 ``cabbage'' released February 16, 2003. +@item +version 21.5.12 ``carrot'' released April 24, 2003. +@item +version 21.5.13 ``cauliflower'' released May 10, 2003. +@item +version 21.5.14 ``cassava'' released June 1, 2003. +@item +version 21.5.15 ``celery'' released September 3, 2003. +@item +version 21.5.16 ``celeriac'' released September 26, 2003. +@item +version 21.5.17 ``chayote'' released March 22, 2004. +@item +version 21.5.18 ``chestnut'' released October 22, 2004. @end itemize @node The XEmacs Split, XEmacs from the Outside, A History of Emacs, Top @@ -2141,7 +2157,7 @@ hundreds of messages long and all of them coming from the XEmacs side. All have failed because they have eventually come to the same conclusion, which is that RMS has no real interest in cooperation at all. If you work with -him, you have to do it his way -- "my way or the highway". Specifically: +him, you have to do it his way -- ``my way or the highway''. Specifically: @enumerate @item @@ -3127,21 +3143,21 @@ @item @file{number-mp.h} @tab @item @file{number.c} @tab @item @file{number.h} @tab -@item @file{objects-gtk-impl.h} @tab -@item @file{objects-gtk.c} @tab -@item @file{objects-gtk.h} @tab -@item @file{objects-impl.h} @tab -@item @file{objects-msw-impl.h} @tab -@item @file{objects-msw.c} @tab @ref{Modules for other Display-Related Lisp Objects}. -@item @file{objects-msw.h} @tab @ref{Modules for other Display-Related Lisp Objects}. -@item @file{objects-tty-impl.h} @tab -@item @file{objects-tty.c} @tab @ref{Modules for other Display-Related Lisp Objects}. -@item @file{objects-tty.h} @tab @ref{Modules for other Display-Related Lisp Objects}. -@item @file{objects-x-impl.h} @tab -@item @file{objects-x.c} @tab @ref{Modules for other Display-Related Lisp Objects}. -@item @file{objects-x.h} @tab @ref{Modules for other Display-Related Lisp Objects}. -@item @file{objects.c} @tab @ref{Modules for other Display-Related Lisp Objects}. -@item @file{objects.h} @tab @ref{Modules for other Display-Related Lisp Objects}. +@item @file{fontcolor-gtk-impl.h} @tab +@item @file{fontcolor-gtk.c} @tab +@item @file{fontcolor-gtk.h} @tab +@item @file{fontcolor-impl.h} @tab +@item @file{fontcolor-msw-impl.h} @tab +@item @file{fontcolor-msw.c} @tab @ref{Modules for other Display-Related Lisp Objects}. +@item @file{fontcolor-msw.h} @tab @ref{Modules for other Display-Related Lisp Objects}. +@item @file{fontcolor-tty-impl.h} @tab +@item @file{fontcolor-tty.c} @tab @ref{Modules for other Display-Related Lisp Objects}. +@item @file{fontcolor-tty.h} @tab @ref{Modules for other Display-Related Lisp Objects}. +@item @file{fontcolor-x-impl.h} @tab +@item @file{fontcolor-x.c} @tab @ref{Modules for other Display-Related Lisp Objects}. +@item @file{fontcolor-x.h} @tab @ref{Modules for other Display-Related Lisp Objects}. +@item @file{fontcolor.c} @tab @ref{Modules for other Display-Related Lisp Objects}. +@item @file{fontcolor.h} @tab @ref{Modules for other Display-Related Lisp Objects}. @item @file{opaque.c} @tab @ref{Modules for Other Aspects of the Lisp Interpreter and Object System}. @item @file{opaque.h} @tab @ref{Modules for Other Aspects of the Lisp Interpreter and Object System}. @item @file{paths.h.in} @tab @@ -4036,8 +4052,8 @@ @end display Then, the problem is that now we can't say that a sequence of -word-constituents makes up a word. For instance, both Hiragana "A" -and Kanji "KAN" are word-constituents but the sequence of these two +word-constituents makes up a word. For instance, both Hiragana ``A'' +and Kanji ``KAN'' are word-constituents but the sequence of these two letters can't be a single word. So, we introduced Sextword for Japanese letters. @@ -4996,7 +5012,7 @@ struct foobar; -go into the "types" section of lisp.h. +go into the ``types'' section of @file{lisp.h}. @end itemize @node Writing New Modules, Working with Lisp Objects, Introduction to Writing C Code, Rules When Writing New C Code @@ -5259,8 +5275,8 @@ returned (created using @samp{wrap_}, if necessary). @c #### declaration -@item DECLARE_LRECORD (, Lisp_) -Declares an @samp{lrecord} for @samp{}, which is the unit of +@item DECLARE_LISP_OBJECT (, Lisp_) +Declares a Lisp object for @samp{}, which is the unit of allocation. @item #define X(x) XRECORD (x, , Lisp_) @@ -5326,24 +5342,24 @@ @enumerate @item -create @var{foo}.h -@item -create @var{foo}.c -@item -add definitions of @code{syms_of_@var{foo}}, etc. to @file{@var{foo}.c} -@item -add declarations of @code{syms_of_@var{foo}}, etc. to @file{symsinit.h} -@item -add calls to @code{syms_of_@var{foo}}, etc. to @file{emacs.c} -@item -add definitions of macros like @code{CHECK_@var{FOO}} and +Create @var{foo}.h +@item +Create @var{foo}.c +@item +Add definitions of @code{syms_of_@var{foo}}, etc. to @file{@var{foo}.c} +@item +Add declarations of @code{syms_of_@var{foo}}, etc. to @file{symsinit.h} +@item +Add calls to @code{syms_of_@var{foo}}, etc. to @file{emacs.c} +@item +Add definitions of macros like @code{CHECK_@var{FOO}} and @code{@var{FOO}P} to @file{@var{foo}.h} @item -add the new type index to @code{enum lrecord_type} -@item -add a DEFINE_LRECORD_IMPLEMENTATION call to @file{@var{foo}.c} -@item -add an INIT_LRECORD_IMPLEMENTATION call to @code{syms_of_@var{foo}.c} +Add the new type index to @code{enum lrecord_type} +@item +Add a @code{DEFINE_*_LISP_OBJECT()} to @file{@var{foo}.c} +@item +Add an @code{INIT_LISP_OBJECT} call to @code{syms_of_@var{foo}.c} @end enumerate @@ -5654,7 +5670,7 @@ sure to update any comments to be correct -- or, at the very least, flag them as incorrect. -To indicate a "todo" or other problem, use four pound signs -- +To indicate a ``todo'' or other problem, use four pound signs -- i.e. @samp{####}. @node Adding Global Lisp Variables, Writing Macros, Writing Good Comments, Rules When Writing New C Code @@ -5826,11 +5842,12 @@ @cindex inline functions, headers @cindex header files, inline functions Every header which contains inline functions, either directly by using -@code{DECLARE_INLINE_HEADER} or indirectly by using @code{DECLARE_LRECORD} must -be added to @file{inline.c}'s includes to make the optimization -described above work. (Optimization note: if all INLINE_HEADER -functions are in fact inlined in all translation units, then the linker -can just discard @code{inline.o}, since it contains only unreferenced code). +@code{DECLARE_INLINE_HEADER} or indirectly by using +@code{DECLARE_LISP_OBJECT} must be added to @file{inline.c}'s includes +to make the optimization described above work. (Optimization note: if +all INLINE_HEADER functions are in fact inlined in all translation +units, then the linker can just discard @code{inline.o}, since it +contains only unreferenced code). The three golden rules of macros: @@ -5839,7 +5856,7 @@ Anything that's an lvalue can be evaluated more than once. @item Macros where anything else can be evaluated more than once should -have the word "unsafe" in their name (exceptions may be made for +have the word ``unsafe'' in their name (exceptions may be made for large sets of macros that evaluate arguments of certain types more than once, e.g. struct buffer * arguments, when clearly indicated in the macro documentation). These macros are generally meant to be @@ -5871,7 +5888,7 @@ reference. @item Capitalize macros that evaluate @strong{any} argument more than once regardless -of whether that's "allowed" (e.g. buffer arguments). +of whether that's ``allowed'' (e.g. buffer arguments). @item Capitalize macros that directly access a field in a Lisp_Object or its equivalent underlying structure. In such cases, access through the @@ -5926,8 +5943,8 @@ will just lead to headaches. But it's important to keep the code clean and understandable, and consistent naming goes a long way towards this. -An example of the right way to do this was the so-called "great integral -type renaming". +An example of the right way to do this was the so-called ``great integral +type renaming''. @menu * Great Integral Type Renaming:: @@ -5954,13 +5971,13 @@ people disagree vociferously with this, but their arguments are mostly theoretical, and are vastly outweighed by the practical headaches of mixing signed and unsigned values, and more importantly by the far -increased likelihood of inadvertent bugs: Because of the broken "viral" +increased likelihood of inadvertent bugs: Because of the broken ``viral'' nature of unsigned quantities in C (operations involving mixed signed/unsigned are done unsigned, when exactly the opposite is nearly always wanted), even a single error in declaring a quantity unsigned that should be signed, or even the even more subtle error of comparing signed and unsigned values and forgetting the necessary cast, can be -catastrophic, as comparisons will yield wrong results. -Wsign-compare +catastrophic, as comparisons will yield wrong results. @samp{-Wsign-compare} is turned on specifically to catch this, but this tends to result in a great number of warnings when mixing signed and unsigned, and the casts are annoying. More has been written on this elsewhere. @@ -5979,17 +5996,17 @@ all be avoided. @item -"count" == a zero-based measurement of some quantity. Includes sizes, +``count'' == a zero-based measurement of some quantity. Includes sizes, offsets, and indexes. @item -"bpos" == a one-based measurement of a position in a buffer. "Charbpos" -and "Bytebpos" count text in the buffer, rather than bytes in memory; +``bpos'' == a one-based measurement of a position in a buffer. ``Charbpos'' +and ``Bytebpos'' count text in the buffer, rather than bytes in memory; thus Bytebpos does not directly correspond to the memory representation. -Use "Membpos" for this. - -@item -"Char" refers to internal-format characters, not to the C type "char", +Use ``Membpos'' for this. + +@item +``Char'' refers to internal-format characters, not to the C type ``char'', which is really a byte. @end itemize @@ -6084,7 +6101,7 @@ /* The have been some arguments over the what the type should be that specifies a count of bytes in a data block to be written out or read in, using @code{Lstream_read()}, @code{Lstream_write()}, and related functions. - Originally it was long, which worked fine; Martin "corrected" these to + Originally it was long, which worked fine; Martin ``corrected'' these to size_t and ssize_t on the grounds that this is theoretically cleaner and is in keeping with the C standards. Unfortunately, this practice is horribly error-prone due to design flaws in the way that mixed @@ -6459,7 +6476,7 @@ @deffn Macro Known-Bug-Expect-Failure body Arrange for failing tests in @var{body} to generate messages prefixed -with "KNOWN BUG:" instead of "FAIL:". @var{body} is a @code{progn}-like +with ``KNOWN BUG:'' instead of ``FAIL:''. @var{body} is a @code{progn}-like body, and may contain several tests. @end deffn @@ -6640,7 +6657,7 @@ adds and deletes on the main line, which you do not want at all. Therefore, you must undo all adds and deletes. To find out what is added and deleted, use something like @code{cvs -n update >&! -cvs.out}, which does a "dry run". (You did make a backup copy first, +cvs.out}, which does a ``dry run''. (You did make a backup copy first, right? What if you forgot the @samp{-n}, for example, and wasn't prepared for the sudden onslaught of merging action?) Take a look at the output file @file{cvs.out} and check very carefully for newly @@ -6672,7 +6689,7 @@ Note that this doesn't actually do anything to your local workspace! It basically just creates another tag in the repository, identical to -the branch point tag but internally marked as a "branch tag" rather +the branch point tag but internally marked as a ``branch tag'' rather than a regular tag. @item @@ -7006,13 +7023,13 @@ mechanism. -A "dynamic array" is a contiguous array of fixed-size elements where there +A ``dynamic array'' is a contiguous array of fixed-size elements where there is no upper limit (except available memory) on the number of elements in the array. Because the elements are maintained contiguously, space is used efficiently (no per-element pointers necessary) and random access to a particular element is in constant time. At any one point, the block of memory that holds the array has an upper limit; if this limit is exceeded, the -memory is realloc()ed into a new array that is twice as big. Assuming that +memory is @code{realloc()}ed into a new array that is twice as big. Assuming that the time to grow the array is on the order of the new size of the array block, this scheme has a provably constant amortized time (i.e. average time over all additions). @@ -7120,10 +7137,10 @@ addition. -A "block-type object" is used to efficiently allocate and free blocks +A ``block-type object'' is used to efficiently allocate and free blocks of a particular size. Freed blocks are remembered in a free list and are reused as necessary to allocate new blocks, so as to avoid as -much as possible making calls to malloc() and free(). +much as possible making calls to @code{malloc()} and @code{free()}. This is a container object. Declare a block-type object of a specific type as follows: @@ -7740,7 +7757,7 @@ @code{GCPRO}ed. @end itemize - In the remaining two categories, the type is stored in the object +In the remaining two categories, the type is stored in the object itself. The tag for all such objects is the generic @dfn{lrecord} (Lisp_Type_Record) tag. The first bytes of the object's structure are an integer (actually a char) characterising the object's type and some @@ -8265,7 +8282,7 @@ Now, the actual marking is feasible. We do so by once using the macro @code{MARK_RECORD_HEADER} to mark the object itself (actually the special flag in the lrecord header), and calling its special marker -"method" @code{marker} if available. The marker method marks every +``method'' @code{marker} if available. The marker method marks every other object that is in reach from our current object. Note, that these marker methods should not call @code{mark_object} recursively, but instead should return the next object from where further marking has to @@ -8320,7 +8337,7 @@ @code{sweep_symbols}, @code{sweep_extents}, @code{sweep_markers} and @code{sweep_extents}. They are the fixed-size types cons, floats, compiled-functions, symbol, marker, extent, and event stored in -so-called "frob blocks", and therefore we can basically do the same on +so-called ``frob blocks'', and therefore we can basically do the same on every type objects, using the same macros, especially defined only to handle everything with respect to fixed-size blocks. The only fixed-size type that is not handled here are the fixed-size portion of strings, @@ -8476,45 +8493,40 @@ @cindex integers and characters @cindex characters, integers and - Integer and character Lisp objects are created from integers using the -macros @code{XSETINT()} and @code{XSETCHAR()} or the equivalent +Integer and character Lisp objects are created from integers using the functions @code{make_int()} and @code{make_char()}. (These are actually macros on most systems.) These functions basically just do some moving of bits around, since the integral value of the object is stored directly in the @code{Lisp_Object}. - @code{XSETINT()} and the like will truncate values given to them that -are too big; i.e. you won't get the value you expected but the tag bits -will at least be correct. - @node Allocation from Frob Blocks, lrecords, Integers and Characters, Allocation of Objects in XEmacs Lisp @section Allocation from Frob Blocks @cindex allocation from frob blocks @cindex frob blocks, allocation from -The uninitialized memory required by a @code{Lisp_Object} of a particular type -is allocated using -@code{ALLOCATE_FIXED_TYPE()}. This only occurs inside of the -lowest-level object-creating functions in @file{alloc.c}: -@code{Fcons()}, @code{make_float()}, @code{Fmake_byte_code()}, -@code{Fmake_symbol()}, @code{allocate_extent()}, -@code{allocate_event()}, @code{Fmake_marker()}, and -@code{make_uninit_string()}. The idea is that, for each type, there are -a number of frob blocks (each 2K in size); each frob block is divided up -into object-sized chunks. Each frob block will have some of these -chunks that are currently assigned to objects, and perhaps some that are -free. (If a frob block has nothing but free chunks, it is freed at the -end of the garbage collection cycle.) The free chunks are stored in a -free list, which is chained by storing a pointer in the first four bytes -of the chunk. (Except for the free chunks at the end of the last frob -block, which are handled using an index which points past the end of the +The uninitialized memory required by a @code{Lisp_Object} of a +particular type is allocated using @code{ALLOCATE_FIXED_TYPE()}. This +only occurs inside of the lowest-level object-creating functions in +@file{alloc.c}: @code{Fcons()}, @code{make_float()}, +@code{Fmake_byte_code()}, @code{Fmake_symbol()}, +@code{allocate_extent()}, @code{allocate_event()}, +@code{Fmake_marker()}, and @code{make_uninit_string()}. The idea is +that, for each type, there are a number of frob blocks (each 2K in +size); each frob block is divided up into object-sized chunks. Each +frob block will have some of these chunks that are currently assigned +to objects, and perhaps some that are free. (If a frob block has +nothing but free chunks, it is freed at the end of the garbage +collection cycle.) The free chunks are stored in a free list, which +is chained by storing a pointer in the first four bytes of the +chunk. (Except for the free chunks at the end of the last frob block, +which are handled using an index which points past the end of the last-allocated chunk in the last frob block.) @code{ALLOCATE_FIXED_TYPE()} first tries to retrieve a chunk from the free list; if that fails, it calls @code{ALLOCATE_FIXED_TYPE_FROM_BLOCK()}, which looks at the end of the last frob block for space, and creates a new frob block if there is -none. (There are actually two versions of these macros, one of which is -more defensive but less efficient and is used for error-checking.) +none. (There are actually two versions of these macros, one of which +is more defensive but less efficient and is used for error-checking.) @node lrecords, Low-level allocation, Allocation from Frob Blocks, Allocation of Objects in XEmacs Lisp @section lrecords @@ -8525,7 +8537,7 @@ @strong{This node needs updating for the ``new garbage collection algorithms'' (KKCC) and the ``incremental'' collector.} - All lrecords have at the beginning of their structure a @code{struct +All lrecords have at the beginning of their structure a @code{struct lrecord_header}. This just contains a type number and some flags, including the mark bit. All builtin type numbers are defined as constants in @code{enum lrecord_type}, to allow the compiler to generate @@ -8534,39 +8546,35 @@ lrecord_implementation}, which is a structure containing method pointers and such. There is one of these for each type, and it is a global, constant, statically-declared structure that is declared in the -@code{DEFINE_LRECORD_IMPLEMENTATION()} macro. - - Simple lrecords (of type (b) above) just have a @code{struct -lrecord_header} at their beginning. lcrecords, however, actually have a -@code{struct lcrecord_header}. This, in turn, has a @code{struct +@code{DEFINE_*_LISP_OBJECT()} macro. + +Frob-block lrecords just have a @code{struct lrecord_header} at their +beginning. lcrecords, however, actually have a +@code{struct old_lcrecord_header}. This, in turn, has a @code{struct lrecord_header} at its beginning, so sanity is preserved; but it also -has a pointer used to chain all lcrecords together, and a special ID -field used to distinguish one lcrecord from another. (This field is used -only for debugging and could be removed, but the space gain is not -significant.) +has a pointer used to chain all lcrecords together. @strong{lcrecords are now obsolete when using the write-barrier-based collector.} - Simple lrecords are created using @code{ALLOCATE_FIXED_TYPE()}, just -like for other frob blocks. The only change is that the implementation -pointer must be initialized correctly. (The implementation structure for -an lrecord, or rather the pointer to it, is named @code{lrecord_float}, -@code{lrecord_extent}, @code{lrecord_buffer}, etc.) - - lcrecords are created using @code{alloc_lcrecord()}. This takes a -size to allocate and an implementation pointer. (The size needs to be -passed because some lcrecords, such as window configurations, are of -variable size.) This basically just @code{malloc()}s the storage, -initializes the @code{struct lcrecord_header}, and chains the lcrecord -onto the head of the list of all lcrecords, which is stored in the -variable @code{all_lcrecords}. The calls to @code{alloc_lcrecord()} -generally occur in the lowest-level allocation function for each lrecord -type. - -Whenever you create an lrecord, you need to call either -@code{DEFINE_LRECORD_IMPLEMENTATION()} or -@code{DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION()}. This needs to be +Frob-block objects are created using @code{ALLOC_FROB_BLOCK_LISP_OBJECT()}. +All this does is call @code{ALLOCATE_FIXED_TYPE()} to allocate an +object, and @code{set_lheader_implementation()} to initialize the header. + +Normal objects (i.e. lcrecords) are created using +@code{ALLOC_NORMAL_LISP_OBJECT()}, which takes a type name (resolved +internally to a structure named @code{lrecord_foo} for type +@code{foo}). If they are of variable size, however, they are created +with @code{ALLOC_SIZED_LISP_OBJECT()}, which takes a size to allocate +in addition to a type. This basically just @code{malloc()}s the +storage, initializes the @code{struct lcrecord_header}, and chains the +lcrecord onto the head of the list of all lcrecords, which is stored +in the variable @code{all_lcrecords}. The calls to the above +allocation macros generally occur in the lowest-level allocation +function for each lrecord type. + +Whenever you create a normal object, you need to call one of the +@code{DEFINE_*_LISP_OBJECT()} macros. This needs to be specified in a @file{.c} file, at the top level. What this actually does is define and initialize the implementation structure for the lrecord. (And possibly declares a function @code{error_check_foo()} that @@ -8583,26 +8591,73 @@ to add new object types without having to add a specific case for each new type in a bunch of different places. - The difference between @code{DEFINE_LRECORD_IMPLEMENTATION()} and -@code{DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION()} is that the former is -used for fixed-size object types and the latter is for variable-size -object types. Most object types are fixed-size; some complex -types, however (e.g. window configurations), are variable-size. -Variable-size object types have an extra method, which is called -to determine the actual size of a particular object of that type. -(Currently this is only used for keeping allocation statistics.) - - For the purpose of keeping allocation statistics, the allocation +The various macros for defining Lisp objects are as follows: + +@itemize @bullet +@item +@code{DEFINE_*_LISP_OBJECT} is for objects with constant size. (Either +@code{DEFINE_DUMPABLE_LISP_OBJECT} for objects that can be saved in a +dumped executable, or @code{DEFINE_NODUMP_LISP_OBJECT} for objects +that cannot be saved -- e.g. that contain pointers to non-persistent +external objects such as window-system windows.) + +@item +@code{DEFINE_*_SIZABLE_LISP_OBJECT} is for objects whose size varies. +This includes some simple types such as vectors, bit vectors and +opaque objects, as well complex types, especially types such as +specifiers, lstreams or coding systems that have subtypes and include +subtype-specific data attached to the end of the structure. +Variable-size objects have an extra method that returns the size of +the object. This is not used at allocation (rather, the size is +specified in the call to the allocation macro), but is used for +operations such as copying a Lisp object, as well as for keeping +allocation statistics. + +@item +@code{DEFINE_*_FROB_BLOCK_LISP_OBJECT} is for objects that are +allocated in large blocks (``frob blocks''), which are parceled up +individually. Such objects need special handling in @file{alloc.c}. +This does not apply to NEW_GC, because it does this automatically. + +@item +@code{DEFINE_*_INTERNAL_LISP_OBJECT} is for ``internal'' objects that +should never be visible on the Lisp level. This is a shorthand for +the most common type of internal objects, which have no equal or hash +method (since they generally won't appear in hash tables), no +finalizer and @code{internal_object_printer()} as their print method +(which prints that the object is internal and shouldn't be visible +externally). For internal objects needing a finalizer, equal or hash +method, or wanting to customize the print method, use the normal +@code{DEFINE_*_LISP_OBJECT} mechanism for defining these objects. + +@item +@code{DEFINE_*_GENERAL_LISP_OBJECT} is for objects that need to +provide one of the less common methods that are omitted on most +objects. These methods include the methods supporting the unified +property interface using @code{get}, @code{put}, @code{remprop} and +@code{object-plist}, and (for dumpable objects only) the +@code{disksaver} method. + +@item +@code{DEFINE_MODULE_*} is for objects defined in an external module. +@end itemize + +@code{MAKE_LISP_OBJECT} and @code{MAKE_MODULE_LISP_OBJECT} are what +underlies all of these; they define a structure containing pointers to +object methods and other info such as the size of the structure +containing the object. + +For the purpose of keeping allocation statistics, the allocation engine keeps a list of all the different types that exist. Note that, -since @code{DEFINE_LRECORD_IMPLEMENTATION()} is a macro that is -specified at top-level, there is no way for it to initialize the global -data structures containing type information, like +since @code{DEFINE_*_LISP_OBJECT()} is a macro that is +specified at top-level, there is no way for it to initialize the +global data structures containing type information, like @code{lrecord_implementations_table}. For this reason a call to -@code{INIT_LRECORD_IMPLEMENTATION} must be added to the same source file -containing @code{DEFINE_LRECORD_IMPLEMENTATION}, but instead of to the -top level, to one of the init functions, typically -@code{syms_of_@var{foo}.c}. @code{INIT_LRECORD_IMPLEMENTATION} must be -called before an object of this type is used. +@code{INIT_LISP_OBJECT()} must be added to the same source +file containing @code{DEFINE_*_LISP_OBJECT()}, but instead of +to the top level, to one of the init functions, typically +@code{syms_of_@var{foo}.c}. @code{INIT_LISP_OBJECT()} must +be called before an object of this type is used. The type number is also used to index into an array holding the number of objects of each type and the total memory allocated for objects of @@ -8610,24 +8665,25 @@ stage. These statistics are returned by the call to @code{garbage-collect}. - Note that for every type defined with a @code{DEFINE_LRECORD_*()} -macro, there needs to be a @code{DECLARE_LRECORD_IMPLEMENTATION()} -somewhere in a @file{.h} file, and this @file{.h} file needs to be -included by @file{inline.c}. - - Furthermore, there should generally be a set of @code{XFOOBAR()}, -@code{FOOBARP()}, etc. macros in a @file{.h} (or occasionally @file{.c}) -file. To create one of these, copy an existing model and modify as -necessary. - - @strong{Please note:} If you define an lrecord in an external -dynamically-loaded module, you must use @code{DECLARE_EXTERNAL_LRECORD}, -@code{DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION}, and -@code{DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION} instead of the -non-EXTERNAL forms. These macros will dynamically add new type numbers -to the global enum that records them, whereas the non-EXTERNAL forms -assume that the programmer has already inserted the correct type numbers -into the enum's code at compile-time. +Note that for every type defined with a @code{DEFINE_*_LISP_OBJECT()} +macro, there needs to be a @code{DECLARE_LISP_OBJECT()} somewhere in a +@file{.h} file, and this @file{.h} file needs to be included by +@file{inline.c}. + +Furthermore, there should generally be a set of @code{XFOOBAR()}, +@code{FOOBARP()}, etc. macros in a @file{.h} (or occasionally +@file{.c}) file. To create one of these, copy an existing model and +modify as necessary. + +@strong{Please note:} If you define an lrecord in an external +dynamically-loaded module, you must use +@code{DECLARE_MODULE_LISP_OBJECT()}, +@code{DEFINE_MODULE_*_LISP_OBJECT()}, and +@code{INIT_MODULE_LISP_OBJECT()} instead of the non-MODULE +forms. These macros will dynamically add new type numbers to the +global enum that records them, whereas the non-MODULE forms assume +that the programmer has already inserted the correct type numbers into +the enum's code at compile-time. The various methods in the lrecord implementation structure are: @@ -8691,25 +8747,18 @@ The finalize method can be NULL if nothing needs to be done. -WARNING #1: The finalize method is also called at the end of the dump -phase; this time with the for_disksave parameter set to non-zero. The -object is @emph{not} about to disappear, so you have to make sure to -@emph{not} free any extra @code{malloc()}ed memory if you're going to -need it later. (Also, signal an error if there are any operating-system -and window-system resources here, because they can't be dumped.) - Finalize methods should, as a rule, set to zero any pointers after -they've been freed, and check to make sure pointers are not zero before -freeing. Although I'm pretty sure that finalize methods are not called -twice on the same object (except for the @code{for_disksave} proviso), -we've gotten nastily burned in some cases by not doing this. - -WARNING #2: The finalize method is @emph{only} called for -lcrecords, @emph{not} for simply lrecords. If you need a -finalize method for simple lrecords, you have to stick +they've been freed, and check to make sure pointers are not zero +before freeing. Although I'm pretty sure that finalize methods are +not called twice on the same object, we've gotten nastily burned in +some cases by not doing this. + +WARNING #1: The finalize method is @emph{only} called for +normal objects, @emph{not} for frob-block objects. If you need a +finalize method for frob-block objects, you have to stick it in the @code{ADDITIONAL_FREE_foo()} macro in @file{alloc.c}. -WARNING #3: Things are in an @emph{extremely} bizarre state +WARNING #2: Things are in an @emph{extremely} bizarre state when @code{ADDITIONAL_FREE_foo()} is called, so you have to be incredibly careful when writing one of these functions. See the comment in @code{gc_sweep()}. If you ever have to add @@ -8749,17 +8798,33 @@ @item @dfn{getprop}, @dfn{putprop}, @dfn{remprop}, and @dfn{plist} methods. -These are used for object types that have properties. I don't feel like -documenting them here. If you create one of these objects, you have to -use different macros to define them, -i.e. @code{DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS()} or -@code{DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS()}. +These are used for object types that have properties, and are called +when @code{get}, @code{put}, @code{remprop}, and @code{object-plist}, +respectively are called on the object. If you create one of these +objects, you have to use a different macro to define them, +i.e. @code{DEFINE_*_GENERAL_LISP_OBJECT()}. @item A @dfn{size_in_bytes} method, when the object is of variable-size. -(i.e. declared with a @code{_SEQUENCE_IMPLEMENTATION} macro.) This should -simply return the object's size in bytes, exactly as you might expect. -For an example, see the methods for window configurations and opaques. +(i.e. declared with a @code{DEFINE_*_SIZABLE_*_LISP_OBJECT} macro.) +This should simply return the object's size in bytes, exactly as you +might expect. For an example, see the methods for lstreams and opaques. + +@item +A @dfn{disksave} method. This is called at the end of the dump phase. +It is used for objects that contain pointers or handles to objects +created in external libraries, such as window-system windows or file +handles. Such external objects cannot be dumped, so it is necessary +to release them at dump time and arrange somehow or other for them to +be resurrected if necessary later on. + +It seems that even non-dumpable objects may be around at dump time, +and a disksaver may be provided. (In fact, the only object currently +with a disksaver, lstream, is non-dumpable.) + +Objects rarely need to provide this method; most of the time it will +be NULL. If you want to provide this method, you have to use the +@code{DEFINE_*_GENERAL_LISP_OBJECT()} macro to define your object. @end enumerate @node Low-level allocation, Cons, lrecords, Allocation of Objects in XEmacs Lisp @@ -9994,7 +10059,7 @@ BEGV, and ZV, and in addition to this we cache 16 positions where the conversion is known. We only look in the cache or update it when we need to move the known region more than a certain amount (currently 50 -chars), and then we throw away a "random" value and replace it with the +chars), and then we throw away a ``random'' value and replace it with the newly calculated value. Finally, we maintain an extra flag that tracks whether the buffer is @@ -10030,7 +10095,7 @@ original value. Dividing by 3, alas, cannot be implemented in any simple shift/subtract method, as far as I know; so we just do a table lookup. For simplicity, we use a table of size 128K, which indexes the -"divide-by-3" values for the first 64K non-negative numbers. (Note that +``divide-by-3'' values for the first 64K non-negative numbers. (Note that we can increase the size up to 384K, i.e. indexing the first 192K non-negative numbers, while still using shorts in the array.) This also means that the size of the known region can be at most 64K for @@ -10060,7 +10125,7 @@ @item the last value we computed @item -a set of positions that are "far away" from previously computed positions +a set of positions that are ``far away'' from previously computed positions (5000 chars currently; #### perhaps should be smaller) @end itemize @@ -10086,7 +10151,7 @@ @code{charcount_to_bytecount_down()}. (The latter two I added for this purpose.) These scan 4 or 8 bytes at a time through purely single-byte characters. -If the amount we had to scan was more than our "far away" distance (5000 +If the amount we had to scan was more than our ``far away'' distance (5000 characters, see above), then cache the new position. #### Things to do: @@ -10096,7 +10161,7 @@ Look at the most recent GNU Emacs to see whether anything has changed. @item Think about whether it makes sense to try to implement some sort of -known region or list of "known regions", like we had before. This would +known region or list of ``known regions'', like we had before. This would be a region of entirely single-byte characters that we can check very quickly. (Previously I used a range of same-width characters of any size; but this adds extra complexity and slows down the scanning, and is @@ -10314,7 +10379,7 @@ @enumerate @item -An explicit "failure stack" has been substituted for recursion. +An explicit ``failure stack'' has been substituted for recursion. @item The @code{match_1_operator}, @code{next_p}, and @code{next_b} functions @@ -10327,7 +10392,7 @@ @item Some cases are combined into short preparation for individual cases, and -a "fall-through" into combined code for several cases. +a ``fall-through'' into combined code for several cases. @item The @code{pattern} type is not an explicit @samp{struct}. Instead, the @@ -10346,7 +10411,7 @@ @end example @end enumerate -But if you keep your eye on the "switch in a loop" structure, you +But if you keep your eye on the ``switch in a loop'' structure, you should be able to understand the parts you need. @node Multilingual Support, Consoles; Devices; Frames; Windows, Text, Top @@ -10808,7 +10873,7 @@ its code point. For more complicated charsets, however, things are not so obvious. Unicode version 2, for example, is a large charset with thousands of characters, each indexed by a 16-bit number, often -represented in hex, e.g. 0x05D0 for the Hebrew letter "aleph". One +represented in hex, e.g. 0x05D0 for the Hebrew letter ``aleph''. One obvious encoding uses two bytes per character (actually two encodings, depending on which of the two possible byte orderings is chosen). This encoding is convenient for internal processing of Unicode text; however, @@ -10829,10 +10894,10 @@ There are 256 characters, and each character is represented using the numbers 0 through 255, which fit into a single byte. With a few exceptions (such as case-changing operations or syntax classes like -'whitespace'), "text" is simply an array of indices into a font. You +@code{whitespace}), ``text'' is simply an array of indices into a font. You can get different languages simply by choosing fonts with different 8-bit character sets (ISO-8859-1, -2, special-symbol fonts, etc.), and -everything will "just work" as long as anyone else receiving your text +everything will ``just work'' as long as anyone else receiving your text uses a compatible font. In the multi-lingual world, however, it is much more complicated. There @@ -10882,8 +10947,8 @@ assumptions can reliably be made about the format of this text. You cannot assume, for example, that the end of text is terminated by a null byte. (For example, if the text is Unicode, it will have many null bytes -in it.) You cannot find the next "slash" character by searching through -the bytes until you find a byte that looks like a "slash" character, +in it.) You cannot find the next ``slash'' character by searching through +the bytes until you find a byte that looks like a ``slash'' character, because it might actually be the second byte of a Kanji character. Furthermore, all text in the internal representation must be converted, even if it is known to be completely ASCII, because the external @@ -10913,7 +10978,7 @@ system aliases, which in essence gives a single coding system two different names. It is effectively used in XEmacs to provide a layer of abstraction on top of the actual coding systems. For example, the coding -system alias "file-name" points to whichever coding system is currently +system alias ``file-name'' points to whichever coding system is currently used for encoding and decoding file names as passed to or retrieved from system calls. In general, the actual encoding will differ from system to system, and also on the particular locale that the user is in. The use @@ -11424,8 +11489,8 @@ S = signed @end example -(Formerly I had a comment saying that type (e) "should be replaced with -void *". However, there are in fact many places where an unsigned char +(Formerly I had a comment saying that type (e) ``should be replaced with +void *''. However, there are in fact many places where an unsigned char * might be used -- e.g. for ease in pointer computation, since void * doesn't allow this, and for compatibility with external APIs.) @@ -11446,8 +11511,8 @@ @cindex different ways of seeing internal text There are various ways of representing internal text. The two primary -ways are as an "array" of individual characters; the other is as a -"stream" of bytes. In the ASCII world, where there are only 255 +ways are as an ``array'' of individual characters; the other is as a +``stream'' of bytes. In the ASCII world, where there are only 255 characters at most, things are easy because each character fits into a byte. In general, however, this is not true -- see the above discussion of characters vs. encodings. @@ -11455,12 +11520,12 @@ In some cases, it's also important to distinguish between a stream representation as a series of bytes and as a series of textual units. This is particularly important wrt Unicode. The UTF-16 representation -(sometimes referred to, rather sloppily, as simply the "Unicode" format) +(sometimes referred to, rather sloppily, as simply the ``Unicode'' format) represents text as a series of 16-bit units. Mostly, each unit corresponds to a single character, but not necessarily, as characters -outside of the range 0-65535 (the BMP or "Basic Multilingual Plane" of +outside of the range 0-65535 (the BMP or ``Basic Multilingual Plane'' of Unicode) require two 16-bit units, through the mechanism of -"surrogates". When a series of 16-bit units is serialized into a byte +``surrogates''. When a series of 16-bit units is serialized into a byte stream, there are at least two possible representations, little-endian and big-endian, and which one is used may depend on the native format of 16-bit integers in the CPU of the machine that XEmacs is running @@ -11477,10 +11542,10 @@ @item UTF-32 has 4-byte (32-bit) units. @item -XEmacs-internal encoding (the old "Mule" encoding) has 1-byte (8-bit) +XEmacs-internal encoding (the old ``Mule'' encoding) has 1-byte (8-bit) units. @item -UTF-7 technically has 7-bit units that are within the "mail-safe" range +UTF-7 technically has 7-bit units that are within the ``mail-safe'' range (ASCII 32 - 126 plus a few control characters), but normally is encoded in an 8-bit stream. (UTF-7 is also a modal encoding, since it has a normal mode where printable ASCII characters represent themselves and a @@ -11545,7 +11610,7 @@ The data in a buffer or string is logically made up of Ibyte objects, where a Ibyte takes up the same amount of space as a char. (It is declared differently, though, to catch invalid usages.) Strings stored -using Ibytes are said to be in "internal format". The important +using Ibytes are said to be in ``internal format''. The important characteristics of internal format are @itemize @minus @@ -11598,11 +11663,11 @@ 8-bit representation of ASCII/ISO-8859-1. @item Extbyte -Strings that go in or out of Emacs are in "external format", typedef'ed +Strings that go in or out of Emacs are in ``external format'', typedef'ed as an array of char or a char *. There is more than one external format (JIS, EUC, etc.) but they all have similar properties. They are modal encodings, which is to say that the meaning of particular bytes is not -fixed but depends on what "mode" the string is currently in (e.g. bytes +fixed but depends on what ``mode'' the string is currently in (e.g. bytes in the range 0 - 0x7f might be interpreted as ASCII, or as Hiragana, or as 2-byte Kanji, depending on the current mode). The mode starts out in ASCII/ISO-8859-1 and is switched using escape sequences -- for example, @@ -11632,7 +11697,7 @@ of these are one-based: the beginning of the buffer is position or index 1, and 0 is not a valid position. -As a "buffer position" (typedef Charbpos): +As a ``buffer position'' (typedef Charbpos): This is an index specifying an offset in characters from the beginning of the buffer. Note that buffer positions are @@ -11641,7 +11706,7 @@ characters between those positions. Buffer positions are the only kind of position externally visible to the user. -As a "byte index" (typedef Bytebpos): +As a ``byte index'' (typedef Bytebpos): This is an index over the bytes used to represent the characters in the buffer. If there is no Mule support, this is identical @@ -11651,7 +11716,7 @@ byte index may be greater than the corresponding buffer position. -As a "memory index" (typedef Membpos): +As a ``memory index'' (typedef Membpos): This is the byte index adjusted for the gap. For positions before the gap, this is identical to the byte index. For @@ -11660,7 +11725,7 @@ position; the memory index at the beginning of the gap should always be used, except in code that deals with manipulating the gap, where both indices may be seen. The address of the - character "at" (i.e. following) a particular position can be + character ``at'' (i.e. following) a particular position can be obtained from the formula buffer_start_address + memory_index(position) - 1 @@ -11769,7 +11834,7 @@ Some terminology: -"itext" appearing in the macros means "internal-format text" -- type +itext" appearing in the macros means "internal-format text" -- type @code{Ibyte *}. Operations on such pointers themselves, rather than on the text being pointed to, have "itext" instead of "itext" in the macro name. "ichar" in the macro names means an Ichar -- the representation @@ -11978,7 +12043,7 @@ @end itemize Turned out that all of the above had bugs, all caused by GCC (hence the -comments about "those GCC wankers" and "ream gcc up the ass"). As for +comments about ``those GCC wankers'' and ``ream gcc up the ass''). As for (a), some versions of GCC (especially on Intel platforms), which had buggy implementations of @code{alloca()} that couldn't handle being called inside of a function call -- they just decremented the stack right in the @@ -12961,7 +13026,7 @@ @item Extbyte, UExtbyte Pointer to text in some external format, which can be defined as all formats other than the internal one. The data representing a string -in "external" format (binary or any external encoding) is logically a +in ``external'' format (binary or any external encoding) is logically a set of Extbytes. Extbyte is guaranteed to be just a char, so for example strlen (Extbyte *) is OK. Extbyte is only a documentation device for referring to external text. @@ -13105,7 +13170,7 @@ @subsection Mule-izing Code A lot of code is written without Mule in mind, and needs to be made -Mule-correct or "Mule-ized". There is really no substitute for +Mule-correct or ``Mule-ized''. There is really no substitute for line-by-line analysis when doing this, but the following checklist can help: @@ -13323,23 +13388,23 @@ @end enumerate @node Locales, More about code pages, Microsoft Documentation, Microsoft Windows-Related Multilingual Issues -@subsection Locales, code pages, and other concepts of "language" -@cindex locales, code pages, and other concepts of "language" +@subsection Locales, code pages, and other concepts of ``language'' +@cindex locales, code pages, and other concepts of ``language'' First, make sure you clearly understand the difference between the C runtime library (CRT) and the Win32 API! See win32.c. There are various different ways of representing the vague concept -of "language", and it can be very confusing. So: - -@itemize @bullet -@item -The CRT library has the concept of "locale", which is a +of ``language'', and it can be very confusing. So: + +@itemize @bullet +@item +The CRT library has the concept of ``locale'', which is a combination of language and country, and which controls the way currency and dates are displayed, the encoding of data, etc. @item -XEmacs has the concept of "language environment", more or less +XEmacs has the concept of ``language environment'', more or less like a locale; although currently in most cases it just refers to the language, and no sub-language distinctions are made. (Exceptions are with Chinese, which has different language @@ -13351,23 +13416,23 @@ @enumerate @item -There are "languages" and "sublanguages", which correspond to +There are ``languages'' and ``sublanguages'', which correspond to the languages and countries of the C library -- e.g. LANG_ENGLISH and SUBLANG_ENGLISH_US. These are identified by 8-bit integers, -called the "primary language identifier" and "sublanguage -identifier", respectively. These are combined into a 16-bit -integer or "language identifier" by MAKELANGID(). - -@item -The language identifier in turn is combined with a "sort -identifier" (and optionally a "sort version") to yield a 32-bit -integer called a "locale identifier" (type LCID), which identifies +called the ``primary language identifier'' and ``sublanguage +identifier'', respectively. These are combined into a 16-bit +integer or ``language identifier'' by @code{MAKELANGID()}. + +@item +The language identifier in turn is combined with a ``sort +identifier'' (and optionally a ``sort version'') to yield a 32-bit +integer called a ``locale identifier'' (type LCID), which identifies locales -- the primary means of distinguishing language/regional settings and similar to C library locales. @item -A "code page" combines the XEmacs concepts of "charset" and "coding -system". It logically encompasses +A ``code page'' combines the XEmacs concepts of ``charset'' and ``coding +system''. It logically encompasses @itemize @minus @item @@ -13380,12 +13445,12 @@ a way of encoding a series of characters into a string of bytes @end itemize -Note that the first two properties correspond to an XEmacs "charset" -and the latter an XEmacs "coding system". +Note that the first two properties correspond to an XEmacs ``charset'' +and the latter an XEmacs ``coding system''. Traditional encodings are either simple one-byte encodings, or combination one-byte/two-byte encodings (aka MBCS encodings, where MBCS -stands for "Multibyte Character Set") with the following properties: +stands for ``Multibyte Character Set'') with the following properties: @itemize @minus @item @@ -13395,7 +13460,7 @@ @item the lower 128 bytes are compatible with ASCII @item -in the higher bytes, the value of the first byte ("lead byte") +in the higher bytes, the value of the first byte (``lead byte'') determines whether a second byte follows @item the values used for second bytes may overlap those used for first @@ -13417,22 +13482,22 @@ native code page under Windows), OEM (a DOS encoding, still used in the FAT file system), Mac (an encoding used on the Macintosh) and EBCDIC (a non-ASCII-compatible encoding used on IBM mainframes, originally based -on the BCD or "binary-coded decimal" encoding of numbers). All code +on the BCD or ``binary-coded decimal'' encoding of numbers). All code pages associated with a locale follow (as far as I know) the properties listed above for traditional code pages. More than one locale can share a code page -- e.g. all the Western European languages, including English, do. @item -Windows also has an "input locale identifier" (aka "keyboard -layout id") or HKL, which is a 32-bit integer composed of the -16-bit language identifier and a 16-bit "device identifier", which +Windows also has an ``input locale identifier'' (aka ``keyboard +layout id'') or HKL, which is a 32-bit integer composed of the +16-bit language identifier and a 16-bit ``device identifier'', which originally specified a particular keyboard layout (e.g. the locale -"US English" can have the QWERTY layout, the Dvorak layout, etc.), +``US English'' can have the QWERTY layout, the Dvorak layout, etc.), but has been expanded to include speech-to-text converters and other non-keyboard ways of inputting text. Note that both the HKL and LCID share the language identifier in the lower 16 bits, and in -both cases a 0 in the upper 16 bits means "default" (sort order or +both cases a 0 in the upper 16 bits means ``default'' (sort order or device), providing a way to convert between HKL's, LCID's, and language identifiers (i.e. language/sublanguage pairs). The default keyboard layout for a language is (as far as I can @@ -13450,7 +13515,7 @@ @subsection More about code pages @cindex more about code pages -Here is what MSDN says about code pages (article "Code Pages"): +Here is what MSDN says about code pages (article ``Code Pages''): @quotation A code page is a character set, which can include numbers, @@ -13492,10 +13557,10 @@ which C programs have traditionally executed. The code page for the "C" locale (code page) corresponds to the ASCII character set. For example, in the "C" locale, islower returns true for the -values 0x61 ?0x7A only. In another locale, islower may return true +values 0x61 to 0x7A only. In another locale, islower may return true for these as well as other values, as defined by that locale. -Under "Locale-Dependent Routines" we notice the following setlocale +Under ``Locale-Dependent Routines'' we notice the following setlocale dependencies: atof, atoi, atol (LC_NUMERIC) @@ -13528,8 +13593,8 @@ _wtoi/_wtol (LC_NUMERIC) @end quotation -NOTE: The above documentation doesn't clearly explain the "locale code -page" and "multibyte code page". These are two different values, +NOTE: The above documentation doesn't clearly explain the ``locale code +page'' and ``multibyte code page''. These are two different values, maintained respectively in the CRT global variables __lc_codepage and __mbcodepage. Calling e.g. setlocale (LC_ALL, "JAPANESE") sets @strong{ONLY} __lc_codepage to 932 (the code page for Japanese), and leaves @@ -13539,12 +13604,12 @@ @itemize @bullet @item -from "Interpretation of Multibyte-Character Sequences" it appears that -all "multibyte-character routines" use the multibyte code page except for -mblen(), _mbstrlen(), mbstowcs(), mbtowc(), wcstombs(), and wctomb(). - -@item -from "_setmbcp": "The multibyte code page also affects +from ``Interpretation of Multibyte-Character Sequences'' it appears that +all ``multibyte-character routines'' use the multibyte code page except for +@code{mblen()}, @code{_mbstrlen()}, @code{mbstowcs()}, @code{mbtowc()}, @code{wcstombs()}, and @code{wctomb()}. + +@item +from ``_setmbcp'': ``The multibyte code page also affects multibyte-character processing by the following run-time library routines: _exec functions _mktemp _stat _fullpath _spawn functions _tempnam _makepath _splitpath tmpnam. In addition, all run-time library @@ -13552,7 +13617,7 @@ as parameters (such as the _exec and _spawn families) process these strings according to the multibyte code page. Hence these routines are also affected by a call to _setmbcp that changes the multibyte code -page." +page.'' @end itemize Summary: from looking at the CRT source (which comes with VC++) and @@ -13560,15 +13625,15 @@ @itemize @bullet @item -the "locale code page" is used by all of the routines listed above -under "Locale-Dependent Routines" (EXCEPT _mbccpy() and _mbclen()), +the ``locale code page'' is used by all of the routines listed above +under ``Locale-Dependent Routines'' (EXCEPT @code{_mbccpy()} and @code{_mbclen()}), as well as any other place that converts between multibyte and Unicode strings, e.g. the startup code. @item -the "multibyte code page" is used in all of the *mb*() routines -except mblen(), _mbstrlen(), mbstowcs(), mbtowc(), wcstombs(), -and wctomb(); also _exec*(), _spawn*(), _mktemp(), _stat(), _fullpath(), -_tempnam(), _makepath(), _splitpath(), tmpnam(), and similar functions +the ``multibyte code page'' is used in all of the @code{mb*()} routines +except @code{mblen()}, @code{_mbstrlen()}, @code{mbstowcs()}, @code{mbtowc()}, @code{wcstombs()}, +and @code{wctomb()}; also @code{_exec*()}, @code{_spawn*()}, @code{_mktemp()}, @code{_stat()}, @code{_fullpath()}, +@code{_tempnam()}, @code{_makepath()}, @code{_splitpath()}, @code{tmpnam()}, and similar functions without the leading underscore. @end itemize @@ -13581,16 +13646,16 @@ @itemize @bullet @item -The system-default locale is the locale defined under "Language -settings for the system" in the "Regional Options" control panel. This +The system-default locale is the locale defined under ``Language +settings for the system'' in the ``Regional Options'' control panel. This is NOT user-specific, and changing it requires a reboot (at least under Windows 2000). The ANSI code page of the system-default locale is -returned by GetACP(), and you can specify this code page in calls +returned by @code{GetACP()}, and you can specify this code page in calls e.g. to MultiByteToWideChar with the constant CP_ACP. @item -The user-default locale is the locale defined under "Settings for the -current user" in the "Regional Options" control panel. +The user-default locale is the locale defined under ``Settings for the +current user'' in the ``Regional Options'' control panel. @item There is a thread-local locale set by SetThreadLocale. #### What is this @@ -13598,11 +13663,11 @@ @end itemize The Win32 API has a bunch of multibyte functions -- all of those that -end with ...A(), and on which we spend so much effort in +end with ...@code{A()}, and on which we spend so much effort in intl-encap-win32.c. These appear to ALWAYS use the ANSI code page of -the system-default locale (GetACP(), CP_ACP). Note that this applies +the system-default locale (@code{GetACP()}, CP_ACP). Note that this applies also, for example, to the encoding of filenames in all file-handling -routines, including the CRT ones such as open(), because they pass their +routines, including the CRT ones such as @code{open()}, because they pass their args unchanged to the Win32 API. @node Unicode support under Windows, The golden rules of writing Unicode-safe code, More about locales, Microsoft Windows-Related Multilingual Issues @@ -13620,20 +13685,20 @@ Under Windows there are two different versions of all library routines that accept or return text, those that handle Unicode text and those handling -"multibyte" text, i.e. variable-width ASCII-compatible text in some +``multibyte'' text, i.e. variable-width ASCII-compatible text in some national format such as EUC or Shift-JIS. Because Windows 95 basically doesn't support Unicode but Windows NT does, and Microsoft doesn't provide any way of writing a single binary that will work on both systems and still use Unicode when it's available (although see below, Microsoft Layer for Unicode), we need to provide a way of run-time conditionalizing so you -could have one binary for both systems. "Unicode-splitting" refers to +could have one binary for both systems. ``Unicode-splitting'' refers to writing code that will handle this properly. This means using Qmswindows_tstr as the external conversion format, calling the appropriate qxe...() Unicode-split version of library functions, and doing other things -in certain cases, e.g. when a qxe() function is not present. +in certain cases, e.g. when a @code{qxe()} function is not present. Unicode support also requires that the various Windows APIs be -"Unicode-encapsulated", so that they automatically call the ANSI or +``Unicode-encapsulated'', so that they automatically call the ANSI or Unicode version of the API call appropriately and handle the size differences in structures. What this means is: @@ -13641,7 +13706,7 @@ @item first, note that Windows already provides a sort of encapsulation of all APIs that deal with text. All such APIs are underlyingly -provided in two versions, with an A or W suffix (ANSI or "wide" +provided in two versions, with an A or W suffix (ANSI or ``wide'' i.e. Unicode), and the compile-time constant UNICODE controls which is selected by the unsuffixed API. Same thing happens with structures, and also with types, where the generic types have names beginning with T -- @@ -13660,7 +13725,7 @@ @item what we do is provide an encapsulation of each standard Windows API call that is split into A and W versions. current theory is to avoid all -preprocessor games; so we name the function with a prefix -- "qxe" +preprocessor games; so we name the function with a prefix -- ``qxe'' currently -- and require callers to use the prefixed name. Callers need to explicitly use the W version of all structures, and convert text themselves using Qmswindows_tstr. the qxe encapsulated version will @@ -13720,8 +13785,8 @@ think twice before doing this. According to Microsoft documentation, only the following functions are -provided under Windows 9x to support Unicode (see MSDN page "Windows -95/98/Me General Limitations"): +provided under Windows 9x to support Unicode (see MSDN page ``Windows +95/98/Me General Limitations''): EnumResourceLanguagesW EnumResourceNamesW @@ -13742,8 +13807,8 @@ TextOutW WideCharToMultiByte -also maybe GetTextExtentExPoint? (KB Q125671 "Unicode Functions Supported -by Windows 95") +also maybe GetTextExtentExPoint? (KB Q125671 ``Unicode Functions Supported +by Windows 95'') Q210341 says this in addition: @@ -13768,7 +13833,7 @@ The Unicode standard offers application developers an opportunity to work with text without the limitations of character set based systems. For more information on the Unicode standard see the -"References" section of this article. Windows NT is a fully Unicode +References" section of this article. Windows NT is a fully Unicode capable operating system so it may be desirable to write software that supports Unicode on Windows 95. @@ -13851,12 +13916,12 @@ wmain() is completely supported, and appropriate Unicode-formatted argv and envp will always be passed. @item -Likewise, wWinMain() is completely supported. (NOTE: The docs are not at +Likewise, @code{wWinMain()} is completely supported. (NOTE: The docs are not at all clear on how these various entry points interact, and implies that -a windows-subsystem program "must" use WinMain(), while a console- -subsystem program "must" use main(), and a program compiled with UNICODE -(which we don't, see above) "must" use the w*() versions, while a program -not compiled this way "must" use the plain versions. In fact it appears +a windows-subsystem program ``must'' use @code{WinMain()}, while a console- +subsystem program ``must'' use @code{main()}, and a program compiled with UNICODE +(which we don't, see above) ``must'' use the @code{w*()} versions, while a program +not compiled this way ``must'' use the plain versions. In fact it appears that the CRT provides four different compiler entry points, namely w?(main|WinMain)CRTStartup, and we simply choose the one we like using the appropriate link flag. @@ -17668,7 +17733,7 @@ types such as scrollbars. -@node Window-System Support, The Redisplay Mechanism, Consoles; Devices; Frames; Windows, Top +@node Window-System Support, Window and Frame Geometry, Consoles; Devices; Frames; Windows, Top @chapter Window-System Support @cindex window-system support @cindex window systems @@ -17735,7 +17800,7 @@ and tty consoles as well as doing a complete refactoring of the console, device, and frame code.) -What is desireable is sharing console, device, and frame methods across +What is desirable is sharing console, device, and frame methods across platforms in a more general way, reducing the amount of duplicated code by pulling it back into the redisplay engine proper or the Lisp modules as appropriate. For example, we should be able to use @@ -17788,7 +17853,7 @@ there is a @samp{CONSOLE_INHERITS_METHOD} constructor, but this actually constructs the name of the parent's method pointer and stores in the derived console type's method table. Of course this is time-efficient, -and since there are few console types it is a neglible waste of space. +and since there are few console types it is a negligible waste of space. However in practice this may have contributed to breaking the various abstractions, and the variant console must be coded in the same file as the parent (because the methods are static). Another minor symptom of @@ -17851,7 +17916,338 @@ -@node The Redisplay Mechanism, Extents, Window-System Support, Top +@node Window and Frame Geometry, The Redisplay Mechanism, Window-System Support, Top +@chapter Window and Frame Geometry + +@menu +* Intro to Window and Frame Geometry:: +* The Frame:: +* The Non-Client Area:: +* The Client Area:: +* The Paned Area:: +* Text Areas:: +* The Displayable Area:: +* Which Functions Use Which?:: +@end menu + +@node Intro to Window and Frame Geometry, The Frame, Window and Frame Geometry, Window and Frame Geometry +@section Intro to Window and Frame Geometry + +Here is an ASCII diagram: + +@example ++------------------------------------------------------------------------| +| window-manager decoration | +| +--------------------------------------------------------------------+ | +| | menubar | | +| ###################################################################### | +| # toolbar # | +| #--------------------------------------------------------------------# | +| # | internal border | # | +| # | +----------------------------------------------------------+ | # | +| # | | gutter | | # | +| # | |-********************************************************-| | # | +|w# | | *@| scrollbar |v* |s* | | #w| +|i# | | *-+-------------------------|e* |c* | | #i| +|n# | | *s| |r* |r* | | #n| +|d# | | *c| |t* |o* | | #d| +|o# | | *r| |.* text area |l* | | #o| +|w# |i| *o| | * |l* |i| #w| +|-# |n| *l| text area |d* |b* |n| #-| +|m# |t| *l| |i* |a* |t| #m| +|a# |e| *b| |v* |r* |e| #a| +|n# t|r| *a| |i*----------------------+-* |r|t #n| +|a# o|n|g*r| |d* scrollbar |@*g|n|o #a| +|g# o|a|u*-+-------------------------|e*----------------------+-*u|a|o #g| +|e# l|l|t* modeline |r* modeline *t|l|l #e| +|r# b| |t********************************************************t| |b #r| +| # a|b|e* =..texttexttex....= |s|v* |s*e|b|a # | +|d# r|o|r*o m=..texttexttextt..=o m|c|e* |c*r|o|r #d| +|e# |r| *u a=.exttexttextte...=u a|r|r* |r* |r| #e| +|c# |d| *t r=....texttexttex..=t r|o|t* |o* |d| #c| +|o# |e| *s g= etc. =s g|l|.* text area |l* |e| #o| +|r# |r| *i i= =i i|l| * |l* |r| #r| +|a# | | *d n= =d n|b|d* |b* | | #a| +|t# | | *e = inner text area =e |a|i* |a* | | #t| +|i# | | * = = |r|v* |r* | | #i| +|o# | | *---===================---+-|i*----------------------+-* | | #o| +|n# | | * scrollbar |@|d* scrollbar |@* | | #n| +| # | | *-------------------------+-|e*----------------------+-* | | # | +| # | | * modeline |r* modeline * | | # | +| # | |-********************************************************-| | # | +| # | | gutter | | # | +| # | |-********************************************************-| | # | +| # | |@* minibuffer *@| | # | +| # | +-********************************************************-+ | # | +| # | internal border | # | +| #--------------------------------------------------------------------# | +| # toolbar # | +| ###################################################################### | +| window manager decoration | ++------------------------------------------------------------------------+ + +# = boundary of client area; * = window boundaries, boundary of paned area += = boundary of inner text area; . = inside margin area; @ = dead boxes +@end example + +Note in particular what happens at the corners, where a ``corner box'' +occurs. Top and bottom toolbars take precedence over left and right +toolbars, extending out horizontally into the corner boxes. Gutters +work the same way. The corner box where the scrollbars meet, however, +is assigned to neither scrollbar, and is known as the ``dead box''; it is +an area that must be cleared specially. There are similar dead boxes at +the bottom-right and bottom-left corners where the minibuffer and +left/right gutters meet, but there is currently a bug in that these dead +boxes are not explicitly cleared and may contain junk. + +@node The Frame, The Non-Client Area, Intro to Window and Frame Geometry, Window and Frame Geometry +@section The Frame + +The ``top-level window area'' is the entire area of a top-level window (or +``frame''). The ``client area'' (a term from MS Windows) is the area of a +top-level window that XEmacs draws into and manages with redisplay. +This includes the toolbar, scrollbars, gutters, dividers, text area, +modeline and minibuffer. It does not include the menubar, title or +outer borders. The ``non-client area'' is the area of a top-level window +outside of the client area and includes the menubar, title and outer +borders. Internally, all frame coordinates are relative to the client +area. + + +@node The Non-Client Area, The Client Area, The Frame, Window and Frame Geometry +@section The Non-Client Area + +Under X, the non-client area is split into two parts: + +@enumerate +@item +The outer layer is the window-manager decorations: The title and +borders. These are controlled by the window manager, a separate process +that controls the desktop, the location of icons, etc. When a process +tries to create a window, the window manager intercepts this action and +``reparents'' the window, placing another window around it which contains +the window decorations, including the title bar, outer borders used for +resizing, etc. The window manager also implements any actions involving +the decorations, such as the ability to resize a window by dragging its +borders, move a window by dragging its title bar, etc. If there is no +window manager or you kill it, windows will have no decorations (and +will lose them if they previously had any) and you will not be able to +move or resize them. + +@item +Inside of the window-manager decorations is the ``shell'', which is +managed by the toolkit and widget libraries your program is linked with. +The code in @file{*-x.c} uses the Xt toolkit and various possible widget +libraries built on top of Xt, such as Motif, Athena, the ``Lucid'' +widgets, etc. Another possibility is GTK (@file{*-gtk.c}), which implements +both the toolkit and widgets. Under Xt, the ``shell'' window is an +EmacsShell widget, containing an EmacsManager widget of the same size, +which in turn contains a menubar widget and an EmacsFrame widget, inside +of which is the client area. (The division into EmacsShell and +EmacsManager is due to the complex and screwy geometry-management system +in Xt [and X more generally]. The EmacsShell handles negotiation with +the window manager; the place of the EmacsManager widget is normally +assumed by a widget that manages the geometry of its child widgets, but +the EmacsManager widget just lets the XEmacs redisplay mechanism do the +positioning.) +@end enumerate + +Under Windows, the non-client area is managed by the window system. +There is no division such as under X. Part of the window-system API +(@file{USER.DLL}) of Win32 includes functions to control the menubars, title, +etc. and implements the move and resize behavior. There @strong{is} an +equivalent of the window manager, called the ``shell'', but it manages +only the desktop, not the windows themselves. The normal shell under +Windows is @file{EXPLORER.EXE}; if you kill this, you will lose the bar +containing the ``Start'' menu and tray and such, but the windows +themselves will not be affected or lose their decorations. + + +@node The Client Area, The Paned Area, The Non-Client Area, Window and Frame Geometry +@section The Client Area + +Inside of the client area is the toolbars, the gutters (where the buffer +tabs are displayed), the minibuffer, the internal border width, and one +or more non-overlapping ``windows'' (this is old Emacs terminology, from +before the time when frames existed at all; the standard terminology for +this would be ``pane''). Each window can contain a modeline, horizontal +and/or vertical scrollbars, and (for non-rightmost windows) a vertical +divider, surrounding a text area. + +The dimensions of the toolbars and gutters are determined by the formula +(THICKNESS + 2 * BORDER-THICKNESS), where ``thickness'' is a cover term +for height or width, as appropriate. The height and width come from +@code{default-toolbar-height} and @code{default-toolbar-width} and the specific +versions of these (@code{top-toolbar-height}, @code{left-toolbar-width}, etc.). +The border thickness comes from @code{default-toolbar-border-height} and +@code{default-toolbar-border-width}, and the specific versions of these. The +gutter works exactly equivalently. + +Note that for any particular toolbar or gutter, it will only be +displayed if [a] its visibility specifier (@code{default-toolbar-visible-p} +etc.) is non-nil; [b] its thickness (@code{default-toolbar-height} etc.) is +greater than 0; [c] its contents (@code{default-toolbar} etc.) are non-nil. + +The position-specific toolbars interact with the default specifications +as follows: If the value for a position-specific specifier is not +defined in a particular domain (usually a window), and the position of +that specifier is set as the default position (using +@code{default-toolbar-position}), then the value from the corresponding +default specifier in that domain will be used. The gutters work the +same. + + +@node The Paned Area, Text Areas, The Client Area, Window and Frame Geometry +@section The Paned Area + +The area occupied by the ``windows'' is called the paned area. +Unfortunately, because of the presence of the gutter @strong{between} the +minibuffer and other windows, the bottom of the paned area is not +well-defined -- does it include the minibuffer (in which case it also +includes the bottom gutter, but none others) or does it not include +the minibuffer? (In which case not all windows are included.) It would +be cleaner to put the bottom gutter @strong{below} the minibuffer instead of +above it. + +Each window can include a horizontal and/or vertical scrollbar, a +modeline and a vertical divider to its right, as well as the text area. +Only non-rightmost windows can include a vertical divider. (The +minibuffer normally does not include either modeline or scrollbars.) + +Note that, because the toolbars and gutters are controlled by +specifiers, and specifiers can have window-specific and buffer-specific +values, the size of the paned area can change depending on which window +is selected: In other words, if the selected window or buffer changes, +the entire paned area for the frame may change. + + +@node Text Areas, The Displayable Area, The Paned Area, Window and Frame Geometry +@section Text Areas, Fringes, Margins + +The space occupied by a window can be divided into the text area and the +fringes. The fringes include the modeline, scrollbars and vertical +divider on the right side (if any); inside of this is the text area, +where the text actually occurs. Note that a window may or may not +contain any of the elements that are part of the fringe -- this is +controlled by specifiers, e.g. @code{has-modeline-p}, +@code{horizontal-scrollbar-visible-p}, @code{vertical-scrollbar-visible-p}, +@code{vertical-divider-always-visible-p}, etc. + +In addition, it is possible to set margins in the text area using the +specifiers @code{left-margin-width} and @code{right-margin-width}. When this is +done, only the ``inner text area'' (the area inside of the margins) will +be used for normal display of text; the margins will be used for glyphs +with a layout policy of @code{outside-margin} (as set on an extent containing +the glyph by @code{set-extent-begin-glyph-layout} or +@code{set-extent-end-glyph-layout}). However, the calculation of the text +area size (e.g. in the function @code{window-text-area-width}) includes the +margins. Which margin is used depends on whether a glyph has been set +as the begin-glyph or end-glyph of an extent (@code{set-extent-begin-glyph} +etc.), using the left and right margins, respectively. + +Technically, the margins outside of the inner text area are known as the +``outside margins''. The ``inside margins'' are in the inner text area and +constitute the whitespace between the outside margins and the first or +last non-whitespace character in a line; their width can vary from line +to line. Glyphs will be placed in the inside margin if their layout +policy is @code{inside-margin} or @code{whitespace}, with @code{whitespace} glyphs on +the inside and @code{inside-margin} glyphs on the outside. Inside-margin +glyphs can spill over into the outside margin if @code{use-left-overflow} or +@code{use-right-overflow}, respectively, is non-nil. + +See the Lisp Reference manual, under Annotations, for more details. + + +@node The Displayable Area, Which Functions Use Which?, Text Areas, Window and Frame Geometry +@section The Displayable Area + +The ``displayable area'' is not so much an actual area as a convenient +fiction. It is the area used to convert between pixel and character +dimensions for frames. The character dimensions for a frame (e.g. as +returned by @code{frame-width} and @code{frame-height} and set by +@code{set-frame-width} and @code{set-frame-height}) are determined from the +displayable area by dividing by the pixel size of the default font as +instantiated in the frame. (For proportional fonts, the ``average'' width +is used. Under Windows, this is a built-in property of the fonts. +Under X, this is based on the width of the lowercase 'n', or if this is +zero then the width of the default character. [We prefer 'n' to the +specified default character because many X fonts have a default +character with a zero or otherwise non-representative width.]) + +The displayable area is essentially the ``theoretical'' gutter area of the +frame, excluding the rightmost and bottom-most scrollbars. That is, it +starts from the client (or ``total'') area and then excludes the +``theoretical'' toolbars and bottom-most/rightmost scrollbars, and the +internal border width. In this context, ``theoretical'' means that all +calculations on based on frame-level values for toolbar and scrollbar +thicknesses. Because these thicknesses are controlled by specifiers, +and specifiers can have window-specific and buffer-specific values, +these calculations may or may not reflect the actual size of the paned +area or of the scrollbars when any particular window is selected. Note +also that the ``displayable area'' may not even be contiguous! In +particular, the gutters are included, but the bottom-most and rightmost +scrollbars are excluded even though they are inside of the gutters. +Furthermore, if the frame-level value of the horizontal scrollbar height +is non-zero, then the displayable area includes the paned area above and +below the bottom horizontal scrollbar (i.e. the modeline and minibuffer) +but not the scrollbar itself. + +As a further twist, the character-dimension calculations are adjusted so +that the truncation and continuation glyphs (see @code{truncation-glyph} and +@code{continuation-glyph}) count as a single character even if they are wider +than the default font width. (Technically, the character width is +computed from the displayable-area width by subtracting the maximum of +the truncation-glyph width, continuation-glyph width and default-font +width before dividing by the default-font width, and then adding 1 to +the result.) (The ultimate motivation for this kludge as well as the +subtraction of the scrollbars, but not the minibuffer or bottom-most +modeline, is to maintain compatibility with TTY's.) + +Despite all these concerns and kludges, however, the ``displayable area'' +concept works well in practice and mostly ensures that by default the +frame will actually fit 79 characters + continuation/truncation glyph. + + +@node Which Functions Use Which?, , The Displayable Area, Window and Frame Geometry +@section Which Functions Use Which? + +@enumerate +@item +Top-level window area: + +@example +set-frame-position +@code{left} and @code{top} frame properties +@end example + +@item +Client area: + +@example +frame-pixel-*, set-frame-pixel-* +@end example + +@item +Paned area: + +@example +window-pixel-edges +event-x-pixel, event-y-pixel, event-properties, make-event +@end example + +@item +Displayable area: + +@example +frame-width, frame-height and other all functions specifying frame size + in characters +frame-displayable-pixel-* +@end example +@end enumerate + + + +@node The Redisplay Mechanism, Extents, Window and Frame Geometry, Top @chapter The Redisplay Mechanism @cindex redisplay mechanism, the @@ -18491,14 +18887,14 @@ @example -@file{objects-msw.c} -@file{objects-msw.h} -@file{objects-tty.c} -@file{objects-tty.h} -@file{objects-x.c} -@file{objects-x.h} -@file{objects.c} -@file{objects.h} +@file{fontcolor-msw.c} +@file{fontcolor-msw.h} +@file{fontcolor-tty.c} +@file{fontcolor-tty.h} +@file{fontcolor-x.c} +@file{fontcolor-x.h} +@file{fontcolor.c} +@file{fontcolor.h} @end example @@ -19456,7 +19852,7 @@ @cindex queues, event There are two event queues here -- the command event queue (#### which -should be called "deferred event queue" and is in my glyph ws) and the +should be called ``deferred event queue'' and is in my glyph ws) and the dispatch event queue. (MS Windows actually has an extra dispatch queue for non-user events and uses the generic one only for user events. This is because user and non-user events in Windows come through the same @@ -19561,7 +19957,7 @@ XEmacs calls this with an event structure which contains window-system dependent information that XEmacs doesn't need to know about, but which must happen in order. If the @code{next_event_cb} never returns an -event of type "magic", this will never be used. +event of type ``magic'', this will never be used. @item format_magic_event_cb Called with a magic event; print a representation of the innards of the @@ -19593,7 +19989,7 @@ These callbacks tell the underlying implementation to add or remove a file descriptor from the list of fds which are polled for inferior-process input. When input becomes available on the given -process connection, an event of type "process" should be generated. +process connection, an event of type ``process'' should be generated. @item select_console_cb @item unselect_console_cb @@ -19721,7 +20117,7 @@ Ben's capsule lecture on focus: In GNU Emacs @code{select-frame} never changes the window-manager frame -focus. All it does is change the "selected frame". This is similar to +focus. All it does is change the ``selected frame''. This is similar to what happens when we call @code{select-device} or @code{select-console}. Whenever an event comes in (including a keyboard event), its frame is selected; therefore, evaluating @code{select-frame} in @samp{*scratch*} @@ -19756,8 +20152,8 @@ minibuffer. GNU Emacs solves this with the crockish @code{redirect-frame-focus}, -which says "for keyboard events received from FRAME, act like they're -coming from FOCUS-FRAME". I think what this means is that, when a +which says ``for keyboard events received from FRAME, act like they're +coming from FOCUS-FRAME''. I think what this means is that, when a keyboard event comes in and the event manager is about to select the event's frame, if that frame has its focus redirected, the redirected-to frame is selected instead. That way, if you're in a minibufferless @@ -19771,8 +20167,8 @@ @code{select-frame} (but not if @code{handle-switch-frame} is called), and saves and restores the frame focus in window configurations, etc. etc. All of this logic is heavily @code{#if 0}'d, with lots of -comments saying "No, this approach doesn't seem to work, so I'm trying -this ... is it reasonable? Well, I'm not sure ..." that are a red flag +comments saying ``No, this approach doesn't seem to work, so I'm trying +this ... is it reasonable? Well, I'm not sure ...'' that are a red flag indicating crockishness. Because of our way of doing things, we can avoid all this crock. @@ -24555,22 +24951,22 @@ likelihood and a list of additional properties indicating certain features detected in the data. The extra properties returned are defined entirely by the particular coding system type and are used -only in the algorithm described below under "user control." However, +only in the algorithm described below under ``user control.'' However, the levels of likelihood have a standard meaning as follows: -Level 4 means "near certainty" and typically indicates that a +Level 4 means ``near certainty'' and typically indicates that a signature has been detected, usually at the beginning of the data, indicating that the data is encoded in this particular coding system type. An example of this would be the byte order mark at the beginning of UCS2 encoded data or the GZIP mark at the beginning of GZIP data. -Level 3 means "highly likely" and indicates that tell-tale signs have +Level 3 means ``highly likely'' and indicates that tell-tale signs have been discovered in the data that are characteristic of this particular coding system type. Examples of this might be ISO 2022 escape sequences or the current Unicode end of line markers at regular intervals. -Level 2 means "strongly statistically likely" indicating that +Level 2 means ``strongly statistically likely'' indicating that statistical analysis concludes that there's a high chance that this data is encoded according to this particular type. For example, this might mean that for UCS2 data, there is a high proportion of null bytes @@ -24579,7 +24975,7 @@ this might indicate that there were no illegal Shift-JIS sequences and a fairly high occurrence of common Shift-JIS characters. -Level 1 means "weak statistical likelihood" meaning that there is some +Level 1 means ``weak statistical likelihood'' meaning that there is some indication that the data is encoded in this coding system type. In fact, there is a reasonable chance that it may be some other type as well. This means, for example, that no illegal sequences were @@ -24587,17 +24983,17 @@ not in other coding system types. For Shift-JIS data, this might mean that some bytes in the range 128 to 159 were encountered in the data. -Level 0 means "neutral" which is to say that there's either not enough +Level 0 means ``neutral'' which is to say that there's either not enough data to make any decision or that the data could well be interpreted as this type (meaning no illegal sequences), but there is little or no indication of anything particular to this particular type. -Level -1 means "weakly unlikely" meaning that some data was +Level -1 means ``weakly unlikely'' meaning that some data was encountered that could conceivably be part of the coding system type but is probably not. For example, successively long line-lengths or very rarely-encountered sequences. -Level -2 means "strongly unlikely" meaning that typically a number +Level -2 means ``strongly unlikely'' meaning that typically a number of illegal sequences were encountered. The algorithm to determine when to stop and indicate that the data has @@ -24616,8 +25012,8 @@ subtypes). It is perfectly legal and quite common in fact, to list the same subtype more than once in the priority list with successively lower requirements. Other facts that can be listed in the priority -list for a subtype are "reject", meaning that the data should never be -detected as this subtype, or "ask", meaning that if the data is +list for a subtype are ``reject'', meaning that the data should never be +detected as this subtype, or ``ask'', meaning that if the data is detected to be this subtype, the user will be asked whether they actually mean this. This latter property could be used, for example, towards the bottom of the priority list. @@ -24634,7 +25030,7 @@ a status box somewhere. If no positive match is found according to the priority list, or if -the matches that are found have the "ask" property on them, then the +the matches that are found have the ``ask'' property on them, then the user will be presented with a list of choices of possible encodings and asked to choose one. This list is typically sorted first by level of likelihood, and then within this, by the order in which the @@ -24651,10 +25047,10 @@ which may either indicate definitely malformed data but from which it's possible to recover, or simply data that appears rather questionable. If any of these status values are reported during -decoding, the user will be informed of this and asked "are you sure?" -As part of the "are you sure" dialog box or question, the user can +decoding, the user will be informed of this and asked ``are you sure?'' +As part of the ``are you sure'' dialog box or question, the user can display the results of the decoding to make sure it's correct. If the -user says "no, they're not sure," then the same list of choices as +user says ``no, they're not sure,'' then the same list of choices as previously mentioned will be presented. @subheading RFC: Autodetection @@ -24874,7 +25270,7 @@ @item Hopefully a system general enough to handle (2)--(4) will handle these, too, but we should watch out for gotchas like -Unicode "plane 14" tags which (I think _both_ Ben and Olivier +Unicode ``plane 14'' tags which (I think _both_ Ben and Olivier will agree) have no place in the internal representation, and thus must be treated as out-of-band control sequences. I don't know if all such gotchas will be as easy to dispose of. @@ -24915,7 +25311,7 @@ like Hrvoje should have an easily available option to to this default (or an optimized approximation which t actually read the whole file into a buffer) or simply -y everything as binary (with the "font" for binary files +y everything as binary (with the ``font'' for binary files a user option). @item @@ -25024,7 +25420,7 @@ Stephen, thank you very much for writing this up. I think it is a good start, and definitely moving in the direction I would like to see things going: more -proposals, less arguing. (aka "more light, less heat") However, I have some +proposals, less arguing. (aka ``more light, less heat'') However, I have some suggestions for cleaning this up: You should try to make it more layered. For example, you might have one @@ -28068,7 +28464,7 @@ @emph{convenient}. Precision means that all properties available in the programming API can be individually specified. Accuracy means that the truename of the font is exactly the list of all properties specified by -the font. Thus, the anomolies that occur with XLFDs on many servers +the font. Thus, the anomalies that occur with XLFDs on many servers (including modern Linux distributions with XFree86 or X.org servers) cannot occur. Convenience is subjective, of course. However, @file{fontconfig} provides a configuration system which (1) explicitly @@ -30904,7 +31300,7 @@ vs. local vs. heap, we could do so easily with bit flags in the object pointed to -- we have space for lots of them. -code reliablity and maintainability would likely substantially +code reliability and maintainability would likely substantially increase due to the ability to express most things in a natural C++ way instead of lots of weird hackish hard-to-understand C stuff implementing stuff the language wasn't really designed for. diff -r 861f2601a38b -r 1f0b15040456 man/lispref/commands.texi --- a/man/lispref/commands.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/commands.texi Sun May 01 18:44:03 2011 +0100 @@ -120,7 +120,7 @@ This section describes how to write the @code{interactive} form that makes a Lisp function an interactively-callable command. -@defspec interactive arg-descriptor +@deffn {Special Operator} interactive arg-descriptor @cindex argument descriptors This special operator declares that the function in which it appears is a command, and that it may therefore be called interactively (via @@ -139,7 +139,7 @@ @code{interactive} form are executed, but at this time @code{interactive} simply returns @code{nil} without even evaluating its argument. -@end defspec +@end deffn There are three possibilities for the argument @var{arg-descriptor}: diff -r 861f2601a38b -r 1f0b15040456 man/lispref/compile.texi --- a/man/lispref/compile.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/compile.texi Sun May 01 18:44:03 2011 +0100 @@ -691,7 +691,7 @@ These features permit you to write code to be evaluated during compilation of a program. -@defspec eval-and-compile body +@deffn {Special Operator} eval-and-compile body This form marks @var{body} to be evaluated both when you compile the containing code and when you run it (whether compiled or not). @@ -699,9 +699,9 @@ and referring to that file with @code{require}. Using @code{require} is preferable if there is a substantial amount of code to be executed in this way. -@end defspec +@end deffn -@defspec eval-when-compile body +@deffn {Special Operator} eval-when-compile body This form marks @var{body} to be evaluated at compile time and not when the compiled program is loaded. The result of evaluation by the compiler becomes a constant which appears in the compiled program. When @@ -712,7 +712,7 @@ @code{(eval-when (compile eval) @dots{})}. Elsewhere, the Common Lisp @samp{#.} reader macro (but not when interpreting) is closer to what @code{eval-when-compile} does. -@end defspec +@end deffn @node Compiled-Function Objects @section Compiled-Function Objects diff -r 861f2601a38b -r 1f0b15040456 man/lispref/control.texi --- a/man/lispref/control.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/control.texi Sun May 01 18:44:03 2011 +0100 @@ -76,7 +76,7 @@ needed now most often inside an @code{unwind-protect}, @code{and}, @code{or}, or in the @var{then}-part of an @code{if}. -@defspec progn forms@dots{} +@deffn {Special Operator} progn forms@dots{} This special operator evaluates all of the @var{forms}, in textual order, returning the result of the final form. @@ -91,12 +91,12 @@ @result{} "The third form" @end group @end example -@end defspec +@end deffn Two other control constructs likewise evaluate a series of forms but return a different value: -@defspec prog1 form1 forms@dots{} +@deffn {Special Operator} prog1 form1 forms@dots{} This special operator evaluates @var{form1} and all of the @var{forms}, in textual order, returning the result of @var{form1}. @@ -118,9 +118,9 @@ @example (prog1 (car x) (setq x (cdr x))) @end example -@end defspec +@end deffn -@defspec prog2 form1 form2 forms@dots{} +@deffn {Special Operator} prog2 form1 form2 forms@dots{} This special operator evaluates @var{form1}, @var{form2}, and all of the following @var{forms}, in textual order, returning the result of @var{form2}. @@ -136,7 +136,7 @@ @result{} "The second form" @end group @end example -@end defspec +@end deffn @node Conditionals @section Conditionals @@ -146,7 +146,7 @@ has two conditional forms: @code{if}, which is much the same as in other languages, and @code{cond}, which is a generalized case statement. -@defspec if condition then-form else-forms@dots{} +@deffn {Special Operator} if condition then-form else-forms@dots{} @code{if} chooses between the @var{then-form} and the @var{else-forms} based on the value of @var{condition}. If the evaluated @var{condition} is non-@code{nil}, @var{then-form} is evaluated and the result returned. @@ -169,9 +169,9 @@ @result{} very-false @end group @end example -@end defspec +@end deffn -@defspec cond clause@dots{} +@deffn {Special Operator} cond clause@dots{} @code{cond} chooses among an arbitrary number of alternatives. Each @var{clause} in the @code{cond} must be a list. The @sc{car} of this list is the @var{condition}; the remaining elements, if any, the @@ -239,7 +239,7 @@ @noindent This expression is a @code{cond} which returns @code{foo} if the value of @code{a} is 1, and returns the string @code{"default"} otherwise. -@end defspec +@end deffn Any conditional construct can be expressed with @code{cond} or with @code{if}. Therefore, the choice between them is a matter of style. @@ -268,7 +268,7 @@ using the name @code{null} if you are testing for an empty list. @end defun -@defspec and conditions@dots{} +@deffn {Special Operator} and conditions@dots{} The @code{and} special operator tests whether all the @var{conditions} are true. It works by evaluating the @var{conditions} one by one in the order written. @@ -320,9 +320,9 @@ (cond (@var{arg1} (cond (@var{arg2} @var{arg3})))) @end group @end example -@end defspec +@end deffn -@defspec or conditions@dots{} +@deffn {Special Operator} or conditions@dots{} The @code{or} special operator tests whether at least one of the @var{conditions} is true. It works by evaluating all the @var{conditions} one by one in the order written. @@ -369,7 +369,7 @@ This is not completely equivalent because it can evaluate @var{arg1} or @var{arg2} twice. By contrast, @code{(or @var{arg1} @var{arg2} @var{arg3})} never evaluates any argument more than once. -@end defspec +@end deffn @node Iteration @section Iteration @@ -381,7 +381,7 @@ of a list, or once for each integer from 0 to @var{n}. You can do this in XEmacs Lisp with the special operator @code{while}: -@defspec while condition forms@dots{} +@deffn {Special Operator} while condition forms@dots{} @code{while} first evaluates @var{condition}. If the result is non-@code{nil}, it evaluates @var{forms} in textual order. Then it reevaluates @var{condition}, and if the result is non-@code{nil}, it @@ -427,7 +427,7 @@ This moves forward one line and continues moving by lines until it reaches an empty. It is unusual in that the @code{while} has no body, just the end test (which also does the real work of moving point). -@end defspec +@end deffn @node Nonlocal Exits @section Nonlocal Exits @@ -499,15 +499,7 @@ @code{throw} can be used in commands such as @code{exit-recursive-edit} that throw back to the editor command loop (@pxref{Recursive Editing}). -@cindex CL note---only @code{throw} in Emacs -@quotation -@b{Common Lisp note:} Most other versions of Lisp, including Common Lisp, -have several ways of transferring control nonsequentially: @code{return}, -@code{return-from}, and @code{go}, for example. XEmacs Lisp has only -@code{throw}. -@end quotation - -@defspec catch tag body@dots{} +@deffn {Special Operator} catch tag body@dots{} @cindex tag on run time stack @code{catch} establishes a return point for the @code{throw} function. The return point is distinguished from other such return points by @var{tag}, @@ -522,7 +514,7 @@ If a @code{throw} is done within @var{body} specifying the same value @var{tag}, the @code{catch} exits immediately; the value it returns is whatever was specified as the second argument of @code{throw}. -@end defspec +@end deffn @defun throw tag value The purpose of @code{throw} is to return from a return point previously @@ -1028,7 +1020,7 @@ by an error handler (though using @code{throw} when there is no suitable @code{catch} signals an error that can be handled). -@defspec condition-case var protected-form handlers@dots{} +@deffn {Special Operator} condition-case var protected-form handlers@dots{} This special operator establishes the error handlers @var{handlers} around the execution of @var{protected-form}. If @var{protected-form} executes without error, the value it returns becomes the value of the @@ -1077,7 +1069,7 @@ If @var{var} is @code{nil}, that means no variable is bound. Then the error symbol and associated data are not available to the handler. -@end defspec +@end deffn @cindex @code{arith-error} example Here is an example of using @code{condition-case} to handle the error @@ -1252,7 +1244,7 @@ temporarily put a data structure in an inconsistent state; it permits you to ensure the data are consistent in the event of an error or throw. -@defspec unwind-protect body cleanup-forms@dots{} +@deffn {Special Operator} unwind-protect body cleanup-forms@dots{} @cindex cleanup forms @cindex protected forms @cindex error cleanup @@ -1278,7 +1270,7 @@ The number of currently active @code{unwind-protect} forms counts, together with the number of local variable bindings, against the limit @code{max-specpdl-size} (@pxref{Local Variables}). -@end defspec +@end deffn For example, here we make an invisible buffer for temporary use, and make sure to kill it before finishing: diff -r 861f2601a38b -r 1f0b15040456 man/lispref/customize.texi --- a/man/lispref/customize.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/customize.texi Sun May 01 18:44:03 2011 +0100 @@ -15,6 +15,7 @@ * Common Keywords:: * Group Definitions:: * Variable Definitions:: +* Face Definitions:: * Customization Types:: * Enabling Behavior:: @end menu @@ -163,6 +164,7 @@ @section Defining Customization Variables Use @code{defcustom} to declare user-editable variables. +For face declarations, use @code{defface} instead. @xref{Face Definitions}. @tindex defcustom @defmac defcustom option default doc [keyword value]... @@ -288,7 +290,67 @@ customization buffer. The @code{saved-value} property is actually a list whose car is an expression which evaluates to the value. -@node Customization Types, Enabling Behavior, Variable Definitions, Customization +@node Face Definitions, Customization Types, Variable Definitions, Customization +@section Face Definitions + +Use @code{defface} to declare a new face. Conventions used in +specifying properties are similar to those for general customizable +variables. @xref{Variable Definitions}. + +@defun defface face spec doc &rest args + +Declare @var{face} as a customizable face that defaults to @var{spec}. +@var{face} does not need to be quoted. + +Third argument @var{doc} is the face documentation. + +If @var{face} has been set with `custom-set-face', set the face attributes +as specified by that function, otherwise set the face attributes +according to @var{spec}. + +The remaining arguments @var{args} are a property list, which has the +form + + @var{keyword} @var{value}... + +The following @var{keyword}s are defined: + +@table @code +@item :group +@var{value} is a customization group. Add @var{face} to that group. +@end table + +@var{spec} is an alist of the form ((@var{display} @var{atts})...). + +@var{atts} is a list of face attributes and their values. The possible +attributes are defined in the variable `custom-face-attributes'. + +The @var{atts} of the first entry in @var{spec} where the +@var{display} matches the frame take effect in that frame. +@var{display} can either be the symbol t, which will match all frames, +or an alist of the form \((@var{req} @var{item}...)...) + +For @var{display} to match a frame, the @var{req} property of the +frame must match one of the @var{item}. The following @var{req} are +defined: + +@table @code +@item @code{type} (the value of @code{window-system}) + Should be one of @code{x}, @code{mswindows}, or @code{tty}. + +@code{class} (the frame's color support) + Should be one of @code{color}, @code{grayscale}, or @code{mono}. + +@code{min-colors} (the minimum number of colors the frame supports) + Should be in integer which is compared to @code{display-color-cells} + +@code{background} (what color is used for the background text) + Should be one of @code{light} or @code{dark}. +@end table +@end defun + + +@node Customization Types, Enabling Behavior, Face Definitions, Customization @section Customization Types When you define a user option with @code{defcustom}, you must specify diff -r 861f2601a38b -r 1f0b15040456 man/lispref/display.texi --- a/man/lispref/display.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/display.texi Sun May 01 18:44:03 2011 +0100 @@ -720,7 +720,7 @@ and then present it to the user for perusal rather than for editing. Many of the help commands use this feature. -@defspec with-output-to-temp-buffer buffer-name forms@dots{} +@deffn {Special Operator} with-output-to-temp-buffer buffer-name forms@dots{} This function executes @var{forms} while arranging to insert any output they print into the buffer named @var{buffer-name}. The buffer is then shown in some window for viewing, displayed but not selected. @@ -760,7 +760,7 @@ ---------- Buffer: foo ---------- @end group @end example -@end defspec +@end deffn @defvar temp-buffer-show-function If this variable is non-@code{nil}, @code{with-output-to-temp-buffer} diff -r 861f2601a38b -r 1f0b15040456 man/lispref/eval.texi --- a/man/lispref/eval.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/eval.texi Sun May 01 18:44:03 2011 +0100 @@ -24,6 +24,7 @@ * Eval:: How to invoke the Lisp interpreter explicitly. * Forms:: How various sorts of objects are evaluated. * Quoting:: Avoiding evaluation (to put constants in the program). +* Multiple values:: Functions may return more than one result. @end menu @node Intro Eval @@ -662,9 +663,9 @@ not necessary to quote self-evaluating objects such as numbers, strings, and vectors.) -@defspec quote object +@deffn {Special Operator} quote object This special operator returns @var{object}, without evaluating it. -@end defspec +@end deffn @cindex @samp{'} for quoting @cindex quoting using apostrophe @@ -708,3 +709,102 @@ Functions}), which causes an anonymous lambda expression written in Lisp to be compiled, and @samp{`} (@pxref{Backquote}), which is used to quote only part of a list, while computing and substituting other parts. + +@node Multiple values +@section Multiple values +@cindex multiple values + +@noindent +Under XEmacs, expressions can return zero or more results, using the +@code{values} and @code{values-list} functions. Results other than the +first are typically discarded, but special operators are provided to +access them. + +@defun values arguments@dots{} +This function returns @var{arguments} as multiple values. Callers will +always receive the first element of @var{arguments}, but must use +various special operators, described below, to access other elements of +@var{arguments}. + +The idiom @code{(values (function-call argument))}, with one +argument, is the normal mechanism to avoid passing multiple values to +the calling form where that is not desired. + +XEmacs implements the Common Lisp specification when it comes to the +exact details of when to discard and when to preserve multiple values; +see Common Lisp the Language or the Common Lisp hyperspec for more +details. The most important thing to keep in mind is when multiple +values are passed as an argument to a function, all but the first are +discarded. +@end defun + +@defun values-list argument +This function returns the elements of the lst @var{argument} as multiple +values. +@end defun + +@deffn {Special Operator} multiple-value-bind (var@dots{}) values-form forms@dots{} +This special operator evaluates @var{values-form}, which may return +multiple values. It then binds the @var{var}s to these respective values, +as if by @code{let}, and then executes the body @var{forms}. +If there are more @var{var}s than values, the extra @var{var}s +are bound to @code{nil}. If there are fewer @var{var}s than +values, the excess values are ignored. +@end deffn + +@deffn {Special Operator} multiple-value-setq (var@dots{}) form +This special operator evaluates @var{form}, which may return multiple +values. It then sets the @var{var}s to these respective values, as if by +@code{setq}. Extra @var{var}s or values are treated the same as +in @code{multiple-value-bind}. +@end deffn + +@deffn {Special Operator} multiple-value-call function forms@dots{} +This special operator evaluates function, discarding any multiple +values. It then evaluates @var{forms}, preserving any multiple values, +and calls @var{function} as a function with the results. Conceptually, this +function is a version of @code{apply'}that by-passes the multiple values +infrastructure, treating multiple values as intercalated lists. +@end deffn + +@deffn {Special Operator} multiple-value-list form +This special operator evaluates @var{form} and returns a list of the +multiple values given by it. +@end deffn + +@deffn {Special Operator} multiple-value-prog1 first body@dots{} +This special operator evaluates the form @var{first}, then the +forms @var{body}. It returns the value given by @var{first}, preserving +any multiple values. This is identical to @code{prog1}, except that +@code{prog1} always discards multiple values. +@end deffn + +@deffn {Special Operator} nth-value n form +This special operator evaluates @var{form} and returns the @var{n}th +value it gave. @var{n} must be an integer of value zero or more. +If @var{form} gave insufficient multiple values, @code{nth-value} +returns @code{nil}. +@end deffn + +@defvar multiple-values-limit +This constant describes the exclusive upper bound on the number of +multiple values that @code{values} accepts and that +@code{multiple-value-bind}, etc. will consume. +@end defvar + +To take full advantage of multiple values, Emacs Lisp code must have +been compiled by XEmacs 21.5 or later, which is not yet true of the +XEmacs packages. Matched @code{values} and @code{multiple-value-bind} +calls will work in code included in the XEmacs packages when run on +21.5, though the following incantation may be necessary at the start of +your file, until appropriate code is included in XEmacs 21.4: + +@example +(eval-when-compile (when (eq 'list (symbol-function 'values)) + (define-compiler-macro values (&rest args) + (cons 'list args)) + (define-compiler-macro values-list (list) list))) +@end example + +Such code cannot, unfortunately, rely on XEmacs to discard multiple +values where that is appropriate. diff -r 861f2601a38b -r 1f0b15040456 man/lispref/extents.texi --- a/man/lispref/extents.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/extents.texi Sun May 01 18:44:03 2011 +0100 @@ -850,8 +850,8 @@ copied into the resulting string. @item -When @code{substring} is called on a string, the relevant extents -are copied into the resulting string. +When @code{subseq} (or its alias, @code{substring}) is called on a +string, the relevant extents are copied into the resulting string. @item When a duplicable extent is detached by @code{detach-extent} or string diff -r 861f2601a38b -r 1f0b15040456 man/lispref/faces.texi --- a/man/lispref/faces.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/faces.texi Sun May 01 18:44:03 2011 +0100 @@ -26,9 +26,13 @@ Each built-in property of a face is controlled using a specifier, which allows it to have separate values in particular buffers, frames, -windows, and devices and to further vary according to device type -(X or TTY) and device class (color, mono, or grayscale). -@xref{Specifiers}, for more information. +windows, and devices. These properties are computed when the face is +instantiated, allowing them to vary according to properties of the +display device, such as type (X or TTY), visual class (color, mono, or +grayscale), and number of colors displayable on the device. +@xref{Specifiers}, for more information on specifiers. +@xref{Face Definitions}, for defining faces whose properties vary +according to their runtime environments. The face named @code{default} is used for ordinary text. The face named @code{modeline} is used for displaying the modeline. The face named diff -r 861f2601a38b -r 1f0b15040456 man/lispref/frames.texi --- a/man/lispref/frames.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/frames.texi Sun May 01 18:44:03 2011 +0100 @@ -785,18 +785,18 @@ @code{focus-follows-mouse}. @end defun -@defspec save-selected-frame forms@dots{} +@deffn {Special Operator} save-selected-frame forms@dots{} This special operator records the selected frame, executes @var{forms} in sequence, then restores the earlier selected frame. The value returned is the value of the last form. -@end defspec +@end deffn -@defspec with-selected-frame frame forms@dots{} +@deffn {Special Operator} with-selected-frame frame forms@dots{} This special operator records the selected frame, then selects @var{frame} and executes @var{forms} in sequence. After the last form is finished, the earlier selected frame is restored. The value returned is the value of the last form. -@end defspec +@end deffn @ignore (FSF Emacs, continued from defun select-frame) XEmacs cooperates with the X server and the window managers by arranging diff -r 861f2601a38b -r 1f0b15040456 man/lispref/functions.texi --- a/man/lispref/functions.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/functions.texi Sun May 01 18:44:03 2011 +0100 @@ -290,10 +290,10 @@ arguments, you get a @code{wrong-number-of-arguments} error. It is often convenient to write a function that allows certain -arguments to be omitted. For example, the function @code{substring} -accepts three arguments---a string, the start index and the end +arguments to be omitted. For example, the function @code{subseq} +accepts three arguments---a sequence, the start index and the end index---but the third argument defaults to the @var{length} of the -string if you omit it. It is also convenient for certain functions to +sequence if you omit it. It is also convenient for certain functions to accept an indefinite number of arguments, as the functions @code{list} and @code{+} do. @@ -331,14 +331,15 @@ function to distinguish between an explicit argument of @code{nil} and an omitted argument. However, the body of the function is free to consider @code{nil} an abbreviation for some other meaningful value. -This is what @code{substring} does; @code{nil} as the third argument to -@code{substring} means to use the length of the string supplied. +This is what @code{subseq} does; @code{nil} as the third argument to +@code{subseq} means to use the length of the sequence supplied. @cindex CL note---default optional arg @quotation @b{Common Lisp note:} Common Lisp allows the function to specify what -default value to use when an optional argument is omitted; XEmacs Lisp -always uses @code{nil}. +default value to use when an optional argument is omitted; this is +available in XEmacs Lisp with the @code{defun*} macro, an alternative to +@code{defun}. @end quotation For example, an argument list that looks like this: @@ -474,7 +475,7 @@ is called @dfn{defining a function}, and it is done with the @code{defun} special operator. -@defspec defun name argument-list body-forms +@deffn {Special Operator} defun name argument-list body-forms @code{defun} is the usual way to define new Lisp functions. It defines the symbol @var{name} as a function that looks like this: @@ -543,7 +544,7 @@ without any hesitation or notification. Redefining a function already defined is often done deliberately, and there is no way to distinguish deliberate redefinition from unintentional redefinition. -@end defspec +@end deffn @defun define-function name definition @defunx defalias name definition @@ -833,14 +834,14 @@ In such cases, we usually use the special operator @code{function} instead of simple quotation to quote the anonymous function. -@defspec function function-object +@deffn {Special Operator} function function-object @cindex function quoting This special operator returns @var{function-object} without evaluating it. In this, it is equivalent to @code{quote}. However, it serves as a note to the XEmacs Lisp compiler that @var{function-object} is intended to be used only as a function, and therefore can safely be compiled. Contrast this with @code{quote}, in @ref{Quoting}. -@end defspec +@end deffn Using @code{function} instead of @code{quote} makes a difference inside a function or macro that you are going to compile. For example: diff -r 861f2601a38b -r 1f0b15040456 man/lispref/hash-tables.texi --- a/man/lispref/hash-tables.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/hash-tables.texi Sun May 01 18:44:03 2011 +0100 @@ -78,10 +78,12 @@ @defun make-hash-table &key @code{test} @code{size} @code{rehash-size} @code{rehash-threshold} @code{weakness} This function returns a new empty hash table object. -Keyword @code{:test} can be @code{eq}, @code{eql} (default) or @code{equal}. +Keyword @code{:test} can be @code{eq}, @code{eql} (default), +@code{equal}, or @code{equalp}. Comparison between keys is done using this function. If speed is important, consider using @code{eq}. -When storing strings in the hash table, you will likely need to use @code{equal}. +When storing strings in the hash table, you will likely need to use +@code{equal}, or @code{equalp} for case-insensitivity. Keyword @code{:size} specifies the number of keys likely to be inserted. This number of entries can be inserted without enlarging the hash table. @@ -135,7 +137,8 @@ @defun hash-table-test hash-table This function returns the test function of @var{hash-table}. -This can be one of @code{eq}, @code{eql} or @code{equal}. +This can be one of @code{eq}, @code{eql}, @code{equal}, @code{equalp}, +or some @var{name} parameter given to @code{define-hash-table-test}. @end defun @defun hash-table-size hash-table @@ -191,6 +194,24 @@ processed by @var{function}. @end defun +@defun define-hash-table-test name test-function hash-function +Creates a new hash table test function, beyond the four specified by +Common Lisp. @var{name} is a symbol, and @code{define-hash-table-test} +will error if there exists a hash table test with that name already. +(If you want to repeatedly define hash tables, use a symbol generated +with @code{gensym} for @var{name}). + +@var{test-function} must accept two arguments and return non-nil if both +arguments are the same. + +@var{hash-function} must accept one argument and return an integer hash +code for its argument. @var{hash-function} should use the entire range +of the underlying C long type, typically represented with two more value +bits than the Lisp fixnum type. + +Returns t on success, an incompatibility with GNU Emacs, which returns +a list comprising @var{test-function} and @var{hash-function}. +@end defun @node Weak Hash Tables @section Weak Hash Tables diff -r 861f2601a38b -r 1f0b15040456 man/lispref/internationalization.texi --- a/man/lispref/internationalization.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/internationalization.texi Sun May 01 18:44:03 2011 +0100 @@ -83,7 +83,7 @@ nothing. @end defun -@defspec domain string +@deffn {Special Operator} domain string This function specifies the text domain used for translating documentation strings and interactive prompts of a function. For example, write: @@ -94,7 +94,7 @@ to specify @code{emacs-foo} as the text domain of the function @code{foo}. The ``call'' to @code{domain} is actually a declaration rather than a function; when actually called, @code{domain} just returns @code{nil}. -@end defspec +@end deffn @defun domain-of function This function returns the text domain of @var{function}; it returns @@ -145,19 +145,19 @@ For variables and constants which have documentation strings, specify the domain after the documentation. -@defspec defvar symbol [value [doc-string [domain]]] +@deffn {Special Operator} defvar symbol [value [doc-string [domain]]] Example: @example (defvar weight 250 "Weight of gorilla, in pounds." "emacs-gorilla") @end example -@end defspec +@end deffn -@defspec defconst symbol [value [doc-string [domain]]] +@deffn {Special Operator} defconst symbol [value [doc-string [domain]]] Example: @example (defconst limbs 4 "Number of limbs" "emacs-gorilla") @end example -@end defspec +@end deffn @defun autoload function filename &optional docstring interactive type This function defines @var{function} to autoload from @var{filename} diff -r 861f2601a38b -r 1f0b15040456 man/lispref/intro.texi --- a/man/lispref/intro.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/intro.texi Sun May 01 18:44:03 2011 +0100 @@ -787,7 +787,7 @@ arguments. Parentheses are used when several arguments are grouped into additional levels of list structure. Here is an example: -@defspec count-loop (@var{var} [@var{from} @var{to} [@var{inc}]]) @var{body}@dots{} +@deffn {Special Operator} count-loop (@var{var} [@var{from} @var{to} [@var{inc}]]) @var{body}@dots{} This imaginary special operator implements a loop that executes the @var{body} forms and then increments the variable @var{var} on each iteration. On the first iteration, the variable has the value @@ -817,7 +817,7 @@ @var{inc} may optionally be specified as well. These arguments are grouped with the argument @var{var} into a list, to distinguish them from @var{body}, which includes all remaining elements of the form. -@end defspec +@end deffn @node A Sample Variable Description @subsubsection A Sample Variable Description diff -r 861f2601a38b -r 1f0b15040456 man/lispref/lists.texi --- a/man/lispref/lists.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/lists.texi Sun May 01 18:44:03 2011 +0100 @@ -655,9 +655,9 @@ (@pxref{String Conversion}). @end defun -@defun reverse list -This function creates a new list whose elements are the elements of -@var{list}, but in reverse order. The original argument @var{list} is +@defun reverse sequence +This function creates a new sequence whose elements are the elements of +@var{sequence}, but in reverse order. The original argument @var{sequence} is @emph{not} altered. @example @@ -998,13 +998,14 @@ @end smallexample @end defun -@defun nreverse list +@defun nreverse sequence @cindex reversing a list - This function reverses the order of the elements of @var{list}. -Unlike @code{reverse}, @code{nreverse} alters its argument by reversing -the @sc{cdr}s in the cons cells forming the list. The cons cell that -used to be the last one in @var{list} becomes the first cell of the -value. +@cindex reversing a sequence + This function reverses the order of the elements of @var{sequence}. +Unlike @code{reverse}, @code{nreverse} alters its argument. If +@var{sequence} is a list, it does this by reversing the @sc{cdr}s in the +cons cells forming the sequence. The cons cell that used to be the last +one in @var{sequence} becomes the first cell of the value. For example: @@ -1027,7 +1028,7 @@ @end example To avoid confusion, we usually store the result of @code{nreverse} -back in the same variable which held the original list: +back in the same variable which held the original sequence: @example (setq x (nreverse x)) @@ -1050,31 +1051,54 @@ @end smallexample @end defun -@defun sort list predicate +@defun sort* sequence predicate &key (key #'identity) @cindex stable sort @cindex sorting lists -This function sorts @var{list} stably, though destructively, and -returns the sorted list. It compares elements using @var{predicate}. A +@cindex sorting arrays +@cindex sort +This function sorts @var{sequence} stably, though destructively, and +returns the sorted sequence. It compares elements using @var{predicate}. A stable sort is one in which elements with equal sort keys maintain their relative order before and after the sort. Stability is important when successive sorts are used to order elements according to different criteria. +@var{sequence} can be any sequence, that is, a list, a vector, a +bit-vector, or a string. + The argument @var{predicate} must be a function that accepts two -arguments. It is called with two elements of @var{list}. To get an +arguments. It is called with two elements of @var{sequence}. To get an increasing order sort, the @var{predicate} should return @code{t} if the first element is ``less than'' the second, or @code{nil} if not. -The destructive aspect of @code{sort} is that it rearranges the cons -cells forming @var{list} by changing @sc{cdr}s. A nondestructive sort +The keyword argument @var{key}, if supplied, is a function used to +extract an object to be used for comparison from each element of +@var{sequence}, and defaults to @code{identity}. For example, to sort a +vector of lists by the numeric value of the first element, you could use +the following code: + +@example +@group +(setq example-vector [(1 "foo") (3.14159 bar) (2 . quux)]) + @result{} [(1 "foo") (3.14159 bar) (2 . quux)] +@end group +@group +(sort* example-vector #'< :key #'car) + @result{} [(1 "foo") (2 . quux) (3.14159 bar)] +@end group +@end example + +If @var{sequence} is a list, @code{sort*} rearranges the cons cells +forming @var{sequence} by changing @sc{cdr}s. A nondestructive sort function would create new cons cells to store the elements in their -sorted order. If you wish to make a sorted copy without destroying the +sorted order. @code{sort*} treats other sequence types in an analogous +fashion---if you wish to make a sorted copy without destroying the original, copy it first with @code{copy-sequence} and then sort. -Sorting does not change the @sc{car}s of the cons cells in @var{list}; -the cons cell that originally contained the element @code{a} in -@var{list} still has @code{a} in its @sc{car} after sorting, but it now -appears in a different position in the list due to the change of +Sorting will not change the @sc{car}s of the cons cells of a list +@var{sequence}; the cons cell that originally contained the element @code{a} in +@var{sequence} still has @code{a} in its @sc{car} after sorting, but it now +appears in a different position in the sequence due to the change of @sc{cdr}s. For example: @example @@ -1083,7 +1107,7 @@ @result{} (1 3 2 6 5 4 0) @end group @group -(sort nums '<) +(sort* nums '<) @result{} (0 1 2 3 4 5 6) @end group @group @@ -1096,17 +1120,23 @@ Note that the list in @code{nums} no longer contains 0; this is the same cons cell that it was before, but it is no longer the first one in the list. Don't assume a variable that formerly held the argument now holds -the entire sorted list! Instead, save the result of @code{sort} and use +the entire sorted list! Instead, save the result of @code{sort*} and use that. Most often we store the result back into the variable that held -the original list: +the original sequence: @example -(setq nums (sort nums '<)) +(setq nums (sort* nums '<)) @end example +In this implementation, @code{sort} is a function alias for +@code{sort*}, and accepts the same arguments. In older XEmacs, and in +current GNU Emacs, @code{sort} only accepted lists, and did not accept +the @var{key} argument, so the byte-compiler will warn you if you call +@code{sort} with more than two arguments. + @xref{Sorting}, for more functions that perform sorting. See @code{documentation} in @ref{Accessing Documentation}, for a -useful example of @code{sort}. +useful example of @code{sort*}. @end defun @node Sets And Lists @@ -1116,59 +1146,97 @@ A list can represent an unordered mathematical set---simply consider a value an element of a set if it appears in the list, and ignore the -order of the list. To form the union of two sets, use @code{append} (as -long as you don't mind having duplicate elements). Other useful -functions for sets include @code{memq} and @code{delq}, and their -@code{equal} versions, @code{member} and @code{delete}. +order of the list. XEmacs provides set operations inherited from Common +Lisp. + +@defun member* item list @t{&key :test :test-not :key} +This function tests to see whether @var{item} is a member of @var{list}, +comparing with @code{eql}. If it is, @code{member*} returns the tail of +@var{list} starting with the first occurrence of @var{item}. Otherwise, +it returns @code{nil}. -@cindex CL note---lack @code{union}, @code{set} -@quotation -@b{Common Lisp note:} Common Lisp has functions @code{union} (which -avoids duplicate elements) and @code{intersection} for set operations, -but XEmacs Lisp does not have them. You can write them in Lisp if -you wish. -@end quotation +This is equivalent to the Common Lisp @code{member} function, but that +name was already taken in Emacs Lisp, whence the asterisk at the end of +@code{member*}. -@defun memq object list -@cindex membership in a list -This function tests to see whether @var{object} is a member of -@var{list}. If it is, @code{memq} returns a list starting with the -first occurrence of @var{object}. Otherwise, it returns @code{nil}. -The letter @samp{q} in @code{memq} says that it uses @code{eq} to -compare @var{object} against the elements of the list. For example: +The @code{:test} keyword argument allows you to specify the test used to +decide whether @var{item} is equivalent to a given element of +@var{list}. The function should return non-@code{nil} if the items +match, @code{nil} if they do not. The @code{:test-not} keyword is +similar, but the meaning of @code{nil} and non-@code{nil} results are +reversed. The @code{:key} keyword allows you to examine a component of +each object in @var{list}, rather than the object itself. @example @group -(memq 'b '(a b c b a)) +(member* 'b '(a b c b a)) @result{} (b c b a) @end group @group -(memq '(2) '((1) (2))) ; @r{@code{(2)} and @code{(2)} are not @code{eq}.} +(member* '(2) '((1) (2))) ; @r{@code{(2)} and @code{(2)} are not @code{eql}.} @result{} nil @end group +@group +(member* '(2) '((1) (2)) :test #'equal) ; @r{but they are @code{equal}.} + @result{} ((2)) +@end group +@group +(member* 3 '((1) (2) (3) (4)) :key 'car) ; @r{key not applied to @var{item}} + @result{} ((3) (4)) +@end group @end example @end defun -@defun delq object list -@cindex deletion of elements -This function destructively removes all elements @code{eq} to -@var{object} from @var{list}. The letter @samp{q} in @code{delq} says -that it uses @code{eq} to compare @var{object} against the elements of -the list, like @code{memq}. +@defun memq item list +This is equivalent to calling @code{(member* item list :test 'eq)}, but +for historical reasons is more common in the XEmacs code base. Both +expressions compile to the same byte-code. +@end defun + +@defun member item list +This is equivalent to calling @code{(member* item list :test 'equal)}. @end defun -When @code{delq} deletes elements from the front of the list, it does so -simply by advancing down the list and returning a sublist that starts -after those elements: +@defun remove* item sequence @t{&key (test #'eql) (key #'identity) (start 0) (end (length sequence)) from-end count test-not} +@cindex removal of elements + +This function removes all occurrences of @var{object} from +@var{sequence}, which can be a list, vector, or bit-vector. + +The @code{:test} keyword argument allows you to specify the test used to +decide whether @var{item} is equivalent to a given element of +@var{sequence}. The function should return non-@code{nil} if the items +match, @code{nil} if they do not. The @code{:test-not} keyword is +similar, but the meaning of @code{nil} and non-@code{nil} results are +reversed. The @code{:key} keyword allows you to examine a component of +each object in @var{sequence}, rather than the object itself. + +The @code{:start} and @code{:end} keywords allow you to specify a +zero-based subrange of @var{sequence} to operate on, @code{remove*} will +call the test function on all items of @var{sequence} between the index +specified by @code{:start}, inclusive, and @code{:end}, +exclusive. @code{:count} gives a maximum number of items to remove, and +@code{:from-end}, most useful in combination with @code{:count}, +specifies that the removal should start from the end of @var{sequence}. + +As with @code{member*}, this function is equivalent to the Common Lisp +function of almost the same name (the Common Lisp function has no +asterisk.) + +When @code{remove*} removes elements from the front of a list +@var{sequence}, it does so simply by advancing down the list and +returning a sublist that starts after those elements: @example @group -(delq 'a '(a b c)) @equiv{} (cdr '(a b c)) +(remove* 'a '(a b c)) @equiv{} (cdr '(a b c)) @end group @end example When an element to be deleted appears in the middle of the list, -removing it involves changing the @sc{cdr}s (@pxref{Setcdr}). +removing it involves copying the list conses up to that point, and +setting the tail of the copied list to the tail of the original list +past that point. @example @group @@ -1176,7 +1244,7 @@ @result{} (a b c (4)) @end group @group -(delq 'a sample-list) +(remove* 'a sample-list) @result{} (b c (4)) @end group @group @@ -1184,7 +1252,55 @@ @result{} (a b c (4)) @end group @group -(delq 'c sample-list) +(remove* 'c sample-list) + @result{} (a b (4)) +@end group +@group +sample-list + @result{} (a b c (4)) +@end group +@end example + +Don't assume that a variable which formerly held the argument @var{list} +now has fewer elements, or that it still holds the original list! +Instead, save the result of @code{remove*} and use that. Most often we +store the result back into the variable that held the original list: + +@example +(setq flowers (remove* 'rose flowers)) +@end example + +In the following example, the @code{(4)} that @code{remove*} attempts to match +and the @code{(4)} in the @code{sample-list} are not @code{eql}: + +@example +@group +(remove* '(4) sample-list) + @result{} (a b c (4)) +@end group +@end example +@end defun + +@defun remq item sequence +This is equivalent to calling @code{(remove* item sequence :test #'eq)}. +@end defun + +@defun remove item sequence +This is equivalent to calling @code{(remove* item sequence :test #'equal)}. +@end defun + +@defun delete* item sequence @t{&key (test #'eql) (key #'identity) (start 0) (end (length sequence)) from-end count test-not} +This is like @code{remove*}, but a list @var{sequence} is modified +in-place (`destructively', in Lisp parlance). So some of the examples +above change: + +@example +@group +(setq sample-list '(a b c (4))) + @result{} (a b c (4)) +@end group +@group +(delete* 'c sample-list) @result{} (a b (4)) @end group @group @@ -1192,78 +1308,80 @@ @result{} (a b (4)) @end group @end example - -Note that @code{(delq 'c sample-list)} modifies @code{sample-list} to -splice out the third element, but @code{(delq 'a sample-list)} does not -splice anything---it just returns a shorter list. Don't assume that a -variable which formerly held the argument @var{list} now has fewer -elements, or that it still holds the original list! Instead, save the -result of @code{delq} and use that. Most often we store the result back -into the variable that held the original list: +@end defun -@example -(setq flowers (delq 'rose flowers)) -@end example - -In the following example, the @code{(4)} that @code{delq} attempts to match -and the @code{(4)} in the @code{sample-list} are not @code{eq}: +@defun delq item sequence +This is equivalent to calling @code{(delete* item sequence :test #'eq)}. +@end defun -@example -@group -(delq '(4) sample-list) - @result{} (a c (4)) -@end group -@end example +@defun delete item list +This is equivalent to calling @code{(delete* item sequence :test #'equal)}. +@end defun -The following two functions are like @code{memq} and @code{delq} but use -@code{equal} rather than @code{eq} to compare elements. They are new in -Emacs 19. - -@defun member object list -The function @code{member} tests to see whether @var{object} is a member -of @var{list}, comparing members with @var{object} using @code{equal}. -If @var{object} is a member, @code{member} returns a list starting with -its first occurrence in @var{list}. Otherwise, it returns @code{nil}. - -Compare this with @code{memq}: +@defun subsetp list1 list2 @t{&key :test :test-not :key} +This function returns non-@code{nil} if every item in @var{list1} is +present in @var{list2}. +@end defun -@example -@group -(member '(2) '((1) (2))) ; @r{@code{(2)} and @code{(2)} are @code{equal}.} - @result{} ((2)) -@end group -@group -(memq '(2) '((1) (2))) ; @r{@code{(2)} and @code{(2)} are not @code{eq}.} - @result{} nil -@end group -@group -;; @r{Two strings with the same contents are @code{equal}.} -(member "foo" '("foo" "bar")) - @result{} ("foo" "bar") -@end group -@end example +@defun union list1 list2 @t{&key :test :test-not :key :stable} +This function calculates the union of two lists, returning a list +containing all those items that appear in either list. It doesn't +guarantee that duplicates in @var{list1} or @var{list2} will be +eliminated; see @code{remove-duplicates} if this is important to you. + +A non-nil value for the @code{:stable} keyword, not specified by Common +Lisp, means return the items in the order they appear in @var{list1}, +followed by the remaining items in the order they appear in @var{list2}. +The other keywords are as in @code{member*}. + +@code{union} does not modify @var{list1} or @var{list2}. @end defun -@defun delete object list -This function destructively removes all elements @code{equal} to -@var{object} from @var{list}. It is to @code{delq} as @code{member} is -to @code{memq}: it uses @code{equal} to compare elements with -@var{object}, like @code{member}; when it finds an element that matches, -it removes the element just as @code{delq} would. For example: +@defun intersection list1 list2 @t{&key :test :test-not :key :stable} +This function calculates the intersection of two lists, returning a list +containing all those items that appear in both lists. It doesn't +guarantee that duplicates in @var{list1} or @var{list2} will be +eliminated; see @code{remove-duplicates} if this is important to +you. @code{intersection} does not modify either list. -@example -@group -(delete '(2) '((2) (1) (2))) - @result{} '((1)) -@end group -@end example +A non-nil value for the @code{:stable} keyword, not specified by Common +Lisp, means return the items in the order they appear in @var{list1}. +The other keywords are as in @code{member*}. +@end defun + +@defun set-difference list1 list2 @t{&key :test :test-not :key :stable} +This function returns those items that are in @var{list1} but not in +@var{list2}. It does not modify either list. + +A non-nil value for the @code{:stable} keyword, not specified by Common +Lisp, means return the items in the order they appear in @var{list1}. +The other keywords are as in @code{member*}. @end defun -@quotation -@b{Common Lisp note:} The functions @code{member} and @code{delete} in -XEmacs Lisp are derived from Maclisp, not Common Lisp. The Common -Lisp versions do not use @code{equal} to compare elements. -@end quotation +@defun set-exclusive-or list1 list2 @t{&key :test :test-not :key :stable} +This function returns those items that are in @var{list1} but not in +@var{list2}, together with those in @var{list2} but not in @var{list1}. +It does not modify either list. + +A non-nil value for the @code{:stable} keyword, not specified by Common +Lisp, means return the items in the order they appear in @var{list1}, +followed by the remaining items in the order they appear in @var{list2}. +The other keywords are as in @code{member*}. +@end defun + +The following functions are equivalent to the previous four functions, +but with two important differences; they do not accept the +@code{:stable} keyword, and they modify one or both list arguments in +the same way @code{delete*} does. + +@defun nintersection list1 list2 @t{&key :test :test-not :key} +@end defun +@defun nset-difference list1 list2 @t{&key :test :test-not :key} +@end defun +@defun nset-exclusive-or list1 list2 @t{&key :test :test-not :key} +@end defun +@defun nunion list1 list2 @t{&key :test :test-not :key} +@end defun See also the function @code{add-to-list}, in @ref{Setting Variables}, for another way to add an element to a list stored in a variable. @@ -1340,21 +1458,21 @@ each key can occur only once. @xref{Property Lists}, for a comparison of property lists and association lists. -@defun assoc key alist +@defun assoc* key alist @t{&key :test :test-not :key} This function returns the first association for @var{key} in @var{alist}. It compares @var{key} against the alist elements using -@code{equal} (@pxref{Equality Predicates}). It returns @code{nil} if no -association in @var{alist} has a @sc{car} @code{equal} to @var{key}. -For example: +@code{eql} (@pxref{Equality Predicates}), or the test specified with the +@code{:test} keyword. It returns @code{nil} if no association in +@var{alist} has a @sc{car} @code{equal} to @var{key}. For example: @smallexample (setq trees '((pine . cones) (oak . acorns) (maple . seeds))) @result{} ((pine . cones) (oak . acorns) (maple . seeds)) -(assoc 'oak trees) +(assoc* 'oak trees) @result{} (oak . acorns) -(cdr (assoc 'oak trees)) +(cdr (assoc* 'oak trees)) @result{} acorns -(assoc 'birch trees) +(assoc* 'birch trees) @result{} nil @end smallexample @@ -1366,31 +1484,36 @@ (3 "Pitch Pine") (5 "White Pine"))) -(cdr (assoc 3 needles-per-cluster)) +(cdr (assoc* 3 needles-per-cluster)) @result{} ("Pitch Pine") -(cdr (assoc 2 needles-per-cluster)) +(cdr (assoc* 2 needles-per-cluster)) @result{} ("Austrian Pine" "Red Pine") @end smallexample + +The @code{:test} keyword argument allows you to specify the test used to +decide whether @var{key} is equivalent to a given element of +@var{alist}. The function should return non-@code{nil} if the items +match, @code{nil} if they do not. The @code{:test-not} keyword is +similar, but the meaning of @code{nil} and non-@code{nil} results are +reversed. The @code{:key} keyword allows you to examine a component of +each @sc{car} in @var{alist}, rather than the @sc{car} itself. @end defun -@defun rassoc value alist +@defun rassoc* value alist @t{&key :test :test-not :key} This function returns the first association with value @var{value} in @var{alist}. It returns @code{nil} if no association in @var{alist} has -a @sc{cdr} @code{equal} to @var{value}. +a @sc{cdr} @code{eql} to @var{value}. -@code{rassoc} is like @code{assoc} except that it compares the @sc{cdr} of +@code{rassoc*} is like @code{assoc*} except that it compares the @sc{cdr} of each @var{alist} association instead of the @sc{car}. You can think of -this as ``reverse @code{assoc}'', finding the key for a given value. +this as ``reverse @code{assoc*}'', finding the key for a given value. + +The keywords work similarly to @code{assoc*}. @end defun @defun assq key alist -This function is like @code{assoc} in that it returns the first -association for @var{key} in @var{alist}, but it makes the comparison -using @code{eq} instead of @code{equal}. @code{assq} returns @code{nil} -if no association in @var{alist} has a @sc{car} @code{eq} to @var{key}. -This function is used more often than @code{assoc}, since @code{eq} is -faster than @code{equal} and most alists use symbols as keys. -@xref{Equality Predicates}. +This is equivalent to calling @code{(assoc* key alist :test 'eq)}, and +compiles to the same byte code. @smallexample (setq trees '((pine . cones) (oak . acorns) (maple . seeds))) @@ -1399,8 +1522,8 @@ @result{} (pine . cones) @end smallexample -On the other hand, @code{assq} is not usually useful in alists where the -keys may not be symbols: +@code{assq} is not usually useful in alists where the keys may not be +symbols: @smallexample (setq leaves @@ -1415,15 +1538,8 @@ @end defun @defun rassq value alist -This function returns the first association with value @var{value} in -@var{alist}. It returns @code{nil} if no association in @var{alist} has -a @sc{cdr} @code{eq} to @var{value}. - -@code{rassq} is like @code{assq} except that it compares the @sc{cdr} of -each @var{alist} association instead of the @sc{car}. You can think of -this as ``reverse @code{assq}'', finding the key for a given value. - -For example: +This is equivalent to calling @code{(rassoc* value alist :test 'eq)}, and +compiles to the same byte code. For example: @smallexample (setq trees '((pine . cones) (oak . acorns) (maple . seeds))) diff -r 861f2601a38b -r 1f0b15040456 man/lispref/locals.texi --- a/man/lispref/locals.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/locals.texi Sun May 01 18:44:03 2011 +0100 @@ -25,9 +25,15 @@ @item buffer-backed-up @pxref{Backup Files} +@item buffer-display-count +@xref{Buffers and Windows}. + @item buffer-display-table @pxref{Display Tables} +@item buffer-display-time +@xref{Buffers and Windows}. + @item buffer-file-format @pxref{Format Conversion} diff -r 861f2601a38b -r 1f0b15040456 man/lispref/macros.texi --- a/man/lispref/macros.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/macros.texi Sun May 01 18:44:03 2011 +0100 @@ -212,7 +212,7 @@ In practice, almost all Lisp macros have names, and they are usually defined with the special operator @code{defmacro}. -@defspec defmacro name argument-list body-forms@dots{} +@deffn {Special Operator} defmacro name argument-list body-forms@dots{} @code{defmacro} defines the symbol @var{name} as a macro that looks like this: @@ -229,7 +229,7 @@ (@pxref{Argument List}). Macros may have a documentation string, but any @code{interactive} declaration is ignored since macros cannot be called interactively. -@end defspec +@end deffn @node Backquote @section Backquote diff -r 861f2601a38b -r 1f0b15040456 man/lispref/mule.texi --- a/man/lispref/mule.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/mule.texi Sun May 01 18:44:03 2011 +0100 @@ -3118,7 +3118,7 @@ possible to use a single Latin coded character set before saving the buffer. -Because the problem is rarely noticable in editing a buffer, but tends +Because the problem is rarely noticeable in editing a buffer, but tends to manifest when that buffer is exported to a file or process, the Unification package uses the strategy of examining the buffer prior to export. If use of multiple Latin coded character sets is detected, diff -r 861f2601a38b -r 1f0b15040456 man/lispref/numbers.texi --- a/man/lispref/numbers.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/numbers.texi Sun May 01 18:44:03 2011 +0100 @@ -871,9 +871,15 @@ There are four functions to convert floating point numbers to integers; they differ in how they round. These functions accept integer arguments -also, and return such arguments unchanged. +also, and return such arguments unchanged. They return multiple values, +@pxref{(cl.info)Multiple values}. -@defun truncate number +All these functions take optional @var{divisor} arguments, and if this +argument is specified, the @var{number} argument is divided by +@var{divisor} before the calculation is made. An @code{arith-error} +results if @var{divisor} is 0. + +@defun truncate number &optional divisor This returns @var{number}, converted to an integer by rounding towards zero. @end defun @@ -881,23 +887,21 @@ @defun floor number &optional divisor This returns @var{number}, converted to an integer by rounding downward (towards negative infinity). - -If @var{divisor} is specified, @var{number} is divided by @var{divisor} -before the floor is taken; this is the division operation that -corresponds to @code{mod}. An @code{arith-error} results if -@var{divisor} is 0. @end defun -@defun ceiling number +@defun ceiling number &optional divisor This returns @var{number}, converted to an integer by rounding upward (towards positive infinity). @end defun -@defun round number +@defun round number &optional divisor This returns @var{number}, converted to an integer by rounding towards the -nearest integer. Rounding a value equidistant between two integers -may choose the integer closer to zero, or it may prefer an even integer, -depending on your machine. +nearest integer. + +Rounding a value equidistant between two integers chooses the even +integer. GNU Emacs and older XEmacs did not guarantee this, and the +direction of rounding depended on the underlying machine and the C +implementation. @end defun @node Arithmetic Operations @@ -1154,24 +1158,35 @@ @code{ftruncate}, the nearest integer in the direction towards zero; @code{fround}, the nearest integer. -@defun ffloor number +All these functions take optional @var{divisor} arguments, and if this +argument is specified, the @var{number} argument is divided by +@var{divisor} before the calculation is made. An @code{arith-error} +results if @var{divisor} is 0. Also, they return multiple values, +@pxref{(cl.info)Multiple values}; the second value is the remainder. + +@defun ffloor number &optional divisor This function rounds @var{number} to the next lower integral value, and returns that value as a floating point number. @end defun -@defun fceiling number +@defun fceiling number &optional divisor This function rounds @var{number} to the next higher integral value, and returns that value as a floating point number. @end defun -@defun ftruncate number +@defun ftruncate number &optional divisor This function rounds @var{number} towards zero to an integral value, and returns that value as a floating point number. @end defun -@defun fround number +@defun fround number &optional divisor This function rounds @var{number} to the nearest integral value, and returns that value as a floating point number. + +Rounding a value equidistant between two integral values chooses the +even value. While this is specified by Common Lisp, GNU Emacs and older +XEmacs did not make this guarantee, and the direction of rounding +depended on the underlying machine and the C implementation. @end defun @node Bitwise Operations diff -r 861f2601a38b -r 1f0b15040456 man/lispref/objects.texi --- a/man/lispref/objects.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/objects.texi Sun May 01 18:44:03 2011 +0100 @@ -349,19 +349,6 @@ primitive types. (This change was necessary in order for @sc{mule}, i.e. Asian-language, support to be correctly implemented.) - Even in XEmacs version 20, remnants of the equivalence between -characters and integers still exist; this is termed the @dfn{char-int -confoundance disease}. In particular, many functions such as @code{eq}, -@code{equal}, and @code{memq} have equivalent functions (@code{old-eq}, -@code{old-equal}, @code{old-memq}, etc.) that pretend like characters -are integers are the same. Byte code compiled under any version 19 -Emacs will have all such functions mapped to their @code{old-} equivalents -when the byte code is read into XEmacs 20. This is to preserve -compatibility---Emacs 19 converts all constant characters to the equivalent -integer during byte-compilation, and thus there is no other way to preserve -byte-code compatibility even if the code has specifically been written -with the distinction between characters and integers in mind. - Every character has an equivalent integer, called the @dfn{character code}. For example, the character @kbd{A} is represented as the @w{integer 65}, following the standard @sc{ascii} representation of @@ -623,6 +610,8 @@ @cindex backslash in character constant @cindex octal character code @cindex hexadecimal character code +@cindex Overlong hex character escape +@cindex Non-ISO-8859-1 octal character escape Finally, there are two read syntaxes involving character codes. It is not possible to represent multibyte or wide characters in this @@ -643,14 +632,21 @@ @samp{?\001} for the character @kbd{C-a}, and @code{?\002} for the character @kbd{C-b}. The reader will finalize the character and start reading the next token when a non-octal-digit is encountered or three -octal digits are read. +octal digits are read. When a given character code is above +@code{#o377}, the Lisp reader signals an @code{invalid-read-syntax} +error. Such errors are typically provoked by code written for older +versions of GNU Emacs, where the absence of the #o octal syntax for +integers made the character syntax convenient for non-character +values. Those older versions of GNU Emacs are long obsolete, so +changing the code to use the #o integer escape is the best +solution. @pxref{Numbers}. The second consists of a question mark followed by a backslash, the character @samp{x}, and the character code in hexadecimal (up to two hexadecimal digits); thus, @samp{?\x41} for the character @kbd{A}, @samp{?\x1} for the character @kbd{C-a}, and @code{?\x2} for the character @kbd{C-b}. If more than two hexadecimal codes are given, the -reader signals an error. +reader signals an @code{invalid-read-syntax} error. @example @group @@ -2228,7 +2224,7 @@ @section Equality Predicates @cindex equality - Here we describe two functions that test for equality between any two + Here we describe functions that test for equality between any two objects. Other functions test equality between objects of specific types, e.g., strings. For these predicates, see the appropriate chapter describing the data type. @@ -2308,28 +2304,27 @@ @end defun -@defun old-eq object1 object2 -This function exists under XEmacs 20 and is exactly like @code{eq} -except that it suffers from the char-int confoundance disease. -In other words, it returns @code{t} if given a character and the -equivalent integer, even though the objects are of different types! -You should @emph{not} ever call this function explicitly in your -code. However, be aware that all calls to @code{eq} in byte code -compiled under version 19 map to @code{old-eq} in XEmacs 20. -(Likewise for @code{old-equal}, @code{old-memq}, @code{old-member}, -@code{old-assq} and @code{old-assoc}.) +@defun eql object1 object2 + +This function returns @code{t} if the two arguments are the same object, +as with @code{eq}. In addition, it returns @code{t} if @var{object1} +and @var{object2} are numeric objects of the same type and with equal +values. Otherwise it returns @code{nil}. @code{eql} is the default +test for hash tables, and for many sequence-oriented functions inherited +from Common Lisp. @example @group -;; @r{Remember, this does not apply under XEmacs 19.} -?A - @result{} ?A -(char-int ?A) - @result{} 65 -(old-eq ?A 65) - @result{} t ; @r{Eek, we've been infected.} -(eq ?A 65) - @result{} nil ; @r{We are still healthy.} +(eql 1 1) + @result{} t +(eql 1 1.0) ; different types + @result{} nil +(eq (+ 0.0 pi) pi) + @result{} nil ; in some contexts can be t, but don't rely on this! +(eql (+ 0.0 pi) pi) + @result{} t ; this is more reliable. +(position (+ 0 pi) (list 0 1 2 pi 4)) + @result{} 3 ; function's test defaults to eql @end group @end example @end defun diff -r 861f2601a38b -r 1f0b15040456 man/lispref/os.texi --- a/man/lispref/os.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/os.texi Sun May 01 18:44:03 2011 +0100 @@ -1026,6 +1026,10 @@ This stands for the year with century. @item %Z This stands for the time zone abbreviation. +@item %\xe6 (the ISO-8859-1 lowercase ae character) +This stands for the month as a lowercase Roman number (i-xii) +@item %\xc6 (the ISO-8859-1 uppercase AE character) +This stands for the month as an uppercase Roman number (I-XII) @end table @end defun diff -r 861f2601a38b -r 1f0b15040456 man/lispref/packaging.texi --- a/man/lispref/packaging.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/packaging.texi Sun May 01 18:44:03 2011 +0100 @@ -993,21 +993,19 @@ # Makefile for build lisp code # This file is part of XEmacs. - -# XEmacs is free software; you can redistribute it and/or modify it +# +# 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. - +# Free Software Foundation, either version 3 of the License, or (at your +# option) any later version. +# # XEmacs is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License # for more details. - +# # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. +# along with XEmacs. If not, see . # For the time being, remove MULE_ELCS from the all dependencies if # building without Mule. diff -r 861f2601a38b -r 1f0b15040456 man/lispref/positions.texi --- a/man/lispref/positions.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/positions.texi Sun May 01 18:44:03 2011 +0100 @@ -766,7 +766,7 @@ described elsewhere (see @ref{Window Configurations} and @pxref{Frame Configurations}). -@defspec save-excursion forms@dots{} +@deffn {Special Operator} save-excursion forms@dots{} @cindex mark excursion @cindex point excursion @cindex current buffer excursion @@ -810,29 +810,29 @@ (set-marker (mark-marker) old-mark))) @end group @end example -@end defspec +@end deffn -@defspec save-current-buffer forms@dots{} +@deffn {Special Operator} save-current-buffer forms@dots{} This special operator is similar to @code{save-excursion} but it only saves and restores the current buffer. Beginning with XEmacs 20.3, @code{save-current-buffer} is a primitive. -@end defspec +@end deffn -@defspec with-current-buffer buffer forms@dots{} +@deffn {Special Operator} with-current-buffer buffer forms@dots{} This macro evaluates @var{forms} with @var{buffer} as the current buffer. It returns the value of the last form. -@end defspec +@end deffn -@defspec with-temp-file filename forms@dots{} +@deffn {Special Operator} with-temp-file filename forms@dots{} This macro creates a new buffer, evaluates @var{forms} there, and writes the buffer to @var{filename}. It returns the value of the last form evaluated. -@end defspec +@end deffn -@defspec save-selected-window forms@dots{} +@deffn {Special Operator} save-selected-window forms@dots{} This macro is similar to @code{save-excursion} but it saves and restores the selected window and nothing else. -@end defspec +@end deffn @node Narrowing @section Narrowing @@ -893,7 +893,7 @@ @var{buffer} defaults to the current buffer if omitted. @end deffn -@defspec save-restriction body@dots{} +@deffn {Special Operator} save-restriction body@dots{} This special operator saves the current bounds of the accessible portion, evaluates the @var{body} forms, and finally restores the saved bounds, thus restoring the same state of narrowing (or absence thereof) formerly @@ -972,4 +972,4 @@ ---------- Buffer: foo ---------- @end group @end example -@end defspec +@end deffn diff -r 861f2601a38b -r 1f0b15040456 man/lispref/processes.texi --- a/man/lispref/processes.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/processes.texi Sun May 01 18:44:03 2011 +0100 @@ -650,7 +650,7 @@ used. If it is @code{nil}, the current buffer's process is used. Optional arguments @var{start} and @var{end} specify part of @var{string}; -see @code{substring}. +see @code{subseq}. The function returns @code{nil}. diff -r 861f2601a38b -r 1f0b15040456 man/lispref/searching.texi --- a/man/lispref/searching.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/searching.texi Sun May 01 18:44:03 2011 +0100 @@ -1458,10 +1458,10 @@ You can save and restore the match data with @code{save-match-data}: -@defspec save-match-data body@dots{} +@deffn {Special Operator} save-match-data body@dots{} This special operator executes @var{body}, saving and restoring the match data around it. -@end defspec +@end deffn Emacs automatically saves and restores the match data when it runs process filter functions (@pxref{Filter Functions}) and process diff -r 861f2601a38b -r 1f0b15040456 man/lispref/sequences.texi --- a/man/lispref/sequences.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/sequences.texi Sun May 01 18:44:03 2011 +0100 @@ -219,6 +219,44 @@ @code{nth} (@pxref{List Elements}). @end defun +@defun fill sequence object @t{&key :start :end} +This function fills the sequence @var{sequence} with @var{object}, so +that each element of @var{sequence} between the indices specified by +@code{:start} (inclusive) and @code{:end} (exclusive), is @var{object}. +It returns @var{sequence}. + +@example +@group +(setq a [a b c d e f g]) + @result{} [a b c d e f g] +(fill a 0 :end 2) + @result{} [0 0 c d e f g] +(fill a 0) + @result{} [0 0 0 0 0 0 0] +a + @result{} [0 0 0 0 0 0 0] +@end group + +@group +(setq s "When in the course") + @result{} "When in the course" +(fill s ?-) + @result{} "------------------" +@end group + +@group +(setq bv #*1101) + @result{} #*1101 +(fill bv 0) + @result{} #*0000 +@end group +@end example + +If @var{sequence} is of a type that cannot hold @var{object} ( +bit-vector can only hold the integers one or zero, strings can only hold +characters) a @code{wrong-type-argument} error results. +@end defun + @node Arrays @section Arrays @cindex array @@ -387,39 +425,6 @@ @code{wrong-type-argument} error results. @end defun -@defun fillarray array object -This function fills the array @var{array} with @var{object}, so that -each element of @var{array} is @var{object}. It returns @var{array}. - -@example -@group -(setq a [a b c d e f g]) - @result{} [a b c d e f g] -(fillarray a 0) - @result{} [0 0 0 0 0 0 0] -a - @result{} [0 0 0 0 0 0 0] -@end group - -@group -(setq s "When in the course") - @result{} "When in the course" -(fillarray s ?-) - @result{} "------------------" -@end group - -@group -(setq bv #*1101) - @result{} #*1101 -(fillarray bv 0) - @result{} #*0000 -@end group -@end example - -If @var{array} is a string and @var{object} is not a character, a -@code{wrong-type-argument} error results. -@end defun - The general sequence functions @code{copy-sequence} and @code{length} are often useful for objects known to be arrays. @xref{Sequence Functions}. diff -r 861f2601a38b -r 1f0b15040456 man/lispref/specifiers.texi --- a/man/lispref/specifiers.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/specifiers.texi Sun May 01 18:44:03 2011 +0100 @@ -875,7 +875,7 @@ @code{add-spec-list-to-specifier}. @end defun -@defspec let-specifier specifier-list &rest body +@deffn {Special Operator} let-specifier specifier-list &rest body This macro temporarily adds specifications to specifiers, evaluates forms in @var{body} and restores the specifiers to their previous states. The specifiers and their temporary specifications are @@ -912,7 +912,7 @@ (let-specifier ((modeline-shadow-thickness 0 (selected-window))) (sit-for 1)) @end example -@end defspec +@end deffn @defun set-specifier specifier value &optional locale tag-set how-to-add This function adds some specifications to @var{specifier}. @var{value} diff -r 861f2601a38b -r 1f0b15040456 man/lispref/strings.texi --- a/man/lispref/strings.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/strings.texi Sun May 01 18:44:03 2011 +0100 @@ -165,6 +165,10 @@ index @var{start} up to (but excluding) the character at the index @var{end}. The first character is at index zero. +In this implementation, @code{substring} is an alias for @code{subseq}, +so @var{string} can be any sequence. In GNU Emacs, @var{string} can be +a string or a vector, and in older XEmacs it can only be a string. + @example @group (substring "abcdefg" 0 3) @@ -268,7 +272,7 @@ @end defun The function @code{split-string}, in @ref{Regexp Search}, generates a -list of strings by splitting a string on occurances of a regular +list of strings by splitting a string on occurrences of a regular expression. @node Predicates for Characters diff -r 861f2601a38b -r 1f0b15040456 man/lispref/text.texi --- a/man/lispref/text.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/text.texi Sun May 01 18:44:03 2011 +0100 @@ -2118,7 +2118,7 @@ Copying text between strings and buffers preserves the properties along with the characters; this includes such diverse functions as -@code{substring}, @code{insert}, and @code{buffer-substring}. +@code{subseq}, @code{insert}, and @code{buffer-substring}. @menu * Examining Properties:: Looking at the properties of one character. diff -r 861f2601a38b -r 1f0b15040456 man/lispref/tips.texi --- a/man/lispref/tips.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/tips.texi Sun May 01 18:44:03 2011 +0100 @@ -466,7 +466,7 @@ @smallexample @group (setq base-version-list ; there was a base - (assoc (substring fn 0 start-vn) ; version to which + (assoc (subseq fn 0 start-vn) ; version to which file-version-assoc-list)) ; this looks like ; a subversion @end group diff -r 861f2601a38b -r 1f0b15040456 man/lispref/variables.texi --- a/man/lispref/variables.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/variables.texi Sun May 01 18:44:03 2011 +0100 @@ -168,7 +168,7 @@ The special operators @code{let} and @code{let*} exist to create local bindings. -@defspec let (bindings@dots{}) forms@dots{} +@deffn {Special Operator} let (bindings@dots{}) forms@dots{} This special operator binds variables according to @var{bindings} and then evaluates all of the @var{forms} in textual order. The @code{let}-form returns the value of the last form in @var{forms}. @@ -196,9 +196,9 @@ @result{} (1 2) @end group @end example -@end defspec +@end deffn -@defspec let* (bindings@dots{}) forms@dots{} +@deffn {Special Operator} let* (bindings@dots{}) forms@dots{} This special operator is like @code{let}, but it binds each variable right after computing its local value, before computing the local value for the next variable. Therefore, an expression in @var{bindings} can @@ -218,7 +218,7 @@ @result{} (1 1) @end group @end example -@end defspec +@end deffn Here is a complete list of the other facilities that create local bindings: @@ -403,7 +403,7 @@ files, and override the default values given in the definitions. For this reason, user options must be defined with @code{defvar}. -@defspec defvar symbol [value [doc-string]] +@deffn {Special Operator} defvar symbol [value [doc-string]] This special operator defines @var{symbol} as a value and initializes it. The definition informs a person reading your code that @var{symbol} is used as a variable that programs are likely to set or change. It is @@ -491,9 +491,9 @@ The @code{defvar} form returns @var{symbol}, but it is normally used at top level in a file where its value does not matter. -@end defspec +@end deffn -@defspec defconst symbol [value [doc-string]] +@deffn {Special Operator} defconst symbol [value [doc-string]] This special operator defines @var{symbol} as a value and initializes it. It informs a person reading your code that @var{symbol} has a global value, established here, that will not normally be changed or locally @@ -530,7 +530,7 @@ @result{} 3 @end group @end example -@end defspec +@end deffn @defun user-variable-p variable @cindex user option @@ -615,7 +615,7 @@ form @code{setq}. When you need to compute the choice of variable at run time, use the function @code{set}. -@defspec setq [symbol form]@dots{} +@deffn {Special Operator} setq [symbol form]@dots{} This special operator is the most common method of changing a variable's value. Each @var{symbol} is given a new value, which is the result of evaluating the corresponding @var{form}. The most-local existing @@ -655,7 +655,7 @@ @result{} 11 @end group @end example -@end defspec +@end deffn @defun set symbol value This function sets @var{symbol}'s value to @var{value}, then returns @@ -1253,7 +1253,7 @@ @code{symbol-value}. @end defun -@defspec setq-default symbol value +@deffn {Special Operator} setq-default symbol value This sets the default value of @var{symbol} to @var{value}. It does not evaluate @var{symbol}, but does evaluate @var{value}. The value of the @code{setq-default} form is @var{value}. @@ -1314,7 +1314,7 @@ @result{} another-default @end group @end example -@end defspec +@end deffn @defun set-default symbol value This function is like @code{setq-default}, except that @var{symbol} is diff -r 861f2601a38b -r 1f0b15040456 man/lispref/windows.texi --- a/man/lispref/windows.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/lispref/windows.texi Sun May 01 18:44:03 2011 +0100 @@ -442,12 +442,12 @@ @end example @end defun -@defspec save-selected-window forms@dots{} +@deffn {Special Operator} save-selected-window forms@dots{} This macro records the selected window, executes @var{forms} in sequence, then restores the earlier selected window. It does not save or restore anything about the sizes, arrangement or contents of windows; therefore, if the @var{forms} change them, the changes are permanent. -@end defspec +@end deffn @cindex finding windows The following functions choose one of the windows on the screen, @@ -705,6 +705,11 @@ @end example @end defun +@defvar buffer-display-count +This variable, local to a given buffer, reflects the number of times +XEmacs has displayed the buffer in a window. +@end defvar + @defun window-buffer &optional window This function returns the buffer that @var{window} is displaying. If @var{window} is omitted, this function returns the buffer for the @@ -729,6 +734,16 @@ the same meaning as for @code{next-window}. @end defun + +@defvar buffer-display-time +This variable records the time at which a buffer was last made visible +in a window. It is always local in each buffer; each time +@code{set-window-buffer} is called, it sets this variable to +@code{(current-time)} in the specified buffer (@pxref{Time of Day}). +When a buffer is first created, @code{buffer-display-time} starts out +with the value @code{nil}. +@end defvar + @node Displaying Buffers @section Displaying Buffers in Windows @cindex switching to a buffer @@ -1954,7 +1969,7 @@ @end example @end defun -@defspec save-window-excursion forms@dots{} +@deffn {Special Operator} save-window-excursion forms@dots{} This macro records the window configuration, executes @var{forms} in sequence, then restores the earlier window configuration. The window configuration includes the value of point and the portion of the buffer @@ -1990,7 +2005,7 @@ ;; @r{The frame is now split again.} @end group @end example -@end defspec +@end deffn @defun window-configuration-p object This function returns @code{t} if @var{object} is a window configuration. diff -r 861f2601a38b -r 1f0b15040456 man/term.texi --- a/man/term.texi Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,394 +0,0 @@ -@\input texinfo @c -*-texinfo-*- -@setfilename ../info/term.info -@settitle XEmacs Terminal Emulator Mode - -@titlepage -@sp 6 -@center @titlefont(XEmacs Terminal Emulator Mode) -@end titlepage - -@ifinfo -@dircategory XEmacs Editor -@direntry -* Term mode: (term). XEmacs Terminal Emulator Mode. -@end direntry - -@node Top, , (DIR) -@top Terminal emulator mode -@end ifinfo - -This is some notes about the term Emacs mode. - -@menu -* term mode:: -@end menu - -@node term mode -@chapter XEmacs Terminal Emulator Mode - -@menu -* Overview:: -* Connecting to remote computers:: -* Paging:: -* Terminal escapes:: -@end menu - -The @code{term} package includes the major modes @code{term}, -@code{shell}, and @code{gud} (for running gdb or another debugger). -It is a replacement for the comint mode of Emacs 19, -as well as shell, gdb, terminal, and telnet modes. -The package works best with recent releases of Emacs 19, -but will also work reasonably well with Emacs 18 as well as Lucid Emacs 19. - -The file @code{nshell.el} is a wrapper to use unless term mode -is built into Emacs. If works around some of the missing -in older Emacs versions. -To use it, edit the paths in @code{nshell.el}, appropriately, -and then @code{M-x load-file nshell.el RET}. -This will also load in replacement shell and gud modes. - -@node Overview -@section Overview - -The @code{term} mode is used to control a program (an "inferior process"). -It sends most keyboard input characters to the program, -and displays output from the program in the buffer. -This is similar to the traditional comint mode, and -modes derived from it (such as shell and gdb modes). -You can do with the new term-based shell the same sort -of things you could do with the old shell mode, -using more or less the same interface. However, the -new mode is more flexible, and works somewhat differently. - -@menu -* Output from the inferior:: -* subbuffer:: The sub-buffer -* altsubbuffer:: The alternate sub-buffer -* Input to the inferior:: -@end menu - -@node Output from the inferior -@subsection Output from the inferior - -In typical usage, output from the inferior is -added to the end of the buffer. If needed, the window -will be scrolled, just like a regular terminal. -(Only one line at a time will be scrolled, just like -regular terminals, and in contrast to the old shell mode.) -Thus the buffer becomes a log of your interaction with the -inferior, just like the old shell mode. - -Like a real terminal, term maintains a "cursor position." -This is the @code{process-mark} of the inferior process. -If the process-mark is not at the end of the buffer, output from -the inferior will overwrite existing text in the buffer. -This is like a real terminal, but unlike the old shell mode -(which inserts the output, instead of overwriting). - -Some programs (such as Emacs itself) need to control the -appearance on the screen in detail. They do this by -sending special control codes. The exact control -codes needed from terminal to terminal, but nowadays -most terminals and terminal emulators (including xterm) -understand the so-called "ANSI escape sequences" (first -popularized by the Digital's VT100 family of terminal). -The term mode also understands these escape sequences, -and for each control code does the appropriate thing -to change the buffer so that the appearance of the window -will match what it would be on a real terminal. -(In contrast, the old shell mode doesn't handle -terminal control codes at all.) - -See <...> for the specific control codes. - -@node subbuffer -@subsection The sub-buffer - -A program that talks to terminal expects the terminal to have a fixed size. -If the program is talking a terminal emulator program such as @code{xterm}, -that size can be changed (if the xterm window is re-sized), but programs -still assume a logical terminal that has a fixed size independent -of the amount of output transmitted by the programs. - -To programs that use it, the Emacs terminal emulator acts as if it -too has a fixed size. The @dfn{sub-buffer} is the part of a @code{term}-mode -buffer that corresponds to a "normal" terminal. Most of the time -(unless you explicitly scroll the window displaying the buffer), -the sub-buffer is the part of the buffer that is displayed in a window. - -The sub-buffer is defined in terms of three buffer-local-variable: - -@defvar term-height -The height of the sub-buffer, in screen lines. -@end defvar - -@defvar term-width -The width of the sub-buffer, in screen columns. -@end defvar - -@defvar term-home-marker -The "home" position, that is the top left corner of the sub-buffer. -@end defvar - -The sub-buffer is assumed to be the end part of the buffer; -the @code{term-home-marker} should never be more than -@code{term-height} screen lines from the end of the buffer. - -@node altsubbuffer -@subsection The alternate sub-buffer - -When a "graphical" program finishes, it is nice to -restore the screen state to what it was before the program started. -Many people are used to this behavior from @code{xterm}, and -its also offered by the @code{term} emulator. - -@defun term-switch-to-alternate-sub-buffer set -If @var{set} is true, and we're not already using the alternate sub-buffer, -switch to it. What this means is that the @code{term-home-marker} -is saved (in the variable @code{term-saved-home-marker}), and the -@code{term-home-marker} is set to the end of the buffer. - -If @var{set} is false and we're using the alternate sub-buffer, -switch back to the saved sub-buffer. What this means is that the -(current, alternate) sub-buffer is deleted (using -@code{(delete-region term-home-marker (point-max))}), and then the -@code{term-home-marker} is restored (from @code{term-saved-home-marker}). -@end defun - -@node Input to the inferior -@subsection Input to the inferior - -Characters typed by the user are sent to the inferior. -How this is done depends on whether the @code{term} buffer -is in "character" mode or "line" mode. -(A @code{term} buffer can also be in "pager" mode. -This is discussed .) -Which of these is currently active is specified in the mode line. -The difference between them is the key-bindings available. - -In character mode, one character (by default @key{C-c}) is special, -and is a prefix for various commands. All other characters are -sent directly to the inferior process, with no interpretation by Emacs. -Character mode looks and feels like a real terminal, or a conventional -terminal emulator such as xterm. - -In line mode, key commands mostly have standard Emacs actions. -Regulars characters insert themselves into the buffer. -When return is typed, the entire current line of the buffer -(except possibly the prompt) is sent to the inferior process. -Line mode is basically the original shell mode from earlier Emacs versions. - -To switch from line mode to character mode type @kbd{C-c C-k}. -To switch from character mode to line mode type @kbd{C-c C-j}. - -In either mode, "echoing" of user input is handled by the inferior. -Therefor, in line mode after an input line at the end of the buffer -is sent to the inferior, it is deleted from the buffer. -This is so that the inferior can echo the input, if it wishes -(which it normally does). - -@node Connecting to remote computers -@section Connecting to remote computers - -If you want to login to a remove computer, you can do that just as -you would expect, using whatever commands you would normally use. - -(This is worth emphasizing, because earlier versions of @code{shell} -mode would not work properly if you tried to log in to some other -computer, because of the way echoing was handled. That is why -there was a separate @code{telnet} mode to partially compensate for -these problems. The @code{telnet} mode is no longer needed, and -is basically obsolete.) - -A program that asks you for a password will normally suppress -echoing of the password, so the password will not show up in the buffer. -This will happen just as if you were using a real terminal, if -the buffer is in char mode. If it is in line mode, the password -will be temporarily visible, but will be erased when you hit return. -(This happens automatically; there is no special password processing.) - -When you log in to a different machine, you need to specify the -type of terminal your using. If you are talking to a Bourne-compatible -shell, and your system understands the @code{TERMCAP} variable, -you can use the command @kbd{M-x shell-send-termcap}, which -sends a string specifying the terminal type and size. -(This command is also useful after the window has changed size.) - -If you need to specify the terminal type manually, you can try the -terminal types "ansi" or "vt100". - -You can of course run gdb on that remote computer. One useful -trick: If you invoke gdb with the @code{--fullname} option, -it will send special commands to Emacs that will cause Emacs to -pop up the source files you're debugging. This will work -whether or not gdb is running on a different computer than Emacs, -assuming can access the source files specified by gdb. - -@node Paging -@section Paging - -When the pager is enabled, Emacs will "pause" after each screenful -of output (since the last input sent to the inferior). -It will enter "pager" mode, which feels a lot like the "more" -program: Typing a space requests another screenful of output. -Other commands request more or less output, or scroll backwards -in the @code{term} buffer. In pager mode, type @kbd{h} or @kbd{?} -to display a help message listing all the available pager mode commands. - -In either character or line mode, type @kbd{C-c p} to enable paging, -and @kbd{C-c D} to disable it. - -@node Terminal escapes -@section Terminal Escape sequences - -A program that does "graphics" on a terminal controls the -terminal by sending strings called @dfn{terminal escape sequences} -that the terminal (or terminal emulator) interprets as special commands. -The @code{term} mode includes a terminal emulator that understands -standard ANSI escape sequences, originally popularized by VT100 terminals, -and now used by the @code{xterm} program and most modern terminal -emulator software. - -@menu -* Cursor motion:: Escape sequences to move the cursor -* Erasing:: Escape commands for erasing text -* Inserting and deleting:: Escape sequences to insert and delete text -* Scrolling:: Escape sequences to scroll part of the visible window -* Command hook:: -* Miscellaneous escapes:: -@end menu - -printing chars - -tab - -LF - -@node Cursor motion -@subsection Escape sequences to move the cursor - -@table @kbd -@item RETURN -Moves to the beginning of the current screen line. - -@item C-b -Moves backwards one column. (Tabs are broken up if needed.) -@comment Line wrap FIXME - -@item Esc [ R ; C H -Move to screen row R, screen column C, where (R=1) is the top row, -and (C=1) is the leftmost column. Defaults are R=1 and C=1. - -@item Esc [ N A -Move N (default 1) screen lines up. -@item Esc [ N B -Move N (default 1) screen lines down. -@item Esc [ N C -Move N (default 1) columns right. -@item Esc [ N D -Move N (default 1) columns left. -@end table - -@node Erasing -@subsection Escape commands for erasing text - -These commands "erase" part of the sub-buffer. -Erasing means replacing by white space; it is not the same as deleting. -The relative screen positions of things that are not erased remain -unchanged with each other, as does the relative cursor position. - -@table @kbd -@item E [ J -Erase from cursor to end of screen. -@item E [ 0 J -Same as E [ J. -@item E [ 1 J -Erase from home position to point. -@item E [ 2 J -Erase whole sub-buffer. -@item E [ K -Erase from point to end of screen line. -@item E [ 0 K -Same as E [ K. -@item E [ 1 K -Erase from beginning of screen line to point. -@item E [ 2 K -Erase whole screen line. -@end table - -@node Inserting and deleting -@subsection Escape sequences to insert and delete text - -@table @kbd -@item Esc [ N L -Insert N (default 1) blank lines. -@item Esc [ N M -Delete N (default 1) lines. -@item Esc [ N P -Delete N (default 1) characters. -@item Esc [ N @@ -Insert N (default 1) spaces. -@end table - -@node Scrolling -@subsection Escape sequences to scroll part of the visible window - -@table @kbd -@item Esc D -Scroll forward one screen line. - -@item Esc M -Scroll backwards one screen line. - -@item Esc [ T ; B r -Set the scrolling region to be from lines T down to line B inclusive, -where line 1 is the topmost line. -@end table - -@node Command hook -@subsection Command hook - -If @kbd{C-z} is seen, any text up to a following @key{LF} is scanned. -The text in between (not counting the initial C-z or the final LF) -is passed to the function that is the value of @code{term-command-hook}. - -The default value of the @code{term-command-hook} variable -is the function @code{term-command-hook}, which handles the following: - -@table @kbd -@item C-z C-z FILENAME:LINENUMBER:IGNORED LF -Set term-pending-frame to @code{(cons "FILENAME" LINENUMBER)}. -When the buffer is displayed in the current window, show -the FILENAME in the other window, and show an arrow at LINENUMBER. -Gdb emits these strings when invoked with the flag --fullname. -This is used by gdb mode; you can also invoke gdb with this flag -from shell mode. - -@item C-z / DIRNAME LF -Set the directory of the term buffer to DIRNAME - -@item C-z ! LEXPR LF -Read and evaluate LEXPR as a Lisp expression. -The result is ignored. -@end table - -@node Miscellaneous escapes -@subsection Miscellaneous escapes - -@table @kbd -@item C-g (Bell) -Calls @code{(beep t)}. - -@item Esc 7 -Save cursor. - -@item Esc 8 -Restore cursor. - -@item Esc [ 47 h -Switch to the alternate sub-buffer, -@item Esc [ 47 l -Switch back to the regular sub-buffer, -@end table - -@bye diff -r 861f2601a38b -r 1f0b15040456 man/texinfo.tex --- a/man/texinfo.tex Sat Feb 20 06:03:00 2010 -0600 +++ b/man/texinfo.tex Sun May 01 18:44:03 2011 +0100 @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2008-04-18.10} +\def\texinfoversion{2011-05-01.18} % % Copyright (C) 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, diff -r 861f2601a38b -r 1f0b15040456 man/xemacs-faq.texi --- a/man/xemacs-faq.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/xemacs-faq.texi Sun May 01 18:44:03 2011 +0100 @@ -327,6 +327,7 @@ * Q2.5.4:: Startup warnings about deducing proper fonts? * Q2.5.5:: Warnings from incorrect key modifiers. * Q2.5.6:: XEmacs 21.1 on Windows used to spawn an ugly console window on every startup. Has that been fixed? +* Q2.5.7:: XEmacs issues messages about ``auto-autoloads already loaded.'' 3 Editing Functions @@ -739,7 +740,7 @@ @node Q1.0.3, Q1.0.4, Q1.0.2, Introduction @unnumberedsubsec Q1.0.3: How do you pronounce XEmacs? -The most common pronounciation is @samp{Eks eemax}, @samp{Eks'im&ks} in +The most common pronunciation is @samp{Eks eemax}, @samp{Eks'im&ks} in Kirshenbaum IPA. (See @uref{http://www.kirshenbaum.net/IPA/ascii-ipa.pdf} if you know the IPA already and want to know how to map from Kirshenbaum to it.) @@ -2445,7 +2446,7 @@ ERC is an Emacs InternetRelayChat client. @item escreen -Multiple editing sessions withing a single frame (like screen). +Multiple editing sessions within a single frame (like screen). @item eshell Command shell implemented entirely in Emacs Lisp. @@ -3149,6 +3150,7 @@ * Q2.5.4:: Startup warnings about deducing proper fonts? * Q2.5.5:: Warnings from incorrect key modifiers. * Q2.5.6:: XEmacs 21.1 on Windows used to spawn an ugly console window on every startup. Has that been fixed? +* Q2.5.7:: XEmacs issues messages about ``auto-autoloads already loaded.'' @end menu @unnumberedsec 2.0: Installation (General) @@ -4032,7 +4034,7 @@ the top-level source directory) to read what it says about your platform. -If you compiled XEmacs 21.4 or ealier using @samp{--use-union-type}, or +If you compiled XEmacs 21.4 or earlier using @samp{--use-union-type}, or 21.5 or later using @samp{--enable-union-type} (or in either case used the option @samp{USE_UNION_TYPE} in @file{config.inc} under Windows), try recompiling again without it. The union type has been known to @@ -4567,7 +4569,7 @@ EOF @end example -@node Q2.5.6, , Q2.5.5, Installation +@node Q2.5.6, Q2.5.7, Q2.5.5, Installation @unnumberedsubsec Q2.5.6: XEmacs 21.1 on Windows used to spawn an ugly console window on every startup. Has that been fixed? Yes. @@ -4617,6 +4619,54 @@ works around the "no useful stdio" problem by creating its own console window as necessary to display messages in.) +@node Q2.5.7, , Q2.5.6, Installation +@unnumberedsubsec Q2.5.7: XEmacs issues messages about ``auto-autoloads already loaded.'' + +On Sat, 05 Mar 2011 11:54:47 -0500, in Message-ID: +<4D726AD7.7020303@@gmail.com> on xemacs-beta, Raymond Toy reported: + +@quotation +[N]ow every time I start xemacs, I get 100+ error messages stating that +the auto-autoload for every package has already been loaded. +@end quotation + +This occurs if you have duplicate packages installed on your load-path. +To detect exactly which paths are duplicated, use @kbd{M-x +list-load-path-shadows}. If you have a small number of duplicated +libraries, it is probably one or more packages available both in the +XEmacs distribution and in third-party distributions. If you prefer the +third-party version, use @kbd{M-x list-packages} to get the package +management UI, and uninstall the particular packages. Removal of third +party packages must be done manually, if you wish to keep the version +distributed by XEmacs. + +When you have many duplicate packages, a common cause is that XEmacs +finds @emph{package root directories} that are duplicates of each other. +This can occur in some automounter configurations, or when the roots +share some subtrees via symlinks. In this case, you will get a warning +for @emph{all} of the packages you have installed. Although this is +basically a site configuration problem, please report these cases. +XEmacs is already aware of many automounter artifacts, and automatically +adjusts for them. Code is being added to try to detect symlinks. We +may not be able to handle every case, but we'd like to know about them, +and where possible incorporate workarounds. + +Package root directories are specified at configuration time via the +@code{--prefix}, @code{--exec-prefix}, and the @samp{--with-*-packages} +options; at runtime relative to the XEmacs binary (@file{../share} and +@file{..} (for run-in-place)); and at runtime via the +@samp{EMACS*PACKAGES} environment variables. Unless you have special +needs, it is best to install XEmacs and the packages (configuring with +@code{--with-prefix=$prefix} for XEmacs and by untarring the SUMOs in +@file{@code{$prefix}/share/xemacs/}. + +Note that older versions of XEmacs (21.1, 21.4, and early releases of +21.5) by default expect the packages to be installed under +@file{@code{$prefix}/lib} rather than @file{@code{$prefix}/share}. See +the documentation for @file{configure} for how to point XEmacs at +@file{@code{$prefix}/share/xemacs/} if that is preferred, or older +XEmacsen need to share packages with recent versions. + @node Editing, Display, Installation, Top @unnumbered 3 Editing Functions @@ -9001,10 +9051,10 @@ This is usually due to using @code{hg diff} on a @dfn{merge commit}. That means the commit has multiple parents, and joins together two lines -of development that occured concurrently. +of development that occurred concurrently. You're diffing against the "wrong" one; try the other one. You get the -relevent revision number or ID from @code{hg log}. In more detail: +relevant revision number or ID from @code{hg log}. In more detail: When there is a merge in Mercurial, it will often be the case that one of the parents is the immediate predecessor of the merge @@ -9054,7 +9104,7 @@ > GAAAAK! What's the best way to restore ChangeLog and its history? -He had just inadvertantly pushed a commit which deleted +He had just inadvertently pushed a commit which deleted @file{src/ChangeLog}! The history is still there, not to worry. (In this case, another developer had restored src/ChangeLog already.) The best way depends on a number of things. First, let's look at the log diff -r 861f2601a38b -r 1f0b15040456 man/xemacs/custom.texi --- a/man/xemacs/custom.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/xemacs/custom.texi Sun May 01 18:44:03 2011 +0100 @@ -2080,6 +2080,8 @@ Change the background pixmap of the given @var{face}. @item M-x set-face-background-pixmap-file A simpler version but with filename completion. +@item M-x set-face-background-placement +Change the placement of the background pixmap of the given @var{face}. @item M-x set-face-font Change the font of the given @var{face}. @item M-x set-face-foreground @@ -2161,6 +2163,18 @@ as much control on the pixmap instantiator, but provides filename completion. +@findex set-face-background-placement +You can set the placement of the background pixmap of the specified +@var{face} with the function @code{set-face-background-placement}. The +placement argument can be either @code{absolute} or @code{relative} (the +default). A @code{relative} placement means that the pixmap is attached +to the frame and moves with it. An @code{absolute} placement means that +the pixmap is rather attached to the frame's root window, so that when +you move the frame on the screen, it will appear to ``slide'' on the +pixmap. This placement mode can be used to achieve pseudo-translucency +for a frame, for example by setting the default face's background pixmap +to the root window's one. + @findex set-face-font You can set the font of the specified @var{face} with the function @code{set-face-font}. The @var{font} argument should be a string, the diff -r 861f2601a38b -r 1f0b15040456 man/xemacs/startup.texi --- a/man/xemacs/startup.texi Sat Feb 20 06:03:00 2010 -0600 +++ b/man/xemacs/startup.texi Sun May 01 18:44:03 2011 +0100 @@ -69,10 +69,10 @@ Moreover, XEmacs expects late hierarchies in the subdirectories @file{site-packages}, @file{mule-packages}, and @file{xemacs-packages} -(in that order) of the @file{/lib/xemacs} subdirectory of one of +(in that order) of the @file{/share/xemacs} subdirectory of one of the installation hierarchies. (If you run in-place, these are direct subdirectories of the build directory.) Furthermore, XEmacs will also -search these subdirectories in the @file{/lib/xemacs-} +search these subdirectories in the @file{/share/xemacs-} subdirectory and prefer directories found there. By default, XEmacs does not have a pre-configured last package @@ -113,12 +113,14 @@ @table @code @item version-specific @cindex version-specific directories -directories are specific to the version of XEmacs they belong to and -typically reside under @file{/lib/xemacs-}. +directories (such as @file{etc}, the @file{info} of the installed XEmacs +and its Lisp files in @file{lisp}) are specific to the version of XEmacs +they belong to and typically reside under +@file{/share/xemacs-}. @item site-specific @cindex site-specific directories -directories are independent of the version of XEmacs they belong to and -typically reside under @file{/lib/xemacs} +directories are independent of the version of XEmacs and +typically reside under @file{/share/xemacs}. @item architecture-specific @cindex architecture-specific directories directories are specific both to the version of XEmacs and the diff -r 861f2601a38b -r 1f0b15040456 modules/ChangeLog --- a/modules/ChangeLog Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/ChangeLog Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,59 @@ +2011-04-29 Stephen J. Turnbull + + * XEmacs 21.5.31 "ginger" is released. + +2011-04-26 Stephen J. Turnbull + + * XEmacs 21.5.30 "garlic" is released. + +2010-04-12 Ben Wing + + * canna/canna_api.c: + * canna/canna_api.c (Fcanna_henkan_begin): + Fixes for errors reported in smoketest build. + +2010-03-12 Ben Wing + + * base64/base64.c: + * base64/base64.c (Fbase64_encode): + * base64/base64.c (Fbase64_decode): + * base64/base64.c (syms_of_base64): + Fix file to follow GNU coding standards for indentation, spacing + before parens. + +2010-03-13 Ben Wing + + * postgresql/postgresql.c (print_pgconn): + * postgresql/postgresql.c (print_pgresult): + printing_unreadable_object -> printing_unreadable_object_fmt. + +2010-03-13 Ben Wing + + * ldap/eldap.c (print_ldap): + printing_unreadable_object -> printing_unreadable_object_fmt. + +2010-03-07 Ben Wing + + * postgresql/postgresql.c (finalize_pgconn): + * postgresql/postgresql.c (finalize_pgresult): + * ldap/eldap.c (finalize_ldap): + Fix the finalizers to go with the new calling sequence. Done + previously but somehow got lost. + +2010-03-05 Ben Wing + + * postgresql/postgresql.c (allocate_pgconn): + * postgresql/postgresql.c (allocate_pgresult): + * postgresql/postgresql.h (struct Lisp_PGconn): + * postgresql/postgresql.h (struct Lisp_PGresult): + * ldap/eldap.c (allocate_ldap): + * ldap/eldap.h (struct Lisp_LDAP): + Same changes as in src/ dir. See large log there in ChangeLog, + but basically: + + ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT + LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER + 2010-02-06 Ben Wing * canna/canna_api.c: @@ -607,3 +663,21 @@ * base64/base64.c - update Bufpos => Charbpos +ChangeLog entries synched from GNU Emacs are the property of the FSF. +Other ChangeLog entries are usually the property of the author of the +change. + +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 3 of the License, 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. If not, see . diff -r 861f2601a38b -r 1f0b15040456 modules/README --- a/modules/README Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/README Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,19 @@ +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 3 of the License, 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. If not, see . + + This directory contains a number of XEmacs dynamic modules. These modules can be loaded directly with the command 'M-x load-module'. However, the preferred method of loading a module is to issue a diff -r 861f2601a38b -r 1f0b15040456 modules/base64/Makefile --- a/modules/base64/Makefile Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/base64/Makefile Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,21 @@ +# Copyright (C) 1998, 1999 William Perry. + +# 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 3 of the License, 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. If not, see . + + # # This is slightly more complicated than would normally be the case, # as this makefile has been tailored to work in the Emacs source tree. diff -r 861f2601a38b -r 1f0b15040456 modules/base64/base64.c --- a/modules/base64/base64.c Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/base64/base64.c Sun May 01 18:44:03 2011 +0100 @@ -1,12 +1,13 @@ /* base64 interface for XEmacs. Copyright (C) 1998, 1999 Free Software Foundation, Inc. + Copyright (C) 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -38,176 +37,170 @@ */ (object, start, end, coding, error_me_not)) { - int cols,bits,char_count; - Lisp_Object instream, outstream,deststream; - Lstream *istr, *ostr, *dstr; - static Extbyte_dynarr *conversion_out_dynarr; - static Extbyte_dynarr *out_dynarr; - char tempbuf[1024]; /* some random amount */ - struct gcpro gcpro1, gcpro2; -#ifdef FILE_CODING - Lisp_Object conv_out_stream, coding_system; - Lstream *costr; - struct gcpro gcpro3; -#endif + int cols,bits,char_count; + Lisp_Object instream, outstream,deststream; + Lstream *istr, *ostr, *dstr; + static Extbyte_dynarr *conversion_out_dynarr; + static Extbyte_dynarr *out_dynarr; + char tempbuf[1024]; /* some random amount */ + struct gcpro gcpro1, gcpro2; + Lisp_Object conv_out_stream, coding_system; + Lstream *costr; + struct gcpro gcpro3; - if (!conversion_out_dynarr) - conversion_out_dynarr = Dynarr_new (Extbyte); - else - Dynarr_reset (conversion_out_dynarr); + if (!conversion_out_dynarr) + conversion_out_dynarr = Dynarr_new (Extbyte); + else + Dynarr_reset (conversion_out_dynarr); + + if (!out_dynarr) + out_dynarr = Dynarr_new (Extbyte); + else + Dynarr_reset (out_dynarr); + + char_count = bits = cols = 0; + + /* set up the in stream */ + if (BUFFERP (object)) + { + struct buffer *b = XBUFFER (object); + Charbpos begv, endv; + /* Figure out where we need to get info from */ + get_buffer_range_char (b, start, end, &begv, &endv, GB_ALLOW_NIL); - if (!out_dynarr) - out_dynarr = Dynarr_new(Extbyte); - else - Dynarr_reset (out_dynarr); - - char_count = bits = cols = 0; + instream = make_lisp_buffer_input_stream (b, begv, endv, 0); + } + else + { + Bytecount bstart, bend; + CHECK_STRING (object); + get_string_range_byte (object, start, end, &bstart, &bend, + GB_HISTORICAL_STRING_BEHAVIOR); + instream = make_lisp_string_input_stream (object, bstart, bend); + } + istr = XLSTREAM (instream); - /* set up the in stream */ - if (BUFFERP (object)) + /* Find out what format the buffer will be saved in, so we can make + the digest based on what it will look like on disk */ + if (NILP (coding)) + { + if (BUFFERP (object)) { - struct buffer *b = XBUFFER (object); - Charbpos begv, endv; - /* Figure out where we need to get info from */ - get_buffer_range_char (b, start, end, &begv, &endv, GB_ALLOW_NIL); - - instream = make_lisp_buffer_input_stream (b, begv, endv, 0); + /* Use the file coding for this buffer by default */ + coding_system = XBUFFER (object)->buffer_file_coding_system; } - else + else + { + /* attempt to autodetect the coding of the string. Note: this VERY hit-and-miss */ + enum eol_type eol = EOL_AUTODETECT; + coding_system = Fget_coding_system (Qundecided); + determine_real_coding_system (istr, &coding_system, &eol); + } + if (NILP (coding_system)) + coding_system = Fget_coding_system (Qbinary); + else { - Bytecount bstart, bend; - CHECK_STRING (object); - get_string_range_byte (object, start, end, &bstart, &bend, - GB_HISTORICAL_STRING_BEHAVIOR); - instream = make_lisp_string_input_stream (object, bstart, bend); + coding_system = Ffind_coding_system (coding_system); + if (NILP (coding_system)) + coding_system = Fget_coding_system (Qbinary); } - istr = XLSTREAM (instream); + } + else + { + coding_system = Ffind_coding_system (coding); + if (NILP (coding_system)) + { + if (NILP (error_me_not)) + signal_simple_error ("No such coding system", coding); + else + coding_system = Fget_coding_system (Qbinary); /* default to binary */ + } + } -#ifdef FILE_CODING - /* Find out what format the buffer will be saved in, so we can make - the digest based on what it will look like on disk */ - if (NILP(coding)) + /* setup the out stream */ + outstream = make_dynarr_output_stream ((unsigned_char_dynarr *)conversion_out_dynarr); + ostr = XLSTREAM (outstream); + deststream = make_dynarr_output_stream ((unsigned_char_dynarr *)out_dynarr); + dstr = XLSTREAM (deststream); + /* setup the conversion stream */ + conv_out_stream = make_encoding_output_stream (ostr, coding_system); + costr = XLSTREAM (conv_out_stream); + GCPRO3 (instream, outstream, conv_out_stream); + + /* Get the data while doing the conversion */ + while (1) + { + int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); + int l; + if (!size_in_bytes) + break; + /* It does seem the flushes are necessary... */ + Lstream_write (costr, tempbuf, size_in_bytes); + Lstream_flush (costr); + Lstream_flush (ostr); + + /* Update the base64 output buffer */ + for (l = 0; l < size_in_bytes; l++) { - if (BUFFERP(object)) - { - /* Use the file coding for this buffer by default */ - coding_system = XBUFFER(object)->buffer_file_coding_system; - } - else + bits += Dynarr_at (conversion_out_dynarr,l); + char_count++; + if (char_count == 3) { - /* attempt to autodetect the coding of the string. Note: this VERY hit-and-miss */ - enum eol_type eol = EOL_AUTODETECT; - coding_system = Fget_coding_system(Qundecided); - determine_real_coding_system(istr, &coding_system, &eol); + static char obuf[4]; + obuf[0] = alphabet[(bits >> 18)]; + obuf[1] = alphabet[(bits >> 12) & 0x3f]; + obuf[2] = alphabet[(bits >> 6) & 0x3f]; + obuf[3] = alphabet[bits & 0x3f]; + + Lstream_write (dstr,obuf,sizeof (obuf)); + cols += 4; + if (cols == 72) + { + Lstream_write (dstr,"\n",sizeof (unsigned char)); + cols = 0; + } + bits = char_count = 0; } - if (NILP(coding_system)) - coding_system = Fget_coding_system(Qbinary); - else + else { - coding_system = Ffind_coding_system (coding_system); - if (NILP(coding_system)) - coding_system = Fget_coding_system(Qbinary); - } - } - else - { - coding_system = Ffind_coding_system (coding); - if (NILP(coding_system)) - { - if (NILP(error_me_not)) - signal_simple_error("No such coding system", coding); - else - coding_system = Fget_coding_system(Qbinary); /* default to binary */ + bits <<= 8; } } -#endif - - /* setup the out stream */ - outstream = make_dynarr_output_stream((unsigned_char_dynarr *)conversion_out_dynarr); - ostr = XLSTREAM (outstream); - deststream = make_dynarr_output_stream((unsigned_char_dynarr *)out_dynarr); - dstr = XLSTREAM (deststream); -#ifdef FILE_CODING - /* setup the conversion stream */ - conv_out_stream = make_encoding_output_stream (ostr, coding_system); - costr = XLSTREAM (conv_out_stream); - GCPRO3 (instream, outstream, conv_out_stream); -#else - GCPRO2 (instream, outstream); -#endif - - /* Get the data while doing the conversion */ - while (1) { - int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); - int l; - if (!size_in_bytes) - break; - /* It does seem the flushes are necessary... */ -#ifdef FILE_CODING - Lstream_write (costr, tempbuf, size_in_bytes); - Lstream_flush (costr); -#else - Lstream_write (ostr, tempbuf, size_in_bytes); -#endif - Lstream_flush (ostr); - - /* Update the base64 output buffer */ - for (l = 0; l < size_in_bytes; l++) { - bits += Dynarr_at(conversion_out_dynarr,l); - char_count++; - if (char_count == 3) { - static char obuf[4]; - obuf[0] = alphabet[(bits >> 18)]; - obuf[1] = alphabet[(bits >> 12) & 0x3f]; - obuf[2] = alphabet[(bits >> 6) & 0x3f]; - obuf[3] = alphabet[bits & 0x3f]; + /* reset the dynarr */ + Lstream_rewind (ostr); + } + Lstream_close (istr); + Lstream_close (costr); + Lstream_close (ostr); - Lstream_write(dstr,obuf,sizeof(obuf)); - cols += 4; - if (cols == 72) { - Lstream_write(dstr,"\n",sizeof(unsigned char)); - cols = 0; - } - bits = char_count = 0; - } else { - bits <<= 8; - } - } - /* reset the dynarr */ - Lstream_rewind(ostr); + if (char_count != 0) + { + bits <<= 16 - (8 * char_count); + Lstream_write (dstr,&alphabet[bits >> 18],sizeof (unsigned char)); + Lstream_write (dstr,&alphabet[(bits >> 12) & 0x3f],sizeof (unsigned char)); + if (char_count == 1) + { + Lstream_write (dstr,"==",2 * sizeof (unsigned char)); + } else + { + Lstream_write (dstr,&alphabet[(bits >> 6) & 0x3f],sizeof (unsigned char)); + Lstream_write (dstr,"=",sizeof (unsigned char)); } - Lstream_close (istr); -#ifdef FILE_CODING - Lstream_close (costr); + } +#if 0 + if (cols > 0) + { + Lstream_write (dstr,"\n",sizeof (unsigned char)); + } #endif - Lstream_close (ostr); + UNGCPRO; + Lstream_delete (istr); + Lstream_delete (ostr); + Lstream_delete (costr); + Lstream_flush (dstr); + Lstream_delete (dstr); - if (char_count != 0) { - bits <<= 16 - (8 * char_count); - Lstream_write(dstr,&alphabet[bits >> 18],sizeof(unsigned char)); - Lstream_write(dstr,&alphabet[(bits >> 12) & 0x3f],sizeof(unsigned char)); - if (char_count == 1) { - Lstream_write(dstr,"==",2 * sizeof(unsigned char)); - } else { - Lstream_write(dstr,&alphabet[(bits >> 6) & 0x3f],sizeof(unsigned char)); - Lstream_write(dstr,"=",sizeof(unsigned char)); - } - } -#if 0 - if (cols > 0) { - Lstream_write(dstr,"\n",sizeof(unsigned char)); - } -#endif - UNGCPRO; - Lstream_delete (istr); - Lstream_delete (ostr); -#ifdef FILE_CODING - Lstream_delete (costr); -#endif - Lstream_flush(dstr); - Lstream_delete(dstr); - - return(make_string(Dynarr_atp(out_dynarr,0),Dynarr_length(out_dynarr))); + return (make_string (Dynarr_atp (out_dynarr,0),Dynarr_length (out_dynarr))); } DEFUN ("base64-decode", Fbase64_decode, 1, 5, 0, /* @@ -222,196 +215,190 @@ */ (object, start, end, coding, error_me_not)) { - static char inalphabet[256], decoder[256]; - int i,cols,bits,char_count,hit_eof; - Lisp_Object instream, outstream,deststream; - Lstream *istr, *ostr, *dstr; - static Extbyte_dynarr *conversion_out_dynarr; - static Extbyte_dynarr *out_dynarr; - char tempbuf[1024]; /* some random amount */ - struct gcpro gcpro1, gcpro2; -#ifdef FILE_CODING - Lisp_Object conv_out_stream, coding_system; - Lstream *costr; - struct gcpro gcpro3; -#endif + static char inalphabet[256], decoder[256]; + int i,cols,bits,char_count,hit_eof; + Lisp_Object instream, outstream,deststream; + Lstream *istr, *ostr, *dstr; + static Extbyte_dynarr *conversion_out_dynarr; + static Extbyte_dynarr *out_dynarr; + char tempbuf[1024]; /* some random amount */ + struct gcpro gcpro1, gcpro2; + Lisp_Object conv_out_stream, coding_system; + Lstream *costr; + struct gcpro gcpro3; - for (i = (sizeof alphabet) - 1; i >= 0 ; i--) { - inalphabet[alphabet[i]] = 1; - decoder[alphabet[i]] = i; + for (i = (sizeof alphabet) - 1; i >= 0 ; i--) + { + inalphabet[alphabet[i]] = 1; + decoder[alphabet[i]] = i; } - if (!conversion_out_dynarr) - conversion_out_dynarr = Dynarr_new (Extbyte); - else - Dynarr_reset (conversion_out_dynarr); + if (!conversion_out_dynarr) + conversion_out_dynarr = Dynarr_new (Extbyte); + else + Dynarr_reset (conversion_out_dynarr); - if (!out_dynarr) - out_dynarr = Dynarr_new(Extbyte); - else - Dynarr_reset (out_dynarr); + if (!out_dynarr) + out_dynarr = Dynarr_new (Extbyte); + else + Dynarr_reset (out_dynarr); - char_count = bits = cols = hit_eof = 0; + char_count = bits = cols = hit_eof = 0; - /* set up the in stream */ - if (BUFFERP (object)) - { - struct buffer *b = XBUFFER (object); - Charbpos begv, endv; - /* Figure out where we need to get info from */ - get_buffer_range_char (b, start, end, &begv, &endv, GB_ALLOW_NIL); + /* set up the in stream */ + if (BUFFERP (object)) + { + struct buffer *b = XBUFFER (object); + Charbpos begv, endv; + /* Figure out where we need to get info from */ + get_buffer_range_char (b, start, end, &begv, &endv, GB_ALLOW_NIL); - instream = make_lisp_buffer_input_stream (b, begv, endv, 0); - } - else - { - Bytecount bstart, bend; - CHECK_STRING (object); - get_string_range_byte (object, start, end, &bstart, &bend, - GB_HISTORICAL_STRING_BEHAVIOR); - instream = make_lisp_string_input_stream (object, bstart, bend); - } - istr = XLSTREAM (instream); + instream = make_lisp_buffer_input_stream (b, begv, endv, 0); + } + else + { + Bytecount bstart, bend; + CHECK_STRING (object); + get_string_range_byte (object, start, end, &bstart, &bend, + GB_HISTORICAL_STRING_BEHAVIOR); + instream = make_lisp_string_input_stream (object, bstart, bend); + } + istr = XLSTREAM (instream); -#ifdef FILE_CODING - /* Find out what format the buffer will be saved in, so we can make - the digest based on what it will look like on disk */ - if (NILP(coding)) + /* Find out what format the buffer will be saved in, so we can make + the digest based on what it will look like on disk */ + if (NILP (coding)) + { + if (BUFFERP (object)) + { + /* Use the file coding for this buffer by default */ + coding_system = XBUFFER (object)->buffer_file_coding_system; + } + else + { + /* attempt to autodetect the coding of the string. Note: this VERY hit-and-miss */ + enum eol_type eol = EOL_AUTODETECT; + coding_system = Fget_coding_system (Qundecided); + determine_real_coding_system (istr, &coding_system, &eol); + } + if (NILP (coding_system)) + coding_system = Fget_coding_system (Qbinary); + else + { + coding_system = Ffind_coding_system (coding_system); + if (NILP (coding_system)) + coding_system = Fget_coding_system (Qbinary); + } + } + else + { + coding_system = Ffind_coding_system (coding); + if (NILP (coding_system)) { - if (BUFFERP(object)) + if (NILP (error_me_not)) + signal_simple_error ("No such coding system", coding); + else + coding_system = Fget_coding_system (Qbinary); /* default to binary */ + } + } + + /* setup the out stream */ + outstream = make_dynarr_output_stream ((unsigned_char_dynarr *)conversion_out_dynarr); + ostr = XLSTREAM (outstream); + deststream = make_dynarr_output_stream ((unsigned_char_dynarr *)out_dynarr); + dstr = XLSTREAM (deststream); + /* setup the conversion stream */ + conv_out_stream = make_encoding_output_stream (ostr, coding_system); + costr = XLSTREAM (conv_out_stream); + GCPRO3 (instream, outstream, conv_out_stream); + + /* Get the data while doing the conversion */ + while (1) + { + int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); + int l; + if (!size_in_bytes) + { + hit_eof = 1; + break; + } + /* It does seem the flushes are necessary... */ + Lstream_write (costr, tempbuf, size_in_bytes); + Lstream_flush (costr); + Lstream_flush (ostr); + + /* Update the base64 output buffer */ + for (l = 0; l < size_in_bytes; l++) + { + if (Dynarr_at (conversion_out_dynarr,l) == '=') + goto decoder_out; + bits += decoder[Dynarr_at (conversion_out_dynarr,l)]; + fprintf (stderr,"%d\n",bits); + char_count++; + if (char_count == 4) { - /* Use the file coding for this buffer by default */ - coding_system = XBUFFER(object)->buffer_file_coding_system; - } - else - { - /* attempt to autodetect the coding of the string. Note: this VERY hit-and-miss */ - enum eol_type eol = EOL_AUTODETECT; - coding_system = Fget_coding_system(Qundecided); - determine_real_coding_system(istr, &coding_system, &eol); + static unsigned char obuf[3]; + obuf[0] = (bits >> 16); + obuf[1] = (bits >> 8) & 0xff; + obuf[2] = (bits & 0xff); + + Lstream_write (dstr,obuf,sizeof (obuf)); + bits = char_count = 0; } - if (NILP(coding_system)) - coding_system = Fget_coding_system(Qbinary); - else + else { - coding_system = Ffind_coding_system (coding_system); - if (NILP(coding_system)) - coding_system = Fget_coding_system(Qbinary); - } - } - else - { - coding_system = Ffind_coding_system (coding); - if (NILP(coding_system)) - { - if (NILP(error_me_not)) - signal_simple_error("No such coding system", coding); - else - coding_system = Fget_coding_system(Qbinary); /* default to binary */ + bits <<= 6; } } -#endif - - /* setup the out stream */ - outstream = make_dynarr_output_stream((unsigned_char_dynarr *)conversion_out_dynarr); - ostr = XLSTREAM (outstream); - deststream = make_dynarr_output_stream((unsigned_char_dynarr *)out_dynarr); - dstr = XLSTREAM (deststream); -#ifdef FILE_CODING - /* setup the conversion stream */ - conv_out_stream = make_encoding_output_stream (ostr, coding_system); - costr = XLSTREAM (conv_out_stream); - GCPRO3 (instream, outstream, conv_out_stream); -#else - GCPRO2 (instream, outstream); -#endif - - /* Get the data while doing the conversion */ - while (1) { - int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); - int l; - if (!size_in_bytes) { - hit_eof = 1; - break; - } - /* It does seem the flushes are necessary... */ -#ifdef FILE_CODING - Lstream_write (costr, tempbuf, size_in_bytes); - Lstream_flush (costr); -#else - Lstream_write (ostr, tempbuf, size_in_bytes); -#endif - Lstream_flush (ostr); - - /* Update the base64 output buffer */ - for (l = 0; l < size_in_bytes; l++) { - if (Dynarr_at(conversion_out_dynarr,l) == '=') - goto decoder_out; - bits += decoder[Dynarr_at(conversion_out_dynarr,l)]; - fprintf(stderr,"%d\n",bits); - char_count++; - if (char_count == 4) { - static unsigned char obuf[3]; - obuf[0] = (bits >> 16); - obuf[1] = (bits >> 8) & 0xff; - obuf[2] = (bits & 0xff); + /* reset the dynarr */ + Lstream_rewind (ostr); + } + decoder_out: + Lstream_close (istr); + Lstream_close (costr); + Lstream_close (ostr); - Lstream_write(dstr,obuf,sizeof(obuf)); - bits = char_count = 0; - } else { - bits <<= 6; - } - } - /* reset the dynarr */ - Lstream_rewind(ostr); - } - decoder_out: - Lstream_close (istr); -#ifdef FILE_CODING - Lstream_close (costr); -#endif - Lstream_close (ostr); - - if (hit_eof) { - if (char_count) { - error_with_frob(object,"base64-decode failed: at least %d bits truncated",((4 - char_count) * 6)); - } + if (hit_eof) + { + if (char_count) + { + error_with_frob (object,"base64-decode failed: at least %d bits truncated",((4 - char_count) * 6)); } - switch(char_count) { - case 1: - error_with_frob(object, "base64 encoding incomplete: at least 2 bits missing"); - break; - case 2: - char_count = bits >> 10; - Lstream_write(dstr,&char_count,sizeof(char_count)); - break; - case 3: - { - unsigned char buf[2]; - buf[0] = (bits >> 16); - buf[1] = (bits >> 8) & 0xff; - Lstream_write(dstr,buf,sizeof(buf)); - break; - } - } + } + switch (char_count) + { + case 1: + error_with_frob (object, "base64 encoding incomplete: at least 2 bits missing"); + break; + case 2: + char_count = bits >> 10; + Lstream_write (dstr,&char_count,sizeof (char_count)); + break; + case 3: + { + unsigned char buf[2]; + buf[0] = (bits >> 16); + buf[1] = (bits >> 8) & 0xff; + Lstream_write (dstr,buf,sizeof (buf)); + break; + } + } - UNGCPRO; - Lstream_delete (istr); - Lstream_delete (ostr); -#ifdef FILE_CODING - Lstream_delete (costr); -#endif - Lstream_flush(dstr); - Lstream_delete(dstr); + UNGCPRO; + Lstream_delete (istr); + Lstream_delete (ostr); + Lstream_delete (costr); + Lstream_flush (dstr); + Lstream_delete (dstr); - return(make_string(Dynarr_atp(out_dynarr,0),Dynarr_length(out_dynarr))); + return (make_string (Dynarr_atp (out_dynarr,0),Dynarr_length (out_dynarr))); } void syms_of_base64 (void) { - DEFSUBR(Fbase64_encode); - DEFSUBR(Fbase64_decode); + DEFSUBR (Fbase64_encode); + DEFSUBR (Fbase64_decode); } void diff -r 861f2601a38b -r 1f0b15040456 modules/canna/Makefile.in.in --- a/modules/canna/Makefile.in.in Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/canna/Makefile.in.in Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ ## This file is part of XEmacs. -## XEmacs is free software; you can redistribute it and/or modify it +## 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. +## Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ ## for more details. ## You should have received a copy of the GNU General Public License -## along with XEmacs; see the file COPYING. If not, write to -## the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -## Boston, MA 02111-1307, USA. +## along with XEmacs. If not, see . ## Synched up with: Not synched with FSF. diff -r 861f2601a38b -r 1f0b15040456 modules/canna/canna_api.c --- a/modules/canna/canna_api.c Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/canna/canna_api.c Sun May 01 18:44:03 2011 +0100 @@ -2,14 +2,14 @@ Copyright (C) 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2005 Ben Wing. + Copyright (C) 2005, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.3. Not in FSF. */ @@ -661,7 +659,7 @@ #define RKBUFSIZE 1024 -static unsigned char yomibuf[RKBUFSIZE]; +static UExtbyte yomibuf[RKBUFSIZE]; static short kugiri[RKBUFSIZE / 2]; static int @@ -720,7 +718,7 @@ strncpy ((char *) yomibuf, ext, sizeof (yomibuf)); yomibuf[sizeof (yomibuf) - 1] = '\0'; - nbun = RkBgnBun (IRCP_context, yomibuf, strlen ((char *) yomibuf), + nbun = RkBgnBun (IRCP_context, (char *) yomibuf, strlen ((char *) yomibuf), (RK_XFER << RK_XFERBITS) | RK_KFER); return kanjiYomiList (IRCP_context, nbun); diff -r 861f2601a38b -r 1f0b15040456 modules/canna/configure --- a/modules/canna/configure Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/canna/configure Sun May 01 18:44:03 2011 +0100 @@ -14,20 +14,18 @@ # # 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 +# 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 3 of the License, 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. +# XEmacs is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. # # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to the Free -# Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -# 02111-1307, USA. +# along with XEmacs. If not, see . ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## diff -r 861f2601a38b -r 1f0b15040456 modules/canna/configure.ac --- a/modules/canna/configure.ac Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/canna/configure.ac Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ 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 +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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to the Free -Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -02111-1307, USA.]) +along with XEmacs. If not, see .]) AC_CONFIG_SRCDIR([sample.c]) AC_PROG_CC diff -r 861f2601a38b -r 1f0b15040456 modules/common/Makefile.common --- a/modules/common/Makefile.common Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/common/Makefile.common Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ ## This file is part of XEmacs. -## XEmacs is free software; you can redistribute it and/or modify it +## 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. +## Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ ## for more details. ## You should have received a copy of the GNU General Public License -## along with XEmacs; see the file COPYING. If not, write to -## the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -## Boston, MA 02111-1307, USA. +## along with XEmacs. If not, see . ## Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 modules/common/configure-post.ac --- a/modules/common/configure-post.ac Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/common/configure-post.ac Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,19 @@ +dnl Copyright (C) 2002 Ben Wing + +dnl This file is part of XEmacs. + +dnl XEmacs is free software: you can redistribute it and/or modify it +dnl under the terms of the GNU General Public License as published by the +dnl Free Software Foundation, either version 3 of the License, or (at your +dnl option) any later version. + +dnl XEmacs is distributed in the hope that it will be useful, but WITHOUT +dnl ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +dnl FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +dnl for more details. + +dnl You should have received a copy of the GNU General Public License +dnl along with XEmacs. If not, see . # This part should appear unchanged in every module configure.ac AC_SUBST(PROGNAME, "module") diff -r 861f2601a38b -r 1f0b15040456 modules/common/configure-pre.ac --- a/modules/common/configure-pre.ac Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/common/configure-pre.ac Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,20 @@ +dnl Copyright (C) 2002 Ben Wing + +dnl This file is part of XEmacs. + +dnl XEmacs is free software: you can redistribute it and/or modify it +dnl under the terms of the GNU General Public License as published by the +dnl Free Software Foundation, either version 3 of the License, or (at your +dnl option) any later version. + +dnl XEmacs is distributed in the hope that it will be useful, but WITHOUT +dnl ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +dnl FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +dnl for more details. + +dnl You should have received a copy of the GNU General Public License +dnl along with XEmacs. If not, see . + AC_PROG_CC AC_PROG_INSTALL AC_SUBST(CFLAGS) diff -r 861f2601a38b -r 1f0b15040456 modules/ldap/Makefile.in.in --- a/modules/ldap/Makefile.in.in Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/ldap/Makefile.in.in Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ ## This file is part of XEmacs. -## XEmacs is free software; you can redistribute it and/or modify it +## 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. +## Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ ## for more details. ## You should have received a copy of the GNU General Public License -## along with XEmacs; see the file COPYING. If not, write to -## the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -## Boston, MA 02111-1307, USA. +## along with XEmacs. If not, see . ## Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 modules/ldap/configure --- a/modules/ldap/configure Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/ldap/configure Sun May 01 18:44:03 2011 +0100 @@ -15,20 +15,18 @@ # # 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 +# 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 3 of the License, 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. +# XEmacs is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. # # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to the Free -# Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -# 02111-1307, USA. +# along with XEmacs. If not, see . ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## diff -r 861f2601a38b -r 1f0b15040456 modules/ldap/configure.ac --- a/modules/ldap/configure.ac Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/ldap/configure.ac Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ 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 +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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to the Free -Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -02111-1307, USA.]) +along with XEmacs. If not, see .]) AC_CONFIG_SRCDIR([eldap.c]) diff -r 861f2601a38b -r 1f0b15040456 modules/ldap/eldap.c --- a/modules/ldap/eldap.c Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/ldap/eldap.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* LDAP client interface for XEmacs. Copyright (C) 1998 Free Software Foundation, Inc. - Copyright (C) 2004 Ben Wing. + Copyright (C) 2004, 2005, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -130,7 +128,7 @@ Lisp_LDAP *ldap = XLDAP (obj); if (print_readably) - printing_unreadable_object ("#", XSTRING_DATA (ldap->host)); + printing_unreadable_object_fmt ("#", XSTRING_DATA (ldap->host)); write_fmt_string_lisp (printcharfun, "#host); if (!ldap->ld) @@ -141,7 +139,7 @@ static Lisp_LDAP * allocate_ldap (void) { - Lisp_LDAP *ldap = ALLOC_LCRECORD_TYPE (Lisp_LDAP, &lrecord_ldap); + Lisp_LDAP *ldap = XLDAP (ALLOC_NORMAL_LISP_OBJECT (ldap)); ldap->ld = NULL; ldap->host = Qnil; @@ -149,23 +147,19 @@ } static void -finalize_ldap (void *header, int for_disksave) +finalize_ldap (Lisp_Object obj) { - Lisp_LDAP *ldap = (Lisp_LDAP *) header; - - if (for_disksave) - invalid_operation ("Can't dump an emacs containing LDAP objects", - make_ldap (ldap)); + Lisp_LDAP *ldap = XLDAP (obj); if (ldap->ld) ldap_unbind (ldap->ld); ldap->ld = NULL; } -DEFINE_LRECORD_IMPLEMENTATION ("ldap", ldap, 0, - mark_ldap, print_ldap, finalize_ldap, - NULL, NULL, ldap_description, Lisp_LDAP); - +DEFINE_NODUMP_LISP_OBJECT ("ldap", ldap, mark_ldap, + print_ldap, finalize_ldap, + NULL, NULL, ldap_description, + Lisp_LDAP); /************************************************************************/ /* Basic ldap accessors */ @@ -616,7 +610,6 @@ int rc; int i, j; Elemcount len; - Lisp_Object values = Qnil; struct gcpro gcpro1; @@ -715,7 +708,6 @@ int i, j, rc; Lisp_Object mod_op; Elemcount len; - Lisp_Object values = Qnil; struct gcpro gcpro1; @@ -816,7 +808,7 @@ void syms_of_eldap (void) { - INIT_LRECORD_IMPLEMENTATION (ldap); + INIT_LISP_OBJECT (ldap); DEFSYMBOL (Qeldap); DEFSYMBOL (Qldapp); @@ -878,7 +870,7 @@ unload_eldap (void) { /* Remove defined types */ - UNDEF_LRECORD_IMPLEMENTATION (ldap); + UNDEF_LISP_OBJECT (ldap); /* Remove staticpro'ing of symbols */ unstaticpro_nodump (&Qeldap); diff -r 861f2601a38b -r 1f0b15040456 modules/ldap/eldap.h --- a/modules/ldap/eldap.h Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/ldap/eldap.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ #ifndef INCLUDED_eldap_h_ #define INCLUDED_eldap_h_ @@ -38,7 +36,7 @@ struct Lisp_LDAP { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; /* The LDAP connection handle used by the LDAP API */ LDAP *ld; /* Name of the host we connected to */ @@ -47,7 +45,7 @@ typedef struct Lisp_LDAP Lisp_LDAP; -DECLARE_LRECORD (ldap, Lisp_LDAP); +DECLARE_LISP_OBJECT (ldap, Lisp_LDAP); #define XLDAP(x) XRECORD (x, ldap, Lisp_LDAP) #define wrap_ldap(p) wrap_record (p, ldap) #define LDAPP(x) RECORDP (x, ldap) diff -r 861f2601a38b -r 1f0b15040456 modules/postgresql/Makefile.in.in --- a/modules/postgresql/Makefile.in.in Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/postgresql/Makefile.in.in Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ ## This file is part of XEmacs. -## XEmacs is free software; you can redistribute it and/or modify it +## 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. +## Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ ## for more details. ## You should have received a copy of the GNU General Public License -## along with XEmacs; see the file COPYING. If not, write to -## the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -## Boston, MA 02111-1307, USA. +## along with XEmacs. If not, see . ## Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 modules/postgresql/configure --- a/modules/postgresql/configure Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/postgresql/configure Sun May 01 18:44:03 2011 +0100 @@ -15,20 +15,18 @@ # # 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 +# 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 3 of the License, 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. +# XEmacs is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. # # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to the Free -# Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -# 02111-1307, USA. +# along with XEmacs. If not, see . ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## diff -r 861f2601a38b -r 1f0b15040456 modules/postgresql/configure.ac --- a/modules/postgresql/configure.ac Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/postgresql/configure.ac Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ 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 +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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to the Free -Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -02111-1307, USA.]) +along with XEmacs. If not, see .]) AC_CONFIG_SRCDIR([postgresql.c]) diff -r 861f2601a38b -r 1f0b15040456 modules/postgresql/postgresql.c --- a/modules/postgresql/postgresql.c Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/postgresql/postgresql.c Sun May 01 18:44:03 2011 +0100 @@ -6,6 +6,21 @@ Author: SL Baur Maintainer: SL Baur +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 3 of the License, 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. If not, see . + Please send patches to this file to me first before submitting them to xemacs-patches. @@ -90,8 +105,10 @@ interface to lcrecord handling has changed with 21.2, so unfortunately we will need a few snippets of backwards compatibility code. */ -#if (EMACS_MAJOR_VERSION == 21) && (EMACS_MINOR_VERSION < 2) +#if (EMACS_MAJOR_VERSION == 21) && (EMACS_MINOR_VERSION <= 1) #define RUNNING_XEMACS_21_1 1 +#elif (EMACS_MAJOR_VERSION == 21) && (EMACS_MINOR_VERSION <= 4) +#define RUNNING_XEMACS_21_4 1 #endif /* #define POSTGRES_LO_IMPORT_IS_VOID 1 */ @@ -251,7 +268,7 @@ strcpy (buf, "#"); /* evil! */ if (print_readably) - printing_unreadable_object ("%s", buf); + printing_unreadable_object_fmt ("%s", buf); else write_cistring (printcharfun, buf); } @@ -262,14 +279,18 @@ #ifdef RUNNING_XEMACS_21_1 Lisp_PGconn *pgconn = ALLOC_LCRECORD_TYPE (Lisp_PGconn, lrecord_pgconn); -#else +#elif defined (RUNNING_XEMACS_21_4) Lisp_PGconn *pgconn = ALLOC_LCRECORD_TYPE (Lisp_PGconn, &lrecord_pgconn); +#else + Lisp_PGconn *pgconn = XPGCONN (ALLOC_NORMAL_LISP_OBJECT (pgconn)); #endif pgconn->pgconn = (PGconn *)NULL; return pgconn; } +#ifdef RUNNING_XEMACS_21_4 + static void finalize_pgconn (void *header, int for_disksave) { @@ -286,18 +307,41 @@ } } +#else /* not RUNNING_XEMACS_21_4 */ + +static void +finalize_pgconn (Lisp_Object obj) +{ + Lisp_PGconn *pgconn = XPGCONN (obj); + + if (pgconn->pgconn) + { + PQfinish (pgconn->pgconn); + pgconn->pgconn = (PGconn *)NULL; + } +} + +#endif /* (not) RUNNING_XEMACS_21_4 */ + #ifdef RUNNING_XEMACS_21_1 DEFINE_LRECORD_IMPLEMENTATION ("pgconn", pgconn, mark_pgconn, print_pgconn, finalize_pgconn, NULL, NULL, Lisp_PGconn); -#else +#elif defined (RUNNING_XEMACS_21_4) DEFINE_LRECORD_IMPLEMENTATION ("pgconn", pgconn, 0, /*dumpable-flag*/ mark_pgconn, print_pgconn, finalize_pgconn, NULL, NULL, pgconn_description, Lisp_PGconn); +#else +DEFINE_NODUMP_LISP_OBJECT ("pgconn", pgconn, + mark_pgconn, print_pgconn, + finalize_pgconn, + NULL, NULL, + pgconn_description, + Lisp_PGconn); #endif /****/ @@ -372,7 +416,7 @@ strcpy (buf, "#"); /* evil! */ if (print_readably) - printing_unreadable_object ("%s", buf); + printing_unreadable_object_fmt ("%s", buf); else write_cistring (printcharfun, buf); } @@ -387,14 +431,18 @@ #ifdef RUNNING_XEMACS_21_1 Lisp_PGresult *pgresult = ALLOC_LCRECORD_TYPE (Lisp_PGresult, lrecord_pgresult); -#else +#elif defined (RUNNING_XEMACS_21_4) Lisp_PGresult *pgresult = ALLOC_LCRECORD_TYPE (Lisp_PGresult, &lrecord_pgresult); +#else + Lisp_PGresult *pgresult = XPGRESULT (ALLOC_NORMAL_LISP_OBJECT (pgresult)); #endif pgresult->pgresult = (PGresult *)NULL; return pgresult; } +#ifdef RUNNING_XEMACS_21_4 + static void finalize_pgresult (void *header, int for_disksave) { @@ -411,18 +459,40 @@ } } +#else /* not RUNNING_XEMACS_21_4 */ + +static void +finalize_pgresult (Lisp_Object obj) +{ + Lisp_PGresult *pgresult = XPGRESULT (obj); + + if (pgresult->pgresult) + { + PQclear (pgresult->pgresult); + pgresult->pgresult = (PGresult *)NULL; + } +} + +#endif /* (not) RUNNING_XEMACS_21_4 */ + #ifdef RUNNING_XEMACS_21_1 DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult, mark_pgresult, print_pgresult, finalize_pgresult, NULL, NULL, Lisp_PGresult); -#else +#elif defined (RUNNING_XEMACS_21_4) DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult, 0, /*dumpable-flag*/ mark_pgresult, print_pgresult, finalize_pgresult, NULL, NULL, pgresult_description, Lisp_PGresult); +#else +DEFINE_NODUMP_LISP_OBJECT ("pgresult", pgresult, + mark_pgresult, print_pgresult, finalize_pgresult, + NULL, NULL, + pgresult_description, + Lisp_PGresult); #endif /***********************/ @@ -1597,8 +1667,8 @@ syms_of_postgresql(void) { #ifndef RUNNING_XEMACS_21_1 - INIT_LRECORD_IMPLEMENTATION (pgconn); - INIT_LRECORD_IMPLEMENTATION (pgresult); + INIT_LISP_OBJECT (pgconn); + INIT_LISP_OBJECT (pgresult); #endif DEFSYMBOL (Qpostgresql); @@ -1870,8 +1940,8 @@ { #ifndef RUNNING_XEMACS_21_1 /* Remove defined types */ - UNDEF_LRECORD_IMPLEMENTATION (pgconn); - UNDEF_LRECORD_IMPLEMENTATION (pgresult); + UNDEF_LISP_OBJECT (pgconn); + UNDEF_LISP_OBJECT (pgresult); #endif /* Remove staticpro'ing of symbols */ diff -r 861f2601a38b -r 1f0b15040456 modules/postgresql/postgresql.h --- a/modules/postgresql/postgresql.h Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/postgresql/postgresql.h Sun May 01 18:44:03 2011 +0100 @@ -6,6 +6,21 @@ Author: SL Baur Maintainer: SL Baur +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 3 of the License, 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. If not, see . + Please send patches to this file to me first before submitting them to xemacs-patches. */ @@ -28,12 +43,12 @@ */ struct Lisp_PGconn { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; PGconn *pgconn; }; typedef struct Lisp_PGconn Lisp_PGconn; -DECLARE_LRECORD (pgconn, Lisp_PGconn); +DECLARE_LISP_OBJECT (pgconn, Lisp_PGconn); #define XPGCONN(x) XRECORD (x, pgconn, Lisp_PGconn) #define wrap_pgconn(p) wrap_record (p, pgconn) @@ -48,12 +63,12 @@ */ struct Lisp_PGresult { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; PGresult *pgresult; }; typedef struct Lisp_PGresult Lisp_PGresult; -DECLARE_LRECORD (pgresult, Lisp_PGresult); +DECLARE_LISP_OBJECT (pgresult, Lisp_PGresult); #define XPGRESULT(x) XRECORD (x, pgresult, Lisp_PGresult) #define wrap_pgresult(p) wrap_record (p, pgresult) diff -r 861f2601a38b -r 1f0b15040456 modules/sample/external/Makefile.in.in --- a/modules/sample/external/Makefile.in.in Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/sample/external/Makefile.in.in Sun May 01 18:44:03 2011 +0100 @@ -3,8 +3,8 @@ ## ## This sample Makefile is free; 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. +## Free Software Foundation, either version 3 of the License, or (at your +## option) any later version. ## This file is not part of XEmacs. diff -r 861f2601a38b -r 1f0b15040456 modules/sample/external/configure.ac --- a/modules/sample/external/configure.ac Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/sample/external/configure.ac Sun May 01 18:44:03 2011 +0100 @@ -1,8 +1,8 @@ # Process this file with autoconf to produce a configure script. # This sample autoconf input script is free; 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. +# the Free Software Foundation, either version 3 of the License, or (at your +# option) any later version. AC_INIT([Sample module], [1.0], [xemacs-beta@xemacs.org]) AC_PREREQ(2.53) AC_REVISION($Revision: 1.1 $) diff -r 861f2601a38b -r 1f0b15040456 modules/sample/external/sample.c --- a/modules/sample/external/sample.c Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/sample/external/sample.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ * (C) Copyright 1998, 1999 J. Kean Johnston. All rights reserved. * (C) Copyright 2002 Jerry James. * - * This sample module code is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License as published - * by the Free Software Foundation; either version 2, or (at your option) - * any later version. + * This sample 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 3 of the License, or (at your + * option) any later version. */ #include diff -r 861f2601a38b -r 1f0b15040456 modules/sample/internal/Makefile.in.in --- a/modules/sample/internal/Makefile.in.in Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/sample/internal/Makefile.in.in Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ ## This file is part of XEmacs. -## XEmacs is free software; you can redistribute it and/or modify it +## 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. +## Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ ## for more details. ## You should have received a copy of the GNU General Public License -## along with XEmacs; see the file COPYING. If not, write to -## the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -## Boston, MA 02111-1307, USA. +## along with XEmacs. If not, see . ## Synched up with: Not synched with FSF. diff -r 861f2601a38b -r 1f0b15040456 modules/sample/internal/configure.ac --- a/modules/sample/internal/configure.ac Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/sample/internal/configure.ac Sun May 01 18:44:03 2011 +0100 @@ -8,20 +8,18 @@ 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 +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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to the Free -Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -02111-1307, USA.]) +along with XEmacs. If not, see .]) AC_CONFIG_SRCDIR([sample.c]) AC_PROG_CC diff -r 861f2601a38b -r 1f0b15040456 modules/sample/internal/sample.c --- a/modules/sample/internal/sample.c Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/sample/internal/sample.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ * (C) Copyright 1998, 1999 J. Kean Johnston. All rights reserved. * (C) Copyright 2002 Jerry James. * - * This sample module code is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License as published - * by the Free Software Foundation; either version 2, or (at your option) - * any later version. + * This sample 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 3 of the License, or (at your + * option) any later version. */ #include diff -r 861f2601a38b -r 1f0b15040456 modules/zlib/Makefile --- a/modules/zlib/Makefile Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/zlib/Makefile Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,21 @@ +# Copyright (C) 1998, 1999 William Perry. + +# 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 3 of the License, 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. If not, see . + + # # Sample makefile for a simple Emacs module. # This is slightly more complicated than would normally be the case, diff -r 861f2601a38b -r 1f0b15040456 modules/zlib/zlib.c --- a/modules/zlib/zlib.c Sat Feb 20 06:03:00 2010 -0600 +++ b/modules/zlib/zlib.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 netinstall/ChangeLog --- a/netinstall/ChangeLog Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,576 +0,0 @@ -2009-05-18 Stephen J. Turnbull - - * XEmacs 21.5.29 "garbanzo" is released. - -2007-08-12 Mike Sperber - - * Makefile.in.in (datarootdir): Add. - -2007-05-21 Stephen J. Turnbull - - * XEmacs 21.5.28 "fuki" is released. - -2006-05-16 Stephen J. Turnbull - - * XEmacs 21.5.27 "fiddleheads" is released. - -2006-03-31 Stephen J. Turnbull - - * XEmacs 21.5.26 "endive" is released. - -2006-02-26 Stephen J. Turnbull - - * XEmacs 21.5.25 "eggplant" is released. - -2005-11-25 Mike Sperber - - * reginfo.h (XEMACS_INFO_XEMACS_EARLY_PACKAGES_KEY) - (XEMACS_INFO_XEMACS_LATE_PACKAGES_KEY) - (XEMACS_INFO_XEMACS_LAST_PACKAGES_KEY): Add. - -2005-12-18 Stephen J. Turnbull - - * XEmacs 21.5.24 "dandelion" is released. - -2005-11-22 Ben Wing - - * Makefile.in.in: - Ignore errors from rm during clean. - -2005-11-13 Ben Wing - - * Makefile.in.in: - Add targets distclean-noconfig, realclean-noconfig, extraclean-noconfig. - Do some refactoring for cleanliness. - -2005-11-06 Stephen J. Turnbull - - * ChangeLog: Nuke useless CVS keyword. - -2005-10-26 Stephen J. Turnbull - - * XEmacs 21.5.23 "daikon" is released. - -2005-09-14 Stephen J. Turnbull - - * XEmacs 21.5.22 "cucumber" is released. - -2005-05-28 Stephen J. Turnbull - - * XEmacs 21.5.21 "corn" is released. - -2005-03-11 Stephen J. Turnbull - - * XEmacs 21.5.20 "cilantro" is released. - -2005-02-18 Stephen J. Turnbull - - * XEmacs 21.5.19 "chives" is released. - -2004-11-05 Ben Wing - - * res.rc: - Fix ^M brokenness. - -2004-10-22 Stephen J. Turnbull - - * XEmacs 21.5.18 "chestnut" is released. - -2004-03-22 Stephen J. Turnbull - - * XEmacs 21.5.17 "chayote" is released. - -2003-09-26 Steve Youngs - - * XEmacs 21.5.16 "celeriac" is released. - -2003-09-03 Steve Youngs - - * XEmacs 21.5.15 "celery" is released. - -2003-06-01 Steve Youngs - - * XEmacs 21.5.14 "cassava" is released. - -2003-05-10 Steve Youngs - - * XEmacs 21.5.13 "cauliflower" is released. - -2003-04-24 Steve Youngs - - * XEmacs 21.5.12 "carrot" is released. - -2003-02-16 Steve Youngs - - * XEmacs 21.5.11 "cabbage" is released. - -2003-01-04 Steve Youngs - - * XEmacs 21.5.10 "burdock" is released. - -2002-08-30 Steve Youngs - - * XEmacs 21.5.9 "brussels sprouts" is released. - -2002-07-27 Steve Youngs - - * XEmacs 21.5.8 "broccoli" is released. - -2002-07-02 Stephen J. Turnbull - - * XEmacs 21.5.7 "broccoflower" is released. - -2002-02-04 Andy Piper - - * install.cc (install_one): Munge installed filename to fit inside - dialog. - -2001-12-17 Andy Piper - - * desktop.cc (do_desktop_setup): register the whole gamut of C++ - file types. - -2001-12-12 Andy Piper - - * win32.h (CDECL): reorder to remove warnings. - - * Makefile.in.in: add new dependencies. - - * desktop.h: new file. - - * uninstall.cc: use it. - - * install.cc (uninstall_one): when uninstalling xemacs remove - shortcuts also. - - * desktop.cc (remove_xemacs_setup): split out from - remove_desktop_setup. - (remove_desktop_setup): call it. - -2001-12-05 Andy Piper - - * win32.h: re-order declarations for native windows from Fabrice - Popineau. - -2001-11-22 Andy Piper - - * Makefile.in.in (setup-bin.ini): cope with kit revisions. - - * source.cc (save_dialog): warning removal. - (load_dialog): ditto. - - * msg.cc: remove cvs id. - - * desktop.cc (find_xemacs_version): new function. Cope with kit - revisions. - (find_xemacs_exe_path): use it. - (find_xemacs_exe_name): ditto. - -2002-04-05 Stephen J. Turnbull - - * XEmacs 21.5.6 "bok choi" is released. - -2002-03-12 Ben Wing - - * The Great Mule Merge of March 2002: - see node by that name in the Internals Manual. - -2002-03-05 Stephen J. Turnbull - - * XEmacs 21.5.5 "beets" is released. - -2002-01-08 Stephen J. Turnbull - - * XEmacs 21.5.4 "bamboo" is released. - -2001-12-12 Andy Piper - - * win32.h (CDECL): reorder to remove warnings. - - * Makefile.in.in: add new dependencies. - - * desktop.h: new file. - - * uninstall.cc: use it. - - * install.cc (uninstall_one): when uninstalling xemacs remove - shortcuts also. - - * desktop.cc (remove_xemacs_setup): split out from - remove_desktop_setup. - (remove_desktop_setup): call it. - -2001-12-05 Andy Piper - - * win32.h: re-order declarations for native windows from Fabrice - Popineau. - -2001-11-22 Andy Piper - - * Makefile.in.in (setup-bin.ini): cope with kit revisions. - - * source.cc (save_dialog): warning removal. - (load_dialog): ditto. - - * msg.cc: remove cvs id. - - * desktop.cc (find_xemacs_version): new function. Cope with kit - revisions. - (find_xemacs_exe_path): use it. - (find_xemacs_exe_name): ditto. - -2001-11-21 Stephen J. Turnbull - - * XEmacs 21.4.6 "Common Lisp" is released. - -2001-10-27 Andy Piper - - * localdir.cc (dialog_cmd): allow download directory to be - created. - * log.cc (exit_setup): cygwin -> XEmacs - * net.cc (dialog_cmd): - (dialog_proc): - (do_net): sync with cygwin installer. - * res.rc: - * resource.h (IDS_CREATE_DIR): new. - * source.cc (load_dialog): - (save_dialog): - (dialog_cmd): - (dialog_proc): - (do_source): sync with cygwin installer. - * uninstall.cc (progress): remove log message. - * Makefile.in.in: generated setup-bin.ini correctly. - -2001-10-25 Andy Piper - - * Merge 21.5 codeline. - -2001-10-25 Andy Piper - - * setup.mak (OBJS): minor build fixes. - (distclean): - -2001-10-25 Andy Piper - - * desktop.cc: - * desktop.cc (do_desktop_setup): - * desktop.cc (load_dialog): - * desktop.cc (save_dialog): - * desktop.cc (do_desktop): handle idl file registration. - * geturl.cc (dialog): warning removal. - * geturl.cc (get_url_to_string): - * geturl.cc (get_url_to_file): make sure the nio gets deleted - after use, this also closes the inbound socket. - * nio-ftp.cc (ftp_line): fix from cygwin installer. - * nio-ftp.cc (NetIO_FTP): fix typeo. - * res.rc: support idl types. - * resource.h (IDC_IDL_TYPE): ditto. - * state.h: ditto. - -2001-09-24 Andy Piper - - * desktop.cc: - * desktop.cc (make_link): - * desktop.cc (find_xemacs_exe_name): - * desktop.cc (remove_link): - * desktop.cc (start_menu): - * desktop.cc (desktop_icon): - * desktop.cc (remove_desktop_setup): - * desktop.cc (FROB): - * desktop.cc (do_desktop_setup): - * desktop.cc (check_startmenu): - * desktop.cc (do_desktop): Be more exacting about removal of - desktop things. - * regedit.cc (remove1): - * regedit.cc (remove_app_path): - * regedit.h (remove_app_path): remove more registry pieces. - * res.rc: - * setup.mak (APPVER): - * setup.mak (CCV): - * setup.mak (OBJS): - * setup.mak (LIBS): - * setup.mak (distclean): - * uninstall.cc: - * uninstall.cc (read_installed_db): - * uninstall.cc (uninstall_all): Cleanup. - -2001-09-08 Andy Piper - - * Makefile.in.in (OBJS): - * Makefile.in.in (all): - * Makefile.in.in (extraclean): - * choose.cc (base): - * desktop.cc: - * desktop.cc (remove_link): - * desktop.cc (start_menu): - * desktop.cc (desktop_icon): - * desktop.cc (remove_desktop_setup): - * desktop.cc (do_desktop_setup): - * desktop.cc (load_dialog): - * desktop.cc (save_dialog): - * desktop.cc (do_desktop): - * dialog.h: - * download.cc (download_one): - * ini.h (pinfo): - * main.cc (WinMain): - * nio-ie5.cc: - * regedit.cc: - * regedit.cc (create_xemacs_root): - * regedit.cc (set_app_path): - * regedit.cc (set_install_path): - * regedit.cc (setup_explorer): - * regedit.cc (remove_app_path): - * regedit.cc (remove_uninstall_path): - * regedit.h (remove_app_path): - * reginfo.h: - * reginfo.h (XEMACS_INFO_XEMACS_ORG_REGISTRY_NAME): - * reginfo.h (XEMACS_NATIVE_ARCH_NAME): - * res.rc: - * resource.h (IDD_UNINSTALL): - * resource.h (IDC_TXT_TYPE): - * root.cc: - * root.cc (browse_cb): - * root.cc (set_default_root): - * splash.cc (do_splash): - * state.h: - * state.h (MIRROR_SITE): - * uninstall.cc: - * uninstall.cc (dialog_proc): - * uninstall.cc (progress): - * uninstall.cc (uninstall_one): - * uninstall.cc (do_uninstall): - * uninstall.cc (read_installed_db): - * uninstall.cc (uninstall_all): - * win32.h: - * win32.h (NOCOMATTRIBUTE): Update netinstaller to support - uninstallation and register standard file-types. - -2001-09-07 Stephen J. Turnbull - - * XEmacs 21.5.3 "asparagus" is released. - -2001-07-28 Stephen J. Turnbull - - * XEmacs 21.5.2 "artichoke" is released. - -2001-05-09 Martin Buchholz - - * XEmacs 21.5.1 "anise" is released. - -2001-04-18 Martin Buchholz - - * XEmacs 21.5.0 "alfalfa" is released. - -2001-03-21 Martin Buchholz - - * XEmacs 21.2.46 "Urania" is released. - -2001-03-01 Andy Piper - - * desktop.cc (find_xemacs_exe_name): support 21.1 and 21.2 series. - - * iniparse.c: remove. - - * inilex.c: remove - -2001-02-23 Martin Buchholz - - * XEmacs 21.2.45 "Thelxepeia" is released. - -2001-02-08 Martin Buchholz - - * XEmacs 21.2.44 "Thalia" is released. - -2001-02-02 Andy Piper - - * res.rc: update mirrors.lst location. - -2001-01-26 Martin Buchholz - - * XEmacs 21.2.43 "Terspichore" is released. - -2001-01-21 Andy Piper - - * Makefile.in.in (%.o): use CXX to compile - - * res.rc: beautify download status and install status. - - * nio-ftp.cc: use xemacs-setup user for identity. - -2001-01-20 Martin Buchholz - - * XEmacs 21.2.42 "Poseidon" is released. - -2001-01-17 Andy Piper - - * ini.h: move extern "C" to aid win32 compilation. From Fabrice - Popineau. - -2001-01-17 Martin Buchholz - - * XEmacs 21.2.41 "Polyhymnia" is released. - -2001-01-12 Andy Piper - - * postinstall.cc (do_postinstall): don't pick up shells if cygwin - isn't installed. - -2001-01-10 Andy Piper - - * README.xemacs: deleted. - - * README: updated. - - * tar.cc (tar_gzctell): new function picked up from some internal - cygnus version of zlib. - - * Makefile.in.in (LOCALCFLAGS): use -O2 - (OBJS): reinstate autoload. - -2001-01-09 Andy Piper - - * root.cc (dialog_cmd): backslash root dir. - - * desktop.cc (do_desktop): runemacs.exe is the exe to run. - - * package-net.el (package-net-batch-convert-index-to-ini): new - batch command. - - * Makefile.in.in (setup.ini): new target. Automatically create. - (LOCALCFLAGS): use extra_includes. - (setup.ini): new target. - - * regedit.cc (create_xemacs_root): write out the package path. - - * reginfo.h (XEMACS_NATIVE_ARCH_NAME): arch dir is i386 not i586 - -2001-01-08 Martin Buchholz - - * XEmacs 21.2.40 is released. - -2000-12-31 Martin Buchholz - - * XEmacs 21.2.39 is released. - -2000-12-28 Andy Piper - - * desktop.cc (FROB): add more app paths. - -2000-12-24 Fabrice Popineau - - * choose.cc (create_listview): CreateWindowEx() does not take this kind of - parameter. - - * choose.cc (package_sort): - * hash.cc (rev_len): - * site.cc (site_sort): must be __cdecl to be called by qsort(). - - * download.cc: - * install.cc: - * nio-file.cc: - * tar.cc: because of the redefinition of stat to _stat, the - inclusion of win32 headers has to be delayed. - - * win32.h: added some declarations, such as CDECL if - not defined, #define for functions that are not standard in msvc - libc (strdup, stat ...) - - * concat.h, concat.cc (concat): must be declared CDECL - - * desktop.cc: is needed. - - * dialog.h (NEXT): cast needed, the first parameter of EndDialog() must - be a HWND. - - * diskfull.cc: syntax when declaring GDFS. - - * ini.cc: Various `extern "C"' declarations: yylineno, yyerror() - and fprintf(). Various CDECL declarations: yyerror(), fprintf(). - - * inilex.l: required. - - * iniparse.y: use strdup(), require "win32.h" and - - * install.cc (dialog): syntax when declaring. CreateDialog() - returns a HWND. - - * postinstall.cc: and are needed. - - * regedit.cc (find_cygwin_mount): WIN32_NATIVE does not know - anything about Cygwin stuff. - - * setup.mak: new makefile for WIN32_NATIVE. - - * splash.cc (load_dialog): GetDlgItem() returns a HWND. - - * tar.cc: msvc knows about __int64, but not `long long'. - - * win32.h: is missing for regedit.cc. Also, I ended up - in including because the files listed there are not - enough for . - - * desktop.cc: - * fromcwd.cc: - * install.cc: - * postinstall.cc: does not exist for WIN32_NATIVE - - * choose.cc (do_choose): - * ini.cc (do_ini): - * nio-ftp.cc (ftp_line): the construct (x ?: y) is not standard. - -2000-12-24 Andy Piper - - * choose.cc (read_installed_db): grok package versions correctly. - - * Makefile.in.in: add MINGW define. - -2000-12-18 Andy Piper - - * res.rc: better look and feel. - -2000-12-18 Andy Piper - - * desktop.cc (do_desktop_setup): more app path fiddling. - -2000-12-13 Andy Piper - - * root.cc (dialog_cmd): create the root in the registry if we are successful. - - * desktop.cc (find_xemacs_exe_path): new function. Split out from - find_xemacs_exe (). - (find_xemacs_exe_name): ditto. - (do_desktop_setup): setup app paths if we are installing xemacs - itself. - (do_desktop): use new functions. - - * regedit.cc (create_xemacs_root): fix key name. - (find_xemacs_root): set isnative whatever the key value. - (set_app_path): new function. Set path for an app. - -2000-12-12 Andy Piper - - * package-net.el (package-net-convert-index-to-ini): use sensible defaults. - -2000-12-12 Andy Piper - - * reginfo.h: new macros. - - * iniparse.y: define xemacs_package. - - * ini.h: declare xemacs_package. - - * fromcwd.cc (found_file): guess core type from name. - - * concat.cc: kill warnings. - * net.cc: ditto. - - * choose.cc (do_choose): pick up core package type chosen. - - * Makefile.in.in: make sure we can pick up a mingw zlib. - - * desktop.cc: fix desktop icon creation. - -2000-11-12 Andy Piper - - * all: port from cygwin setup. - diff -r 861f2601a38b -r 1f0b15040456 netinstall/Makefile.in.in --- a/netinstall/Makefile.in.in Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,285 +0,0 @@ -## Copyright (c) 2000, Red Hat, Inc. -## Copyright (C) 2005 Ben Wing. -## -## This program is free software; you can redistribute it and/or modify -## it under the terms of the GNU General Public License as published by -## the Free Software Foundation; either version 2 of the License, or -## (at your option) any later version. -## -## A copy of the GNU General Public License can be found at -## http://www.gnu.org/ -## -## Written by Christopher Faylor -## Adapted for XEmacs by Andy Piper -## -## Makefile for Cygwin installer - -## For performance and consistency, no built-in rules -.SUFFIXES: -.SUFFIXES: .c .cc .h .o -## ==================== Things "configure" will edit ==================== - -@SET_MAKE@ -SHELL = /bin/sh -RM = rm -f -pwd = /bin/pwd - -CC=@CC@ -CPP=@CPP@ -CFLAGS=@CFLAGS@ -CPPFLAGS=@CPPFLAGS@ -LDFLAGS=@LDFLAGS@ -ALLOCA=@ALLOCA@ -LN_S=@LN_S@ -version=@version@ - -## This will be the name of the generated binary and is set automatically -## by configure. -PROGNAME=@PROGNAME@ -INSTALLABLES=setup -#ifdef USE_GNU_MAKE -vpath %.c @srcdir@ -vpath %.cc @srcdir@ -vpath %.h @srcdir@ -vpath %.l @srcdir@ -vpath %.y @srcdir@ -vpath %.rc @srcdir@ -#else -VPATH=@srcdir@ -#endif - -## ==================== Where To Install Things ==================== - -prefix=@prefix@ -exec_prefix=@exec_prefix@ -bindir=@bindir@ -libdir=@libdir@ -srcdir=@srcdir@ -datarootdir=@datarootdir@ -datadir=@datadir@ -instvardir=@instvardir@ -top_srcdir=@top_srcdir@ -archlibdir=@archlibdir@ -configuration=@configuration@ -moduledir=@moduledir@ -sitemoduledir=@sitemoduledir@ -extra_includes=@extra_includes@ -blddir=@blddir@ - -## ==================== Utility Programs for the Build ================= - -INSTALL = @install_pp@ @INSTALL@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_DATA = @INSTALL_DATA@ -SHELL = @SHELL@ -## ========================== Lists of Files =========================== - -#define NO_SHORTNAMES -#define NOT_C_CODE -#include "../src/config.h" - -program_transform_name = @program_transform_name@ - -CC = @CC@ -CC_FOR_TARGET = $(CC) - -## -O3 has problems so fix this locally -LOCALCFLAGS = $(CFLAGS) -O2 -DMINGW $(extra_includes) -CXXFLAGS = $(LOCALCFLAGS) -fno-exceptions -nostdinc++ -fno-rtti - -WINDRES = windres -MINGW_INCLUDES = -I. -I$(srcdir) -MINGW_CXXFLAGS = $(CXXFLAGS) -mno-cygwin $(MINGW_INCLUDES) -mwindows -MINGW_CFLAGS = $(LOCALCFLAGS) -mno-cygwin $(MINGW_INCLUDES) -mwindows -MINGW_ZLIB_DIR = /usr/local/lib - -PROGS = setup.exe -XEMACS=${blddir}/src/${PROGNAME} - -CYGWIN_SIZE=0 -WIN32_SIZE=0 -KIT_VERSION="" - -CONFIG_H = ../src/config.h - -OBJS = \ - autoload.o \ - choose.o \ - concat.o \ - desktop.o \ - dialog.o \ - diskfull.o \ - download.o \ - find.o \ - fromcwd.o \ - geturl.o \ - hash.o \ - ini.o \ - inilex.o \ - iniparse.o \ - init.o \ - install.o \ - localdir.o \ - log.o \ - main.o \ - mkdir.o \ - mklink2.o \ - regedit.o \ - msg.o \ - net.o \ - netio.o \ - nio-ie5.o \ - nio-file.o \ - nio-ftp.o \ - nio-http.o \ - other.o \ - postinstall.o \ - res.o \ - root.o \ - simpsock.o \ - site.o \ - source.o \ - splash.o \ - state.o \ - tar.o \ - uninstall.o \ - version.o - -.SUFFIXES: -.NOEXPORT: - -.PHONY: all install - -all: Makefile $(PROGS) - -setup.exe: $(OBJS) - $(CXX) $(MINGW_CXXFLAGS) -o $@ $(OBJS) \ - -lole32 -lwsock32 -lnetapi32 -ladvapi32 \ - -luuid -lkernel32 -luser32 \ - -L$(MINGW_ZLIB_DIR) -lz -lmingw32 - @chmod a-x $@ - -setup-bin.ini: - V=`grep '^\$$Revision.*' $(srcdir)/ChangeLog \ - | sed -e 's/\$$Revision:* *//' -e 's/ *$$.*//'` ;\ - $(XEMACS) -batch -vanilla \ - -eval '(setq package-net-cygwin32-binary-size $(CYGWIN_SIZE) \ - package-net-win32-binary-size $(WIN32_SIZE) \ - package-net-kit-version "$(KIT_VERSION)" \ - package-net-setup-version "'$$V'")' \ - -l ${srcdir}/../lisp/package-net.el \ - -f package-net-batch-generate-bin-ini - -install: - @echo; echo "Installing net setup." - for file in ${INSTALLABLES} ; do \ - (cd .. && $(INSTALL_PROGRAM) netinstall/$${file} ${bindir}/$${file}) ; \ - done - -version.c : $(srcdir)/ChangeLog Makefile - V=`grep '^\$$Revision.*' $(srcdir)/ChangeLog \ - | sed -e 's/\$$Revision:* *//' \ - -e 's/ *$$.*//'` ;\ - echo "char *version = \"$$V\";" > version.tmp ;\ - echo "static char *id = \"\\n%%% setup-version $$V\\n\";" >> version.tmp - mv version.tmp version.c - -%.o: %.rc - $(WINDRES) --include-dir $(srcdir) -o $@ $< - -%.o: %.c - $(CC) $(MINGW_CFLAGS) -c -o $@ $< - -%.o: %.cc - $(CC) $(MINGW_CXXFLAGS) -c -o $@ $< - -iniparse.c iniparse.h : iniparse.y - bison -d -o iniparse.c $(srcdir)/iniparse.y - -inilex.c : inilex.l iniparse.h - flex -8 $(srcdir)/inilex.l - mv lex.yy.c inilex.c - -.PHONY: mostlyclean clean distclean realclean extraclean -.PHONY: distclean-noconfig realclean-noconfig extraclean-noconfig -mostlyclean: - -$(RM) *.o *.i *.ini core -clean: mostlyclean - -$(RM) $(PROGS) -distclean-noconfig: clean - -$(RM) TAGS -## This is used in making a distribution. -## Do not use it on development directories! -distclean: distclean-noconfig - -$(RM) GNUmakefile Makefile Makefile.in -realclean-noconfig: distclean-noconfig -realclean: distclean -extraclean-noconfig: realclean-noconfig - -$(RM) *~ \#* -extraclean: realclean - -$(RM) *~ \#* - -choose.o: choose.cc win32.h dialog.h resource.h state.h ini.h concat.h \ - msg.h log.h find.h reginfo.h -concat.o: concat.cc -desktop.o: desktop.cc win32.h resource.h ini.h msg.h state.h concat.h \ - mkdir.h dialog.h version.h port.h reginfo.h desktop.h -dialog.o: dialog.cc win32.h dialog.h msg.h log.h -diskfull.o: diskfull.cc win32.h diskfull.h -download.o: download.cc win32.h resource.h msg.h ini.h dialog.h \ - concat.h geturl.h state.h mkdir.h log.h -find.o: find.cc win32.h port.h -fromcwd.o: fromcwd.cc win32.h ini.h resource.h concat.h state.h \ - dialog.h msg.h find.h version.h port.h -geturl.o: geturl.cc win32.h dialog.h \ - geturl.h resource.h netio.h msg.h log.h -hash.o: hash.cc hash.h -ini.o: ini.cc win32.h ini.h resource.h concat.h state.h geturl.h \ - dialog.h msg.h mkdir.h log.h reginfo.h version.h -inilex.o: inilex.c win32.h \ - ini.h \ - iniparse.h -iniparse.o: iniparse.c ini.h \ - iniparse.h \ - port.h -install.o: install.cc win32.h \ - resource.h ini.h dialog.h concat.h geturl.h mkdir.h state.h tar.h \ - diskfull.h msg.h regedit.h reginfo.h log.h hash.h port.h desktop.h -init.o: init.cc win32.h resource.h dialog.h state.h msg.h log.h -uninstall.o: uninstall.cc win32.h \ - resource.h ini.h dialog.h concat.h geturl.h mkdir.h state.h tar.h \ - diskfull.h msg.h regedit.h reginfo.h log.h hash.h port.h desktop.h -localdir.o: localdir.cc win32.h dialog.h resource.h state.h msg.h \ - concat.h log.h -log.o: log.cc win32.h resource.h msg.h log.h dialog.h state.h concat.h \ - mkdir.h -main.o: main.cc win32.h resource.h dialog.h state.h msg.h netio.h \ - find.h log.h port.h -mkdir.o: mkdir.cc win32.h mkdir.h -mklink2.o: mklink2.c win32.h /usr/include/w32api/shlobj.h -msg.o: msg.cc win32.h dialog.h log.h -net.o: net.cc win32.h dialog.h resource.h state.h msg.h log.h -netio.o: netio.cc win32.h resource.h state.h msg.h netio.h nio-file.h \ - nio-ie5.h nio-http.h nio-ftp.h dialog.h log.h port.h -nio-file.o: nio-file.cc win32.h netio.h nio-file.h resource.h msg.h -nio-ftp.o: nio-ftp.cc win32.h resource.h state.h simpsock.h log.h \ - netio.h nio-ftp.h -nio-http.o: nio-http.cc win32.h resource.h state.h simpsock.h msg.h \ - netio.h nio-http.h -nio-ie5.o: nio-ie5.cc win32.h resource.h state.h dialog.h msg.h \ - netio.h nio-ie5.h -other.o: other.cc win32.h dialog.h resource.h state.h msg.h log.h -postinstall.o: postinstall.cc win32.h state.h dialog.h find.h concat.h \ - port.h -regedit.o: regedit.cc win32.h reginfo.h regedit.h msg.h resource.h \ - dialog.h -root.o: root.cc win32.h dialog.h resource.h state.h msg.h regedit.h \ - reginfo.h concat.h log.h -simpsock.o: simpsock.cc win32.h simpsock.h msg.h -site.o: site.cc win32.h dialog.h resource.h state.h geturl.h msg.h \ - concat.h regedit.h reginfo.h log.h port.h -source.o: source.cc win32.h dialog.h resource.h state.h msg.h log.h -splash.o: splash.cc win32.h dialog.h resource.h msg.h version.h -state.o: state.cc state.h -tar.o: tar.cc win32.h tar.h mkdir.h log.h port.h -version.o: version.c diff -r 861f2601a38b -r 1f0b15040456 netinstall/README --- a/netinstall/README Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -This directory contains the source for the setup program for the XEmacs -net releases. - -For commentary on how to do a release please see `package-net.el' - -This code has been adapted from the cygwin net release installer. In -particular note that the cygwin net release installer is actively -maintained and therefore we will want to incorporate improvements from -that. I have therefore tried to use the cygwin way wherever -possible. I have however cleaned up the code somewhat so that there -are not billions of warnings. - -This program should get built as part of the standard XEmacs -make. Note however that if you use trhe cygwin build you will need a -NON CYGWIN VERSION OF ZLIB. - diff -r 861f2601a38b -r 1f0b15040456 netinstall/autoload.c --- a/netinstall/autoload.c Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,77 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -#include "win32.h" - -typedef struct { - char *name; - HINSTANCE handle; -} DllInfo; - -#define DLL(n) static DllInfo n ## _info __asm__ (#n "_info") = { #n, 0} - -#define Auto(dll, func, size) \ - __asm__ ("\t.data"); \ - __asm__ ("\t.global\t_" #func "@" #size); \ - __asm__ ("_" #func "@" #size ":"); \ - __asm__ ("\tcall\tautoload_common"); \ - __asm__ ("\t.long\t" #dll "_info"); \ - __asm__ ("\t.ascii\t\"" #func "\\0\"") - -DLL (wininet); - -Auto (wininet, InternetAttemptConnect, 4); -Auto (wininet, InternetCloseHandle, 4); -Auto (wininet, InternetGetLastResponseInfoA, 12); -Auto (wininet, InternetOpenA, 20); -Auto (wininet, InternetOpenUrlA, 24); -Auto (wininet, InternetReadFile, 16); -Auto (wininet, InternetSetOptionA, 16); -Auto (wininet, InternetQueryOptionA, 16); -Auto (wininet, HttpQueryInfoA, 20); -Auto (wininet, HttpSendRequestA, 20); - -typedef struct { - DllInfo *dll; - char name[100]; -} AutoEntry; - -static void autoload_common () __asm__ ("autoload_common"); - -static void -autoload_common (int x) -{ - int fp, rel; - unsigned char *proc; - HINSTANCE h; - AutoEntry *a; - - a = *(AutoEntry **)(&x - 1); - if (a->dll->handle == 0) - { - h = LoadLibrary (a->dll->name); - a->dll->handle = h; - } - fp = (int) GetProcAddress (a->dll->handle, a->name); - proc = ((unsigned char *)a) - 5; - rel = fp - (int)(a); /* now it's a relative call */ - *proc++ = 0xe9; /* jump near 32-bit relative */ - *proc++ = rel; - *proc++ = rel>>8; - *proc++ = rel>>16; - *proc++ = rel>>24; - - *(int *)(&x-1) = (int)proc-5; -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/choose.cc --- a/netinstall/choose.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,831 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The purpose of this file is to let the user choose which packages - to install, and which versions of the package when more than one - version is provided. The "trust" level serves as an indication as - to which version should be the default choice. At the moment, all - we do is compare with previously installed packages to skip any - that are already installed (by setting the action to ACTION_SAME). - While the "trust" stuff is supported, it's not really implemented - yet. We always prefer the "current" option. In the future, this - file might have a user dialog added to let the user choose to not - install packages, or to install packages that aren't installed by - default. */ - -#include "win32.h" -#include -#include -#include - -#include "dialog.h" -#include "resource.h" -#include "state.h" -#include "ini.h" -#include "concat.h" -#include "msg.h" -#include "log.h" -#include "find.h" -#include "reginfo.h" - -#define HMARGIN 10 -#define ROW_MARGIN 5 -#define ICON_MARGIN 4 - -#define CHECK_SIZE 11 - -#define TRUST_KEEP 101 -#define TRUST_UNINSTALL 102 -#define TRUST_NONE 103 - -static int initialized = 0; - -static int full_list = 0; - -static int scroll_ulc_x, scroll_ulc_y; - -static HWND lv, nextbutton; -static TEXTMETRIC tm; -static int header_height; -static HANDLE sysfont; -static int row_height; -static HANDLE bm_spin, bm_rtarrow, bm_checkyes, bm_checkno, bm_checkna; -static HDC bitmap_dc; - -static struct { - char *text; - int slen; - int width; - int x; -} headers[] = { - { "Current", 7, 0, 0 }, -#define CURRENT_COL 0 - { "New", 3, 0, 0 }, -#define NEW_COL 1 - { "Src?", 4, 0, 0 }, -#define SRC_COL 2 - { "Package", 7, 0, 0 }, -#define PACKAGE_COL 3 - { 0, 0, 0, 0 } -}; -#define NUM_COLUMNS (sizeof(headers)/(sizeof(headers[0]))-1) - -int *package_indexes, nindexes; - -struct ExtraPackageInfo { - char *installed_file; /* filename of previous "install" file */ - char *installed_ver; /* version part */ - int installed_size; /* ditto, size. */ - - int in_partial_list; - int pick; - int npick; - int which_is_installed; /* == TRUST* or -1 */ - - struct { - int src_avail; - int trust; /* may be keep or uninstall */ - char *caption; /* ==0 at EOL */ - } chooser[NTRUST+3]; /* one extra for NULL above */ -}; - -static ExtraPackageInfo *extra; - -static void -paint (HWND hwnd) -{ - HDC hdc; - PAINTSTRUCT ps; - int x, y, i, ii; - - hdc = BeginPaint (hwnd, &ps); - - SelectObject (hdc, sysfont); - - RECT cr; - GetClientRect (hwnd, &cr); - - POINT p; - - x = cr.left - scroll_ulc_x; - y = cr.top - scroll_ulc_y + header_height; - - - for (i=0; headers[i].text; i++) - { - TextOut (hdc, x+headers[i].x, 3, headers[i].text, headers[i].slen); - MoveToEx (hdc, x+headers[i].x, header_height-3, &p); - LineTo (hdc, x+headers[i].x+headers[i].width, header_height-3); - } - - IntersectClipRect (hdc, cr.left, cr.top+header_height, cr.right, cr.bottom); - - for (ii=0; ii 1) - { - SelectObject (bitmap_dc, bm_spin); - BitBlt (hdc, x+headers[NEW_COL].x, by, 11, 11, - bitmap_dc, 0, 0, SRCCOPY); - } - } - - HANDLE check_bm = bm_checkna; - if (extra[i].chooser[extra[i].pick].src_avail) - { - if (package[i].srcaction == SRCACTION_NO) - check_bm = bm_checkno; - else if (package[i].srcaction == SRCACTION_YES) - check_bm = bm_checkyes; - } - SelectObject (bitmap_dc, check_bm); - BitBlt (hdc, x+headers[SRC_COL].x, by, 11, 11, - bitmap_dc, 0, 0, SRCCOPY); - - if (package[i].name) - TextOut (hdc, x+headers[PACKAGE_COL].x, r, package[i].name, strlen(package[i].name)); - } - - if (nindexes == 0) - { - static char *m = "Nothing to Install/Update"; - TextOut (hdc, HMARGIN, header_height, m, strlen (m)); - } - - EndPaint (hwnd, &ps); -} - -static void -scroll_common (HWND hwnd, int which, int *var, int code) -{ - SCROLLINFO si; - si.cbSize = sizeof (si); - si.fMask = SIF_ALL; - GetScrollInfo (hwnd, which, &si); - - switch (code) - { - case SB_THUMBTRACK: - si.nPos = si.nTrackPos; - break; - case SB_THUMBPOSITION: - break; - case SB_BOTTOM: - si.nPos = si.nMax; - break; - case SB_TOP: - si.nPos = 0; - break; - case SB_LINEDOWN: - si.nPos += row_height; - break; - case SB_LINEUP: - si.nPos -= row_height; - break; - case SB_PAGEDOWN: - si.nPos += si.nPage * 9/10; - break; - case SB_PAGEUP: - si.nPos -= si.nPage * 9/10; - break; - } - - if ((int)si.nPos < 0) - si.nPos = 0; - if ((int)(si.nPos + si.nPage) > si.nMax) - si.nPos = si.nMax - si.nPage; - - si.fMask = SIF_POS; - SetScrollInfo (hwnd, which, &si, TRUE); - - int ox = scroll_ulc_x; - int oy = scroll_ulc_y; - *var = si.nPos; - - RECT cr, sr; - GetClientRect (hwnd, &cr); - sr = cr; - sr.top += header_height; - ScrollWindow (hwnd, ox - scroll_ulc_x, oy - scroll_ulc_y, &sr, &sr); - sr.bottom = sr.top; - sr.top = cr.top; - ScrollWindow (hwnd, ox - scroll_ulc_x, 0, &sr, &sr); -} - -static LRESULT CALLBACK -list_vscroll (HWND hwnd, HWND hctl, UINT code, int pos) -{ - scroll_common (hwnd, SB_VERT, &scroll_ulc_y, code); - return FALSE; -} - -static LRESULT CALLBACK -list_hscroll (HWND hwnd, HWND hctl, UINT code, int pos) -{ - scroll_common (hwnd, SB_HORZ, &scroll_ulc_x, code); - return FALSE; -} - -static LRESULT CALLBACK -list_click (HWND hwnd, BOOL dblclk, int x, int y, UINT hitCode) -{ - int r; - - if (nindexes == 0) - return 0; - - if (y < header_height) - return 0; - x += scroll_ulc_x; - y += scroll_ulc_y - header_height; - - r = (y + ROW_MARGIN/2) / row_height; - - if (r < 0 || r >= npackages) - return 0; - - int p = package_indexes[r]; - - if (x >= headers[NEW_COL].x - HMARGIN/2 && x <= headers[NEW_COL+1].x - HMARGIN/2) - { - extra[p].pick ++; - if (extra[p].chooser[extra[p].pick].caption == 0) - extra[p].pick = 0; - } - - if (x >= headers[SRC_COL].x - HMARGIN/2 && x <= headers[SRC_COL+1].x - HMARGIN/2) - { - if (extra[p].chooser[extra[p].pick].src_avail) - package[p].srcaction ^= (SRCACTION_NO^SRCACTION_YES); - } - - RECT rect; - rect.left = headers[NEW_COL].x - scroll_ulc_x; - rect.right = headers[SRC_COL+1].x - scroll_ulc_x; - rect.top = header_height + r * row_height - scroll_ulc_y; - rect.bottom = rect.top + row_height; - InvalidateRect (hwnd, &rect, TRUE); - return FALSE; -} - -static LRESULT CALLBACK -listview_proc (HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam) -{ - switch (message) { - case WM_HSCROLL: - return HANDLE_WM_HSCROLL (hwnd, wParam, lParam, list_hscroll); - case WM_VSCROLL: - return HANDLE_WM_VSCROLL (hwnd, wParam, lParam, list_vscroll); - case WM_LBUTTONDOWN: - return HANDLE_WM_LBUTTONDOWN (hwnd, wParam, lParam, list_click); - case WM_PAINT: - paint (hwnd); - return 0; - default: - return DefWindowProc (hwnd, message, wParam, lParam); - } -} - -static void -register_windows (HINSTANCE hinst) -{ - WNDCLASSEX wcex; - static int done = 0; - - if (done) - return; - done = 1; - - memset (&wcex, 0, sizeof (wcex)); - wcex.cbSize = sizeof (WNDCLASSEX); - wcex.style = CS_HREDRAW | CS_VREDRAW; - wcex.lpfnWndProc = listview_proc; - wcex.hInstance = hinst; - wcex.hIcon = LoadIcon (0, IDI_APPLICATION); - wcex.hCursor = LoadCursor (0, IDC_ARROW); - wcex.hbrBackground = (HBRUSH) (COLOR_WINDOW+1); - wcex.lpszClassName = "listview"; - - RegisterClassEx (&wcex); -} - -static void -note_width (HDC dc, char *string, int addend, int column) -{ - if (!string) - return; - SIZE s; - GetTextExtentPoint32 (dc, string, strlen (string), &s); - if (headers[column].width < s.cx + addend) - headers[column].width = s.cx + addend; -} - -static int -best_trust (int p, int trust) -{ - int t; - for (t=trust; t>=0; t--) - if (package[p].info[t].install) - return t; - for (t=trust+1; t<=NTRUST; t++) - if (package[p].info[t].install) - return t; - if (extra[p].installed_file) - return TRUST_KEEP; - return TRUST_NONE; -} - -static void -default_trust (HWND h, int trust) -{ - int i, t, c; - - for (i=0; ileft, r->top, - r->right-r->left+1, r->bottom-r->top+1, - dlg, - NULL, // ??? MAKEINTRESOURCE(IDC_CHOOSE_LIST), - hinstance, - 0); - ShowWindow (lv, SW_SHOW); - - for (i=0; headers[i].text; i++) - headers[i].width = 0; - - HDC dc = GetDC (lv); - sysfont = GetStockObject (DEFAULT_GUI_FONT); - SelectObject (dc, sysfont); - GetTextMetrics (dc, &tm); - header_height = tm.tmHeight + 5 + 3; - - bitmap_dc = CreateCompatibleDC (dc); - - row_height = (tm.tmHeight + tm.tmExternalLeading + ROW_MARGIN); - int irh = tm.tmExternalLeading + tm.tmDescent + 11 + ROW_MARGIN; - if (row_height < irh) - row_height = irh; - - for (i=0; headers[i].text; i++) - note_width (dc, headers[i].text, 0, i); - for (i=0; ileft; - p.y = r->top; - ScreenToClient (parent, &p); - r->left = p.x; - r->top = p.y; - p.x = r->right; - p.y = r->bottom; - ScreenToClient (parent, &p); - r->right = p.x; - r->bottom = p.y; -} - -static BOOL CALLBACK -dialog_proc (HWND h, UINT message, WPARAM wParam, LPARAM lParam) -{ - HWND frame; - RECT r; - switch (message) - { - case WM_INITDIALOG: - nextbutton = GetDlgItem (h, IDOK); - frame = GetDlgItem (h, IDC_LISTVIEW_POS); - GetParentRect (h, frame, &r); - r.top += 2; - r.bottom -= 2; - create_listview (h, &r); -#if 0 - load_dialog (h); -#endif - return FALSE; - case WM_COMMAND: - return HANDLE_WM_COMMAND (h, wParam, lParam, dialog_cmd); - } - return FALSE; -} - -char * -base (char *s) -{ - if (!s) - return 0; - char *rv = s; - while (*s) - { - if ((*s == '/' || *s == ':' || *s == '\\') && s[1]) - rv = s+1; - s++; - } - return rv; -} - -static void -scan2 (char *path, unsigned int size) -{ - int i, t; - for (i=0; iname, b->name); -} - -void -do_choose (HINSTANCE h) -{ - int rv, i; - - qsort (package, npackages, sizeof (package[0]), package_sort); - - nextbutton = 0; - bm_spin = LoadImage (h, MAKEINTRESOURCE (IDB_SPIN), IMAGE_BITMAP, 0, 0, 0); - bm_rtarrow = LoadImage (h, MAKEINTRESOURCE (IDB_RTARROW), IMAGE_BITMAP, 0, 0, 0); - - bm_checkyes = LoadImage (h, MAKEINTRESOURCE (IDB_CHECK_YES), IMAGE_BITMAP, 0, 0, 0); - bm_checkno = LoadImage (h, MAKEINTRESOURCE (IDB_CHECK_NO), IMAGE_BITMAP, 0, 0, 0); - bm_checkna = LoadImage (h, MAKEINTRESOURCE (IDB_CHECK_NA), IMAGE_BITMAP, 0, 0, 0); - - extra = (ExtraPackageInfo *) malloc (npackages * sizeof (ExtraPackageInfo)); - memset (extra, 0, npackages * sizeof (ExtraPackageInfo)); - for (i=0; i - * - */ - -/* See concat.h. Note that we canonicalize the result, this avoids - multiple slashes being interpreted as UNCs. */ - -#include "win32.h" -#include -#include -#include - -char * CDECL -concat (char *s, ...) -{ - int len; - char *rv, *arg; - va_list v; - - if (!s) - return 0; - - len = strlen (s); - - va_start (v, s); - while (1) - { - arg = va_arg (v, char *); - if (arg == 0) - break; - len += strlen (arg); - } - va_end (v); - - rv = (char *) malloc (len+1); - strcpy (rv, s); - va_start (v, s); - while (1) - { - arg = va_arg (v, char *); - if (arg == 0) - break; - strcat (rv, arg); - } - va_end (v); - - /* concat is only used for urls and files, so we can safely - canonicalize the results */ - char *d; - for (s=rv; *s; s++) - if (*s == '\\') - *s = '/'; - for (s=d=rv; *s; s++) - { - *d++ = *s; - /* special case for URLs */ - if (*s == ':' && s[1] == '/' && s[2] == '/' && s > rv+1) - { - *d++ = *++s; - *d++ = *++s; - } - else if (*s == '/') - while (s[1] == '/') - s++; - } - *d = 0; - - return rv; -} - -char * -backslash (char *s) -{ - for (char *t = s; *t; t++) - if (*t == '/') - *t = '\\'; - return s; -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/concat.h --- a/netinstall/concat.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,25 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* Pass a null-terminated list of strings, and it concatenates them - into a single string. Warning - it assumes the result is a file - name or URL, and will canonicalize the result accordingly - (i.e. replace \ with /, collapse multiple /// to a single /, etc.) */ - -char * CDECL concat (char *s, ...); - -/* convert slashes to backslashes */ - -char * backslash (char *s); diff -r 861f2601a38b -r 1f0b15040456 netinstall/desktop.cc --- a/netinstall/desktop.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,537 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The purpose of this file is to manage all the desktop setup, such - as start menu, batch files, desktop icons, and shortcuts. Note - that unlike other do_* functions, this one is called directly from - install.cc */ - - -#include "win32.h" -#include - -#include -#include -#include -#ifndef WIN32_NATIVE -#include -#endif - -#include "resource.h" -#include "ini.h" -#include "msg.h" -#include "state.h" -#include "concat.h" -#include "mkdir.h" -#include "dialog.h" -#include "version.h" -#include "reginfo.h" -#include "regedit.h" -#include "port.h" -#include "log.h" -#include "desktop.h" - -extern "C" { - void make_link_2 (char *exepath, char *args, char *icon, char *lname); -}; - -static OSVERSIONINFO verinfo; - -/* Lines starting with '@' are conditionals - include 'N' for NT, - '5' for Win95, '8' for Win98, '*' for all, like this: - echo foo - @N8 - echo NT or 98 - @* - */ - -#define COMMAND9XARGS "/E:4096 /c" -#define COMMAND9XEXE "\\command.com" - -static char *iconname; -static char *batname; -static char *uninstname; - -static void -make_link (char *linkpath, char *title, char *target, char* args) -{ -#if 0 - char argbuf[_MAX_PATH]; -#endif - char *fname = concat (linkpath, "/", title, ".lnk", 0); - - if (_access (fname, 0) == 0) - return; /* already exists */ - - msg ("make_link %s, %s, %s, %s\n", fname, title, target, args); - - mkdir_p (0, fname); - - char *exepath; -#if 0 - /* If we are running Win9x, build a command line. */ - if (verinfo.dwPlatformId == VER_PLATFORM_WIN32_NT) - { -#endif - exepath = target; -#if 0 - } - else - { - char windir[MAX_PATH]; - - GetWindowsDirectory (windir, sizeof (windir)); - exepath = concat (windir, COMMAND9XEXE, 0); - sprintf (argbuf, "%s %s", COMMAND9XARGS, target); - args = argbuf; - } -#endif - msg ("make_link_2 (%s, %s, %s, %s)", exepath, args, iconname, fname); - make_link_2 (backslash (exepath), args, iconname, fname); -} - -static char* -find_xemacs_version () -{ - char* v = strdup (xemacs_package->info[xemacs_package->trust].version); - char* dash = strrchr (v, '-'); - if (dash) - *dash = 0; - return v; -} - -static char* -find_xemacs_exe_path () -{ - if (xemacs_package->type == TY_CYGWIN) - return backslash (concat (root_dir, "/bin/", XEMACS_CYGWIN_ARCH_NAME, 0)); - else - return backslash (concat (root_dir, "\\XEmacs-", - find_xemacs_version (), - "\\", XEMACS_NATIVE_ARCH_NAME, 0)); -} - -char* -find_xemacs_exe_name () -{ - /* Hack to support older versions. */ - if (strncmp (xemacs_package->info[xemacs_package->trust].version, - "21.1", 4) == 0) - return strdup ("runemacs.exe"); - else if (xemacs_package->type == TY_CYGWIN) - return backslash (concat ("xemacs-", - find_xemacs_version (), - ".exe", 0)); - else - return strdup ("xemacs.exe"); -} - -static void -remove_link (char *linkpath, char* title) -{ - if (title) - { - char *fname = backslash (concat (linkpath, "/", title, ".lnk", 0)); - msg ("remove_link %s, %s\n", fname, title); - if (_access (fname, 0) != 0) - return; /* doesn't exist */ - _unlink (fname); - } - else - { - msg ("remove_link %s\n", linkpath); - if (_access (linkpath, 0) != 0) - return; /* doesn't exist */ - _rmdir (linkpath); - } -} - -static void -start_menu (char *title, char *target, int rem, char* args) -{ - char path[_MAX_PATH]; - LPITEMIDLIST id; - int issystem = (root_scope == IDC_ROOT_SYSTEM) ? 1 : 0; - SHGetSpecialFolderLocation (NULL, issystem ? CSIDL_COMMON_PROGRAMS : CSIDL_PROGRAMS, &id); - SHGetPathFromIDList (id, path); -// following lines added because it appears Win95 does not use common programs -// unless it comes into play when multiple users for Win95 is enabled - msg("Program directory for program link: %s",path); - if ( strlen(path) == 0) { - SHGetSpecialFolderLocation (NULL, CSIDL_PROGRAMS, &id); - SHGetPathFromIDList (id, path); - msg("Program directory for program link changed to: %s",path); - } -// end of Win95 addition - strcat (path, "\\"); - strcat (path, XEMACS_INFO_XEMACS_ORG_REGISTRY_NAME); - if (rem == 0) - make_link (path, title, target, args); - else - remove_link (path, title); -} - -static void -desktop_icon (char *title, char *target, int rem) -{ - char path[_MAX_PATH]; - LPITEMIDLIST id; - int issystem = (root_scope == IDC_ROOT_SYSTEM) ? 1 : 0; - //SHGetSpecialFolderLocation (NULL, issystem ? CSIDL_DESKTOP : CSIDL_COMMON_DESKTOPDIRECTORY, &id); - SHGetSpecialFolderLocation (NULL, issystem ? CSIDL_COMMON_DESKTOPDIRECTORY : CSIDL_DESKTOPDIRECTORY, &id); - SHGetPathFromIDList (id, path); -// following lines added because it appears Win95 does not use common programs -// unless it comes into play when multiple users for Win95 is enabled - msg("Desktop directory for desktop link: %s",path); - if ( strlen(path) == 0) { - SHGetSpecialFolderLocation (NULL, CSIDL_DESKTOPDIRECTORY, &id); - SHGetPathFromIDList (id, path); - msg("Desktop directory for deskop link changed to: %s",path); - } -// end of Win95 addition - if (rem == 0) - make_link (path, title, target, ""); - else - remove_link (path, title); -} - -static void -save_icon () -{ - iconname = backslash (concat (root_dir, XEMACS_RESOURCE_DIR, - "xemacs.ico", 0)); - - HRSRC rsrc = FindResource (NULL, "XEMACS.ICON", "FILE"); - if (rsrc == NULL) - { - fatal ("FindResource failed"); - } - HGLOBAL res = LoadResource (NULL, rsrc); - char *data = (char *) LockResource (res); - int len = SizeofResource (NULL, rsrc); - - FILE *f = fopen (iconname, "wb"); - if (f) - { - fwrite (data, 1, len, f); - fclose (f); - } -} - -void -remove_xemacs_setup() -{ - if (xemacs_package == 0) - return; - - start_menu ("XEmacs", 0, 1, 0); - desktop_icon ("XEmacs", 0, 1); - -#define FROB(exe) remove_app_path (exe) - FROB (find_xemacs_exe_name ()); - FROB ("runemacs.exe"); - FROB ("xemacs.exe"); -#undef FROB -} - -void -remove_desktop_setup() -{ - remove_xemacs_setup(); - start_menu ("Uninstall XEmacs", 0, 1, 0); - start_menu (0, 0, 1, 0); -} - -static void -do_desktop_setup() -{ - save_icon (); - - if (root_menu && batname) { - start_menu ("XEmacs", batname, 0, ""); - start_menu ("Uninstall XEmacs", uninstname, 0, "-u"); - } - - if (root_desktop && batname) { - desktop_icon ("XEmacs", batname, 0); - } - - // set regkeys for the application - if (xemacs_package != 0) - { - int issystem = (root_scope == IDC_ROOT_SYSTEM ? 1 : 0); - if (xemacs_package->type == TY_NATIVE - || xemacs_package->type == TY_CYGWIN) - { - if (xemacs_package->type == TY_NATIVE) - { -#define FROB(exe) set_app_path ((exe), \ - find_xemacs_exe_path (), \ - issystem) - FROB (find_xemacs_exe_name ()); - FROB ("runemacs.exe"); - FROB ("xemacs.exe"); -#undef FROB - } - else if (xemacs_package->type == TY_CYGWIN) - { - int junk; - char* root = find_cygwin_root (&junk); -#define FROB(exe) set_app_path ((exe), \ - concat (find_xemacs_exe_path (), ";", \ - root, "\\bin;", \ - root, "\\usr\\bin", 0), \ - issystem) - FROB (find_xemacs_exe_name ()); - FROB ("runemacs.exe"); - FROB ("xemacs.exe"); -#undef FROB - } - set_install_path (find_xemacs_exe_path(), issystem); - } - // Register file types - if (batname) - { - if (reg_java) - { - log (0, "Registering .java files"); - setup_explorer ("java", "Java Source file", batname); - setup_explorer ("jav", "Java Source file", batname); - } - if (reg_cpp) - { - log (0, "Registering .cpp files"); - setup_explorer ("cpp", "C++ Source file", batname); - setup_explorer ("cc", "C++ Source file", batname); - setup_explorer ("cxx", "C++ Source file", batname); - setup_explorer ("hh", "C++ Header file", batname); - setup_explorer ("hpp", "C++ Header file", batname); - setup_explorer ("hxx", "C++ Header file", batname); - } - if (reg_c) - { - log (0, "Registering .c files"); - setup_explorer ("c", "C Source file", batname); - setup_explorer ("h", "C Header file", batname); - } - if (reg_elisp) - { - log (0, "Registering .el files"); - setup_explorer ("el", "E-Lisp Source file", batname); - } - if (reg_txt) - { - log (0, "Registering .txt files"); - setup_explorer ("txt", "Text file", batname); - } - if (reg_idl) - { - log (0, "Registering .idl files"); - setup_explorer ("idl", "OMG IDL file", batname); - } - } - } -} - -static int da[] = { IDC_ROOT_DESKTOP, 0 }; -static int ma[] = { IDC_ROOT_MENU, 0 }; - -static int ct[] = { IDC_C_TYPE, 0 }; -static int javat[] = { IDC_JAVA_TYPE, 0 }; -static int cppt[] = { IDC_CPP_TYPE, 0 }; -static int elispt[] = { IDC_ELISP_TYPE, 0 }; -static int txtt[] = { IDC_TXT_TYPE, 0 }; -static int idlt[] = { IDC_IDL_TYPE, 0 }; - -static void -check_if_enable_next (HWND h) -{ - EnableWindow (GetDlgItem (h, IDOK), 1); -} - -static void -load_dialog (HWND h) -{ - rbset (h, da, root_desktop); - rbset (h, ma, root_menu); - rbset (h, ct, reg_c); - rbset (h, javat, reg_java); - rbset (h, cppt, reg_cpp); - rbset (h, elispt, reg_elisp); - rbset (h, txtt, reg_txt); - rbset (h, idlt, reg_idl); - check_if_enable_next (h); -} - -static int check_desktop (char *title, char *target) -{ - char path[_MAX_PATH]; - LPITEMIDLIST id; - int issystem = (root_scope == IDC_ROOT_SYSTEM) ? 1 : 0; - SHGetSpecialFolderLocation (NULL, issystem ? CSIDL_COMMON_DESKTOPDIRECTORY : CSIDL_DESKTOPDIRECTORY, &id); - SHGetPathFromIDList (id, path); - // following lines added because it appears Win95 does not use common programs - // unless it comes into play when multiple users for Win95 is enabled - msg ("Desktop directory for desktop link: %s",path); - if (strlen (path) == 0) { - SHGetSpecialFolderLocation (NULL, CSIDL_DESKTOPDIRECTORY, &id); - SHGetPathFromIDList (id, path); - msg ("Desktop directory for deskop link changed to: %s",path); - } - // end of Win95 addition - char *fname = concat (path, "/", title, ".lnk", 0); - - if (_access (fname, 0) == 0) - return 0; /* already exists */ - - fname = concat (path, "/", title, ".pif", 0); /* check for a pif as well */ - - if (_access (fname, 0) == 0) - return 0; /* already exists */ - - return IDC_ROOT_DESKTOP; -} - -static int check_startmenu (char *title, char *target) -{ - char path[_MAX_PATH]; - LPITEMIDLIST id; - int issystem = (root_scope == IDC_ROOT_SYSTEM) ? 1 : 0; - SHGetSpecialFolderLocation (NULL, issystem ? CSIDL_COMMON_PROGRAMS : CSIDL_PROGRAMS, &id); - SHGetPathFromIDList (id, path); - // following lines added because it appears Win95 does not use common programs - // unless it comes into play when multiple users for Win95 is enabled - msg ("Program directory for program link: %s",path); - if (strlen (path) == 0) { - SHGetSpecialFolderLocation (NULL, CSIDL_PROGRAMS, &id); - SHGetPathFromIDList (id, path); - msg ("Program directory for program link changed to: %s",path); - } - // end of Win95 addition - strcat (path, "\\"); - strcat (path, XEMACS_INFO_XEMACS_ORG_REGISTRY_NAME); - char *fname = concat (path, "\\", title, ".lnk", 0); - - if (_access (fname, 0) == 0) - return 0; /* already exists */ - - fname = concat (path, "\\", title, ".pif", 0); /* check for a pif as well */ - - if (_access (fname, 0) == 0) - return 0; /* already exists */ - - return IDC_ROOT_MENU; -} - -static void -save_dialog (HWND h) -{ - root_desktop= rbget (h, da); - root_menu = rbget (h, ma); - reg_c = rbget (h, ct); - reg_java = rbget (h, javat); - reg_cpp = rbget (h, cppt); - reg_elisp = rbget (h, elispt); - reg_txt = rbget (h, txtt); - reg_idl = rbget (h, idlt); -} - -static BOOL -dialog_cmd (HWND h, int id, HWND hwndctl, UINT code) -{ - switch (id) - { - - case IDC_ROOT_DESKTOP: - case IDC_ROOT_MENU: - save_dialog (h); - check_if_enable_next (h); - break; - - case IDOK: - save_dialog (h); - do_desktop_setup(); - NEXT (IDD_S_POSTINSTALL); - break; - - case IDC_BACK: - save_dialog (h); - NEXT (IDD_CHOOSE); - break; - - case IDCANCEL: - NEXT (0); - break; - } - return FALSE; -} - -static BOOL CALLBACK -dialog_proc (HWND h, UINT message, WPARAM wParam, LPARAM lParam) -{ - switch (message) - { - case WM_INITDIALOG: - load_dialog (h); - return FALSE; - case WM_COMMAND: - return HANDLE_WM_COMMAND (h, wParam, lParam, dialog_cmd); - } - return FALSE; -} - -void -do_desktop (HINSTANCE h) -{ - CoInitialize (NULL); - - verinfo.dwOSVersionInfoSize = sizeof (verinfo); - GetVersionEx (&verinfo); - batname = 0; - uninstname = 0; - - if (xemacs_package != 0 && xemacs_package->type != TY_GENERIC) - { - batname = concat (find_xemacs_exe_path (), "\\", - find_xemacs_exe_name (), - 0); - uninstname = concat (find_xemacs_exe_path (), "\\", "setup.exe", 0); - root_desktop = check_desktop ("XEmacs", batname); - root_menu = check_startmenu ("XEmacs", batname); - reg_c = IDC_C_TYPE; - reg_cpp = IDC_CPP_TYPE; - reg_java = IDC_JAVA_TYPE; - reg_elisp = IDC_ELISP_TYPE; - reg_txt = IDC_TXT_TYPE; - reg_idl = IDC_IDL_TYPE; - } - else - { - root_desktop = 0; - root_menu = 0; - reg_c = 0; - reg_cpp = 0; - reg_java = 0; - reg_elisp = 0; - reg_txt = 0; - reg_idl = 0; - } - - int rv = 0; - - rv = DialogBox (h, MAKEINTRESOURCE (IDD_DESKTOP), 0, dialog_proc); - if (rv == -1) - fatal (IDS_DIALOG_FAILED); -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/desktop.h --- a/netinstall/desktop.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,23 +0,0 @@ -/* - Copyright (C) 2001 Andy Piper. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -extern void remove_desktop_setup (); -extern void remove_xemacs_setup (); -extern char* find_xemacs_exe_name(); diff -r 861f2601a38b -r 1f0b15040456 netinstall/dialog.cc --- a/netinstall/dialog.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,95 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The purpose of this file is to provide common functionality for - all the dialogs in the program. */ - -#include "win32.h" -#include -#include -#include "dialog.h" -#include "msg.h" -#include "log.h" - -char * -eget (HWND h, int id, char *var) -{ - char tmp[4000]; - if (var) - { - free (var); - var = 0; - } - if (GetDlgItemText (h, id, tmp, sizeof (tmp)) > 0) - { - var = (char *) malloc (strlen (tmp)+1); - strcpy (var, tmp); - } - return var; -} - -int -eget (HWND h, int id) -{ - BOOL s; - int r = GetDlgItemInt (h, id, &s, TRUE); - return r; -} - -void -eset (HWND h, int id, char *val) -{ - SetDlgItemText (h, id, val); -} - -void -eset (HWND h, int id, int val) -{ - SetDlgItemInt (h, id, (UINT)val, TRUE); -} - -int -rbget (HWND h, int *ids) -{ - int i; - for (i=0; ids[i]; i++) - if (IsDlgButtonChecked (h, ids[i]) == BST_CHECKED) - return ids[i]; - return 0; -} - -void -rbset (HWND h, int *ids, int id) -{ - int i; - for (i=0; ids[i]; i++) - CheckDlgButton (h, ids[i], id==ids[i] ? BST_CHECKED : BST_UNCHECKED); -} - -void -fatal (char *m) -{ - DWORD e = GetLastError (); - char *buf; - FormatMessage (FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM, - 0, - e, - 0, - (CHAR *)&buf, - 0, - 0); - MessageBox (0, buf, m, 0); - exit_setup (1); -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/dialog.h --- a/netinstall/dialog.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,74 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* global instance for the application; set in main.cc */ -extern HINSTANCE hinstance; - -/* used by main.cc to select the next do_* function */ -extern int next_dialog; - -/* either "nothing to do" or "setup complete" or something like that */ -extern int exit_msg; - -#define D(x) void x(HINSTANCE _h) - -/* prototypes for all the do_* functions (most called by main.cc) */ - -D(do_choose); -D(do_desktop); -D(do_download); -D(do_fromcwd); -D(do_ini); -D(do_init); -D(do_install); -D(do_local_dir); -D(do_net); -D(do_other); -D(do_postinstall); -D(do_uninstall); -D(do_root); -D(do_site); -D(do_source); -D(do_splash); - -#undef D - -/* end this dialog and select the next. Pass 0 to exit the program */ -#define NEXT(id) EndDialog((HWND)h, 0), next_dialog = id - -/* Get the value of an EditText control. Pass the previously stored - value and it will free the memory if needed. */ - -char *eget (HWND h, int id, char *var); - -/* Same, but convert the value to an integer */ - -int eget (HWND h, int id); - -/* Set the EditText control to the given string or integer */ - -void eset (HWND h, int id, char *var); -void eset (HWND h, int id, int var); - -/* RadioButtons. ids is a null-terminated list of IDs. Get - returns the selected ID (or zero), pass an ID to set */ - -int rbget (HWND h, int *ids); -void rbset (HWND h, int *ids, int id); - -/* *This* version of fatal (compare with msg.h) uses GetLastError() to - format a suitable error message. Similar to perror() */ - -void fatal (char *msg); diff -r 861f2601a38b -r 1f0b15040456 netinstall/diskfull.cc --- a/netinstall/diskfull.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,66 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The purpose of this file is to hide the mess needed just to figure - out how full a given disk is. There is an old API that can't - handle disks bigger than 2G, and a new API that isn't always - available. */ - -#include "win32.h" -#include "diskfull.h" - -typedef BOOL (WINAPI * GDFS)(LPCTSTR, PULARGE_INTEGER, PULARGE_INTEGER, - PULARGE_INTEGER); - -int -diskfull (char *path) -{ - GDFS gdfs = 0; - - HINSTANCE k = LoadLibrary ("KERNEL32.DLL"); - if (k) - { - gdfs = (GDFS) GetProcAddress (k, "GetDiskFreeSpaceExA"); - - if (gdfs) - { - ULARGE_INTEGER avail, total, free; - if (gdfs (path, &avail, &total, &free)) - { - int perc = avail.QuadPart * 100 / total.QuadPart; - return 100-perc; - } - } - } - - char root[4]; - if (path[1] != ':') - return 0; - - root[0] = path[0]; - root[1] = ':'; - root[2] = '\\'; - root[3] = 0; - - DWORD junk, free_clusters, total_clusters; - - if (GetDiskFreeSpace (root, &junk, &junk, &free_clusters, &total_clusters)) - { - int perc = free_clusters * 100 / total_clusters; - return 100-perc; - } - - return 0; -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/diskfull.h --- a/netinstall/diskfull.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,17 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* returns 0..100 (percent) */ -int diskfull (char *path); diff -r 861f2601a38b -r 1f0b15040456 netinstall/download.cc --- a/netinstall/download.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,112 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The purpose of this file is to download all the files we need to - do the installation. */ - -#include -#include -#include - -#include "win32.h" - -#include "resource.h" -#include "msg.h" -#include "ini.h" -#include "dialog.h" -#include "concat.h" -#include "geturl.h" -#include "state.h" -#include "mkdir.h" -#include "log.h" - -static int -download_one (char *name, int expected_size) -{ - char *local = name; - - struct stat s; - if (stat (local, &s) >= 0) - if (s.st_size == expected_size) - return 0; - - mkdir_p (0, local); - - if (get_url_to_file (concat (MIRROR_SITE, "/", name, 0), - concat (local, ".tmp", 0), - expected_size)) - { - note (IDS_DOWNLOAD_FAILED, name); - return 1; - } - else - { - stat (concat (local, ".tmp", 0), &s); - if (s.st_size == expected_size) - { - log (0, "Downloaded %s", local); - rename (concat (local, ".tmp", 0), local); - } - else - { - log (0, "Download %s wrong size (%d actual vs %d expected)", - local, s.st_size, expected_size); - note (IDS_DOWNLOAD_SHORT, local, s.st_size, expected_size); - return 1; - } - } - - return 0; -} - -void -do_download (HINSTANCE h) -{ - int i; - int errors = 0; - - for (i=0; i - * - */ - -/* The purpose of this file is to doa recursive find on a given - directory, calling a given function for each file found. */ - -#include "win32.h" -#include -#include - -#include "port.h" - -static void (*for_each)(char *, unsigned int); -static char dir[_MAX_PATH], *found_part; - -static int -find_sub () -{ - WIN32_FIND_DATA wfd; - HANDLE h; - char *end = dir + strlen (dir); - int rv = 0; - - *end++ = '/'; - strcpy (end, "*"); - - h = FindFirstFile (dir, &wfd); - - if (h == INVALID_HANDLE_VALUE) - return 0; - - do { - if (strcmp (wfd.cFileName, ".") == 0 - || strcmp (wfd.cFileName, "..") == 0) - continue; - - strcpy (end, wfd.cFileName); - - if (wfd.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) - find_sub (); - else - { - for_each (found_part, wfd.nFileSizeLow); - rv ++; - } - - } while (FindNextFile (h, &wfd)); - - FindClose (h); - return rv; -} - -int -find (char *starting_dir, void (*_for_each)(char *, unsigned int)) -{ - strcpy (dir, starting_dir); - for_each = _for_each; - found_part = dir + strlen (dir) + 1; - - return find_sub (); -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/find.h --- a/netinstall/find.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,22 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The for_each function is called once for each file found in the - starting_dir or any subdir (recursively), passing the relative path - (i.e. it doesn't include "starting_dir") and the size of the file - (bytes). find() returns the number of files found. Directories - are scanned but not included in the "found" files. */ - -extern int find (char *starting_dir, void (*for_each)(char *, unsigned int)); diff -r 861f2601a38b -r 1f0b15040456 netinstall/fromcwd.cc --- a/netinstall/fromcwd.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,190 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The purpose of this file is to handle the case where we're - installing from files that already exist in the current directory. - If a setup.ini file is present, we set the mirror site to "." and - pretend we're installing from the `internet' ;-) else we have to - find all the .tar.gz files, deduce their versions, and try to - compare versions in the case where the current directory contains - multiple versions of any given package. We do *not* try to compare - versions with already installed packages; we always choose a - package in the current directory over one that's already installed - (otherwise, why would you have asked to install it?). Note - that we search recursively. */ - -#include "win32.h" - -#include -#include -#include -#include -#ifndef WIN32_NATIVE -#include -#endif - -#include "ini.h" -#include "resource.h" -#include "concat.h" -#include "state.h" -#include "dialog.h" -#include "msg.h" -#include "find.h" -#include "version.h" - -#include "port.h" - -static int -is_test_version (char *v) -{ - int i; - for (i=0; v[i] && isdigit (v[i]); i++) ; - return (i >= 6) ? 1 : 0; -} - -char * -canonicalize_version (char *v) -{ - static char nv[3][100]; - static int idx = 0; - char *np, *dp; - int i; - - idx = (idx+1) % 3; - np = nv[idx]; - - while (*v) - { - if (isdigit (*v)) - { - for (dp=v; *dp && isdigit (*dp); dp++) ; - for (i=dp-v; i<12; i++) - *np++ = '0'; - while (v < dp) - *np++ = *v++; - } - else - *np++ = *v++; - } - *np++ = 0; - return nv[idx]; -} - -static void -found_file (char *path, unsigned int fsize) -{ - char base[_MAX_PATH], *ver; - - int l = strlen (path); - - if (strcmp (path + l - 7, ".tar.gz") != 0) - return; - if (strstr (path, "-src.")) - return; - if (strstr (path, "-patch.")) - return; - - char *sl = strrchr (path, '/'); - if (sl) - sl ++; - else - sl = path; - strcpy (base, sl); - base[strlen (base) - 7] = 0; /* remove .tar.gz */ - for (ver=base; *ver; ver++) - if ((*ver == '-' || *ver == '_') && isdigit (ver[1])) - { - *ver++ = 0; - break; - } - - Package *p = 0; - int i; - - for (i=0; iinfo[trust].version) - { - char *ov = canonicalize_version (p->info[trust].version); - char *nv = canonicalize_version (ver); - if (strcmp (ov, nv) > 0) - return; - } - - l = strlen (base); - if (l >= 5 && strcmp (base + l - 5, "win32") == 0) - p->type = TY_NATIVE; - if (l >= 8 && strcmp (base + l - 8, "cygwin32") == 0) - p->type = TY_CYGWIN; - - p->info[trust].version = strdup (ver); - p->info[trust].install = strdup (path); - p->info[trust].install_size = fsize; -} - -void -do_fromcwd (HINSTANCE h) -{ - if (_access ("./setup.ini", 0) == 0) - { - mirror_site = "."; - next_dialog = IDD_S_LOAD_INI; - return; - } - - next_dialog = IDD_CHOOSE; - - find (".", found_file); - - // Now see about source tarballs - int i, t; - Package *p; - char srcpath[_MAX_PATH]; - for (i=0; iinfo[t].install) - { - strcpy (srcpath, p->info[t].install); - strcpy (srcpath + strlen (srcpath) - 7, "-src.tar.gz"); - msg ("looking for %s", srcpath); - - WIN32_FIND_DATA wfd; - HANDLE h = FindFirstFile (srcpath, &wfd); - if (h != INVALID_HANDLE_VALUE) - { - msg("-- got it"); - FindClose (h); - p->info[t].source = strdup (srcpath); - p->info[t].source_size = wfd.nFileSizeLow; - } - } - } - - return; -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/geturl.cc --- a/netinstall/geturl.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,262 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The purpose of this file is to act as a pretty interface to - netio.cc. We add a progress dialog and some convenience functions - (like collect to string or file */ - -#include "win32.h" -#include "commctrl.h" - -#include -#include -#include - -#include "dialog.h" -#include "geturl.h" -#include "resource.h" -#include "netio.h" -#include "msg.h" -#include "log.h" - -static int is_showing = 0; -static HWND gw_dialog = 0; -static HWND gw_url = 0; -static HWND gw_rate = 0; -static HWND gw_progress = 0; -static HANDLE init_event; -static int max_bytes = 0; - -static BOOL -dialog_cmd (HWND h, int id, HWND hwndctl, UINT code) -{ - switch (id) - { - case IDCANCEL: - exit_setup (0); - } - return FALSE; -} - -static BOOL CALLBACK -dialog_proc (HWND h, UINT message, WPARAM wParam, LPARAM lParam) -{ - switch (message) - { - case WM_INITDIALOG: - gw_dialog = h; - gw_url = GetDlgItem (h, IDC_DLS_URL); - gw_rate = GetDlgItem (h, IDC_DLS_RATE); - gw_progress = GetDlgItem (h, IDC_DLS_PROGRESS); - SetEvent (init_event); - return FALSE; - case WM_COMMAND: - return HANDLE_WM_COMMAND (h, wParam, lParam, dialog_cmd); - } - return FALSE; -} - -static DWORD WINAPI -dialog (void *) -{ - MSG m; - HWND lgw_dialog = CreateDialog (hinstance, MAKEINTRESOURCE (IDD_DLSTATUS), - 0, dialog_proc); - ShowWindow (lgw_dialog, SW_SHOWNORMAL); - UpdateWindow (lgw_dialog); - while (GetMessage (&m, 0, 0, 0) > 0) { - TranslateMessage (&m); - DispatchMessage (&m); - } - return FALSE; -} - -static DWORD start_tics; - -static void -init_dialog (char *url, int length) -{ - if (gw_dialog == 0) - { - DWORD tid; - HANDLE thread; - init_event = CreateEvent (0, 0, 0, 0); - thread = CreateThread (0, 0, dialog, 0, 0, &tid); - WaitForSingleObject (init_event, 1000); - CloseHandle (init_event); - SendMessage (gw_progress, PBM_SETRANGE, 0, MAKELPARAM (0, 100)); - is_showing = 0; - } - char *sl=url, *cp; - for (cp=url; *cp; cp++) - if (*cp == '/' || *cp == '\\' || *cp == ':') - sl = cp+1; - max_bytes = length; - SetWindowText (gw_url, sl); - SetWindowText (gw_rate, "Connecting..."); - SendMessage (gw_progress, PBM_SETPOS, (WPARAM) 0, 0); - ShowWindow (gw_progress, (length > 0) ? SW_SHOW : SW_HIDE); - ShowWindow (gw_dialog, SW_SHOWNORMAL); - if (!is_showing) - { - SetForegroundWindow (gw_dialog); - is_showing = 1; - } - start_tics = GetTickCount (); -} - - -static void -progress (int bytes) -{ - static char buf[100]; - int kbps; - static DWORD last_tics = 0; - DWORD tics = GetTickCount (); - if (tics == start_tics) // to prevent division by zero - return; - if (tics < last_tics + 200) // to prevent flickering updates - return; - last_tics = tics; - - kbps = bytes / (tics - start_tics); - ShowWindow (gw_progress, (max_bytes > 0) ? SW_SHOW : SW_HIDE); - if (max_bytes > 100) - { - int perc = bytes / (max_bytes / 100); - SendMessage (gw_progress, PBM_SETPOS, (WPARAM) perc, 0); - sprintf (buf, "%3d %% (%dk/%dk) %d kb/s\n", - perc, bytes/1000, max_bytes/1000, kbps); - } - else - sprintf (buf, "%d %d kb/s\n", bytes, kbps); - - SetWindowText (gw_rate, buf); -} - -struct GUBuf { - GUBuf *next; - int count; - char buf[2000]; -}; - -char * -get_url_to_string (char *_url) -{ - log (LOG_BABBLE, "get_url_to_string %s", _url); - init_dialog (_url, 0); - NetIO *n = NetIO::open (_url); - if (!n || !n->ok ()) - { - delete n; - log (LOG_BABBLE, "get_url_to_string failed!"); - return 0; - } - - if (n->file_size) - max_bytes = n->file_size; - - GUBuf *bufs = 0; - GUBuf **nextp = &bufs; - int total_bytes = 1; /* for the NUL */ - progress (0); - while (1) - { - GUBuf *b = new GUBuf; - *nextp = b; - b->next = 0; - nextp = &(b->next); - - b->count = n->read (b->buf, sizeof (b->buf)); - if (b->count <= 0) - break; - total_bytes += b->count; - progress (total_bytes); - } - - char *rv = (char *) malloc (total_bytes); - char *rvp = rv; - while (bufs && bufs->count > 0) - { - GUBuf *tmp = bufs->next; - memcpy (rvp, bufs->buf, bufs->count); - rvp += bufs->count; - delete bufs; - bufs = tmp; - } - *rvp = 0; - - if (n) - delete n; - - return rv; -} - -int -get_url_to_file (char *_url, char *_filename, int expected_length) -{ - log (LOG_BABBLE, "get_url_to_file %s %s", _url, _filename); - init_dialog (_url, expected_length); - - remove (_filename); /* but ignore errors */ - - NetIO *n = NetIO::open (_url); - if (!n || !n->ok ()) - { - delete n; - log (LOG_BABBLE, "get_url_to_file failed!"); - return 1; - } - - FILE *f = fopen (_filename, "wb"); - if (!f) - { - char *err = strerror (errno); - if (!err) - err = "(unknown error)"; - fatal (IDS_ERR_OPEN_WRITE, _filename, err); - } - - if (n->file_size) - max_bytes = n->file_size; - - int total_bytes = 0; - progress (0); - while (1) - { - char buf[8192]; - int count; - count = n->read (buf, sizeof (buf)); - if (count <= 0) - break; - fwrite (buf, 1, count, f); - total_bytes += count; - progress (total_bytes); - } - - fclose (f); - - if (n) - delete n; - - return 0; -} - -void -dismiss_url_status_dialog () -{ - ShowWindow (gw_dialog, SW_HIDE); - is_showing = 0; -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/geturl.h --- a/netinstall/geturl.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,21 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* Download files from the Internet. These pop up a progress dialog; - don't forget to dismiss it when you're done downloading for a while */ - -char *get_url_to_string (char *_url); -int get_url_to_file (char *_url, char *_filename, int expected_size); -void dismiss_url_status_dialog (); diff -r 861f2601a38b -r 1f0b15040456 netinstall/hash.cc --- a/netinstall/hash.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,99 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* Simple hash class for install.cc */ - -#include "win32.h" -#include -#include - -#include "hash.h" - -class hash_internals { -public: - char **keys; - int numkeys; - int maxkeys; - int prev_index; -}; - -hash::hash () -{ - h = new hash_internals; - h->numkeys = 0; - h->maxkeys = 10; - h->keys = (char **) malloc (h->maxkeys * sizeof (char *)); - h->prev_index = 0; -} - -hash::~hash () -{ - free (h->keys); - free (h); -} - - -void -hash::add (char *string) -{ - int i; - for (i=0; inumkeys; i++) - if (strcmp (h->keys[i], string) == 0) - return; - if (h->numkeys >= h->maxkeys) - { - h->maxkeys += 10; - h->keys = (char **) realloc (h->keys, h->maxkeys * sizeof (char *)); - } - - h->keys[h->numkeys] = _strdup (string); - h->numkeys ++; -} - - -int -hash::has (char *string) -{ - int i; - for (i=0; inumkeys; i++) - if (strcmp (h->keys[i], string) == 0) - return 1; - return 0; -} - -char * -hash::enumerate (char *prev) -{ - if (prev == 0) - h->prev_index = -1; - h->prev_index ++; - if (h->prev_index >= h->numkeys) - return 0; - return h->keys[h->prev_index]; -} - -static int CDECL -rev_len (const void *va, const void *vb) -{ - char *a = *(char **)va; - char *b = *(char **)vb; - return strcmp (b, a); -} - -void -hash::reverse_sort () -{ - qsort (h->keys, h->numkeys, sizeof (h->keys[0]), rev_len); -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/hash.h --- a/netinstall/hash.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,34 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* Simple hash class for install.cc */ - -class hash_internals; - -class hash { - hash_internals *h; - public: - hash (); - ~hash (); - - void add (char *string); - int has (char *string); - - /* specialty for install.cc */ - void add_subdirs (char *path); - void reverse_sort (); - - char *enumerate (char *prev=0); -}; diff -r 861f2601a38b -r 1f0b15040456 netinstall/ini.cc --- a/netinstall/ini.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,187 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The purpose of this file is to get and parse the setup.ini file - from the mirror site. A few support routines for the bison and - flex parsers are provided also. We check to see if this setup.ini - is older than the one we used last time, and if so, warn the user. */ - -#include "win32.h" - -#include -#include -#include - -#include "ini.h" -#include "resource.h" -#include "concat.h" -#include "state.h" -#include "geturl.h" -#include "dialog.h" -#include "msg.h" -#include "mkdir.h" -#include "log.h" -#include "reginfo.h" -#include "version.h" - -unsigned int setup_timestamp = 0; -char *setup_version = 0; - -extern "C" int yyparse (); -/*extern int yydebug;*/ - -static char *error_buf = 0; -static int error_count = 0; - -void -do_ini (HINSTANCE h) -{ - char *ini_file = get_url_to_string (concat (MIRROR_SITE, "/setup.ini", 0)); - dismiss_url_status_dialog (); - - if (!ini_file) - { - note (IDS_SETUPINI_MISSING, MIRROR_SITE); - next_dialog = IDD_SITE; - return; - } - - package = 0; - npackages = 0; - setup_timestamp = 0; - setup_version = 0; - - ini_init (ini_file); - - setup_timestamp = 0; - /*yydebug = 1;*/ - - if (yyparse () || error_count > 0) - { - if (error_count == 1) - MessageBox (0, error_buf, "Parse Error", 0); - else - MessageBox (0, error_buf, "Parse Errors", 0); - } - else - { - /* save known-good setup.ini locally */ - FILE *inif = fopen ("setup.ini", "wb"); - if (inif) - { - fwrite (ini_file, 1, strlen (ini_file), inif); - fclose (inif); - } - } - - if (root_dir) - { - mkdir_p (1, concat (root_dir, XEMACS_SETUP_DIR, 0)); - - unsigned int old_timestamp = 0; - FILE *ots = fopen (concat (root_dir, XEMACS_SETUP_DIR, "timestamp", 0), "rt"); - if (ots) - { - fscanf (ots, "%u", &old_timestamp); - fclose (ots); - if (old_timestamp && setup_timestamp - && (old_timestamp > setup_timestamp)) - { - int yn = yesno (IDS_OLD_SETUPINI); - if (yn == IDNO) - exit_setup (1); - } - } - if (setup_timestamp) - { - FILE *nts = fopen (concat (root_dir, XEMACS_SETUP_DIR, "timestamp", 0), "wt"); - if (nts) - { - fprintf (nts, "%u", setup_timestamp); - fclose (nts); - } - } - } - - msg ("setup_version is %s, our_version is %s", setup_version? setup_version : "(null)", version); - if (setup_version) - { - char *ini_version = canonicalize_version (setup_version); - char *our_version = canonicalize_version (version); - if (strcmp (our_version, ini_version) < 0) - note (IDS_OLD_SETUP_VERSION, version, setup_version); - } - - next_dialog = IDD_CHOOSE; -} - -extern "C" int yylineno; - -extern "C" int CDECL yyerror (char *s, ...) -{ - char buf[1000]; - int len; - sprintf (buf, "setup.ini line %d: ", yylineno); - va_list args; - va_start (args, s); - vsprintf (buf + strlen (buf), s, args); - OutputDebugString (buf); - if (error_buf) - { - strcat (error_buf, "\n"); - len = strlen (error_buf) + strlen (buf) + 5; - error_buf = (char *) realloc (error_buf, len); - strcat (error_buf, buf); - } - else - { - len = strlen (buf) + 5; - error_buf = (char *) malloc (len); - strcpy (error_buf, buf); - } - error_count++; - return 0; -} - -extern "C" int CDECL fprintf (FILE *f, const char *s, ...); - -static char stderrbuf[1000]; - -int CDECL -fprintf (FILE *f, const char *fmt, ...) -{ - char buf[1000]; - int rv; - va_list args; - va_start (args, fmt); - if (f == stderr) - { - rv = vsprintf (buf, fmt, args); - strcat (stderrbuf, buf); - if (char *nl = strchr (stderrbuf, '\n')) - { - *nl = 0; - /*OutputDebugString (stderrbuf);*/ - MessageBox (0, buf, "XEmacs Setup", 0); - stderrbuf[0] = 0; - } - - } - else - { - rv = vfprintf (f, fmt, args); - } - return rv; -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/ini.h --- a/netinstall/ini.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,87 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* When setup.ini is parsed, the information is stored according to - the declarations here. ini.cc (via inilex and iniparse) - initializes these structures. choose.cc sets the action and trust - fields. download.cc downloads any needed files for selected - packages (the chosen "install" field). install.cc installs - selected packages. */ - -#define YYSTYPE char * - -/* lowest number must be most trusted, highest least trusted */ -#define TRUST_PREV 0 -#define TRUST_CURR 1 -#define TRUST_TEST 2 -#define NTRUST 3 -#define TRUST_UNKNOWN 3 /* intentionally not in NTRUST */ - -#define TY_GENERIC 0 -#define TY_CYGWIN 1 -#define TY_NATIVE 2 - -#define ACTION_UNKNOWN 0 -#define ACTION_SAME 1 -#define ACTION_NEW 2 -#define ACTION_UPGRADE 3 -#define ACTION_UNINSTALL 4 -#define ACTION_ERROR 5 - -#define SRCACTION_NO 0 -#define SRCACTION_YES 1 - -typedef struct { - char *name; /* package name, like "cygwin" */ - char *sdesc; /* short description (replaces "name" if provided) */ - char *ldesc; /* long description (multi-line) */ - int action; /* ACTION_* - only NEW and UPGRADE get installed */ - int srcaction;/* SRCACTION_ */ - int trust; /* TRUST_* (selects among info[] below) */ - int type; /* TY_GENERIC, TY_CYGWIN or TY_NATIVE. */ - - struct { - char *version; /* version part of filename */ - char *install; /* file name to install */ - int install_size; /* in bytes */ - char *source; /* sources for installed binaries */ - int source_size; /* in bytes */ - } info[NTRUST+1]; /* +1 for TRUST_UNKNOWN */ -} Package; - -#ifdef __cplusplus -extern "C" { -#endif - -extern Package *package; -extern Package *xemacs_package; - -extern int npackages; - -Package *new_package (char *name); -void ini_init (char *string); - -#define pinfo(p) ((p).info[(p).trust]) -#define pi pinfo(package[i]) - -#define LOOP_PACKAGES \ - for (i=0; i - * - */ - -/* tokenize the setup.ini files. We parse a string which we've - previously downloaded. The program must call ini_init() to specify - that string. */ - -#include "win32.h" -#include -#include - -#include "ini.h" -#include "iniparse.h" - -#define YY_INPUT(buf,result,max_size) { result = ini_getchar(buf, max_size); } - -static int ini_getchar(char *buf, int max_size); -static void ignore_line (); - -%} - -/*%option debug */ -%option noyywrap -%option yylineno -%option never-interactive - -STR [a-zA-Z0-9_./-]+ - -%% - -\"[^"]*\" { yylval = strdup (yytext+1); - yylval[strlen (yylval)-1] = 0; - return STRING; } - -"setup-timestamp:" return SETUP_TIMESTAMP; -"setup-version:" return SETUP_VERSION; -"version:" return VERSION; -"install:" return INSTALL; -"type:" return TYPE; -"source:" return SOURCE; -"sdesc:" return SDESC; -"ldesc:" return LDESC; - -^{STR}":" ignore_line (); - -"[curr]" return T_CURR; -"[test]" return T_TEST; -"[exp]" return T_TEST; -"[prev]" return T_PREV; -"["{STR}"]" return T_UNKNOWN; - -{STR} { yylval = strdup (yytext); - return STRING; } - -[ \t\r]+ /* do nothing */ - -"#".*\n /* ignore comments */ - -\n { return yytext[0]; } -. { return yytext[0]; } - -%% - -static char *input_string = 0; -static char *end_input_string; - -void -ini_init(char *string) -{ - input_string = string; - end_input_string = input_string + strlen(input_string); -} - -static int -ini_getchar(char *buf, int max_size) -{ - if (input_string) - { - int avail = end_input_string - input_string; - if (avail == 0) - { - input_string = end_input_string = 0; - return 0; - } - if (avail > max_size) - avail = max_size; - memcpy(buf, input_string, avail); - input_string += avail; - return avail; - } - else - return 0; -} - -static void -ignore_line () -{ - char c; - while (c = input ()) - { - if (c == EOF) - return; - if (c == '\n') - return; - } -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/iniparse.h --- a/netinstall/iniparse.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -#ifndef YYSTYPE -#define YYSTYPE int -#endif -#define STRING 257 -#define SETUP_TIMESTAMP 258 -#define SETUP_VERSION 259 -#define VERSION 260 -#define INSTALL 261 -#define SOURCE 262 -#define SDESC 263 -#define LDESC 264 -#define TYPE 265 -#define T_PREV 266 -#define T_CURR 267 -#define T_TEST 268 -#define T_UNKNOWN 269 - - -extern YYSTYPE yylval; diff -r 861f2601a38b -r 1f0b15040456 netinstall/iniparse.y --- a/netinstall/iniparse.y Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,134 +0,0 @@ -%{ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* Parse the setup.ini files. inilex.l provides the tokens for this. */ - -#include -#include -#include -#include "win32.h" - -#include "ini.h" -#include "iniparse.h" - -#include "port.h" - -#define YYERROR_VERBOSE 1 -/*#define YYDEBUG 1*/ - -static Package *cp; -static int trust; -extern unsigned int setup_timestamp; -extern char *setup_version; -extern int yylineno; -extern int CDECL yyerror (char *s, ...); - -#define cpt (cp->info+trust) - -%} - -%token STRING -%token SETUP_TIMESTAMP SETUP_VERSION VERSION INSTALL SOURCE SDESC LDESC TYPE -%token T_PREV T_CURR T_TEST T_UNKNOWN - -%% - -whole_file - : setup_headers packages - ; - -setup_headers - : setup_header setup_headers - | /* empty */ - ; - -setup_header - : SETUP_TIMESTAMP STRING '\n' { setup_timestamp = strtoul ($2, 0, 0); } - | SETUP_VERSION STRING '\n' { setup_version = strdup ($2); } - | '\n' - | error { yyerror ("unrecognized line in setup.ini headers (do you have the latest setup?)"); } '\n' - ; - -packages - : package packages - | /* empty */ - ; - -package - : '@' STRING '\n' { new_package($2); } - lines - ; - -lines - : simple_line '\n' lines - | simple_line - ; - -simple_line - : VERSION STRING { cpt->version = $2; } - | SDESC STRING { cp->sdesc = $2; } - | LDESC STRING { cp->ldesc = $2; } - | INSTALL STRING STRING { cpt->install = $2; - cpt->install_size = atoi($3); } - | SOURCE STRING STRING { cpt->source = $2; - cpt->source_size = atoi($3); } - | TYPE STRING { if (!strcmp ($2, "cygwin")) - cp->type = TY_CYGWIN; - else if (!strcmp ($2, "native")) - cp->type = TY_NATIVE; - else - cp->type = TY_GENERIC; } - | T_PREV { trust = TRUST_PREV; } - | T_CURR { trust = TRUST_CURR; } - | T_TEST { trust = TRUST_TEST; } - | T_UNKNOWN { trust = TRUST_UNKNOWN; } - | /* empty */ - | error '\n' { yylineno --; - yyerror ("unrecognized line in package %s (do you have the latest setup?)", cp->name); - yylineno ++; - } - ; - -%% - -Package *package = 0; -Package *xemacs_package = 0; -int npackages = 0; -static int maxpackages = 0; - -Package * -new_package (char *name) -{ - if (package == 0) - maxpackages = npackages = 0; - if (npackages >= maxpackages) - { - maxpackages += 10; - if (package) - package = (Package *) realloc (package, maxpackages * sizeof (Package)); - else - package = (Package *) malloc (maxpackages * sizeof (Package)); - } - cp = package + npackages; - npackages ++; - - memset (cp, 0, sizeof (Package)); - cp->name = name; - - trust = TRUST_CURR; - - return cp; -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/init.cc --- a/netinstall/init.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,65 +0,0 @@ -/* Initialisation for netinstall. - Copyright (C) 2001 Andy Piper. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -#include "win32.h" -#include -#include -#include "dialog.h" -#include "log.h" -#include "resource.h" -#include "state.h" -#include "msg.h" -#include "regedit.h" -#include "reginfo.h" -#include "version.h" - -static void -init_root () -{ - int isnative, issystem; - root_dir = find_root_location (&issystem, &isnative); - if (root_dir) - { - if (isnative) - install_type = IDC_INSTALL_NATIVE; - else - install_type = IDC_INSTALL_CYGWIN; - - if (issystem) - root_scope = IDC_ROOT_SYSTEM; - else - root_scope = IDC_ROOT_USER; - root_dir_default = 0; - } -} - -void -do_init (HINSTANCE h) -{ - char cwd[_MAX_PATH]; - GetCurrentDirectory (sizeof (cwd), cwd); - local_dir = strdup (cwd); - log (0, "Current Directory: %s", cwd); - - HANDLE gnu = LoadImage (h, MAKEINTRESOURCE (IDB_GNU), - IMAGE_BITMAP, 0, 0, 0); - init_root(); -} - diff -r 861f2601a38b -r 1f0b15040456 netinstall/install.cc --- a/netinstall/install.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,509 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The purpose of this file is to intall all the packages selected in - the install list (in ini.h). Note that we use a separate thread to - maintain the progress dialog, so we avoid the complexity of - handling two tasks in one thread. We also create or update all the - files in /etc/setup and create the mount points. */ - -#include -#include -#include -#ifndef WIN32_NATIVE -#include -#endif -#include -#include -#include -#include - -#include "win32.h" -#include "commctrl.h" - -#include "resource.h" -#include "ini.h" -#include "dialog.h" -#include "concat.h" -#include "geturl.h" -#include "mkdir.h" -#include "state.h" -#include "tar.h" -#include "diskfull.h" -#include "msg.h" -#include "regedit.h" -#include "reginfo.h" -#include "log.h" -#include "hash.h" -#include "desktop.h" -#include "port.h" - -static HWND ins_dialog = 0; -static HWND ins_action = 0; -static HWND ins_pkgname = 0; -static HWND ins_filename = 0; -static HWND ins_pprogress = 0; -static HWND ins_iprogress = 0; -static HWND ins_diskfull = 0; -static HANDLE init_event; - -static int total_bytes = 0; -static int total_bytes_sofar = 0; -static int package_bytes = 0; - -static BOOL -dialog_cmd (HWND h, int id, HWND hwndctl, UINT code) -{ - switch (id) - { - case IDCANCEL: - exit_setup (1); - } - return FALSE; -} - -static BOOL CALLBACK -dialog_proc (HWND h, UINT message, WPARAM wParam, LPARAM lParam) -{ - switch (message) - { - case WM_INITDIALOG: - ins_dialog = h; - ins_action = GetDlgItem (h, IDC_INS_ACTION); - ins_pkgname = GetDlgItem (h, IDC_INS_PKG); - ins_filename = GetDlgItem (h, IDC_INS_FILE); - ins_pprogress = GetDlgItem (h, IDC_INS_PPROGRESS); - ins_iprogress = GetDlgItem (h, IDC_INS_IPROGRESS); - ins_diskfull = GetDlgItem (h, IDC_INS_DISKFULL); - SetEvent (init_event); - return FALSE; - case WM_COMMAND: - return HANDLE_WM_COMMAND (h, wParam, lParam, dialog_cmd); - } - return FALSE; -} - -static DWORD WINAPI -dialog (void *) -{ - MSG m; - HWND new_dialog = CreateDialog (hinstance, MAKEINTRESOURCE (IDD_INSTATUS), - 0, dialog_proc); - if (new_dialog == 0) - fatal ("create dialog"); - ShowWindow (new_dialog, SW_SHOWNORMAL); - UpdateWindow (new_dialog); - while (GetMessage (&m, 0, 0, 0) > 0) { - TranslateMessage (&m); - DispatchMessage (&m); - } - return FALSE; -} - -static void -init_dialog () -{ - if (ins_dialog == 0) - { - DWORD tid; - HANDLE thread; - init_event = CreateEvent (0, 0, 0, 0); - thread = CreateThread (0, 0, dialog, 0, 0, &tid); - WaitForSingleObject (init_event, 10000); - CloseHandle (init_event); - SendMessage (ins_pprogress, PBM_SETRANGE, 0, MAKELPARAM (0, 100)); - SendMessage (ins_iprogress, PBM_SETRANGE, 0, MAKELPARAM (0, 100)); - SendMessage (ins_diskfull, PBM_SETRANGE, 0, MAKELPARAM (0, 100)); - } - - SetWindowText (ins_pkgname, ""); - SetWindowText (ins_filename, ""); - SendMessage (ins_pprogress, PBM_SETPOS, (WPARAM) 0, 0); - SendMessage (ins_iprogress, PBM_SETPOS, (WPARAM) 0, 0); - SendMessage (ins_diskfull, PBM_SETPOS, (WPARAM) 0, 0); - ShowWindow (ins_dialog, SW_SHOWNORMAL); - SetForegroundWindow (ins_dialog); -} - -static void -progress (int bytes) -{ - int perc; - - if (package_bytes > 100) - { - perc = bytes / (package_bytes / 100); - SendMessage (ins_pprogress, PBM_SETPOS, (WPARAM) perc, 0); - } - - if (total_bytes > 100) - { - perc = (total_bytes_sofar + bytes) / (total_bytes / 100); - SendMessage (ins_iprogress, PBM_SETPOS, (WPARAM) perc, 0); - } -} - -static void -badrename (char *o, char *n) -{ - char *err = strerror (errno); - if (!err) - err = "(unknown error)"; - note (IDS_ERR_RENAME, o, n, err); -} - -static char *standard_dirs[] = { - 0 -}; - -void -hash::add_subdirs (char *path) -{ - char *nonp, *pp; - for (nonp = path; *nonp == '\\' || *nonp == '/'; nonp++); - for (pp = path + strlen(path) - 1; pp>nonp; pp--) - if (*pp == '/' || *pp == '\\') - { - int i, s=0; - char c = *pp; - *pp = 0; - for (i=0; standard_dirs[i]; i++) - if (strcmp (standard_dirs[i]+1, path) == 0) - { - s = 1; - break; - } - if (s == 0) - add (path); - *pp = c; - } -} - -char * -map_filename (char *fn, int type) -{ - char *dest_file; - while (*fn == '/' || *fn == '\\') - fn++; - if (type == TY_GENERIC) - dest_file = concat (root_dir, XEMACS_PACKAGE_DIR, fn, 0); - else // TY_CYGWIN | TY_NATIVE - dest_file = concat (root_dir, "/", fn, 0); - return dest_file; -} - -static int -exists (char *file) -{ - if (_access (file, 0) == 0) - return 1; - return 0; -} - - -static int num_installs, num_uninstalls; - -static void -uninstall_one (char *name, int action, int type) -{ - hash dirs; - char line[_MAX_PATH]; - char* fname = (type == TY_GENERIC ? - concat (root_dir, XEMACS_PACKAGE_DIR, "pkginfo/MANIFEST.", - name, 0) : - concat (root_dir, XEMACS_SETUP_DIR, "MANIFEST.", name, 0)); - - FILE* lst = fopen (fname, "rb"); - - if (lst) - { - SetWindowText (ins_pkgname, name); - SetWindowText (ins_action, "Uninstalling..."); - // remove shortcuts and registry entries - if (type != TY_GENERIC) - remove_xemacs_setup(); - - if (action == ACTION_UPGRADE) - log (0, "Uninstalling old %s", name); - else - log (0, "Uninstalling %s", name); - - while (fgets (line, sizeof (line), lst)) - { - if (line[strlen(line)-1] == '\n') - line[strlen(line)-1] = 0; - - dirs.add_subdirs (line); - - char *d = map_filename (line, type); - DWORD dw = GetFileAttributes (d); - if (dw != 0xffffffff && !(dw & FILE_ATTRIBUTE_DIRECTORY)) - { - log (LOG_BABBLE, "unlink %s", d); - DeleteFile (d); - } - } - fclose (lst); - - remove (fname); - - dirs.reverse_sort (); - char *subdir = 0; - while ((subdir = dirs.enumerate (subdir)) != 0) - { - char *d = map_filename (subdir, type); - if (RemoveDirectory (d)) - log (LOG_BABBLE, "rmdir %s", d); - } - num_uninstalls ++; - } -} - - -static int -install_one (char *name, char *file, int file_size, int action, int type) -{ - int errors = 0; - char *local = file, *cp, *fn, *base; - - base = local; - for (cp=local; *cp; cp++) - if (*cp == '/' || *cp == '\\' || *cp == ':') - base = cp+1; - - SetWindowText (ins_pkgname, base); - - if (!exists (local) && exists (base)) - local = base; - if (!exists (local)) - { - note (IDS_ERR_OPEN_READ, local, "No such file"); - return 1; - } - - char* fname = (type == TY_GENERIC ? - concat (root_dir, XEMACS_PACKAGE_DIR, "pkginfo/MANIFEST.", - name, 0) : - concat (root_dir, XEMACS_SETUP_DIR, "MANIFEST.", name, 0)); - - FILE* lst = fopen (fname, "wb"); - - package_bytes = file_size; - - switch (action) - { - case ACTION_NEW: - SetWindowText (ins_action, "Installing..."); - break; - case ACTION_UPGRADE: - SetWindowText (ins_action, "Upgrading..."); - break; - } - - log (0, "Installing %s", local); - tar_open (local); - while ((fn = tar_next_file ())) - { - char *dest_file, *disp_file; - int len; - - if (lst) - fprintf (lst, "%s\n", fn); - - dest_file = map_filename (fn, type); - - // The installer uses a variable width font. Assume roughly 32 chars - // will fit and munge the file accordingly. -#define MAX_DISP_SIZE 50 - disp_file = strdup(dest_file); - if ((len = strlen(dest_file)) > MAX_DISP_SIZE) { - disp_file += (len - MAX_DISP_SIZE); - disp_file[0] = '.'; - disp_file[1] = '.'; - disp_file[2] = '.'; - } -#undef MAX_DISP_SIZE - SetWindowText (ins_filename, disp_file); - - log (LOG_BABBLE, "Installing file %s", dest_file); - if (tar_read_file (dest_file) != 0) - { - log (0, "Unable to install file %s", dest_file); - errors ++; - } - - progress (tar_ftell ()); - num_installs ++; - } - tar_close (); - - total_bytes_sofar += file_size; - progress (0); - - int df = diskfull (root_dir); - SendMessage (ins_diskfull, PBM_SETPOS, (WPARAM) df, 0); - - if (lst) - fclose (lst); - - return errors; -} - -void -do_install (HINSTANCE h) -{ - int i; - int errors = 0; - - num_installs = 0, num_uninstalls = 0; - - next_dialog = IDD_DESKTOP; - - mkdir_p (1, root_dir); - - for (i=0; standard_dirs[i]; i++) - { - char *p = concat (root_dir, standard_dirs[i], 0); - mkdir_p (1, p); - free (p); - } - - dismiss_url_status_dialog (); - - init_dialog (); - - total_bytes = 0; - total_bytes_sofar = 0; - - int df = diskfull (root_dir); - SendMessage (ins_diskfull, PBM_SETPOS, (WPARAM) df, 0); - - LOOP_PACKAGES - { - total_bytes += pi.install_size; - } - - for (i=0; i - * based on work and suggestions of DJ Delorie - * - * Sync'ed with cinstall 2001-10-16 - */ - -/* The purpose of this file is to ask the user where they want the - root of the installation to be, and to ask whether the user prefers - text or binary mounts. */ - -#include "win32.h" -#include -#include -#include -#include -#include - -#include "mkdir.h" -#include "dialog.h" -#include "resource.h" -#include "state.h" -#include "msg.h" -#include "concat.h" -#include "log.h" - -static void -check_if_enable_next (HWND h) -{ - EnableWindow (GetDlgItem (h, IDOK), local_dir != 0); -} - -static void -load_dialog (HWND h) -{ - eset (h, IDC_LOCAL_DIR, local_dir); - check_if_enable_next (h); -} - -static void -save_dialog (HWND h) -{ - local_dir = eget (h, IDC_LOCAL_DIR, local_dir); -} - - -static int CALLBACK -browse_cb (HWND h, UINT m, LPARAM lp, LPARAM data) -{ - switch (m) - { - case BFFM_INITIALIZED: - if (local_dir) - SendMessage (h, BFFM_SETSELECTION, TRUE, (LPARAM)local_dir); - break; - } - return 0; -} - -static void -browse (HWND h) -{ - BROWSEINFO bi; - CHAR name[MAX_PATH]; - LPITEMIDLIST pidl; - memset (&bi, 0, sizeof (bi)); - bi.hwndOwner = h; - bi.pszDisplayName = name; - bi.lpszTitle = "Select download directory"; - bi.ulFlags = BIF_RETURNONLYFSDIRS; - bi.lpfn = browse_cb; - pidl = SHBrowseForFolder (&bi); - if (pidl) - { - if (SHGetPathFromIDList (pidl, name)) - eset (h, IDC_LOCAL_DIR, name); - } -} - - -static BOOL -dialog_cmd (HWND h, int id, HWND hwndctl, UINT code) -{ - switch (id) - { - - case IDC_LOCAL_DIR: - save_dialog (h); - check_if_enable_next (h); - break; - - case IDC_LOCAL_DIR_BROWSE: - browse (h); - break; - - case IDOK: - save_dialog (h); - if (_access (local_dir, 0) != 0 && yesno (IDS_CREATE_DIR, local_dir) == IDYES) - { - log (0, "Created install directory %s\n", local_dir); - mkdir_p (1, local_dir); - } - if (SetCurrentDirectoryA (local_dir)) - { - switch (source) - { - case IDC_SOURCE_DOWNLOAD: - NEXT (IDD_NET); - break; - case IDC_SOURCE_NETINST: - case IDC_SOURCE_CWD: - NEXT (IDD_ROOT); - break; - default: - NEXT (0); - break; - } - } - else - note (IDS_ERR_CHDIR, local_dir); - - break; - - case IDC_BACK: - save_dialog (h); - NEXT (IDD_SOURCE); - break; - - case IDCANCEL: - NEXT (0); - break; - } -} - -static BOOL CALLBACK -dialog_proc (HWND h, UINT message, WPARAM wParam, LPARAM lParam) -{ - switch (message) - { - case WM_INITDIALOG: - load_dialog (h); - return FALSE; - case WM_COMMAND: - return HANDLE_WM_COMMAND (h, wParam, lParam, dialog_cmd); - } - return FALSE; -} - -extern char cwd[_MAX_PATH]; - -void -do_local_dir (HINSTANCE h) -{ - int rv = 0; - rv = DialogBox (h, MAKEINTRESOURCE (IDD_LOCAL_DIR), 0, dialog_proc); - if (rv == -1) - fatal (IDS_DIALOG_FAILED); - - log (0, "Selected local directory: %s", local_dir); -} - diff -r 861f2601a38b -r 1f0b15040456 netinstall/log.cc --- a/netinstall/log.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,127 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The purpose of this file is to centralize all the logging functions. */ - -#include "win32.h" -#include -#include -#include -#include - -#include "resource.h" -#include "msg.h" -#include "log.h" -#include "dialog.h" -#include "state.h" -#include "concat.h" -#include "mkdir.h" - -struct LogEnt { - LogEnt *next; - int flags; - time_t when; - char msg[1]; -}; - -static LogEnt *first_logent = 0; -static LogEnt **next_logent = &first_logent; - -void -log (int flags, char *fmt, ...) -{ - char buf[1000]; - va_list args; - va_start (args, fmt); - vsprintf (buf, fmt, args); - - LogEnt *l = (LogEnt *) malloc (sizeof (LogEnt) + strlen (buf) + 20); - l->next = 0; - l->flags = flags; - time (&(l->when)); - *next_logent = l; - next_logent = &(l->next); - - char *b = l->msg; - if (flags & LOG_TIMESTAMP) - { - struct tm *tm = localtime (&(l->when)); - strftime (b, 1000, "%Y/%m/%d %H:%M:%S ", tm); - b += strlen (b); - } - - strcpy (b, buf); - msg ("LOG: %d %s", l->flags, l->msg); -} - -void -log_save (int babble, char *filename, int append) -{ - static int been_here = 0; - if (been_here) - return; - been_here = 1; - - mkdir_p (0, filename); - - FILE *f = fopen (filename, append ? "at" : "wt"); - if (!f) - { - fatal (IDS_NOLOGFILE, filename); - return; - } - - LogEnt *l; - - for (l=first_logent; l; l=l->next) - { - if (babble || !(l->flags & LOG_BABBLE)) - { - fputs (l->msg, f); - if (l->msg[strlen(l->msg)-1] != '\n') - fputc ('\n', f); - } - } - - fclose (f); - been_here = 0; -} - -void -exit_setup (int exit_code) -{ - static int been_here = 0; - if (been_here) - ExitProcess (1); - been_here = 1; - - if (exit_msg) - note (exit_msg); - - log (LOG_TIMESTAMP, "Ending XEmacs install"); - - if (source == IDC_SOURCE_DOWNLOAD || !root_dir) - { - log_save (LOG_BABBLE, "setup.log.full", 0); - log_save (0, "setup.log", 1); - } - else - { - log_save (LOG_BABBLE, concat (root_dir, "/setup.log.full", 0), 0); - log_save (0, concat (root_dir, "/setup.log", 0), 1); - } - - ExitProcess (exit_code); -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/log.h --- a/netinstall/log.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,32 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* This is for "printf"-like logging. Messages are stored in memory - until they're written out. "babble" means the message is just idle - babbling; it can be ignored for shorter logs. */ - -#define LOG_BABBLE 1 -#define LOG_TIMESTAMP 2 - -void log (int flags, char *fmt, ...); - -/* Here, "babble" means to write out the babble also. If "append" is - nonzero, the log is appended to any existing file. */ - -void log_save (int babble, char *filename, int append); - -/* This is the only legal way to exit. It writes out all the logs and things */ - -void exit_setup (int exit_code); diff -r 861f2601a38b -r 1f0b15040456 netinstall/main.cc --- a/netinstall/main.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,100 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* OK, here's how this works. Each of the steps needed for install - - dialogs, downloads, installs - are in their own files and have some - "do_*" function (prototype in dialog.h) and a resource id (IDD_* or - IDD_S_* in resource.h) for that step. Each step is responsible for - selecting the next step! See the NEXT macro in dialog.h. Note - that the IDD_S_* ids are fake; those are for steps that don't - really have a controlling dialog (some have progress dialogs, but - those don't count, although they could). Replace the IDD_S_* with - IDD_* if you create a real dialog for those steps. */ - -#include "win32.h" - -#include -#include -#include "resource.h" -#include "dialog.h" -#include "state.h" -#include "msg.h" -#include "netio.h" -#include "find.h" -#include "log.h" - -#include "port.h" - -void netio_test (char *); - -int next_dialog; -int exit_msg = 0; - -HINSTANCE hinstance; - -int WINAPI -WinMain (HINSTANCE h, - HINSTANCE hPrevInstance, - LPSTR command_line, - int cmd_show) -{ - hinstance = h; - int pos = -1; - if ((pos = strcspn(command_line, "-")) >= 0 - && - command_line[pos+1] == 'u') - { - next_dialog = IDD_UNINSTALL; - log (LOG_TIMESTAMP, "Starting XEmacs uninstall"); - uninstall = 1; - } - else - { - next_dialog = IDD_SPLASH; - log (LOG_TIMESTAMP, "Starting XEmacs install"); - } - - do_init(h); - - while (next_dialog) - { - switch (next_dialog) - { - case IDD_SPLASH: do_splash (h); break; - case IDD_UNINSTALL: do_uninstall (h); break; - case IDD_SOURCE: do_source (h); break; - case IDD_LOCAL_DIR: do_local_dir (h); break; - case IDD_ROOT: do_root (h); break; - case IDD_NET: do_net (h); break; - case IDD_SITE: do_site (h); break; - case IDD_OTHER_URL: do_other (h); break; - case IDD_S_LOAD_INI: do_ini (h); break; - case IDD_S_FROM_CWD: do_fromcwd (h); break; - case IDD_CHOOSE: do_choose (h); break; - case IDD_S_DOWNLOAD: do_download (h); break; - case IDD_S_INSTALL: do_install (h); break; - case IDD_DESKTOP: do_desktop (h); break; - case IDD_S_POSTINSTALL: do_postinstall (h); break; - - default: - next_dialog = 0; - break; - } - } - - exit_setup (0); - - return EXIT_SUCCESS; -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/mkdir.cc --- a/netinstall/mkdir.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,75 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* see mkdir.h */ - -#include "win32.h" -#include -#include "mkdir.h" - -int -mkdir_p (int isadir, char *path) -{ - char saved_char, *slash = 0; - char *c; - DWORD d, gse; - - d = GetFileAttributes (path); - if (d != 0xffffffff && d & FILE_ATTRIBUTE_DIRECTORY) - return 0; - - if (isadir) - { - if (CreateDirectory (path, 0)) - return 0; - gse = GetLastError (); - if (gse != ERROR_PATH_NOT_FOUND && gse != ERROR_FILE_NOT_FOUND) - { - if (gse == ERROR_ALREADY_EXISTS) - { - fprintf (stderr, "warning: deleting \"%s\" so I can make a directory there\n", - path); - if (DeleteFileA (path)) - return mkdir_p (isadir, path); - } - return 1; - } - } - - for (c=path; *c; c++) - { - if (*c == ':') - slash = 0; - if (*c == '/' || *c == '\\') - slash = c; - } - - if (!slash) - return 0; - - saved_char = *slash; - *slash = 0; - if (mkdir_p (1, path)) - { - *slash = saved_char; - return 1; - } - *slash = saved_char; - - if (!isadir) - return 0; - - return mkdir_p (isadir, path); -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/mkdir.h --- a/netinstall/mkdir.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,21 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* Create a directory, and any needed parent directories. If "isadir" - is non-zero, "path" is the name of a directory. If "isadir" is - zero, "path" is the name of a *file* that we need a directory - for. */ - -extern int mkdir_p (int isadir, char *path); diff -r 861f2601a38b -r 1f0b15040456 netinstall/mklink2.c --- a/netinstall/mklink2.c Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,27 +0,0 @@ -#include "win32.h" -#include "shlobj.h" - -/* This part of the code must be in C because the C++ interface to COM -doesn't work. */ - -void -make_link_2 (char *exepath, char *args, char *icon, char *lname) -{ - IShellLink *sl; - IPersistFile *pf; - WCHAR widepath [_MAX_PATH]; - - CoCreateInstance (&CLSID_ShellLink, NULL, - CLSCTX_INPROC_SERVER, &IID_IShellLink, (LPVOID *) & sl); - sl->lpVtbl->QueryInterface (sl, &IID_IPersistFile, (void **) &pf); - - sl->lpVtbl->SetPath (sl, exepath); - sl->lpVtbl->SetArguments (sl, args); - sl->lpVtbl->SetIconLocation (sl, icon, 0); - - MultiByteToWideChar (CP_ACP, 0, lname, -1, widepath, _MAX_PATH); - pf->lpVtbl->Save (pf, widepath, TRUE); - - pf->lpVtbl->Release (pf); - sl->lpVtbl->Release (sl); -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/msg.cc --- a/netinstall/msg.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,71 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The purpose of this file is to centralize all the message - functions. */ - -#include "win32.h" -#include -#include -#include "dialog.h" -#include "log.h" - -void -msg (char *fmt, ...) -{ - char buf[1000]; - va_list args; - va_start (args, fmt); - vsprintf (buf, fmt, args); - OutputDebugString (buf); -} - -static int -mbox (char *name, int type, int id, va_list args) -{ - char buf[1000], fmt[1000]; - - if (LoadString (hinstance, id, fmt, sizeof (fmt)) <= 0) - ExitProcess (0); - - vsprintf (buf, fmt, args); - log (0, "mbox %s: %s", name, buf); - return MessageBox (0, buf, "XEmacs Setup", type | MB_TOPMOST); -} - -void -note (int id, ...) -{ - va_list args; - va_start (args, id); - mbox ("note", 0, id, args); -} - -void -fatal (int id, ...) -{ - va_list args; - va_start (args, id); - mbox ("fatal", 0, id, args); - exit_setup (1); -} - -int -yesno (int id, ...) -{ - va_list args; - va_start (args, id); - return mbox ("yesno", MB_YESNO, id, args); -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/msg.h --- a/netinstall/msg.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,33 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* This is for "printf"-like debugging. Messages go to - OutputDebugString, which can be seen while debugging under GDB or - via a debug message monitor. */ - -void msg(char *fmt, ...); - -/* This pops up a dialog with text from the string table ("id"), which - is interpreted like printf. The program exits when the user - presses OK. */ - -void fatal (int id, ...); - -/* Similar, but the program continues when the user presses OK */ - -void note (int id, ...); - -/* returns IDYES or IDNO, otherwise same as note() */ -int yesno (int id, ...); diff -r 861f2601a38b -r 1f0b15040456 netinstall/net.cc --- a/netinstall/net.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,156 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - * Sync'ed with cinstall 2001-10-16 - */ - -/* The purpose of this file is to get the network configuration - information from the user. */ - -#include "win32.h" -#include -#include -#include "dialog.h" -#include "resource.h" -#include "state.h" -#include "msg.h" -#include "log.h" - -static int rb[] = { IDC_NET_IE5, IDC_NET_DIRECT, IDC_NET_PROXY, 0 }; - -static void -check_if_enable_next (HWND h) -{ - int e = 0, p = 0, pu = 0; - if (net_method == IDC_NET_IE5) - pu = 1; - if (net_method == IDC_NET_IE5 || net_method == IDC_NET_DIRECT) - e = 1; - else if (net_method == IDC_NET_PROXY) - { - p = pu = 1; - if (net_proxy_host && net_proxy_port) - e = 1; - } - EnableWindow (GetDlgItem (h, IDOK), e); - EnableWindow (GetDlgItem (h, IDC_PROXY_HOST), p); - EnableWindow (GetDlgItem (h, IDC_PROXY_PORT), p); -} - -static void -load_dialog (HWND h) -{ - rbset (h, rb, net_method); - eset (h, IDC_PROXY_HOST, net_proxy_host); - if (net_proxy_port == 0) - net_proxy_port = 80; - eset (h, IDC_PROXY_PORT, net_proxy_port); - check_if_enable_next (h); -} - -static void -save_dialog (HWND h) -{ - net_method = rbget (h, rb); - net_proxy_host = eget (h, IDC_PROXY_HOST, net_proxy_host); - net_proxy_port = eget (h, IDC_PROXY_PORT); -} - -static BOOL -dialog_cmd (HWND h, int id, HWND hwndctl, UINT code) -{ - switch (id) - { - - case IDC_NET_IE5: - case IDC_NET_DIRECT: - case IDC_NET_PROXY: - case IDC_PROXY_HOST: - case IDC_PROXY_PORT: - save_dialog (h); - check_if_enable_next (h); - break; - - case IDOK: - save_dialog (h); - switch (source) - { - case IDC_SOURCE_NETINST: - case IDC_SOURCE_DOWNLOAD: - NEXT (IDD_SITE); - break; - case IDC_SOURCE_CWD: - NEXT (0); - break; - default: - msg ("source is default? %d\n", source); - NEXT (0); - } - break; - - case IDC_BACK: - save_dialog (h); - switch (source) - { - case IDC_SOURCE_DOWNLOAD: - NEXT (IDD_LOCAL_DIR); - break; - case IDC_SOURCE_NETINST: - case IDC_SOURCE_CWD: - NEXT (IDD_ROOT); - break; - } - break; - - case IDCANCEL: - NEXT (0); - break; - } -} - -static BOOL CALLBACK -dialog_proc (HWND h, UINT message, WPARAM wParam, LPARAM lParam) -{ - switch (message) - { - case WM_INITDIALOG: - load_dialog (h); - - // Check to see if any radio buttons are selected. If not, select a default. - if ((!SendMessage(GetDlgItem (h, IDC_NET_IE5), BM_GETCHECK, 0, 0) == BST_CHECKED) - && (!SendMessage(GetDlgItem (h, IDC_NET_PROXY), BM_GETCHECK, 0, 0) == BST_CHECKED)) - { - SendMessage(GetDlgItem (h, IDC_NET_DIRECT), BM_CLICK, 0, 0); - } - return FALSE; - case WM_COMMAND: - return HANDLE_WM_COMMAND (h, wParam, lParam, dialog_cmd); - } - return FALSE; -} - -void -do_net (HINSTANCE h) -{ - int rv = 0; - - net_method = IDC_NET_DIRECT; - rv = DialogBox (h, MAKEINTRESOURCE (IDD_NET), 0, dialog_proc); - if (rv == -1) - fatal (IDS_DIALOG_FAILED); - - log (0, "net: %s", - (net_method == IDC_NET_IE5) ? "IE5" : - (net_method == IDC_NET_DIRECT) ? "Direct" : "Proxy"); -} - diff -r 861f2601a38b -r 1f0b15040456 netinstall/netio.cc --- a/netinstall/netio.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,240 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The purpose of this file is to coordinate the various access - methods known to setup. To add a new method, create a pair of - nio-*.[ch] files and add the logic to NetIO::open here */ - -#include "win32.h" -#include -#include -#include - -#include "resource.h" -#include "state.h" -#include "msg.h" -#include "netio.h" -#include "nio-file.h" -#include "nio-ie5.h" -#include "nio-http.h" -#include "nio-ftp.h" -#include "dialog.h" -#include "log.h" - -#include "port.h" - -NetIO::NetIO (char *Purl) -{ - set_url (Purl); -} - -NetIO::~NetIO () -{ - if (url) - free (url); - if (proto) - free (proto); - if (host) - free (host); - if (path) - free (path); -} - -void -NetIO::set_url (char *Purl) -{ - char *bp, *ep, c; - - file_size = 0; - url = _strdup (Purl); - proto = 0; - host = 0; - port = 0; - path = 0; - - bp = url; - ep = strstr (bp, "://"); - if (!ep) - { - path = url; - return; - } - - *ep = 0; - proto = _strdup (bp); - *ep = ':'; - bp = ep+3; - - ep = bp + strcspn (bp, ":/"); - c = *ep; - *ep = 0; - host = _strdup (bp); - *ep = c; - - if (*ep == ':') - { - port = atoi (ep+1); - ep = strchr (ep, '/'); - } - - if (*ep) - path = _strdup (ep); -} - -int -NetIO::ok () -{ - return 0; -} - -int -NetIO::read (char *buf, int nbytes) -{ - return 0; -} - -NetIO * -NetIO::open (char *url) -{ - NetIO *rv = 0; - enum {http, ftp, file} proto; - if (strncmp (url, "http://", 7) == 0) - proto = http; - else if (strncmp (url, "ftp://", 6) == 0) - proto = ftp; - else - proto = file; - - if (proto == file) - rv = new NetIO_File (url); - else if (net_method == IDC_NET_IE5) - rv = new NetIO_IE5 (url); - else if (net_method == IDC_NET_PROXY) - rv = new NetIO_HTTP (url); - else if (net_method == IDC_NET_DIRECT) - { - switch (proto) - { - case http: - rv = new NetIO_HTTP (url); - break; - case ftp: - rv = new NetIO_FTP (url); - break; - } - } - - if (!rv->ok ()) - { - delete rv; - return 0; - } - - return rv; -} - - -static char **user, **passwd; -static int loading = 0; - -static void -check_if_enable_ok (HWND h) -{ - int e = 0; - if (*user && *passwd) - e = 1; - EnableWindow (GetDlgItem (h, IDOK), e); -} - -static void -load_dialog (HWND h) -{ - loading = 1; - eset (h, IDC_NET_USER, *user); - eset (h, IDC_NET_PASSWD, *passwd); - check_if_enable_ok (h); - loading = 0; -} - -static void -save_dialog (HWND h) -{ - *user = eget (h, IDC_NET_USER, *user); - *passwd = eget (h, IDC_NET_PASSWD, *passwd); -} - -static BOOL -auth_cmd (HWND h, int id, HWND hwndctl, UINT code) -{ - switch (id) - { - - case IDC_NET_USER: - case IDC_NET_PASSWD: - if (code == EN_CHANGE && !loading) - { - save_dialog (h); - check_if_enable_ok (h); - } - break; - - case IDOK: - save_dialog (h); - EndDialog (h, 0); - break; - - case IDCANCEL: - EndDialog (h, 1); - exit_setup (1); - break; - } - return FALSE; -} - -static BOOL CALLBACK -auth_proc (HWND h, UINT message, WPARAM wParam, LPARAM lParam) -{ - switch (message) - { - case WM_INITDIALOG: - load_dialog (h); - return FALSE; - case WM_COMMAND: - return HANDLE_WM_COMMAND (h, wParam, lParam, auth_cmd); - } - return FALSE; -} - -static int -auth_common (HINSTANCE h, int id) -{ - return DialogBox (h, MAKEINTRESOURCE (id), 0, auth_proc); -} - -int -NetIO::get_auth () -{ - user = &net_user; - passwd = &net_passwd; - return auth_common (hinstance, IDD_NET_AUTH); -} - -int -NetIO::get_proxy_auth () -{ - user = &net_proxy_user; - passwd = &net_proxy_passwd; - return auth_common (hinstance, IDD_PROXY_AUTH); -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/netio.h --- a/netinstall/netio.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,53 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* This is the parent class for all the access methods known to setup - (i.e. ways to download files from the internet or other sources */ - -class NetIO { -protected: - NetIO (char *url); - void set_url (char *url); - -public: - /* if nonzero, this is the estimated total file size */ - int file_size; - /* broken down url FYI */ - char *url; - char *proto; - char *host; - int port; - char *path; - virtual ~NetIO (); - - /* The user calls this function to create a suitable accessor for - the given URL. It uses the network setup state in state.h. If - anything fails, either the return values is NULL or the returned - object is !ok() */ - static NetIO * open (char *url); - - /* If !ok() that means the transfer isn't happening. */ - virtual int ok (); - - /* Read `nbytes' bytes from the file. Returns zero when the file - is complete. */ - virtual int read (char *buf, int nbytes); - - /* Helper functions for http/ftp protocols. Both return nonzero for - "cancel", zero for "ok". They set net_proxy_user, etc, in - state.h */ - int get_auth (); - int get_proxy_auth (); -}; diff -r 861f2601a38b -r 1f0b15040456 netinstall/nio-file.cc --- a/netinstall/nio-file.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,64 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The purpose of this file is to manage access to files stored on the - local disk (i.e. "downloading" setup.ini). Called from netio.cc */ - -#include -#include -#include -#include -#include "win32.h" -#include "netio.h" -#include "nio-file.h" -#include "resource.h" -#include "msg.h" - -NetIO_File::NetIO_File (char *Purl) - : NetIO (Purl) -{ - struct stat s; - fd = fopen (path, "rb"); - if (fd) - { - stat (path, &s); - file_size = s.st_size; - } - else - { - char *err = strerror (errno); - if (!err) - err = "(unknown error)"; - note (IDS_ERR_OPEN_READ, path, err); - } -} - -NetIO_File::~NetIO_File () -{ - if (fd) - fclose ((FILE *)fd); -} - -int -NetIO_File::ok () -{ - return fd ? 1 : 0; -} - -int -NetIO_File::read (char *buf, int nbytes) -{ - return fread (buf, 1, nbytes, (FILE *)fd); -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/nio-file.h --- a/netinstall/nio-file.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,25 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* see nio-file.cc */ - -class NetIO_File : public NetIO { -public: - NetIO_File (char *url); - void *fd; - ~NetIO_File (); - virtual int ok (); - virtual int read (char *buf, int nbytes); -}; diff -r 861f2601a38b -r 1f0b15040456 netinstall/nio-ftp.cc --- a/netinstall/nio-ftp.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,141 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* This file is responsible for implementing all direct FTP protocol - channels. It is intentionally simplistic. */ - -#include "win32.h" -#include "winsock.h" -#include -#include -#include - -#include "resource.h" -#include "state.h" -#include "simpsock.h" -#include "log.h" - -#include "netio.h" -#include "nio-ftp.h" - -static SimpleSocket *cmd = 0; -static char *cmd_host = 0; -static int cmd_port = 0; - -static char *last_line; - -static int -ftp_line (SimpleSocket *s) -{ - do { - last_line = s->gets (); - log (LOG_BABBLE, "ftp > %s", last_line); - } while (last_line && (!isdigit (last_line[0]) || last_line[3] != ' ')); - return atoi (last_line ?: "0"); -} - -NetIO_FTP::NetIO_FTP (char *Purl) - : NetIO (Purl) -{ - s = 0; - int code; - - if (port == 0) - port = 21; - - if (cmd_host && strcmp (host, cmd_host) != 0 || port != cmd_port) - { - if (cmd) - cmd->printf ("QUIT\r\n"); - delete cmd; - free (cmd_host); - cmd = 0; - cmd_host = 0; - } - - if (cmd == 0) - { - SimpleSocket *c = new SimpleSocket (host, port); - code = ftp_line (c); - c->printf ("USER anonymous\r\n"); - code = ftp_line (c); - if (code == 331) - { - c->printf ("PASS xemacs-setup@\r\n"); - code = ftp_line (c); - } - - if (code < 200 || code >= 300) - { - delete c; - return; - } - - cmd = c; - cmd_host = _strdup (host); - cmd_port = port; - - cmd->printf ("TYPE I\r\n"); - code = ftp_line (cmd); - } - - cmd->printf ("PASV\r\n"); - do { - code = ftp_line (cmd); - } while (code == 226); /* previous RETR */ - if (code != 227) - return; - - char *paren = strchr (last_line, '('); - if (!paren) - return; - - int i1, i2, i3, i4, p1, p2; - sscanf (paren+1, "%d,%d,%d,%d,%d,%d", &i1, &i2, &i3, &i4, &p1, &p2); - char tmp[20]; - sprintf (tmp, "%d.%d.%d.%d", i1, i2, i3, i4); - s = new SimpleSocket (tmp, p1*256 + p2); - - cmd->printf ("RETR %s\r\n", path); - code = ftp_line (cmd); - if (code != 150) - { - delete s; - s = 0; - return; - } -} - -NetIO_FTP::~NetIO_FTP () -{ - if (s) - delete s; -} - -int -NetIO_FTP::ok () -{ - if (s) - return 1; - return 0; -} - -int -NetIO_FTP::read (char *buf, int nbytes) -{ - if (!s) - return 0; - return s->read (buf, nbytes); -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/nio-ftp.h --- a/netinstall/nio-ftp.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,33 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* Direct FTP (without proxy) */ - -class SimpleSocket; - -class NetIO_FTP : public NetIO { - SimpleSocket *s; - -public: - NetIO_FTP (char *url); - virtual ~NetIO_FTP (); - - /* If !ok() that means the transfer isn't happening. */ - virtual int ok (); - - /* Read `nbytes' bytes from the file. Returns zero when the file - is complete. */ - virtual int read (char *buf, int nbytes); -}; diff -r 861f2601a38b -r 1f0b15040456 netinstall/nio-http.cc --- a/netinstall/nio-http.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,179 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* This file is responsible for implementing all direct HTTP protocol - channels. It is intentionally simplistic. */ - -#include "win32.h" -#include "winsock.h" -#include -#include - -#include "resource.h" -#include "state.h" -#include "simpsock.h" -#include "msg.h" - -#include "netio.h" -#include "nio-http.h" - -static char six2pr[64] = { - 'A','B','C','D','E','F','G','H','I','J','K','L','M', - 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', - 'a','b','c','d','e','f','g','h','i','j','k','l','m', - 'n','o','p','q','r','s','t','u','v','w','x','y','z', - '0','1','2','3','4','5','6','7','8','9','+','/' -}; - -static char * -base64_encode (char *username, char *password) -{ - unsigned char *ep; - char *rp; - static char *rv = 0; - if (rv) - free (rv); - rv = (char *) malloc (2 * (strlen (username) + strlen (password)) + 5); - - char *up = (char *) malloc (strlen (username) + strlen (password) + 6); - strcpy (up, username); - strcat (up, ":"); - strcat (up, password); - ep = (unsigned char *)up + strlen (up); - *ep++ = 0; - *ep++ = 0; - *ep++ = 0; - - char block[4]; - - rp = rv; - - for (ep = (unsigned char *)up; *ep; ep += 3) - { - block[0] = six2pr[ep[0] >> 2]; - block[1] = six2pr[((ep[0] << 4) & 0x30) | ((ep[1] >> 4) & 0x0f)]; - block[2] = six2pr[((ep[1] << 2) & 0x3c) | ((ep[2] >> 6) & 0x03)]; - block[3] = six2pr[ep[2] & 0x3f]; - - if (ep[1] == 0) - block[2] = block[3] = '='; - if (ep[2] == 0) - block[3] = '='; - memcpy (rp, block, 4); - rp += 4; - } - *rp = 0; - - free (up); - - return rv; -} - -NetIO_HTTP::NetIO_HTTP (char *Purl) - : NetIO (Purl) -{ - retry_get: - if (port == 0) - port = 80; - - if (net_method == IDC_NET_PROXY) - s = new SimpleSocket (net_proxy_host, net_proxy_port); - else - s = new SimpleSocket (host, port); - - if (!s->ok()) - { - s = 0; - return; - } - - if (net_method == IDC_NET_PROXY) - s->printf ("GET %s HTTP/1.0\r\n", url); - else - s->printf ("GET %s HTTP/1.0\r\n", path); - s->printf ("Host: %s:%d\r\n", host, port); - - if (net_user && net_passwd) - s->printf ("Authorization: Basic %s\r\n", - base64_encode (net_user, net_passwd)); - - if (net_proxy_user && net_proxy_passwd) - s->printf ("Proxy-Authorization: Basic %s\r\n", - base64_encode (net_proxy_user, net_proxy_passwd)); - - s->printf ("\r\n"); - - char *l = s->gets (); - int code; - sscanf (l, "%*s %d", &code); - if (code >= 300 && code < 400) - { - do { - l = s->gets (); - if (_strnicmp (l, "Location:", 9) == 0) - { - char *u = l + 9; - while (*u == ' ' || *u == '\t') - u++; - set_url (u); - delete s; - goto retry_get; - } - } while (*l); - } - if (code == 401) /* authorization required */ - { - get_auth (); - delete s; - goto retry_get; - } - if (code == 407) /* proxy authorization required */ - { - get_proxy_auth (); - delete s; - goto retry_get; - } - if (code >= 300) - { - delete s; - s = 0; - return; - } - do { - l = s->gets (); - if (_strnicmp (l, "Content-Length:", 15) == 0) - sscanf (l, "%*s %d", &file_size); - } while (*l); -} - -NetIO_HTTP::~NetIO_HTTP () -{ - if (s) - delete s; -} - -int -NetIO_HTTP::ok () -{ - if (s) - return 1; - return 0; -} - -int -NetIO_HTTP::read (char *buf, int nbytes) -{ - return s->read (buf, nbytes); -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/nio-http.h --- a/netinstall/nio-http.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,33 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* Direct HTTP (with or without proxy) */ - -class SimpleSocket; - -class NetIO_HTTP : public NetIO { - SimpleSocket *s; - -public: - NetIO_HTTP (char *url); - virtual ~NetIO_HTTP (); - - /* If !ok() that means the transfer isn't happening. */ - virtual int ok (); - - /* Read `nbytes' bytes from the file. Returns zero when the file - is complete. */ - virtual int read (char *buf, int nbytes); -}; diff -r 861f2601a38b -r 1f0b15040456 netinstall/nio-ie5.cc --- a/netinstall/nio-ie5.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,160 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The purpose of this file is to manage internet downloads using the - Internet Explorer version 5 DLLs. To use this method, the user - must already have installed and configured IE5. This module is - called from netio.cc, which is called from geturl.cc */ - -#include "win32.h" - -#include "resource.h" -#include "state.h" -#include "dialog.h" -#include "msg.h" -#include "netio.h" -#include "nio-ie5.h" - -static HINTERNET internet = 0; - -NetIO_IE5::NetIO_IE5 (char *_url) - : NetIO (_url) -{ - int resend = 0; - - if (internet == 0) - { - HINSTANCE h = LoadLibrary ("wininet.dll"); - if (!h) - { - note (IDS_WININET); - connection = 0; - return; - } - InternetAttemptConnect (0); - internet = InternetOpen ("Cygwin Setup", INTERNET_OPEN_TYPE_PRECONFIG, - NULL, NULL, 0); - } - - DWORD flags = - INTERNET_FLAG_DONT_CACHE | - INTERNET_FLAG_KEEP_CONNECTION | - INTERNET_FLAG_PRAGMA_NOCACHE | - INTERNET_FLAG_RELOAD | - INTERNET_FLAG_EXISTING_CONNECT | - INTERNET_FLAG_PASSIVE; - - connection = InternetOpenUrl (internet, url, NULL, 0, flags, 0); - - try_again: - - if (net_user && net_passwd) - { - InternetSetOption (connection, INTERNET_OPTION_USERNAME, - net_user, strlen (net_user)); - InternetSetOption (connection, INTERNET_OPTION_PASSWORD, - net_passwd, strlen (net_passwd)); - } - - if (net_proxy_user && net_proxy_passwd) - { - InternetSetOption (connection, INTERNET_OPTION_PROXY_USERNAME, - net_proxy_user, strlen (net_proxy_user)); - InternetSetOption (connection, INTERNET_OPTION_PROXY_PASSWORD, - net_proxy_passwd, strlen (net_proxy_passwd)); - } - - if (resend) - if (!HttpSendRequest (connection, 0, 0, 0, 0)) - connection = 0; - - if (!connection) - { - if (GetLastError () == ERROR_INTERNET_EXTENDED_ERROR) - { - char buf[2000]; - DWORD e, l=sizeof (buf); - InternetGetLastResponseInfo (&e, buf, &l); - MessageBox (0, buf, "Internet Error", 0); - } - } - - DWORD type, type_s; - type_s = sizeof (type); - InternetQueryOption (connection, INTERNET_OPTION_HANDLE_TYPE, - &type, &type_s); - - switch (type) - { - case INTERNET_HANDLE_TYPE_HTTP_REQUEST: - case INTERNET_HANDLE_TYPE_CONNECT_HTTP: - type_s = sizeof (DWORD); - if (HttpQueryInfo (connection, - HTTP_QUERY_STATUS_CODE | HTTP_QUERY_FLAG_NUMBER, - &type, &type_s, NULL)) - { - if (type == 401) /* authorization required */ - { - flush_io(); - get_auth (); - resend = 1; - goto try_again; - } - else if (type == 407) /* proxy authorization required */ - { - flush_io(); - get_proxy_auth (); - resend = 1; - goto try_again; - } - else if (type >= 300) - { - connection = 0; - return; - } - } - } -} - -void -NetIO_IE5::flush_io () -{ - DWORD actual = 0; - char buf[1024]; - do { - InternetReadFile (connection, buf, 1024, &actual); - } while (actual > 0); -} - -NetIO_IE5::~NetIO_IE5 () -{ - if (connection) - InternetCloseHandle (connection); -} - -int -NetIO_IE5::ok () -{ - return (connection == NULL) ? 0 : 1; -} - -int -NetIO_IE5::read (char *buf, int nbytes) -{ - DWORD actual; - if (InternetReadFile (connection, buf, nbytes, &actual)) - return actual; - return -1; -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/nio-ie5.h --- a/netinstall/nio-ie5.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,26 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* see nio-ie5.cc */ - -class NetIO_IE5 : public NetIO { - HINTERNET connection; -public: - NetIO_IE5 (char *url); - ~NetIO_IE5 (); - virtual int ok (); - virtual int read (char *buf, int nbytes); - void flush_io(); -}; diff -r 861f2601a38b -r 1f0b15040456 netinstall/other.cc --- a/netinstall/other.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,104 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* This handles the "other URL" option from the mirror site - selection. */ - -#include "win32.h" -#include -#include -#include -#include "dialog.h" -#include "resource.h" -#include "state.h" -#include "msg.h" -#include "log.h" - -/* private shared function, from site.cc */ -void save_site_url (void); - -static void -check_if_enable_next (HWND h) -{ - EnableWindow (GetDlgItem (h, IDOK), other_url ? 1 : 0); -} - -static void -load_dialog (HWND h) -{ - eset (h, IDC_OTHER_URL, other_url); - check_if_enable_next (h); -} - -static void -save_dialog (HWND h) -{ - other_url = eget (h, IDC_OTHER_URL, other_url); -} - -static BOOL -dialog_cmd (HWND h, int id, HWND hwndctl, UINT code) -{ - switch (id) - { - - case IDC_OTHER_URL: - save_dialog (h); - check_if_enable_next (h); - break; - - case IDOK: - save_dialog (h); - save_site_url (); - NEXT (IDD_S_LOAD_INI); - break; - - case IDC_BACK: - save_dialog (h); - NEXT (IDD_SITE); - break; - - case IDCANCEL: - NEXT (0); - break; - } - return FALSE; -} - -static BOOL CALLBACK -dialog_proc (HWND h, UINT message, WPARAM wParam, LPARAM lParam) -{ - switch (message) - { - case WM_INITDIALOG: - load_dialog (h); - return FALSE; - case WM_COMMAND: - return HANDLE_WM_COMMAND (h, wParam, lParam, dialog_cmd); - } - return FALSE; -} - -void -do_other (HINSTANCE h) -{ - int rv = 0; - rv = DialogBox (h, MAKEINTRESOURCE (IDD_OTHER_URL), 0, dialog_proc); - if (rv == -1) - fatal (IDS_DIALOG_FAILED); - - log (0, "site: %s", other_url); -} - diff -r 861f2601a38b -r 1f0b15040456 netinstall/port.h --- a/netinstall/port.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,28 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* I prefer building a cygwin version of setup for debugging, as I - find that gdb can debug those programs (and the exceptions they - cause) better. This file handles the slight differences between - cygwin and mingw. */ - -#if defined(__CYGWIN__) || defined (__CYGWIN32__) - -#define _MAX_PATH MAX_PATH - -#define _access access -#define _strdup strdup - -#endif diff -r 861f2601a38b -r 1f0b15040456 netinstall/postinstall.cc --- a/netinstall/postinstall.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,149 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The purpose of this file is to run all the post-install scripts - in their various forms. */ - -#include "win32.h" - -#include -#include -#include -#ifndef WIN32_NATIVE -#include -#endif - -#include "state.h" -#include "dialog.h" -#include "find.h" -#include "concat.h" -#include "regedit.h" -#include "reginfo.h" -#include "resource.h" -#include "port.h" - -static char *sh = 0; -static char *cmd = 0; -static OSVERSIONINFO verinfo; - -static void -run (char *shscript, char *args, char *file) -{ - BOOL b; - char cmdline [_MAX_PATH]; - STARTUPINFO si; - PROCESS_INFORMATION pi; - - sprintf (cmdline, "%s %s %s", shscript, args, file); - memset (&pi, 0, sizeof (pi)); - memset (&si, 0, sizeof (si)); - si.cb = sizeof (si); - si.lpTitle = "XEmacs Setup Post-Install Script"; - si.dwFlags = STARTF_USEPOSITION; - - b = CreateProcess (0, cmdline, 0, 0, 0, - CREATE_NEW_CONSOLE, 0, root_dir, &si, &pi); - - if (b) - WaitForSingleObject (pi.hProcess, INFINITE); -} - -static void -each (char *fname, unsigned int size) -{ - char *ext = strrchr (fname, '.'); - if (!ext) - return; - - if (sh && strcmp (ext, ".sh") == 0) - { - char *f2 = concat (root_dir, XEMACS_SETUP_DIR, "postinstall/", fname, 0); - run (sh, "-c", f2); - free (f2); - } - else if (cmd && strcmp (ext, ".bat") == 0) - { - char *f2 = backslash (concat (root_dir, XEMACS_SETUP_DIR, "postinstall/", - fname, 0)); - run (cmd, "/c", f2); - free (f2); - } - else - return; - - rename (concat (root_dir, XEMACS_SETUP_DIR, "postinstall/", fname, 0), - concat (root_dir, XEMACS_SETUP_DIR, "postinstall/", fname, ".done", 0)); -} - -static char *shells [] = { - "/bin/sh.exe", - "/usr/bin/sh.exe", - "/bin/bash.exe", - "/usr/bin/bash.exe", - 0 -}; - -void -do_postinstall (HINSTANCE h) -{ - int issystem; - next_dialog = 0; - char* cygroot = find_cygwin_root (&issystem); - int i; - - sh = 0; - - if (cygroot) - { - for (i=0; shells[i]; i++) - { - sh = backslash (concat (cygroot, shells[i], 0)); - if (_access (sh, 0) == 0) - break; - free (sh); - sh = 0; - } - } - - char old_path[_MAX_PATH]; - GetEnvironmentVariable ("PATH", old_path, sizeof (old_path)); -#if 0 - SetEnvironmentVariable ("PATH", - backslash (concat (root_dir, "/bin;", - root_dir, "/usr/bin;", - old_path, 0))); - - SetEnvironmentVariable ("CYGWINROOT", root_dir); -#endif - SetCurrentDirectory (root_dir); - - verinfo.dwOSVersionInfoSize = sizeof (verinfo); - GetVersionEx (&verinfo); - - switch (verinfo.dwPlatformId) - { - case VER_PLATFORM_WIN32_NT: - cmd = "cmd.exe"; - break; - case VER_PLATFORM_WIN32_WINDOWS: - cmd = "command.com"; - break; - default: - cmd = "command.com"; - break; - } - - find (concat (root_dir, XEMACS_SETUP_DIR, "postinstall", 0), each); -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/regedit.cc --- a/netinstall/regedit.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,359 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* Manipulate the registry for XEmacs. */ - -#include "win32.h" - -#include -#if defined(CYGWIN) || defined(MINGW) -#include -#include -#endif - -#include "reginfo.h" -#include "regedit.h" -#include "msg.h" -#include "resource.h" -#include "dialog.h" - -static char * -find_cygwin_mount (HKEY rkey, int *istext) -{ - char buf[1000]; - char *retval = 0; - HKEY key; - DWORD retvallen = 0; - DWORD flags = 0; - DWORD type; - -#if defined(CYGWIN) || defined(MINGW) - sprintf (buf, "Software\\%s\\%s\\%s\\/", - CYGWIN_INFO_CYGNUS_REGISTRY_NAME, - CYGWIN_INFO_CYGWIN_REGISTRY_NAME, - CYGWIN_INFO_CYGWIN_MOUNT_REGISTRY_NAME); - - if (RegOpenKeyEx (rkey, buf, 0, KEY_READ, &key) != ERROR_SUCCESS) - return 0; - - if (RegQueryValueEx (key, "native", 0, &type, 0, &retvallen) - == ERROR_SUCCESS) - { - retval = new char[retvallen+1]; - if (RegQueryValueEx (key, "native", 0, &type, (BYTE *)retval, &retvallen) - != ERROR_SUCCESS) - { - delete retval; - retval = 0; - } - } - - retvallen = sizeof (flags); - RegQueryValueEx (key, "flags", 0, &type, (BYTE *)&flags, &retvallen); - - RegCloseKey (key); - - if (retval) - *istext = (flags & MOUNT_BINARY) ? 0 : 1; - return retval; -#else - return 0; -#endif -} - -static char * -find_xemacs_root (HKEY rkey, int* isnative) -{ - char buf[1000]; - char *retval = 0; - HKEY key; - DWORD retvallen = 0; - DWORD type; - DWORD itype; - - sprintf (buf, "Software\\%s\\%s", - XEMACS_INFO_XEMACS_ORG_REGISTRY_NAME, - XEMACS_INFO_XEMACS_REGISTRY_NAME); - - if (RegOpenKeyEx (rkey, buf, 0, KEY_READ, &key) != ERROR_SUCCESS) - return 0; - - if (RegQueryValueEx (key, XEMACS_INFO_XEMACS_ROOT_KEY, - 0, &type, 0, &retvallen) == ERROR_SUCCESS) - { - retval = new char[retvallen+1]; - if (RegQueryValueEx (key, XEMACS_INFO_XEMACS_ROOT_KEY, - 0, &type, (BYTE *)retval, &retvallen) - != ERROR_SUCCESS) - { - delete retval; - retval = 0; - } - } - - retvallen = sizeof (itype); - RegQueryValueEx (key, XEMACS_INFO_XEMACS_ROOT_TYPE, - 0, &type, (BYTE *)&itype, &retvallen); - - if (itype == 1) - *isnative = 1; - else - *isnative = 0; - - RegCloseKey (key); - - return retval; -} - -char * -find_root_location (int *issystem, int *isnative) -{ - char *rv; - if ((rv = find_xemacs_root (HKEY_CURRENT_USER, isnative))) - { - *issystem = 0; - return rv; - } - else if ((rv = find_xemacs_root (HKEY_LOCAL_MACHINE, isnative))) - { - *issystem = 1; - return rv; - } - return 0; -} - -char * -find_cygwin_root (int *issystem) -{ - char *rv; - int istext; - if ((rv = find_cygwin_mount (HKEY_CURRENT_USER, &istext))) - { - *issystem = 0; - return rv; - } - else if ((rv = find_cygwin_mount (HKEY_LOCAL_MACHINE, &istext))) - { - *issystem = 1; - return rv; - } - return 0; -} - -void -create_xemacs_root (char *path, int issystem, int isnative) -{ - char buf[1000]; - HKEY key; - DWORD disposition; - DWORD itype = isnative ? 1 : 0; - - remove_xemacs_root (); - - sprintf (buf, "Software\\%s\\%s", - XEMACS_INFO_XEMACS_ORG_REGISTRY_NAME, - XEMACS_INFO_XEMACS_REGISTRY_NAME); - - HKEY kr = issystem ? HKEY_LOCAL_MACHINE : HKEY_CURRENT_USER; - if (RegCreateKeyEx (kr, buf, 0, "XEmacs", 0, KEY_ALL_ACCESS, - 0, &key, &disposition) != ERROR_SUCCESS) - fatal ("create_xemacs_root"); - - RegSetValueEx (key, XEMACS_INFO_XEMACS_ROOT_KEY, - 0, REG_SZ, (BYTE *)path, strlen (path)+1); - RegSetValueEx (key, XEMACS_INFO_XEMACS_ROOT_TYPE, - 0, REG_DWORD, (BYTE *)&itype, sizeof (itype)); - // write out the package path - sprintf (buf, "~\\.xemacs;%s\\site-packages;%s\\xemacs-packages", - path, path); - RegSetValueEx (key, XEMACS_INFO_XEMACS_PACKAGE_KEY, - 0, REG_SZ, (BYTE *)buf, strlen (buf)+1); - RegCloseKey (key); -} - -void -set_app_path (char *exe, char* path, int issystem) -{ - char buf[1000]; - HKEY key; - DWORD disposition; - - sprintf (buf, "SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\App Paths\\%s", - exe); - - HKEY kr = issystem ? HKEY_LOCAL_MACHINE : HKEY_CURRENT_USER; - RegDeleteKey (kr, buf); - - if (RegCreateKeyEx (kr, buf, 0, "XEmacs", 0, KEY_ALL_ACCESS, - 0, &key, &disposition) != ERROR_SUCCESS) - fatal ("set_app_path"); - - RegSetValueEx (key, "Path", - 0, REG_SZ, (BYTE *)path, strlen (path)+1); - RegCloseKey (key); -} - -void -set_install_path (char* path, int issystem) -{ - char buf[1000]; - HKEY key; - DWORD disposition; - - sprintf (buf, "SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\XEmacs"); - - HKEY kr = issystem ? HKEY_LOCAL_MACHINE : HKEY_CURRENT_USER; - RegDeleteKey (kr, buf); - - if (RegCreateKeyEx (kr, buf, 0, "XEmacs", 0, KEY_ALL_ACCESS, - 0, &key, &disposition) != ERROR_SUCCESS) - fatal ("set_install_path"); - - RegSetValueEx (key, "DisplayName", - 0, REG_SZ, (BYTE *)"XEmacs", strlen ("XEmacs")+1); - - sprintf (buf, "%s\\setup.exe -u", path); - RegSetValueEx (key, "UninstallString", - 0, REG_SZ, (BYTE *)buf, strlen (buf)+1); - RegCloseKey (key); -} - -void -setup_explorer (char* file_type, char* name, char *exe) -{ - char buf[1000]; - char ftype[32]; - HKEY key; - DWORD disposition; - - sprintf (buf, ".%s", file_type); - RegDeleteKey (HKEY_CLASSES_ROOT, buf); - - if (RegCreateKeyEx (HKEY_CLASSES_ROOT, buf, 0, "XEmacs", 0, KEY_ALL_ACCESS, - 0, &key, &disposition) != ERROR_SUCCESS) - fatal ("setup_explorer"); - - // set default key - sprintf (ftype, "%sfile", file_type); - RegSetValueEx (key, NULL, - 0, REG_SZ, (BYTE *)ftype, strlen (ftype)+1); - RegCloseKey (key); - - // create file type entry - RegDeleteKey (HKEY_CLASSES_ROOT, ftype); - if (RegCreateKeyEx (HKEY_CLASSES_ROOT, ftype, 0, "XEmacs", - 0, KEY_ALL_ACCESS, - 0, &key, &disposition) != ERROR_SUCCESS) - fatal ("setup_explorer"); - RegSetValueEx (key, NULL, - 0, REG_SZ, (BYTE *)name, strlen (name)+1); - RegSetValueEx (key, "AlwaysShowExt", - 0, REG_SZ, (BYTE *)"", strlen ("")+1); - RegCloseKey (key); - - // make xemacs file the default icon - sprintf(buf, "%s\\DefaultIcon", ftype); - if (RegCreateKeyEx (HKEY_CLASSES_ROOT, buf, 0, "XEmacs", 0, KEY_ALL_ACCESS, - 0, &key, &disposition) != ERROR_SUCCESS) - fatal ("setup_explorer"); - - sprintf(buf, "%s,1", exe); - RegSetValueEx (key, NULL, - 0, REG_SZ, (BYTE *)buf, strlen (buf)+1); - RegCloseKey (key); - - // command default key (exe) - sprintf(buf, "%s\\shell\\Open\\command", ftype); - if (RegCreateKeyEx (HKEY_CLASSES_ROOT, buf, 0, "XEmacs", 0, KEY_ALL_ACCESS, - 0, &key, &disposition) != ERROR_SUCCESS) - fatal ("setup_explorer"); - - sprintf(buf, "\"%s\"", exe); // Don't need %1 because dde will open the file - RegSetValueEx (key, NULL, - 0, REG_SZ, (BYTE *)buf, strlen (buf)+1); - RegCloseKey (key); - - // ddeexec - sprintf(buf, "%s\\shell\\Open\\ddeexec", ftype); - if (RegCreateKeyEx (HKEY_CLASSES_ROOT, buf, 0, "XEmacs", 0, KEY_ALL_ACCESS, - 0, &key, &disposition) != ERROR_SUCCESS) - fatal ("setup_explorer"); - -#define DDE_OPEN "Open(\"%1\")" - RegSetValueEx (key, NULL, - 0, REG_SZ, (BYTE *)DDE_OPEN, strlen (DDE_OPEN)+1); - RegCloseKey (key); - - // ddeexec application - sprintf(buf, "%s\\shell\\Open\\ddeexec\\application", ftype); - if (RegCreateKeyEx (HKEY_CLASSES_ROOT, buf, 0, "XEmacs", 0, KEY_ALL_ACCESS, - 0, &key, &disposition) != ERROR_SUCCESS) - fatal ("setup_explorer"); - RegSetValueEx (key, NULL, - 0, REG_SZ, (BYTE *)"XEmacs", strlen ("XEmacs")+1); - RegCloseKey (key); - - // ddeexec topic - sprintf(buf, "%s\\shell\\Open\\ddeexec\\topic", ftype); - if (RegCreateKeyEx (HKEY_CLASSES_ROOT, buf, 0, "XEmacs", 0, KEY_ALL_ACCESS, - 0, &key, &disposition) != ERROR_SUCCESS) - fatal ("setup_explorer"); - RegSetValueEx (key, NULL, - 0, REG_SZ, (BYTE *)"system", strlen ("system")+1); - RegCloseKey (key); -} - -static void -remove1 (HKEY rkey) -{ - char buf[1000]; - - sprintf (buf, "Software\\%s\\%s", - XEMACS_INFO_XEMACS_ORG_REGISTRY_NAME, - XEMACS_INFO_XEMACS_REGISTRY_NAME); - RegDeleteKey (rkey, buf); - - sprintf (buf, "Software\\%s", - XEMACS_INFO_XEMACS_ORG_REGISTRY_NAME); - RegDeleteKey (rkey, buf); -} - -void -remove_xemacs_root () -{ - remove1 (HKEY_LOCAL_MACHINE); - remove1 (HKEY_CURRENT_USER); -} - -void -remove_app_path (char *exe) -{ - char buf[1000]; - sprintf (buf, "SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\App Paths\\%s", - exe); - - RegDeleteKey (HKEY_LOCAL_MACHINE, buf); - RegDeleteKey (HKEY_CURRENT_USER, buf); -} - -void -remove_uninstall_path () -{ - char buf[1000]; - sprintf (buf, "SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\XEmacs"); - - RegDeleteKey (HKEY_LOCAL_MACHINE, buf); - RegDeleteKey (HKEY_CURRENT_USER, buf); -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/regedit.h --- a/netinstall/regedit.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,30 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* Finds the existing root point, or returns NULL. */ - -char * find_root_location (int *issystem, int *isnative); -char * find_cygwin_root (int *issystem); - -/* Similar to the mount and umount functions, but simplified */ - -void create_xemacs_root (char *posix, int issystem, int isnative); -void remove_xemacs_root (); -void set_app_path (char *exe, char* path, int issystem); -void set_install_path (char* path, int issystem); -void setup_explorer (char* file_type, char* name, char *exe); -void remove_app_path (char *exe); -void remove_uninstall_path (); - diff -r 861f2601a38b -r 1f0b15040456 netinstall/reginfo.h --- a/netinstall/reginfo.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,59 +0,0 @@ -/* reginfo.h -- XEmacs version numbers and accompanying documentation. - -Copyright (C) 2000 Andy Piper. */ - -#define XEMACS_INFO_XEMACS_ORG_REGISTRY_NAME "XEmacs" -#define XEMACS_INFO_XEMACS_REGISTRY_NAME "XEmacs" -/* Keys */ -#define XEMACS_INFO_XEMACS_ROOT_KEY "emacs_dir" -#define XEMACS_INFO_XEMACS_ROOT_TYPE "install_type" -#define XEMACS_INFO_XEMACS_PACKAGE_KEY "EMACSPACKAGEPATH" -#define XEMACS_INFO_XEMACS_EARLY_PACKAGES_KEY "EMACSEARLYPACKAGES" -#define XEMACS_INFO_XEMACS_LATE_PACKAGES_KEY "EMACSLATEPACKAGES" -#define XEMACS_INFO_XEMACS_LAST_PACKAGES_KEY "EMACSLASTPACKAGES" -#define XEMACS_INFO_XEMACS_VERSION_KEY "version" - -#define XEMACS_DEFAULT_ROOT "\\Program Files\\XEmacs" -#define XEMACS_CYGWIN_DEFAULT_ROOT "\\usr\\local" - -#define XEMACS_SETUP_DIR \ - ((char*)(install_type == IDC_INSTALL_NATIVE ? "\\setup\\" : "/lib/xemacs/setup/")) -#define XEMACS_RESOURCE_DIR \ - ((char*)(install_type == IDC_INSTALL_NATIVE ? "\\" : "/lib/xemacs/")) -#define XEMACS_PACKAGE_DIR \ - ((char*)(install_type == IDC_INSTALL_NATIVE ? "\\xemacs-packages\\" \ - : "/lib/xemacs/xemacs-packages/")) -#define XEMACS_NATIVE_ARCH_NAME "i586-pc-win32" -#define XEMACS_CYGWIN_ARCH_NAME "i686-pc-cygwin" - -/* - * Installation hierarchy is: - * C:\Program Files\XEmacs - * \xemacs-packages - * \etc - * \info - * \lib-src - * \lisp - * \man - * \pkginfo - * \site-packages - * \mule-packages - * \XEmacs-21.4 - * \i586-pc-win32 - * \etc - * \info - * \lisp - * Or: - * /usr/local/lib - * /xemacs/xemacs-packages - * /xemacs/site-packages - * /xemacs/mule-packages - * /xemacs-21.4 - * /i686-pc-cygwin - * /etc - * /info - * /lisp - * /usr/local/bin/i686-pc-cygwin - */ - - diff -r 861f2601a38b -r 1f0b15040456 netinstall/res.rc --- a/netinstall/res.rc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,546 +0,0 @@ -//Microsoft Developer Studio generated resource script. -// -#include "resource.h" - -#define APSTUDIO_READONLY_SYMBOLS -///////////////////////////////////////////////////////////////////////////// -// -// Generated from the TEXTINCLUDE 2 resource. -// -#define APSTUDIO_HIDDEN_SYMBOLS -#include "windows.h" -#undef APSTUDIO_HIDDEN_SYMBOLS - -///////////////////////////////////////////////////////////////////////////// -#undef APSTUDIO_READONLY_SYMBOLS - -///////////////////////////////////////////////////////////////////////////// -// English (U.S.) resources - -#if !defined(AFX_RESOURCE_DLL) || defined(AFX_TARG_ENU) -#ifdef _WIN32 -LANGUAGE LANG_ENGLISH, SUBLANG_ENGLISH_US -#pragma code_page(1252) -#endif //_WIN32 - -///////////////////////////////////////////////////////////////////////////// -// -// Dialog -// - -IDD_SOURCE DIALOG DISCARDABLE 0, 0, 311, 201 -STYLE DS_MODALFRAME | DS_CENTER | WS_POPUP | WS_CAPTION | WS_SYSMENU -CAPTION "XEmacs Setup" -FONT 8, "MS Sans Serif" -BEGIN - PUSHBUTTON "Next >",IDOK,199,176,45,15,WS_GROUP - PUSHBUTTON "Cancel",IDCANCEL,256,176,45,15 - CONTROL "Download from the Internet",IDC_SOURCE_DOWNLOAD,"Button", - BS_AUTORADIOBUTTON | WS_TABSTOP,127,102,152,10 - CONTROL "Install from the Internet",IDC_SOURCE_NETINST,"Button", - BS_AUTORADIOBUTTON | WS_TABSTOP,127,121,87,10 - CONTROL "Install from Local Directory",IDC_SOURCE_CWD,"Button", - BS_AUTORADIOBUTTON | WS_TABSTOP,127,140,104,10 - LTEXT "",IDC_STATIC,10,10,87,151,SS_SUNKEN | NOT WS_GROUP - LTEXT "",IDC_STATIC,10,169,291,1,SS_SUNKEN | NOT WS_GROUP - LTEXT "Setup will use the following installation method.", - IDC_STATIC,112,11,170,17 - LTEXT "To exit setup click Cancel at any time.",IDC_STATIC,112, - 32,166,17 - GROUPBOX "Installation method",IDC_STATIC,113,84,188,77 - CONTROL "GNU",IDC_STATIC,"Static",SS_BITMAP,19,36,69,62 -END - -IDD_LOCAL_DIR DIALOG DISCARDABLE 0, 0, 311, 201 -STYLE DS_MODALFRAME | DS_CENTER | WS_POPUP | WS_CAPTION | WS_SYSMENU -CAPTION "Local package directory" -FONT 8, "MS Sans Serif" -BEGIN - DEFPUSHBUTTON "Next >",IDOK,199,176,45,15,WS_DISABLED - PUSHBUTTON "< Back",IDC_BACK,154,176,45,15 - PUSHBUTTON "Cancel",IDCANCEL,256,176,45,15 - LTEXT "",IDC_STATIC,10,10,87,151,SS_SUNKEN | NOT WS_GROUP - LTEXT "",IDC_STATIC,10,169,291,1,SS_SUNKEN | NOT WS_GROUP - EDITTEXT IDC_LOCAL_DIR,120,138,122,12,ES_AUTOHSCROLL - PUSHBUTTON "Browse...",IDC_LOCAL_DIR_BROWSE,252,137,38,14 - LTEXT "Setup will use the following folder to install XEmacs and / or packages from.", - IDC_STATIC,112,10,170,17 - LTEXT "To select a different folder, click Browse and select another folder.", - IDC_STATIC,112,36,170,18 - LTEXT "To exit setup click Cancel at any time.",IDC_STATIC,112, - 63,166,17 - GROUPBOX "Local Package Directory",IDC_STATIC,112,126,186,31 - CONTROL "GNU",IDC_STATIC,"Static",SS_BITMAP,19,36,69,62 -END - -IDD_ROOT DIALOG DISCARDABLE 0, 0, 311, 201 -STYLE DS_MODALFRAME | DS_CENTER | WS_POPUP | WS_CAPTION | WS_SYSMENU -CAPTION "XEmacs Setup" -FONT 8, "MS Sans Serif" -BEGIN - DEFPUSHBUTTON "Next >",IDOK,199,176,45,15 - PUSHBUTTON "< Back",IDC_BACK,154,176,45,15 - PUSHBUTTON "Cancel",IDCANCEL,256,176,45,15 - LTEXT "",IDC_STATIC,10,10,87,151,SS_SUNKEN | NOT WS_GROUP - LTEXT "",IDC_STATIC,10,169,291,1,SS_SUNKEN | NOT WS_GROUP - EDITTEXT IDC_ROOT_DIR,120,138,122,12,ES_AUTOHSCROLL - PUSHBUTTON "Browse...",IDC_ROOT_BROWSE,252,137,38,14 - LTEXT "Setup will use the following folder in which to install XEmacs and / or packages.", - IDC_STATIC,112,10,170,17 - LTEXT "To select a different folder, click Browse and select another folder.", - IDC_STATIC,112,35,170,18 - LTEXT "To exit setup click Cancel at any time.",IDC_STATIC,112, - 63,166,17 - GROUPBOX "Installation Root Directory",IDC_STATIC,112,126,186,31 - CONTROL "All",IDC_ROOT_SYSTEM,"Button",BS_AUTORADIOBUTTON | - WS_GROUP,177,110,25,8 - CONTROL "Just Me",IDC_ROOT_USER,"Button",BS_AUTORADIOBUTTON,220, - 110,50,8 - LTEXT "Installation Type :",IDC_STATIC,112,95,60,8 - LTEXT "Install For :",IDC_STATIC,112,110,43,8 - CONTROL "Native",IDC_INSTALL_NATIVE,"Button",BS_AUTORADIOBUTTON, - 177,93,37,10 - CONTROL "Cygwin",IDC_INSTALL_CYGWIN,"Button",BS_AUTORADIOBUTTON, - 220,93,39,10 - CONTROL "GNU",IDC_STATIC,"Static",SS_BITMAP,19,36,69,62 -END - -IDD_SITE DIALOG DISCARDABLE 0, 0, 311, 201 -STYLE DS_MODALFRAME | DS_CENTER | WS_POPUP | WS_CAPTION | WS_SYSMENU -CAPTION "XEmacs Setup" -FONT 8, "MS Sans Serif" -BEGIN - DEFPUSHBUTTON "Next >",IDOK,199,176,45,15 - PUSHBUTTON "< Back",IDC_BACK,154,176,45,15 - PUSHBUTTON "Cancel",IDCANCEL,256,176,45,15 - LTEXT "",IDC_STATIC,10,10,87,151,SS_SUNKEN | NOT WS_GROUP - LTEXT "",IDC_STATIC,10,169,291,1,SS_SUNKEN | NOT WS_GROUP - LTEXT "Select Download Site",IDC_STATIC,113,11,135,11 - LISTBOX IDC_URL_LIST,121,24,179,136,LBS_NOINTEGRALHEIGHT | - WS_VSCROLL | WS_HSCROLL | WS_TABSTOP - CONTROL "GNU",IDC_STATIC,"Static",SS_BITMAP,19,36,69,62 -END - -IDD_OTHER_URL DIALOG DISCARDABLE 0, 0, 311, 201 -STYLE DS_MODALFRAME | DS_CENTER | WS_POPUP | WS_CAPTION | WS_SYSMENU -CAPTION "XEmacs Setup" -FONT 8, "MS Sans Serif" -BEGIN - DEFPUSHBUTTON "Next >",IDOK,199,176,45,15 - PUSHBUTTON "< Back",IDC_BACK,154,176,45,15 - PUSHBUTTON "Cancel",IDCANCEL,256,176,45,15 - LTEXT "",IDC_STATIC,10,10,87,151,SS_SUNKEN | NOT WS_GROUP - LTEXT "",IDC_STATIC,10,169,291,1,SS_SUNKEN | NOT WS_GROUP - EDITTEXT IDC_OTHER_URL,120,138,170,12,ES_AUTOHSCROLL - LTEXT "Setup will use the following URL to install XEmacs and / or packages from.", - IDC_STATIC,112,10,170,17 - LTEXT "To select a different URL, edit the text.",IDC_STATIC, - 112,36,170,18 - LTEXT "To exit setup click Cancel at any time.",IDC_STATIC,112, - 58,166,17 - GROUPBOX "Select URL to download from",IDC_STATIC,112,126,186,31 - CONTROL "GNU",IDC_STATIC,"Static",SS_BITMAP,19,36,69,62 -END - -IDD_NET DIALOG DISCARDABLE 0, 0, 311, 201 -STYLE DS_MODALFRAME | DS_CENTER | WS_POPUP | WS_CAPTION | WS_SYSMENU -CAPTION "XEmacs Setup" -FONT 8, "MS Sans Serif" -BEGIN - PUSHBUTTON "Next >",IDOK,199,176,45,15,WS_GROUP - PUSHBUTTON "< Back",IDC_BACK,154,176,45,15 - PUSHBUTTON "Cancel",IDCANCEL,256,176,45,15 - LTEXT "",IDC_STATIC,10,10,87,151,SS_SUNKEN | NOT WS_GROUP - LTEXT "",IDC_STATIC,10,169,291,1,SS_SUNKEN | NOT WS_GROUP - LTEXT "Setup will use the following connection method.", - IDC_STATIC,112,11,170,17,NOT WS_GROUP - LTEXT "To exit setup click Cancel at any time.",IDC_STATIC,112, - 32,166,17,NOT WS_GROUP - CONTROL "Use IE5 Settings",IDC_NET_IE5,"Button", - BS_AUTORADIOBUTTON | WS_TABSTOP,128,93,69,10 - CONTROL "Direct Connection",IDC_NET_DIRECT,"Button", - BS_AUTORADIOBUTTON | WS_TABSTOP,128,109,73,10 - CONTROL "Use HTTP/FTP Proxy:",IDC_NET_PROXY,"Button", - BS_AUTORADIOBUTTON | WS_TABSTOP,128,124,88,10 - EDITTEXT IDC_PROXY_HOST,128,141,80,12,ES_AUTOHSCROLL | - WS_DISABLED - LTEXT "Proxy",IDC_STATIC,10,55,50,15,SS_CENTERIMAGE, - WS_EX_RIGHT - LTEXT "Port",IDC_STATIC,229,139,20,15,SS_CENTERIMAGE, - WS_EX_RIGHT - EDITTEXT IDC_PROXY_PORT,257,141,30,12,ES_AUTOHSCROLL | - WS_DISABLED - GROUPBOX "Installation method",IDC_STATIC,113,78,188,83 - CONTROL "GNU",IDC_STATIC,"Static",SS_BITMAP,19,36,69,62 -END - -IDD_DLSTATUS DIALOG DISCARDABLE 0, 0, 311, 201 -STYLE DS_MODALFRAME | DS_SETFOREGROUND | DS_CENTER | WS_POPUP | WS_VISIBLE | - WS_CAPTION | WS_SYSMENU -CAPTION "XEmacs Setup" -FONT 8, "MS Sans Serif" -BEGIN - PUSHBUTTON "Cancel",IDCANCEL,256,176,45,15 - LTEXT "",IDC_STATIC,10,10,87,151,SS_SUNKEN | NOT WS_GROUP - LTEXT "",IDC_STATIC,10,169,291,1,SS_SUNKEN | NOT WS_GROUP - LTEXT "Downloading Packages",IDC_STATIC,112,10,170,17 - LTEXT "(URL)",IDC_DLS_URL,112,26,170,11 - LTEXT "(RATE)",IDC_DLS_RATE,112,41,166,11 - CONTROL "Progress1",IDC_DLS_PROGRESS,"msctls_progress32", - WS_BORDER,123,143,165,10 - GROUPBOX "Progress",IDC_STATIC,112,130,186,31 - CONTROL "GNU",IDC_STATIC,"Static",SS_BITMAP,19,36,69,62 -END - -IDD_INSTATUS DIALOG DISCARDABLE 0, 0, 311, 201 -STYLE DS_MODALFRAME | DS_SETFOREGROUND | DS_CENTER | WS_POPUP | WS_VISIBLE | - WS_CAPTION | WS_SYSMENU -CAPTION "XEmacs Setup" -FONT 8, "MS Sans Serif" -BEGIN - PUSHBUTTON "Cancel",IDCANCEL,256,176,45,15 - LTEXT "",IDC_STATIC,10,10,87,151,SS_SUNKEN | NOT WS_GROUP - LTEXT "",IDC_STATIC,10,169,291,1,SS_SUNKEN | NOT WS_GROUP - LTEXT "Installing Packages",IDC_STATIC,112,10,170,17 - LTEXT "(PKG)",IDC_INS_PKG,112,26,170,11 - LTEXT "(FILE)",IDC_INS_FILE,112,41,183,11 - CONTROL "Progress1",IDC_INS_DISKFULL,"msctls_progress32", - WS_BORDER,123,143,165,10 - CONTROL "Progress1",IDC_INS_IPROGRESS,"msctls_progress32", - WS_BORDER,125,106,163,10 - CONTROL "Progress1",IDC_INS_PPROGRESS,"msctls_progress32", - WS_BORDER,125,67,163,10 - GROUPBOX "Disk",IDC_STATIC,112,130,186,31 - GROUPBOX "Package",IDC_STATIC,112,54,186,31 - GROUPBOX "Total",IDC_STATIC,112,93,186,31 - CONTROL "GNU",IDC_STATIC,"Static",SS_BITMAP,19,36,69,62 -END - -IDD_UNINSTALL DIALOG DISCARDABLE 0, 0, 311, 201 -STYLE DS_MODALFRAME | DS_CENTER | WS_POPUP | WS_CAPTION | WS_SYSMENU -CAPTION "Uninstall XEmacs" -FONT 8, "MS Sans Serif" -BEGIN - PUSHBUTTON "Cancel",IDCANCEL,199,176,45,15 - DEFPUSHBUTTON "Uninstall",IDOK,256,176,45,15 - LTEXT "",IDC_STATIC,10,10,87,151,SS_SUNKEN | NOT WS_GROUP - LTEXT "",IDC_STATIC,10,169,291,1,SS_SUNKEN | NOT WS_GROUP - LTEXT "Uninstalling Packages",IDC_STATIC,112,10,170,17 - LTEXT "(PKG)",IDC_UNINS_PKG,112,26,170,11 - LTEXT "(FILE)",IDC_UNINS_FILE,112,41,166,11 - CONTROL "Progress1",IDC_UNINS_DISKFULL,"msctls_progress32", - WS_BORDER,123,143,165,10 - CONTROL "Progress1",IDC_UNINS_IPROGRESS,"msctls_progress32", - WS_BORDER,125,106,163,10 - CONTROL "Progress1",IDC_UNINS_PPROGRESS,"msctls_progress32", - WS_BORDER,125,67,163,10 - GROUPBOX "Disk",IDC_STATIC,112,130,186,31 - GROUPBOX "Package",IDC_STATIC,112,54,186,31 - GROUPBOX "Total",IDC_STATIC,112,93,186,31 - CONTROL "GNU",IDC_STATIC,"Static",SS_BITMAP,19,36,69,62 -END - -IDD_PROXY_AUTH DIALOG DISCARDABLE 0, 0, 215, 95 -STYLE DS_MODALFRAME | DS_CENTER | WS_POPUP | WS_CAPTION | WS_SYSMENU -CAPTION "XEmacs Setup" -FONT 8, "MS Sans Serif" -BEGIN - ICON IDI_XEMACS,IDC_STATIC,5,5,20,20 - EDITTEXT IDC_NET_USER,65,28,145,12,ES_AUTOHSCROLL - LTEXT "Proxy User ID",IDC_STATIC,5,28,55,15,SS_CENTERIMAGE, - WS_EX_RIGHT - EDITTEXT IDC_NET_PASSWD,65,43,145,12,ES_PASSWORD | ES_AUTOHSCROLL - LTEXT "Password",IDC_STATIC,10,43,50,15,SS_CENTERIMAGE, - WS_EX_RIGHT - LTEXT "Proxy Authorization Required",IDC_STATIC,65,10,145,10 - DEFPUSHBUTTON "OK",IDOK,100,75,45,15,WS_DISABLED - PUSHBUTTON "Cancel",IDCANCEL,165,75,45,15 -END - -IDD_NET_AUTH DIALOG DISCARDABLE 0, 0, 215, 95 -STYLE DS_MODALFRAME | DS_CENTER | WS_POPUP | WS_CAPTION | WS_SYSMENU -CAPTION "XEmacs Setup" -FONT 8, "MS Sans Serif" -BEGIN - ICON IDI_XEMACS,IDC_STATIC,5,5,20,20 - EDITTEXT IDC_NET_USER,65,28,145,12,ES_AUTOHSCROLL - LTEXT "User ID",IDC_STATIC,5,28,55,15,SS_CENTERIMAGE, - WS_EX_RIGHT - EDITTEXT IDC_NET_PASSWD,65,43,145,12,ES_PASSWORD | ES_AUTOHSCROLL - LTEXT "Password",IDC_STATIC,10,43,50,15,SS_CENTERIMAGE, - WS_EX_RIGHT - LTEXT "Server Authorization Required",IDC_STATIC,65,10,145,10 - DEFPUSHBUTTON "OK",IDOK,100,75,45,15,WS_DISABLED - PUSHBUTTON "Cancel",IDCANCEL,165,75,45,15 -END - -IDD_SPLASH DIALOG DISCARDABLE 0, 0, 311, 201 -STYLE DS_MODALFRAME | DS_CENTER | WS_POPUP | WS_CAPTION | WS_SYSMENU -CAPTION "XEmacs Setup" -FONT 8, "MS Sans Serif" -BEGIN - DEFPUSHBUTTON "Next >",IDOK,199,176,45,15 - PUSHBUTTON "Cancel",IDCANCEL,256,176,45,15 - ICON IDI_XEMACS,IDC_STATIC,107,10,20,20 - LTEXT "Welcome to the XEmacs Net Release Setup Program. This will install XEmacs and/or associated packages on your computer.", - IDC_STATIC,133,10,158,29 - LTEXT "Version (unknown)",IDC_VERSION,112,117,120,10 - LTEXT "Copyright (C) 2000 Red Hat Inc",IDC_STATIC,111,132,135, - 8 - LTEXT "http://www.xemacs.org/",IDC_STATIC,111,147,150,10 - LTEXT "It is strongly recommended that you exit all Windows programs before running this utility.", - IDC_STATIC,110,43,191,19 - LTEXT "",IDC_STATIC,10,169,291,1,SS_SUNKEN | NOT WS_GROUP - LTEXT "",IDC_STATIC,10,10,87,151,SS_SUNKEN | NOT WS_GROUP - CONTROL "GNU",IDC_STATIC,"Static",SS_BITMAP,19,36,69,62 -END - -IDD_CHOOSE DIALOG DISCARDABLE 0, 0, 311, 239 -STYLE DS_MODALFRAME | DS_CENTER | WS_POPUP | WS_CAPTION | WS_SYSMENU -CAPTION "XEmacs Setup" -FONT 8, "MS Sans Serif" -BEGIN - DEFPUSHBUTTON "Next >",IDOK,199,214,45,15 - PUSHBUTTON "< Back",IDC_BACK,154,214,45,15 - PUSHBUTTON "Cancel",IDCANCEL,256,214,45,15 - LTEXT "",IDC_STATIC,10,201,291,1,SS_SUNKEN | NOT WS_GROUP - LTEXT "Select packages to install",IDC_STATIC,55,5,85,8 - ICON IDI_XEMACS,IDC_STATIC,5,5,21,20 - LTEXT "",IDC_LISTVIEW_POS,55,15,230,155,SS_SUNKEN | NOT - WS_VISIBLE | NOT WS_GROUP - CONTROL "SPIN",IDC_STATIC,"Static",SS_BITMAP,55,170,15,13 - LTEXT "= click to choose action, (p) = previous version, (x) = experimental", - IDC_STATIC,65,170,220,8 - PUSHBUTTON "Full/Part",IDC_CHOOSE_FULLPART,250,5,35,10 - PUSHBUTTON "Exp",IDC_CHOOSE_EXP,215,5,25,10 - PUSHBUTTON "Curr",IDC_CHOOSE_CURR,190,5,25,10 - PUSHBUTTON "Prev",IDC_CHOOSE_PREV,165,5,25,10 -END - -IDD_DESKTOP DIALOG DISCARDABLE 0, 0, 311, 201 -STYLE DS_MODALFRAME | DS_CENTER | WS_POPUP | WS_CAPTION | WS_SYSMENU -CAPTION "XEmacs Setup" -FONT 8, "MS Sans Serif" -BEGIN - DEFPUSHBUTTON "Finish",IDOK,199,176,45,15 - PUSHBUTTON "< Back",IDC_BACK,154,176,45,15 - PUSHBUTTON "Cancel",IDCANCEL,256,176,45,15 - LTEXT "Setup has now finished. To create desktop shortcuts, please select from the following options.", - IDC_STATIC,112,11,170,17 - LTEXT "To complete setup click Finish.",IDC_STATIC,112,32,166, - 17 - CONTROL "Create Desktop Icon",IDC_ROOT_DESKTOP,"Button", - BS_AUTOCHECKBOX,113,50,100,8 - CONTROL "Add to Start Menu",IDC_ROOT_MENU,"Button", - BS_AUTOCHECKBOX,113,66,100,8 - CONTROL "GNU",IDC_STATIC,"Static",SS_BITMAP,19,36,69,62 - CONTROL "Text",IDC_TXT_TYPE,"Button",BS_AUTOCHECKBOX,209,101,38, - 8 - CONTROL "Java",IDC_JAVA_TYPE,"Button",BS_AUTOCHECKBOX,113,100,50, - 8 - CONTROL "C",IDC_C_TYPE,"Button",BS_AUTOCHECKBOX,113,116,41,8 - CONTROL "C++",IDC_CPP_TYPE,"Button",BS_AUTOCHECKBOX,113,133,38,8 - CONTROL "E-Lisp",IDC_ELISP_TYPE,"Button",BS_AUTOCHECKBOX,113,148, - 38,8 - LTEXT "Register XEmacs for these file types:",IDC_STATIC,113, - 84,166,13 - LTEXT "",IDC_STATIC,10,169,291,1,SS_SUNKEN | NOT WS_GROUP - LTEXT "",IDC_STATIC,10,10,87,151,SS_SUNKEN | NOT WS_GROUP - CONTROL "GNU",IDC_STATIC,"Static",SS_BITMAP,19,36,69,62 - CONTROL "IDL",IDC_IDL_TYPE,"Button",BS_AUTOCHECKBOX,209,116,38,8 -END - - -#ifdef APSTUDIO_INVOKED -///////////////////////////////////////////////////////////////////////////// -// -// TEXTINCLUDE -// - -1 TEXTINCLUDE DISCARDABLE -BEGIN - "resource.h\0" -END - -2 TEXTINCLUDE DISCARDABLE -BEGIN - "#define APSTUDIO_HIDDEN_SYMBOLS\r\n" - "#include ""windows.h""\r\n" - "#undef APSTUDIO_HIDDEN_SYMBOLS\r\n" - "\0" -END - -3 TEXTINCLUDE DISCARDABLE -BEGIN - "\r\n" - "\0" -END - -#endif // APSTUDIO_INVOKED - - -///////////////////////////////////////////////////////////////////////////// -// -// Icon -// - -// Icon with lowest ID value placed first to ensure application icon -// remains consistent on all systems. -IDI_XEMACS ICON DISCARDABLE "xemacs.ico" - -///////////////////////////////////////////////////////////////////////////// -// -// FILE -// - -XEMACS.ICON FILE DISCARDABLE "xemacs.ico" - -///////////////////////////////////////////////////////////////////////////// -// -// DESIGNINFO -// - -#ifdef APSTUDIO_INVOKED -GUIDELINES DESIGNINFO DISCARDABLE -BEGIN - IDD_SOURCE, DIALOG - BEGIN - VERTGUIDE, 113 - VERTGUIDE, 127 - END - - IDD_LOCAL_DIR, DIALOG - BEGIN - VERTGUIDE, 112 - HORZGUIDE, 10 - END - - IDD_ROOT, DIALOG - BEGIN - VERTGUIDE, 112 - HORZGUIDE, 103 - HORZGUIDE, 118 - END - - IDD_SITE, DIALOG - BEGIN - HORZGUIDE, 11 - HORZGUIDE, 161 - END - - IDD_NET, DIALOG - BEGIN - VERTGUIDE, 128 - BOTTOMMARGIN, 191 - HORZGUIDE, 153 - END - - IDD_INSTATUS, DIALOG - BEGIN - VERTGUIDE, 112 - VERTGUIDE, 125 - VERTGUIDE, 288 - END - - IDD_PROXY_AUTH, DIALOG - BEGIN - BOTTOMMARGIN, 49 - END - - IDD_NET_AUTH, DIALOG - BEGIN - BOTTOMMARGIN, 49 - END - - IDD_SPLASH, DIALOG - BEGIN - LEFTMARGIN, 10 - RIGHTMARGIN, 301 - TOPMARGIN, 10 - BOTTOMMARGIN, 191 - END - - IDD_CHOOSE, DIALOG - BEGIN - BOTTOMMARGIN, 229 - HORZGUIDE, 214 - END - - IDD_DESKTOP, DIALOG - BEGIN - VERTGUIDE, 113 - VERTGUIDE, 209 - HORZGUIDE, 124 - END -END -#endif // APSTUDIO_INVOKED - - -///////////////////////////////////////////////////////////////////////////// -// -// Bitmap -// - -SPIN BITMAP DISCARDABLE "choose-spin.bmp" -IDB_SPIN BITMAP DISCARDABLE "choose-spin.bmp" -IDB_RTARROW BITMAP DISCARDABLE "choose-rtarrow.bmp" -IDB_CHECK_YES BITMAP DISCARDABLE "check-yes.bmp" -IDB_CHECK_NO BITMAP DISCARDABLE "check-no.bmp" -IDB_CHECK_NA BITMAP DISCARDABLE "check-na.bmp" -GNU BITMAP DISCARDABLE "gnu.bmp" -IDB_GNU BITMAP DISCARDABLE "gnu.bmp" - -///////////////////////////////////////////////////////////////////////////// -// -// String Table -// - -STRINGTABLE DISCARDABLE -BEGIN - IDS_ROOT_SLASH "Warning: we recommend you do NOT use the root of your hard drive as the XEmacs root. Proceed anyway?" - IDS_ROOT_SPACE "You should not choose a root path that include spaces in directory names. Proceed anyway?" - IDS_MIRROR_LST "http://www.xemacs.org/Download/mirrors.lst" - IDS_DIALOG_FAILED "Unable to create Dialog Box" - IDS_CYGWIN_FUNC_MISSING "Error: unable to find function `%s' in %s" - IDS_DOWNLOAD_SHORT "Download error: %s too short (%d, wanted %d)" - IDS_ERR_OPEN_WRITE "Can't open %s for writing: %s" - IDS_SETUPINI_MISSING "Unable to get setup.ini from %s" - IDS_OLD_SETUPINI "This setup.ini is older than the one you used last time you installed cygwin. Proceed anyway?" - IDS_ERR_RENAME "Can't rename %s to %s: %s" - IDS_NOTHING_INSTALLED "Nothing needed to be installed" - IDS_INSTALL_COMPLETE "Installation Complete" -END - -STRINGTABLE DISCARDABLE -BEGIN - IDS_ERR_OPEN_READ "Can't open %s for reading: %s" - IDS_ROOT_ABSOLUTE "The install directory must be absolute, with both a drive letter and leading slash, like C:\\Cygwin" - IDS_DOWNLOAD_COMPLETE "Download Complete" - IDS_CVSID "\n%%% $Id: res.rc,v 1.9 2002/04/25 18:03:43 andyp Exp $\n" - IDS_NOLOGFILE "Cannot open log file %s for writing" - IDS_UNINSTALL_COMPLETE "Uninstalls complete." - IDS_WININET "Unable to find or load the Internet Explorer 5 DLLs" - IDS_ERR_CHDIR "Could not change dir to %s" - IDS_OLD_SETUP_VERSION "This setup is version %s, but setup.ini claims version %s is available.\nYou might want to upgrade to get the latest features and bug fixes." - IDS_DOWNLOAD_FAILED "Unable to download %s" - IDS_DOWNLOAD_INCOMPLETE "Download Incomplete. Try again?" - IDS_INSTALL_INCOMPLETE "Installation incomplete. Check /setup.log.full for details" - IDS_ROOT_NOCYGWIN "You should not install the Cygwin version without Cygwin installed. Proceed anyway?" - IDS_CREATE_DIR "The directory %s does not exist, create it?" -END - -#endif // English (U.S.) resources -///////////////////////////////////////////////////////////////////////////// - - - -#ifndef APSTUDIO_INVOKED -///////////////////////////////////////////////////////////////////////////// -// -// Generated from the TEXTINCLUDE 3 resource. -// - - -///////////////////////////////////////////////////////////////////////////// -#endif // not APSTUDIO_INVOKED - diff -r 861f2601a38b -r 1f0b15040456 netinstall/resource.h --- a/netinstall/resource.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,127 +0,0 @@ -//{{NO_DEPENDENCIES}} -// Microsoft Developer Studio generated include file. -// Used by res.rc -// -#define IDS_ROOT_SLASH 1 -#define IDS_ROOT_SPACE 2 -#define IDS_CWD_NONEMPTY 3 -#define IDS_MIRROR_LST 6 -#define IDS_DIALOG_FAILED 7 -#define IDS_CYGWIN_FUNC_MISSING 8 -#define IDS_DOWNLOAD_SHORT 9 -#define IDS_ERR_OPEN_WRITE 10 -#define IDS_SETUPINI_MISSING 11 -#define IDS_OLD_SETUPINI 12 -#define IDS_ERR_RENAME 13 -#define IDS_NOTHING_INSTALLED 14 -#define IDS_INSTALL_COMPLETE 15 -#define IDS_ERR_OPEN_READ 16 -#define IDS_ROOT_ABSOLUTE 17 -#define IDS_DOWNLOAD_COMPLETE 18 -#define IDS_CVSID 19 -#define IDS_NOLOGFILE 20 -#define IDS_UNINSTALL_COMPLETE 21 -#define IDS_WININET 22 -#define IDS_ERR_CHDIR 23 -#define IDS_OLD_SETUP_VERSION 24 -#define IDS_DOWNLOAD_FAILED 25 -#define IDS_DOWNLOAD_INCOMPLETE 26 -#define IDS_INSTALL_INCOMPLETE 27 -#define IDS_ROOT_NOCYGWIN 28 -#define IDS_CREATE_DIR 29 -#define IDD_ROOT 101 -#define IDD_SOURCE 102 -#define IDD_OTHER_URL 103 -#define IDD_SITE 104 -#define IDD_NET 105 -#define IDD_DLSTATUS 106 -#define IDD_S_LOAD_INI 107 -#define IDD_S_FROM_CWD 108 -#define IDD_CHOOSE 109 -#define IDD_S_DOWNLOAD 110 -#define IDD_S_INSTALL 111 -#define IDD_INSTATUS 112 -#define IDD_DESKTOP 113 -#define IDD_PROXY_AUTH 114 -#define IDD_S_POSTINSTALL 115 -#define IDD_NET_AUTH 116 -#define IDD_SPLASH 117 -#define IDB_SPIN 118 -#define IDB_RTARROW 119 -#define IDI_SPIN 120 -#define IDI_XEMACS 121 -#define IDD_LOCAL_DIR 122 -#define IDB_CHECK_YES 123 -#define IDB_CHECK_NO 124 -#define IDB_CHECK_NA 125 -#define IDB_GNU 126 -#define IDD_UNINSTALL 127 -#define IDC_SOURCE_DOWNLOAD 1000 -#define IDC_SOURCE_NETINST 1001 -#define IDC_SOURCE_CWD 1002 -#define IDC_ROOT_DIR 1003 -#define IDC_ROOT_BROWSE 1004 -#define IDC_ROOT_TEXT 1005 -#define IDC_ROOT_BINARY 1006 -#define IDC_URL_LIST 1007 -#define IDC_SITE_NEXT 1008 -#define IDC_BACK 1009 -#define IDC_OTHER_URL 1010 -#define IDC_NET_IE5 1011 -#define IDC_NET_DIRECT 1012 -#define IDC_NET_PROXY 1013 -#define IDC_PROXY_HOST 1014 -#define IDC_PROXY_PORT 1015 -#define IDC_PROXY_USER 1016 -#define IDC_DLS_PROGRESS 1019 -#define IDC_DLS_URL 1020 -#define IDC_DLS_RATE 1021 -#define IDC_INS_PKG 1022 -#define IDC_INS_FILE 1023 -#define IDC_INS_DISKFULL 1024 -#define IDC_INS_IPROGRESS 1025 -#define IDC_INS_PPROGRESS 1026 -#define IDC_ROOT_SYSTEM 1028 -#define IDC_ROOT_USER 1029 -#define IDC_NET_USER 1030 -#define IDC_NET_PASSWD 1031 -#define IDC_VERSION 1033 -#define IDC_LISTVIEW_POS 1034 -#define IDC_CHOOSE_FULLPART 1035 -#define IDC_CHOOSE_EXP 1036 -#define IDC_CHOOSE_CURR 1037 -#define IDC_CHOOSE_PREV 1038 -#define IDC_CHOOSE_LIST 1039 -#define IDC_INS_ACTION 1040 -#define IDC_ROOT_DESKTOP 1041 -#define IDC_ROOT_MENU 1042 -#define IDC_LOCAL_DIR_BROWSE 1043 -#define IDC_TXT_TYPE 1043 -#define IDC_LOCAL_DIR 1044 -#define IDC_JAVA_TYPE 1044 -#define IDC_INSTALL_NATIVE 1045 -#define IDC_C_TYPE 1045 -#define IDC_INSTALL_CYGWIN 1046 -#define IDC_CPP_TYPE 1046 -#define IDC_UNINS_PKG 1047 -#define IDC_ELISP_TYPE 1047 -#define IDC_UNINS_FILE 1048 -#define IDC_IDL_TYPE 1048 -#define IDC_UNINS_DISKFULL 1049 -#define IDC_UNINS_IPROGRESS 1050 -#define IDC_UNINS_PPROGRESS 1051 -#define IDC_UNINS_ACTION 1052 -#define IDC_STATIC -1 - -// Next default values for new objects -// -#ifdef APSTUDIO_INVOKED -#ifndef APSTUDIO_READONLY_SYMBOLS -#define _APS_NO_MFC 1 -#define _APS_3D_CONTROLS 1 -#define _APS_NEXT_RESOURCE_VALUE 127 -#define _APS_NEXT_COMMAND_VALUE 40003 -#define _APS_NEXT_CONTROL_VALUE 1050 -#define _APS_NEXT_SYMED_VALUE 101 -#endif -#endif diff -r 861f2601a38b -r 1f0b15040456 netinstall/root.cc --- a/netinstall/root.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,318 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The purpose of this file is to ask the user where they want the - root of the installation to be, and to ask whether the user prefers - text or binary mounts. */ - -#include "win32.h" -#include -#include -#include -#include - -#include "dialog.h" -#include "resource.h" -#include "state.h" -#include "msg.h" -#include "regedit.h" -#include "reginfo.h" -#include "concat.h" -#include "log.h" - -static int rb[] = { IDC_INSTALL_CYGWIN, IDC_INSTALL_NATIVE, 0 }; -static int su[] = { IDC_ROOT_SYSTEM, IDC_ROOT_USER, 0 }; - -static void -check_if_enable_next (HWND h) -{ - EnableWindow (GetDlgItem (h, IDOK), install_type && root_dir && root_scope); -} - -static void -load_dialog (HWND h) -{ - rbset (h, rb, install_type); - rbset (h, su, root_scope); - eset (h, IDC_ROOT_DIR, root_dir); - check_if_enable_next (h); -} - -static void -save_dialog (HWND h) -{ - install_type = rbget (h, rb); - root_scope = rbget (h, su); - char* new_root_dir = eget (h, IDC_ROOT_DIR, root_dir); - - if (!root_dir || strcmp (new_root_dir, root_dir) != 0) - root_dir_default = 0; - - root_dir = new_root_dir; -} - -/* - * is_admin () determines whether or not the current user is a member of the - * Administrators group. On Windows 9X, the current user is considered an - * Administrator by definition. - */ - -static int -is_admin () -{ - // Windows 9X users are considered Administrators by definition - OSVERSIONINFO verinfo; - verinfo.dwOSVersionInfoSize = sizeof (verinfo); - GetVersionEx (&verinfo); - if (verinfo.dwPlatformId != VER_PLATFORM_WIN32_NT) - return 1; - - // Get the process token for the current process - HANDLE token; - BOOL status = OpenProcessToken (GetCurrentProcess(), TOKEN_QUERY, &token); - if (!status) - return 0; - - // Get the group token information - UCHAR token_info[1024]; - PTOKEN_GROUPS groups = (PTOKEN_GROUPS) token_info; - DWORD token_info_len = sizeof (token_info); - status = GetTokenInformation (token, TokenGroups, token_info, token_info_len, &token_info_len); - CloseHandle(token); - if (!status) - return 0; - - // Create the Administrators group SID - PSID admin_sid; - SID_IDENTIFIER_AUTHORITY authority = SECURITY_NT_AUTHORITY; - status = AllocateAndInitializeSid (&authority, 2, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, &admin_sid); - if (!status) - return 0; - - // Check to see if the user is a member of the Administrators group - status = 0; - for (UINT i=0; iGroupCount; i++) { - if (EqualSid(groups->Groups[i].Sid, admin_sid)) { - status = 1; - break; - } - } - - // Destroy the Administrators group SID - FreeSid (admin_sid); - - // Return whether or not the user is a member of the Administrators group - return status; -} - -static void -change_default_root (int id) -{ - int issystem; - char* cygroot = find_cygwin_root (&issystem); - if (id == IDC_INSTALL_CYGWIN && cygroot) - { - root_dir = concat (cygroot, XEMACS_CYGWIN_DEFAULT_ROOT, 0); - install_type = IDC_INSTALL_CYGWIN; - } - else if (id == IDC_INSTALL_NATIVE) - { - char windir[_MAX_PATH]; - GetWindowsDirectory (windir, sizeof (windir)); - windir[2] = 0; - root_dir = concat (windir, XEMACS_DEFAULT_ROOT, 0); - install_type = IDC_INSTALL_NATIVE; - } -} - -static int CALLBACK -browse_cb (HWND h, UINT m, LPARAM lp, LPARAM data) -{ - switch (m) - { - case BFFM_INITIALIZED: - if (root_dir) - SendMessage (h, BFFM_SETSELECTION, TRUE, (LPARAM)root_dir); - break; - } - return 0; -} - -static void -browse (HWND h) -{ - BROWSEINFO bi; - CHAR name[MAX_PATH]; - LPITEMIDLIST pidl; - memset (&bi, 0, sizeof (bi)); - bi.hwndOwner = h; - bi.pszDisplayName = name; - bi.lpszTitle = "Select an installation root directory"; - bi.ulFlags = BIF_RETURNONLYFSDIRS; - bi.lpfn = browse_cb; - pidl = SHBrowseForFolder (&bi); - if (pidl) - { - if (SHGetPathFromIDList (pidl, name)) - eset (h, IDC_ROOT_DIR, name); - } -} - -#define isslash(c) ((c) == '\\' || (c) == '/') - -static int -directory_is_absolute () -{ - if (isalpha (root_dir[0]) - && root_dir[1] == ':' - && (root_dir[2] == '\\' || root_dir[2] == '/')) - return 1; - return 0; -} - -static int -directory_is_rootdir () -{ - char *c; - for (c = root_dir; *c; c++) - if (isslash (c[0]) && c[1] && !isslash (c[1])) - return 0; - return 1; -} - -static int -cygwin_without_cygwin () -{ - int issystem; - if (install_type == IDC_INSTALL_CYGWIN - && !find_cygwin_root (&issystem)) - return 1; - return 0; -} - -static BOOL -dialog_cmd (HWND h, int id, HWND hwndctl, UINT code) -{ - switch (id) - { - - case IDC_ROOT_DIR: - case IDC_ROOT_SYSTEM: - case IDC_ROOT_USER: - save_dialog (h); - check_if_enable_next (h); - break; - - case IDC_INSTALL_NATIVE: - case IDC_INSTALL_CYGWIN: - if (root_dir_default) - { - change_default_root (id); - eset (h, IDC_ROOT_DIR, root_dir); - } - save_dialog (h); - check_if_enable_next (h); - break; - - case IDC_ROOT_BROWSE: - browse (h); - break; - - case IDOK: - save_dialog (h); - - if (! directory_is_absolute ()) - { - note (IDS_ROOT_ABSOLUTE); - break; - } - - if (directory_is_rootdir ()) - if (IDNO == yesno (IDS_ROOT_SLASH)) - break; - - if (cygwin_without_cygwin ()) - if (IDNO == yesno (IDS_ROOT_NOCYGWIN)) - break; - - create_xemacs_root (backslash (root_dir), - root_scope == IDC_ROOT_SYSTEM ? 1 : 0, - install_type == IDC_INSTALL_NATIVE ? 1 : 0); - - switch (source) - { - case IDC_SOURCE_NETINST: - NEXT (IDD_NET); - break; - case IDC_SOURCE_CWD: - NEXT (IDD_S_FROM_CWD); - break; - default: - msg ("source is default? %d\n", source); - NEXT (0); - } - break; - - case IDC_BACK: - save_dialog (h); - NEXT (IDD_LOCAL_DIR); - break; - - case IDCANCEL: - NEXT (0); - break; - } - return FALSE; -} - -static BOOL CALLBACK -dialog_proc (HWND h, UINT message, WPARAM wParam, LPARAM lParam) -{ - switch (message) - { - case WM_INITDIALOG: - load_dialog (h); - return FALSE; - case WM_COMMAND: - return HANDLE_WM_COMMAND (h, wParam, lParam, dialog_cmd); - } - return FALSE; -} - -static void -set_default_root () -{ - change_default_root (IDC_INSTALL_NATIVE); - root_scope = (is_admin()) ? IDC_ROOT_SYSTEM : IDC_ROOT_USER; - root_dir_default = 1; -} - -void -do_root (HINSTANCE h) -{ - int rv = 0; - // init will have read a previous root - if (!root_dir) - set_default_root (); - - rv = DialogBox (h, MAKEINTRESOURCE (IDD_ROOT), 0, dialog_proc); - if (rv == -1) - fatal (IDS_DIALOG_FAILED); - - log (0, "root: %s %s %s", root_dir, - (install_type == IDC_INSTALL_NATIVE) ? "native" : "cygwin", - (root_scope == IDC_ROOT_USER) ? "user" : "system"); -} - diff -r 861f2601a38b -r 1f0b15040456 netinstall/setup.mak --- a/netinstall/setup.mak Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,252 +0,0 @@ -# Makefile for Microsoft NMAKE -# Copyright (C) 1995 Board of Trustees, University of Illinois. -# Copyright (C) 1995, 1996, 2000 Ben Wing. -# Copyright (C) 1995 Sun Microsystems, Inc. -# Copyright (C) 1998 Free Software Foundation, Inc. -# -# This file is part of XEmacs. -# -# XEmacs is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any -# later version. -# -# XEmacs is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. -# -# You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. -# -# Synched up with: Not in FSF. -# - -TARGETOS=BOTH -APPVER=4.0 - -default: all - -# APA: Since there seems to be no way to determine the directory where -# xemacs.mak is located (from within nmake) we just insist on the user -# to invoke nmake in the directory where xemacs.mak is. -!if !exist("$(MAKEDIR)\setup.mak") -!error Please run nmake from the directory of this makefile (xemacs\netinstall). -!endif - -XEMACS=$(MAKEDIR)\.. - -# Define a variable for the 'del' command to use -DEL=-del - -# Configuration from nt subdirectory if needed - -!include "$(XEMACS)\nt\config.inc" - -OUTDIR = obj - -# -# Compiler command echo control. Define VERBOSECC=1 to get verbose compilation. -# -!if !defined(VERBOSECC) -VERBOSECC=0 -!endif -!if $(VERBOSECC) -CCV=$(CC) -!else -CCV=@$(CC) -!endif - -!if $(DEBUG_XEMACS) -cdebug=-Od -Gr -Zi -Zp8 -!else -cdebug=-Oxsb2 -Oy- -G5rFs -Zi -Zp8 -!endif - -defines = -DWIN32_NATIVE -I$(ZLIBDIR) $(ZLIB_FLAGS) - -# -# Object files -# -OBJS = \ - $(OUTDIR)\choose.obj \ - $(OUTDIR)\concat.obj \ - $(OUTDIR)\desktop.obj \ - $(OUTDIR)\dialog.obj \ - $(OUTDIR)\diskfull.obj \ - $(OUTDIR)\download.obj \ - $(OUTDIR)\find.obj \ - $(OUTDIR)\fromcwd.obj \ - $(OUTDIR)\geturl.obj \ - $(OUTDIR)\hash.obj \ - $(OUTDIR)\ini.obj \ - $(OUTDIR)\init.obj \ - $(OUTDIR)\inilex.obj \ - $(OUTDIR)\iniparse.obj \ - $(OUTDIR)\install.obj \ - $(OUTDIR)\localdir.obj \ - $(OUTDIR)\log.obj \ - $(OUTDIR)\main.obj \ - $(OUTDIR)\mkdir.obj \ - $(OUTDIR)\mklink2.obj \ - $(OUTDIR)\regedit.obj \ - $(OUTDIR)\msg.obj \ - $(OUTDIR)\net.obj \ - $(OUTDIR)\netio.obj \ - $(OUTDIR)\nio-ie5.obj \ - $(OUTDIR)\nio-file.obj \ - $(OUTDIR)\nio-ftp.obj \ - $(OUTDIR)\nio-http.obj \ - $(OUTDIR)\other.obj \ - $(OUTDIR)\postinstall.obj \ - $(OUTDIR)\root.obj \ - $(OUTDIR)\simpsock.obj \ - $(OUTDIR)\site.obj \ - $(OUTDIR)\source.obj \ - $(OUTDIR)\splash.obj \ - $(OUTDIR)\state.obj \ - $(OUTDIR)\tar.obj \ - $(OUTDIR)\uninstall.obj \ - $(OUTDIR)\version.obj - -# -# Libraries -# -LIBS = libcmt.lib $(olelibsmt) \ - kernel32.lib shell32.lib \ - wsock32.lib netapi32.lib \ - wininet.lib $(zlib) - -# Rules - -.SUFFIXES: -.SUFFIXES: .c .cc .obj .texi .info - -# nmake rule -.cc{$(OUTDIR)}.obj: - $(CC) /TP $(cflags) $(cdebug) $(cvarsmt) $(defines) -Fo$@ $< -.c{$(OUTDIR)}.obj: - $(CC) $(cflags) $(cdebug) $(cvarsmt) $(defines) -Fo$@ $< - -# -# Main target -# -all: setup.exe - -# -# Link target. setargv.obj is provided in the compiler library directory. -# -setup.exe: $(OUTDIR) $(OBJS) res.res - $(link) /OUT:$@ $(ldebug) $(guilflags) $(OBJS) res.res $(LIBS) - -iniparse.c iniparse.h : iniparse.y - bison -d -o iniparse.c $(srcdir)/iniparse.y - -$(OUTDIR)\inilex.obj: iniparse.h - -inilex.c : inilex.l iniparse.h - flex -t $(srcdir)/inilex.l | sed "/^extern int isatty YY/d" > inilex.c - -version.c : $(srcdir)/ChangeLog version.pl - perl version.pl < ChangeLog > version.c - -res.res: res.rc - $(rc) $(rcvars) $(rcflags) /fo$@ $** - -$(OUTDIR): - -@mkdir $(OUTDIR) - -install:: all - -clean:: - $(DEL) $(OUTDIR)\*.obj *.pdb *.aps res.res lex.yy.c - -distclean:: clean - $(DEL) *~ setup.exe - -# DO NOT DELETE - -$(OUTDIR)/autoload.obj: autoload.c win32.h -$(OUTDIR)/inilex.obj: inilex.c win32.h ini.h iniparse.h -$(OUTDIR)/init.obj: win32.h dialog.h resource.h \ - state.h ini.h concat.h msg.h log.h find.h reginfo.h -$(OUTDIR)/iniparse.obj: iniparse.c ini.h iniparse.h port.h -$(OUTDIR)/inilex.obj: inilex.c win32.h ini.h iniparse.h -$(OUTDIR)/mklink2.obj: mklink2.c win32.h -$(OUTDIR)/choose.obj: choose.cc win32.h dialog.h resource.h \ - state.h ini.h concat.h msg.h log.h find.h reginfo.h -$(OUTDIR)/concat.obj: concat.cc win32.h -$(OUTDIR)/desktop.obj: desktop.cc win32.h \ - resource.h ini.h msg.h state.h \ - concat.h mkdir.h dialog.h version.h reginfo.h regedit.h port.h -$(OUTDIR)/dialog.obj: dialog.cc win32.h dialog.h msg.h log.h \ - win32.h -$(OUTDIR)/diskfull.obj: diskfull.cc diskfull.h -$(OUTDIR)/download.obj: download.cc win32.h resource.h msg.h \ - ini.h dialog.h concat.h geturl.h state.h mkdir.h log.h -$(OUTDIR)/find.obj: find.cc win32.h port.h -$(OUTDIR)/fromcwd.obj: fromcwd.cc win32.h \ - ini.h resource.h concat.h \ - state.h dialog.h msg.h find.h version.h port.h -$(OUTDIR)/geturl.obj: geturl.cc win32.h dialog.h geturl.h \ - resource.h netio.h msg.h log.h -$(OUTDIR)/hash.obj: hash.cc win32.h hash.h -$(OUTDIR)/ini.obj: ini.cc win32.h ini.h resource.h concat.h \ - state.h geturl.h dialog.h msg.h mkdir.h log.h reginfo.h version.h -$(OUTDIR)/install.obj: install.cc win32.h \ - $(ZLIBDIR)/zlib.h $(ZLIBDIR)/zconf.h \ - resource.h ini.h dialog.h concat.h geturl.h mkdir.h state.h tar.h \ - diskfull.h msg.h regedit.h reginfo.h log.h hash.h port.h -$(OUTDIR)/localdir.obj: localdir.cc win32.h dialog.h resource.h \ - state.h msg.h concat.h log.h -$(OUTDIR)/log.obj: log.cc win32.h resource.h msg.h log.h dialog.h \ - state.h concat.h mkdir.h -$(OUTDIR)/main.obj: main.cc win32.h resource.h dialog.h state.h \ - msg.h netio.h find.h log.h port.h -$(OUTDIR)/mkdir.obj: mkdir.cc win32.h mkdir.h -$(OUTDIR)/msg.obj: msg.cc win32.h dialog.h log.h -$(OUTDIR)/net.obj: net.cc win32.h dialog.h resource.h state.h \ - msg.h log.h -$(OUTDIR)/netio.obj: netio.cc win32.h resource.h state.h msg.h \ - netio.h nio-file.h nio-ie5.h nio-http.h nio-ftp.h dialog.h log.h port.h \ - win32.h -$(OUTDIR)/nio-file.obj: nio-file.cc netio.h nio-file.h resource.h \ - msg.h -$(OUTDIR)/nio-ftp.obj: nio-ftp.cc win32.h resource.h state.h \ - simpsock.h log.h netio.h nio-ftp.h -$(OUTDIR)/nio-http.obj: nio-http.cc win32.h resource.h state.h \ - simpsock.h msg.h netio.h nio-http.h -$(OUTDIR)/nio-ie5.obj: nio-ie5.cc win32.h resource.h state.h \ - dialog.h msg.h netio.h nio-ie5.h -$(OUTDIR)/other.obj: other.cc win32.h dialog.h resource.h state.h \ - msg.h log.h -$(OUTDIR)/postinstall.obj: postinstall.cc win32.h \ - state.h dialog.h find.h \ - concat.h regedit.h reginfo.h resource.h port.h -$(OUTDIR)/regedit.obj: regedit.cc win32.h reginfo.h regedit.h \ - msg.h resource.h dialog.h -$(OUTDIR)/root.obj: root.cc win32.h dialog.h resource.h state.h \ - msg.h regedit.h reginfo.h concat.h log.h -$(OUTDIR)/simpsock.obj: simpsock.cc win32.h simpsock.h msg.h \ - win32.h -$(OUTDIR)/site.obj: site.cc dialog.h resource.h state.h geturl.h \ - msg.h concat.h regedit.h reginfo.h log.h port.h -$(OUTDIR)/source.obj: source.cc win32.h dialog.h resource.h \ - state.h msg.h log.h -$(OUTDIR)/splash.obj: splash.cc win32.h dialog.h resource.h msg.h \ - version.h -$(OUTDIR)/state.obj: state.cc state.h -$(OUTDIR)/uninstall.obj: install.cc win32.h \ - $(ZLIBDIR)/zlib.h $(ZLIBDIR)/zconf.h \ - resource.h ini.h dialog.h concat.h geturl.h mkdir.h state.h tar.h \ - diskfull.h msg.h regedit.h reginfo.h log.h hash.h port.h -$(OUTDIR)/tar.obj: tar.cc win32.h \ - $(ZLIBDIR)/zlib.h $(ZLIBDIR)/zconf.h \ - tar.h mkdir.h log.h port.h - -# -# Local Variables: -# mode: makefile -# End: diff -r 861f2601a38b -r 1f0b15040456 netinstall/simpsock.cc --- a/netinstall/simpsock.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,201 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* Simplified socket access functions */ - -#include "win32.h" -#include -#include -#include -#include - -#include "simpsock.h" -#include "msg.h" - -#define SSBUFSZ 1024 - -SimpleSocket::SimpleSocket (char *hostname, int port) -{ - static int initted = 0; - if (!initted) - { - initted = 1; - WSADATA d; - WSAStartup (MAKEWORD (1,1), &d); - } - - s = INVALID_SOCKET; - buf = (char *) malloc (SSBUFSZ + 3); - putp = getp = 0; - - int i1, i2, i3, i4; - unsigned char ip[4]; - - if (sscanf (hostname, "%d.%d.%d.%d", &i1, &i2, &i3, &i4) == 4) - { - ip[0] = i1; - ip[1] = i2; - ip[2] = i3; - ip[3] = i4; - } - else - { - struct hostent *he; - he = gethostbyname (hostname); - if (!he) - { - msg ("Can't resolve `%s'\n", hostname); - return; - } - memcpy (ip, he->h_addr_list[0], 4); - } - - s = socket (AF_INET, SOCK_STREAM, 0); - if (s == INVALID_SOCKET) - { - msg ("Can't create socket, %d", WSAGetLastError ()); - return; - } - - struct sockaddr_in name; - - memset (&name, 0, sizeof (name)); - name.sin_family = AF_INET; - name.sin_port = htons (port); - memcpy (&name.sin_addr, ip, 4); - - if (connect (s, (sockaddr *)&name, sizeof(name))) - { - msg ("Can't connect to %s:%d", hostname, port); - closesocket (s); - s = INVALID_SOCKET; - return; - } - - return; -} - -SimpleSocket::~SimpleSocket () -{ - if (s != INVALID_SOCKET) - closesocket (s); - s = INVALID_SOCKET; - if (buf) - free (buf); - buf = 0; -} - -int -SimpleSocket::ok () -{ - if (s == INVALID_SOCKET) - return 0; - return 1; -} - -int -SimpleSocket::printf (char *fmt, ...) -{ - char localbuf[SSBUFSZ]; - va_list args; - va_start (args, fmt); - vsprintf (localbuf, fmt, args); - return send (s, localbuf, strlen (localbuf), 0); -} - -int -SimpleSocket::write (char *localbuf, int len) -{ - return send (s, localbuf, len, 0); -} - -int -SimpleSocket::fill () -{ - if (putp == getp) - putp = getp = 0; - - int n = SSBUFSZ - putp; - if (n == 0) - return 0; - int r = recv (s, buf + putp, n, 0); - if (r > 0) - { - putp += r; - return r; - } - return 0; -} - -char * -SimpleSocket::gets () -{ - if (getp > 0 && putp > getp) - { - memmove (buf, buf+getp, putp-getp); - putp -= getp; - getp = 0; - } - if (putp == getp) - fill(); - - // getp is zero, always, here, and putp is the count - char *nl; - while ((nl = (char *)memchr (buf, '\n', putp)) == NULL && putp < SSBUFSZ) - if (fill () <= 0) - break; - - if (nl) - { - getp = nl - buf + 1; - while ((*nl == '\n' || *nl == '\r') && nl >= buf) - *nl-- = 0; - } - else - { - getp = putp; - nl = buf + putp; - nl[1] = 0; - } - - return buf; -} - -#define MIN(a,b) ((a) < (b) ? (a) : (b)) - -int -SimpleSocket::read (char *ubuf, int ulen) -{ - int n, rv=0; - if (putp > getp) - { - n = MIN (ulen, putp-getp); - memmove (ubuf, buf+getp, n); - getp += n; - ubuf += n; - ulen -= n; - rv += n; - } - while (ulen > 0) - { - n = recv (s, ubuf, ulen, 0); - if (n <= 0) - return rv; - ubuf += n; - ulen -= n; - rv += n; - } - return rv; -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/simpsock.h --- a/netinstall/simpsock.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,36 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* Simplified socket access functions */ - -class SimpleSocket { - - SOCKET s; - char *buf; - int putp, getp; - int fill (); - - public: - SimpleSocket (char *hostname, int port); - ~SimpleSocket (); - - int ok (); - - int printf (char *fmt, ...); - int write (char *buf, int len); - - char *gets (); - int read (char *buf, int len); -}; diff -r 861f2601a38b -r 1f0b15040456 netinstall/site.cc --- a/netinstall/site.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,329 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The purpose of this file is to get the list of mirror sites and ask - the user which mirror site they want to download from. */ - -#include "win32.h" -#include -#include -#include - -#include "dialog.h" -#include "resource.h" -#include "state.h" -#include "geturl.h" -#include "msg.h" -#include "concat.h" -#include "regedit.h" -#include "reginfo.h" -#include "log.h" - -#include "port.h" - -#define NO_IDX (-1) -#define OTHER_IDX (-2) - -typedef struct { - char *url; - char *displayed_url; - char *sort_key; -} site_list_type; - -static site_list_type *site_list = 0; -static int list_idx = NO_IDX; -static int mirror_idx = NO_IDX; - -static void -check_if_enable_next (HWND h) -{ - EnableWindow (GetDlgItem (h, IDOK), (mirror_idx != NO_IDX) ? 1 : 0); -} - -static void -load_dialog (HWND h) -{ - HWND listbox = GetDlgItem (h, IDC_URL_LIST); - SendMessage (listbox, LB_SETCURSEL, list_idx, 0); - check_if_enable_next (h); -} - -static void -save_dialog (HWND h) -{ - HWND listbox = GetDlgItem (h, IDC_URL_LIST); - list_idx = SendMessage (listbox, LB_GETCURSEL, 0, 0); - if (list_idx == LB_ERR) - { - mirror_site = 0; - mirror_idx = NO_IDX; - list_idx = NO_IDX; - } - else - { - mirror_idx = SendMessage (listbox, LB_GETITEMDATA, list_idx, 0); - if (mirror_idx == OTHER_IDX) - mirror_site = 0; - else - mirror_site = site_list[mirror_idx].url; - } -} - -static void -get_root_dir () -{ - int issystem, isnative; - if (root_dir) - return; - root_dir = find_root_location (&issystem, &isnative); -} - -void -save_site_url () -{ - if (! MIRROR_SITE) - return; - - get_root_dir (); - if (! root_dir) - return; - - FILE *f = fopen (concat (root_dir, XEMACS_SETUP_DIR, "last-mirror", 0), "wb"); - if (!f) - return; - fprintf (f, "%s\n", MIRROR_SITE); - fclose (f); -} - -static BOOL -dialog_cmd (HWND h, int id, HWND hwndctl, UINT code) -{ - switch (id) - { - - case IDC_URL_LIST: - save_dialog (h); - check_if_enable_next (h); - break; - - case IDOK: - save_dialog (h); - if (mirror_idx == OTHER_IDX) - NEXT (IDD_OTHER_URL); - else - { - other_url = 0; - save_site_url (); - NEXT (IDD_S_LOAD_INI); - } - break; - - case IDC_BACK: - save_dialog (h); - NEXT (IDD_NET); - break; - - case IDCANCEL: - NEXT (0); - break; - } - return FALSE; -} - -static BOOL CALLBACK -dialog_proc (HWND h, UINT message, WPARAM wParam, LPARAM lParam) -{ - int i, j; - HWND listbox; - switch (message) - { - case WM_INITDIALOG: - listbox = GetDlgItem (h, IDC_URL_LIST); - for (i=0; site_list[i].url; i++) - { - j = SendMessage (listbox, LB_ADDSTRING, 0, (LPARAM)site_list[i].displayed_url); - SendMessage (listbox, LB_SETITEMDATA, j, i); - } - j = SendMessage (listbox, LB_ADDSTRING, 0, (LPARAM)"Other URL"); - SendMessage (listbox, LB_SETITEMDATA, j, OTHER_IDX); - load_dialog (h); - return FALSE; - case WM_COMMAND: - return HANDLE_WM_COMMAND (h, wParam, lParam, dialog_cmd); - } - return FALSE; -} - -static int CDECL -site_sort (const void *va, const void *vb) -{ - site_list_type *a = (site_list_type *)va; - site_list_type *b = (site_list_type *)vb; - return strcmp (a->sort_key, b->sort_key); -} - -static int -get_site_list (HINSTANCE h) -{ - char mirror_url[1000]; - if (LoadString (h, IDS_MIRROR_LST, mirror_url, sizeof (mirror_url)) <= 0) - return 1; - char *mirrors = get_url_to_string (mirror_url); - dismiss_url_status_dialog (); - if (!mirrors) - return 1; - - char *bol, *eol, *nl; - - - /* null plus account for possibly missing NL plus account for "Other - URL" from previous run. */ - int nmirrors = 3; - - for (bol=mirrors; *bol; bol++) - if (*bol == '\n') - nmirrors ++; - - site_list = (site_list_type *) malloc (nmirrors * sizeof (site_list_type)); - nmirrors = 0; - - nl = mirrors; - while (*nl) - { - bol = nl; - for (eol = bol; *eol && *eol != '\n'; eol++) ; - if (*eol) - nl = eol+1; - else - nl = eol; - while (eol > bol && eol[-1] == '\r') - eol--; - *eol = 0; - if (bol[0] != '#' && bol[0] > ' ') - { - char *semi = strchr (bol, ';'); - if (semi) - *semi = 0; - site_list[nmirrors].url = _strdup (bol); - site_list[nmirrors].displayed_url = _strdup (bol); - char *dot = strchr (site_list[nmirrors].displayed_url, '.'); - if (dot) - { - dot = strchr (dot, '/'); - if (dot) - *dot = 0; - } - site_list[nmirrors].sort_key = (char *) malloc (2*strlen (bol) + 3); - - dot = site_list[nmirrors].displayed_url; - dot += strlen (dot); - char *dp = site_list[nmirrors].sort_key; - while (dot != site_list[nmirrors].displayed_url) - { - if (*dot == '.' || *dot == '/') - { - char *sp; - if (dot[3] == 0) - *dp++ = '~'; /* sort .com/.edu/.org together */ - for (sp=dot+1; *sp && *sp != '.' && *sp != '/';) - *dp++ = *sp++; - *dp++ = ' '; - } - dot--; - } - *dp++ = ' '; - strcpy (dp, site_list[nmirrors].displayed_url); - - nmirrors++; - } - } - site_list[nmirrors].url = 0; - - qsort (site_list, nmirrors, sizeof (site_list_type), site_sort); - - return 0; -} - -/* List of machines that should not be used by default when saved - in "last-mirror". */ -#define NOSAVE1 "ftp://ftp.xemacs.org/" -#define NOSAVE1_LEN (sizeof ("ftp://ftp.xemacs.org/") - 1) - -static void -get_initial_list_idx () -{ - get_root_dir (); - if (! root_dir) - return; - - FILE *f = fopen (concat (root_dir, XEMACS_SETUP_DIR, "last-mirror", 0), "rt"); - if (!f) - return; - - char site[1000]; - site[0]='\0'; - char * fg_ret = fgets (site, 1000, f); - fclose (f); - if (! fg_ret) - return; - - char *eos = site + strlen (site) - 1; - while (eos >= site && (*eos == '\n' || *eos == '\r')) - *eos-- = '\0'; - - if (eos < site) - return; - - int i; - for (i = 0; site_list[i].url; i++) - if (strcmp (site_list[i].url, site) == 0) - break; - - if (! site_list[i].url) - { - /* Don't default to certain machines ever since they suffer - from bandwidth limitations. */ - if (strnicmp (site, NOSAVE1, NOSAVE1_LEN) == 0) - return; - site_list[i].displayed_url = - site_list[i].url = _strdup (site); - site_list[i+1].url = 0; - } - - mirror_idx = list_idx = i; -} - -void -do_site (HINSTANCE h) -{ - int rv = 0; - - if (site_list == 0) - if (get_site_list (h)) - { - NEXT (IDD_NET); - return; - } - - get_initial_list_idx (); - - rv = DialogBox (h, MAKEINTRESOURCE (IDD_SITE), 0, dialog_proc); - if (rv == -1) - fatal (IDS_DIALOG_FAILED); - - if (mirror_idx != OTHER_IDX) - log (0, "site: %s", mirror_site); -} - diff -r 861f2601a38b -r 1f0b15040456 netinstall/source.cc --- a/netinstall/source.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,108 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - * Sync'ed with cinstall 2001-10-16 - */ - -/* The purpose of this file is to manage the dialog box that lets the - user choose the source of the install - from the net, from the - current directory, or to just download files. */ - -#include "win32.h" -#include -#include "dialog.h" -#include "resource.h" -#include "state.h" -#include "msg.h" -#include "log.h" - -static int rb[] = { IDC_SOURCE_NETINST, IDC_SOURCE_DOWNLOAD, IDC_SOURCE_CWD, 0 }; - -static void -load_dialog (HWND h) -{ - rbset (h, rb, source); -} - -static void -save_dialog (HWND h) -{ - source = rbget (h, rb); -} - -static BOOL -dialog_cmd (HWND h, int id, HWND hwndctl, UINT code) -{ - switch (id) - { - - case IDC_SOURCE_DOWNLOAD: - case IDC_SOURCE_NETINST: - case IDC_SOURCE_CWD: - save_dialog (h); - break; - - case IDOK: - save_dialog (h); - NEXT (IDD_LOCAL_DIR); - break; - - case IDC_BACK: - save_dialog (h); - NEXT (0); - break; - - case IDCANCEL: - NEXT (0); - break; - - default: - break; - } -} - -static BOOL CALLBACK -dialog_proc (HWND h, UINT message, WPARAM wParam, LPARAM lParam) -{ - switch (message) - { - case WM_INITDIALOG: - load_dialog (h); - // Check to see if any radio buttons are selected. If not, select a default. - if ((!SendMessage(GetDlgItem (h, IDC_SOURCE_DOWNLOAD), BM_GETCHECK, 0, 0) == BST_CHECKED) - && (!SendMessage(GetDlgItem (h, IDC_SOURCE_CWD), BM_GETCHECK, 0, 0) == BST_CHECKED)) - { - SendMessage(GetDlgItem (h, IDC_SOURCE_NETINST), BM_SETCHECK, BST_CHECKED, 0); - } - return FALSE; - case WM_COMMAND: - return HANDLE_WM_COMMAND (h, wParam, lParam, dialog_cmd); - } - return FALSE; -} - -void -do_source (HINSTANCE h) -{ - int rv = 0; - /* source = IDC_SOURCE_CWD;*/ - source = IDC_SOURCE_NETINST; - rv = DialogBox (h, MAKEINTRESOURCE (IDD_SOURCE), 0, dialog_proc); - if (rv == -1) - fatal (IDS_DIALOG_FAILED); - - log (0, "source: %s", - (source == IDC_SOURCE_DOWNLOAD) ? "download" : - (source == IDC_SOURCE_NETINST) ? "network install" : "from cwd"); -} - diff -r 861f2601a38b -r 1f0b15040456 netinstall/splash.cc --- a/netinstall/splash.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,75 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The purpose of this file is to display the program name, version, - copyright notice, and project URL. */ - -#include "win32.h" -#include -#include "dialog.h" -#include "resource.h" -#include "msg.h" -#include "version.h" - -static void -load_dialog (HWND h) -{ - char buffer[100]; - HWND v = GetDlgItem (h, IDC_VERSION); - sprintf (buffer, "Setup.exe version %s", - version[0] ? version : "[unknown]"); - SetWindowText (v, buffer); -} - -static BOOL -dialog_cmd (HWND h, int id, HWND hwndctl, UINT code) -{ - switch (id) - { - - case IDOK: - NEXT (IDD_SOURCE); - break; - - case IDCANCEL: - NEXT (0); - break; - } - return FALSE; -} - -static BOOL CALLBACK -dialog_proc (HWND h, UINT message, WPARAM wParam, LPARAM lParam) -{ - switch (message) - { - case WM_INITDIALOG: - load_dialog (h); - return FALSE; - case WM_COMMAND: - return HANDLE_WM_COMMAND (h, wParam, lParam, dialog_cmd); - } - return FALSE; -} - -void -do_splash (HINSTANCE h) -{ - int rv = 0; - rv = DialogBox (h, MAKEINTRESOURCE (IDD_SPLASH), 0, dialog_proc); - if (rv == -1) - fatal (IDS_DIALOG_FAILED); -} - diff -r 861f2601a38b -r 1f0b15040456 netinstall/state.cc --- a/netinstall/state.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* All we do here is instantiate the extern'd variables from state.h */ - -#define extern -#include "state.h" diff -r 861f2601a38b -r 1f0b15040456 netinstall/state.h --- a/netinstall/state.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,54 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The purpose of this file is to contain all the global variables - that define the "state" of the install, that is, all the - information that the user has provided so far. These are set by - the various dialogs and used by the various actions. */ - -extern int source; - -extern char * local_dir; - -extern char * root_dir; -extern int root_dir_default; -extern int install_type; -extern int root_scope; -extern int root_menu; -extern int root_desktop; - -extern int reg_c; -extern int reg_cpp; -extern int reg_java; -extern int reg_elisp; -extern int reg_txt; -extern int reg_idl; - -extern int net_method; -extern char * net_proxy_host; -extern int net_proxy_port; - -extern char * net_user; -extern char * net_passwd; -extern char * net_proxy_user; -extern char * net_proxy_passwd; - -extern char * mirror_site; -extern char * other_url; - -extern int trust_level; -extern int uninstall; - -#define MIRROR_SITE (mirror_site ? mirror_site : other_url) diff -r 861f2601a38b -r 1f0b15040456 netinstall/tar.cc --- a/netinstall/tar.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,538 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* Built-in tar functionality. See tar.h for usage. */ - -#include -#include -#include -#include - -#include "win32.h" -#include -#include "tar.h" -#include "mkdir.h" -#include "log.h" - -#include "port.h" - -#if defined(CYGWIN) || defined(MINGW) -#define FACTOR (0x19db1ded53ea710LL) -#define NSPERSEC 10000000LL -#else -__int64 FACTOR=0x19db1ded53ea710L; -__int64 NSPERSEC=10000000L; -#endif -#define SYMLINK_COOKIE "!" - -typedef struct { - char name[100]; /* 0 */ - char mode[8]; /* 100 */ - char uid[8]; /* 108 */ - char gid[8]; /* 116 */ - char size[12]; /* 124 */ - char mtime[12]; /* 136 */ - char chksum[8]; /* 148 */ - char typeflag; /* 156 */ - char linkname[100]; /* 157 */ - char magic[6]; /* 257 */ - char version[2]; /* 263 */ - char uname[32]; /* 265 */ - char gname[32]; /* 297 */ - char devmajor[8]; /* 329 */ - char devminor[8]; /* 337 */ - char prefix[155]; /* 345 */ - char junk[12]; /* 500 */ -} tar_header_type; - -typedef struct tar_map_result_type_s { - struct tar_map_result_type_s *next; - char *stored_name; - char *mapped_name; -} tar_map_result_type; - -static tar_map_result_type *tar_map_result = 0; - -static int err; - -static char file_name[_MAX_PATH+512]; -static char have_longname = 0; -static int file_length; - -static tar_header_type tar_header; -static char buf[512]; - -static int _tar_file_size = 0; -int _tar_verbose = 0; -FILE * _tar_vfile = 0; -#define vp if (_tar_verbose) fprintf -#define vp2 if (_tar_verbose>1) fprintf - -static gzFile g = 0; - -static char * -xstrdup (char *c) -{ - char *r = (char *) malloc (strlen (c) + 1); - if (!r) - exit_setup (1); - strcpy (r, c); - return r; -} - -int -tar_open (char *pathname) -{ - struct stat s; - if (_tar_vfile == 0) - _tar_vfile = stderr; - - vp2 (_tar_vfile, "tar: open `%s'\n", pathname); - if (stat (pathname, &s) < 0) - return 1; - _tar_file_size = s.st_size; - - g = gzopen (pathname, "rb"); - if (sizeof (tar_header) != 512) - { - /* drastic, but important */ - fprintf (stderr, "compilation error: tar header struct not 512" - " bytes (it's %d)\n", sizeof (tar_header)); - exit_setup (1); - } - err = 0; - return g ? 0 : 1; -} - -/* For some reason the cygwin version uses a function that is not in - the original source. We duplicate it here - although this does mean - revealing some internals. */ -extern "C" { - z_off_t ZEXPORT tar_gzctell (gzFile file); - typedef struct gz_stream { - z_stream stream; - int z_err; /* error code for last stream operation */ - int z_eof; /* set if end of input file */ - FILE *file; /* .gz file */ - Byte *inbuf; /* input buffer */ - Byte *outbuf; /* output buffer */ - uLong crc; /* crc32 of uncompressed data */ - char *msg; /* error message */ - char *path; /* path name for debugging only */ - int transparent; /* 1 if input file is not a .gz file */ - char mode; /* 'w' or 'r' */ - long startpos; /* start of compressed data in file (header skipped) */ - } gz_stream; -}; - -z_off_t ZEXPORT tar_gzctell (gzFile file) -{ - gz_stream *s = (gz_stream *)file; - return ftell(s->file); -} - -int -tar_ftell () -{ - return tar_gzctell (g); -} - -static void -skip_file () -{ - while (file_length > 0) - { - gzread (g, buf, 512); - file_length -= 512; - } -} - -char * -tar_next_file () -{ - int r, n; - char *c; - r = gzread (g, &tar_header, 512); - - /* See if we're at end of file */ - if (r != 512) - return 0; - - /* See if the header is all zeros (i.e. last block) */ - n = 0; - for (r = 512/sizeof (int); r; r--) - n |= ((int *)&tar_header)[r-1]; - if (n == 0) - return 0; - - if (!have_longname && tar_header.typeflag != 'L') - { - memcpy (file_name, tar_header.name, 100); - file_name[100] = 0; - } - - sscanf (tar_header.size, "%o", &file_length); - - vp2 (_tar_vfile, "%c %9d %s\n", tar_header.typeflag, file_length, file_name); - - switch (tar_header.typeflag) - { - case 'L': /* GNU tar long name extension */ - if (file_length > _MAX_PATH) - { - skip_file (); - fprintf (stderr, "error: long file name exceeds %d characters\n", - _MAX_PATH); - err ++; - gzread (g, &tar_header, 512); - sscanf (tar_header.size, "%o", &file_length); - skip_file (); - return tar_next_file (); - } - c = file_name; - while (file_length > 0) - { - int need = file_length > 512 ? 512 : file_length; - if (gzread (g, buf, 512) < 512) - return 0; - memcpy (c, buf, need); - c += need; - file_length -= need; - } - *c = 0; - have_longname = 1; - return tar_next_file (); - - case '3': /* char */ - case '4': /* block */ - case '6': /* fifo */ - fprintf (stderr, "warning: not extracting special file %s\n", - file_name); - err ++; - return tar_next_file (); - - case '0': /* regular file */ - case 0: /* regular file also */ - case '2': /* symbolic link */ - case '5': /* directory */ - case '7': /* contiguous file */ - return file_name; - - case '1': /* hard link, we just copy */ - return file_name; - - default: - fprintf (stderr, "error: unknown (or unsupported) file type `%c'\n", - tar_header.typeflag); - err ++; - skip_file (); - return tar_next_file (); - } -} - -static void -fix_time_stamp (char *path) -{ - int mtime; -#if defined(CYGWIN) || defined(MINGW) - long long ftimev; -#else - __int64 ftimev; -#endif - FILETIME ftime; - HANDLE h; - - sscanf (tar_header.mtime, "%o", &mtime); - ftimev = mtime * NSPERSEC + FACTOR; - ftime.dwHighDateTime = ftimev >> 32; - ftime.dwLowDateTime = ftimev; - h = CreateFileA (path, GENERIC_WRITE, FILE_SHARE_READ | FILE_SHARE_WRITE, - 0, OPEN_EXISTING, - FILE_ATTRIBUTE_NORMAL | FILE_FLAG_BACKUP_SEMANTICS, 0); - if (h) - { - SetFileTime (h, 0, 0, &ftime); - CloseHandle (h); - } -} - -static FILE * -common_fopen (char *path) -{ - FILE *out; - out = fopen (path, "wb"); - if (!out) - { - /* maybe we need to create a directory */ - if (mkdir_p (0, path)) - { - skip_file (); - return 0; - } - out = fopen (path, "wb"); - } - if (!out) - { - fprintf (stderr, "unable to write to file %s\n", path); - perror ("The error was"); - skip_file (); - return 0; - } - return out; -} - -static void -prepare_for_file (char *path) -{ - DWORD w; - mkdir_p (0, path); - - w = GetFileAttributes (path); - if (w != 0xffffffff && w & FILE_ATTRIBUTE_DIRECTORY) - { - char *tmp = (char *) malloc (strlen (path) + 10); - int i = 0; - do { - i++; - sprintf (tmp, "%s.old-%d", path, i); - } while (GetFileAttributes (tmp) != 0xffffffff); - fprintf (stderr, "warning: moving directory \"%s\" out of the way.\n", path); - MoveFile (path, tmp); - free (tmp); - } - - DeleteFileA (path); -} - -int -tar_read_file (char *path) -{ - FILE *out, *copy; - HANDLE h; - DWORD w; - int got; - tar_map_result_type *tmr; - - switch (tar_header.typeflag) - { - case '0': /* regular files */ - case 0: - case '7': - vp (_tar_vfile, "F %s\n", path); - prepare_for_file (path); - out = common_fopen (path); - if (!out) - return 1; - - while (file_length > 0) - { - int put; - int want = file_length > 512 ? 512 : file_length; - got = gzread (g, buf, 512); - if (got < 512) - { - fprintf (stderr, "tar: unexpected end of file reading %s\n", path); - fclose (out); - remove (path); - return 1; - } - put = fwrite (buf, 1, want, out); - if (put < want) - { - fprintf (stderr, "tar: out of disk space writing %s\n", path); - fclose (out); - remove (path); - skip_file (); - return 1; - } - file_length -= want; - } - fclose (out); - - fix_time_stamp (path); - - /* we need this to do hard links below */ - tmr = (tar_map_result_type *) malloc (sizeof (tar_map_result_type)); - tmr->next = tar_map_result; - tmr->stored_name = xstrdup (file_name); - tmr->mapped_name = xstrdup (path); - tar_map_result = tmr; - - return 0; - - case '1': /* hard links; we just copy */ - for (tmr = tar_map_result; tmr; tmr=tmr->next) - if (strcmp (tmr->stored_name, tar_header.linkname) == 0) - break; - if (!tmr) - { - fprintf (stderr, "tar: can't find %s to link %s to\n", - tar_header.linkname, path); - return 1; - } - vp (_tar_vfile, "H %s <- %s\n", path, tmr->mapped_name); - prepare_for_file (path); - copy = fopen (tmr->mapped_name, "rb"); - if (!copy) - { - fprintf (stderr, "tar: unable to read %s\n", tmr->mapped_name); - return 1; - } - out = common_fopen (path); - if (!out) - return 1; - - while ((got = fread (buf, 1, 512, copy)) > 0) - { - int put = fwrite (buf, 1, got, out); - if (put < got) - { - fprintf (stderr, "tar: out of disk space writing %s\n", path); - fclose (out); - fclose (copy); - remove (path); - return 1; - } - } - fclose (out); - fclose (copy); - - fix_time_stamp (path); - return 0; - - case '5': /* directories */ - vp (_tar_vfile, "D %s\n", path); - while (path[0] && path[strlen (path)-1] == '/') - path[strlen (path) - 1] = 0; - return mkdir_p (1, path); - - - case '2': /* symbolic links */ - vp (_tar_vfile, "L %s -> %s\n", path, tar_header.linkname); - prepare_for_file (path); - h = CreateFileA (path, GENERIC_WRITE, 0, 0, CREATE_NEW, - FILE_ATTRIBUTE_NORMAL, 0); - if (h == INVALID_HANDLE_VALUE) - { - fprintf (stderr, "error: unable to create symlink \"%s\" -> \"%s\"\n", - path, tar_header.linkname); - return 1; - } - strcpy (buf, SYMLINK_COOKIE); - strcat (buf, tar_header.linkname); - if (WriteFile (h, buf, strlen (buf) + 1, &w, NULL)) - { - CloseHandle (h); - SetFileAttributesA (path, FILE_ATTRIBUTE_SYSTEM); - return 0; - } - CloseHandle (h); - fprintf (stderr, "error: unable to write symlink \"%s\"\n", path); - DeleteFileA (path); - return 1; - } - - return 0; -} - -int -tar_close () -{ -#if 0 - while (tar_map_result) - { - tar_map_result_type *t = tar_map_result->next; - free (tar_map_result->stored_name); - free (tar_map_result->mapped_name); - free (tar_map_result); - tar_map_result = t; - } -#endif - tar_map_result = 0; - - if (gzclose (g)) - err ++; - return err; /* includes errors for skipped files, etc */ -} - -typedef struct { - char *from; - int from_len; - char *to; - int to_len; -} map_type; - -static map_type *map; -static int nmaps; - -int -tar_auto (char *pathname, char **maplist) -{ - char *c; - int errcount = 0; - int i, j; - map_type mtemp; - char newname[_MAX_PATH+512]; - static char twiddles[] = "|\b/\b-\b\\\b"; - int t = 0; - - for (nmaps=0; maplist[nmaps*2]; nmaps++) ; - map = (map_type *) malloc ((nmaps+1) * sizeof (map_type)); - for (nmaps=0; maplist[nmaps*2]; nmaps++) - { - map[nmaps].from = maplist[nmaps*2]; - map[nmaps].from_len = strlen (maplist[nmaps*2]); - map[nmaps].to = maplist[nmaps*2+1]; - map[nmaps].to_len = strlen (maplist[nmaps*2+1]); - } - /* bubble sort - expect the maps to be short */ - for (i=0; i= map[i].from_len - && strncmp (c, map[i].from, map[i].from_len) == 0) - { - strcpy (newname, map[i].to); - strcpy (newname+map[i].to_len, c + map[i].from_len); - c = newname; - break; - } - - t = (t+2) % 8; - fwrite (twiddles+t, 1, 2, stderr); - - if (tar_read_file (c)) - errcount ++; - } - if (tar_close ()) - errcount ++; - - fwrite (" \b", 1, 2, stderr); - - vp2 (_tar_vfile, "tar_auto returns %d\n", errcount); - return errcount; -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/tar.h --- a/netinstall/tar.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,49 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -#ifndef __TAR_H_ -#define __TAR_H_ - -/* Only one tarfile may be open at a time. gzipped files handled - automatically */ - -/* returns zero on success, nonzero on failure */ -int tar_open (char *pathname); - -/* returns pointer to static buf containing name of next file */ -char * tar_next_file (); - -/* byte position in [compressed] file */ -int tar_ftell (); - -/* pass adjusted path, returns zero on success, nonzero on failure */ -int tar_read_file (char *path); - -/* closes the file */ -int tar_close (); - -/* pass path to tar file and from/to pairs for path prefix (NULLs at - end , returns zero if completely successful, nonzero (counts - errors) on failure */ -int tar_auto (char *pathname, char **map); - -int tar_mkdir_p (int isadir, char *path); - -/* -extern int _tar_verbose; -extern FILE * _tar_vfile; -*/ - -#endif diff -r 861f2601a38b -r 1f0b15040456 netinstall/uninstall.cc --- a/netinstall/uninstall.cc Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,326 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The purpose of this file is to intall all the packages selected in - the install list (in ini.h). Note that we use a separate thread to - maintain the progress dialog, so we avoid the complexity of - handling two tasks in one thread. We also create or update all the - files in /etc/setup and create the mount points. */ - -#include -#include -#include -#include -#ifndef WIN32_NATIVE -#include -#endif -#include -#include -#include -#include - -#include "win32.h" -#include "commctrl.h" - -#include "resource.h" -#include "ini.h" -#include "dialog.h" -#include "concat.h" -#include "geturl.h" -#include "mkdir.h" -#include "state.h" -#include "tar.h" -#include "diskfull.h" -#include "msg.h" -#include "regedit.h" -#include "reginfo.h" -#include "log.h" -#include "hash.h" -#include "desktop.h" - -#include "port.h" - -#define XM_DONE (WM_USER + 101) - -static HWND unins_dialog = 0; -static HWND unins_action = 0; -static HWND unins_pkgname = 0; -static HWND unins_filename = 0; -static HWND unins_pprogress = 0; -static HWND unins_iprogress = 0; -static HWND unins_diskfull = 0; -static HANDLE init_event; - -static int package_bytes = 0; -static int uninstall_started = 0; - -extern char * map_filename (char *fn, int type); -static void start_uninstall (); - -char * -base (char *s); - -static BOOL -dialog_cmd (HWND h, int id, HWND hwndctl, UINT code) -{ - switch (id) - { - case IDCANCEL: - exit_setup (1); - case IDOK: - if (uninstall_started == 0) { - uninstall_started = 1; - start_uninstall(); - } - else - exit_setup(0); - break; - } - return FALSE; -} - -static BOOL CALLBACK -dialog_proc (HWND h, UINT message, WPARAM wParam, LPARAM lParam) -{ - switch (message) - { - case WM_INITDIALOG: - unins_dialog = h; - unins_action = GetDlgItem (h, IDC_UNINS_ACTION); - unins_pkgname = GetDlgItem (h, IDC_UNINS_PKG); - unins_filename = GetDlgItem (h, IDC_UNINS_FILE); - unins_pprogress = GetDlgItem (h, IDC_UNINS_PPROGRESS); - unins_iprogress = GetDlgItem (h, IDC_UNINS_IPROGRESS); - unins_diskfull = GetDlgItem (h, IDC_UNINS_DISKFULL); - SendMessage (unins_pprogress, PBM_SETRANGE, 0, MAKELPARAM (0, 100)); - SendMessage (unins_iprogress, PBM_SETRANGE, 0, MAKELPARAM (0, 100)); - SendMessage (unins_diskfull, PBM_SETRANGE, 0, MAKELPARAM (0, 100)); - SetWindowText (unins_pkgname, ""); - SetWindowText (unins_filename, ""); - SendMessage (unins_pprogress, PBM_SETPOS, (WPARAM) 0, 0); - SendMessage (unins_iprogress, PBM_SETPOS, (WPARAM) 0, 0); - SendMessage (unins_diskfull, PBM_SETPOS, (WPARAM) 0, 0); - return FALSE; - - case XM_DONE: - { - SetWindowText (GetDlgItem (h, IDOK), "Ok"); - LONG style = GetWindowLong (GetDlgItem (h, IDCANCEL), - GWL_STYLE); - SetWindowLong (GetDlgItem (h, IDCANCEL), - GWL_STYLE, style & WS_DISABLED); - } - return FALSE; - - case WM_COMMAND: - return HANDLE_WM_COMMAND (h, wParam, lParam, dialog_cmd); - } - return DefWindowProc (h, message, wParam, lParam); -} - -static DWORD WINAPI uninstall_all (void *); - -static void -start_uninstall () -{ - DWORD tid; - HANDLE thread; - init_event = CreateEvent (0, 0, 0, 0); - thread = CreateThread (0, 0, uninstall_all, 0, 0, &tid); - WaitForSingleObject (init_event, 10000); - CloseHandle (init_event); -} - -static void -progress (int bytes, int num) -{ - int perc; - log (0, "%d bytes", bytes); - if (package_bytes > 100) - { - perc = (bytes * 100) / package_bytes; - SendMessage (unins_pprogress, PBM_SETPOS, (WPARAM) perc, 0); - } - - if (npackages > 0) - { - perc = (num * 100) / npackages; - SendMessage (unins_iprogress, PBM_SETPOS, (WPARAM) perc, 0); - } -} - -static int num_installs, num_uninstalls; - -static void -uninstall_one (char *name, int type, int num) -{ - hash dirs; - char line[_MAX_PATH]; - char* fname = (type == TY_GENERIC ? - concat (root_dir, XEMACS_PACKAGE_DIR, "pkginfo/MANIFEST.", - name, 0) : - concat (root_dir, XEMACS_SETUP_DIR, "MANIFEST.", name, 0)); - - FILE* lst = fopen (fname, "rb"); - int pos = 0; - - if (lst) - { - fseek (lst, 0, SEEK_END); - package_bytes = ftell (lst); - fseek (lst, 0, SEEK_SET); - - SetWindowText (unins_pkgname, name); - SetWindowText (unins_action, "Uninstalling..."); - log (0, "uninstalling %s", name); - - while (fgets (line, sizeof (line), lst)) - { - progress (pos, num); - pos += strlen(line); - if (line[strlen(line)-1] == '\n') - line[strlen(line)-1] = 0; - - dirs.add_subdirs (line); - - char *d = map_filename (line, type); - DWORD dw = GetFileAttributes (d); - if (dw != 0xffffffff && !(dw & FILE_ATTRIBUTE_DIRECTORY)) - { - log (LOG_BABBLE, "unlink %s", d); - DeleteFile (d); - } - } - fclose (lst); - remove (fname); - - dirs.reverse_sort (); - char *subdir = 0; - while ((subdir = dirs.enumerate (subdir)) != 0) - { - char *d = map_filename (subdir, type); - if (RemoveDirectory (d)) - log (LOG_BABBLE, "rmdir %s", d); - } - num_uninstalls ++; - } -} - -void -do_uninstall (HINSTANCE h) -{ - num_installs = 0, num_uninstalls = 0; - - next_dialog = 0; // we're done after this - - if (!root_dir) - fatal ("no installation found"); - - int rv = DialogBox (h, MAKEINTRESOURCE (IDD_UNINSTALL), 0, dialog_proc); - if (rv == -1) - fatal (IDS_DIALOG_FAILED); -} - -static void -read_installed_db () -{ - if (!root_dir) - return; - - char line[1000], pkg[1000], inst[1000], src[1000]; - int instsz, srcsz; - - FILE *db = fopen (concat (root_dir, XEMACS_SETUP_DIR, "installed.db", 0), "rt"); - if (!db) - return; - - while (fgets (line, 1000, db)) - { - src[0] = 0; - srcsz = 0; - sscanf (line, "%s %s %d %s %d", pkg, inst, &instsz, src, &srcsz); - - log (0, "read %s", pkg); - Package* np = new_package(strdup(pkg)); - pinfo(*np).install = inst; - pinfo(*np).install_size = instsz; - // pick up versoin - char *v, *d; - for (v=base (inst); *v; v++) - if (*v == '-' && isdigit(v[1])) - { - v++; - break; - } - if (!v) - v = inst; - for (d=v; *d; d++) - if (strncmp (d, ".tar", 4) == 0 - || strncmp (d, "-pkg", 4) == 0) - { - *d = 0; - break; - } - if (v[0]) - pinfo(*np).version = strdup (v); - else - pinfo(*np).version = "0"; - // Crude but effective - if (pkg != 0) - if (strncmp ("xemacs-i686", pkg, 11) == 0 - || (strncmp ("xemacs-i586", pkg, 11) == 0)) - { - np->type = install_type; - xemacs_package = np; - } - } - fclose (db); -} - -static DWORD WINAPI -uninstall_all (void *) -{ - int i; - SetEvent (init_event); - - int df = diskfull (root_dir); - SendMessage (unins_diskfull, PBM_SETPOS, (WPARAM) df, 0); - - read_installed_db(); - - log (0, "There are %d packages\n", npackages); - for (i=0; i - * - */ - -/* misc version-related things */ - -extern "C" char *version; -extern "C" char *setup_version; -extern "C" unsigned int setup_timestamp; - -extern char *canonicalize_version (char *); diff -r 861f2601a38b -r 1f0b15040456 netinstall/version.pl --- a/netinstall/version.pl Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,6 +0,0 @@ -while () { - if (/^\$Revision:\s*([0-9\.]*)/) { - print "char *version = \"$1\";\n"; - print "static char *id = \"\\n%%% setup-version $1\\n\";\n"; - } -} diff -r 861f2601a38b -r 1f0b15040456 netinstall/win32.h --- a/netinstall/win32.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,47 +0,0 @@ -/* - * Copyright (c) 2000, Red Hat, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * A copy of the GNU General Public License can be found at - * http://www.gnu.org/ - * - * Written by DJ Delorie - * - */ - -/* The purpose of this file is to limit the number of Win32 headers we - actually have to parse. The Setup program only uses a few of them, - so there's no point in parsing them all (even lean-n-mean). Doing - this cuts compile time in half. */ - -#ifndef _MINI_WIN32_ -#define _MINI_WIN32_ - -#define NOCOMATTRIBUTE - -/* Cope with native win32 & mingw differences. Written by F. Popineau - */ -#ifdef WIN32_NATIVE -# pragma warning( disable : 4007 4096 4018 4244 ) -# define strdup _strdup -# define stat _stat -# define strnicmp _strnicmp -#endif - -#include - -#define WIN32_LEAN_AND_MEAN -#include - -#include -#include - -#ifndef CDECL -#define CDECL __cdecl -#endif - -#endif /* _MINI_WIN32_ */ diff -r 861f2601a38b -r 1f0b15040456 nt/ChangeLog --- a/nt/ChangeLog Sat Feb 20 06:03:00 2010 -0600 +++ b/nt/ChangeLog Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,47 @@ +2011-04-29 Stephen J. Turnbull + + * XEmacs 21.5.31 "ginger" is released. + +2011-04-26 Stephen J. Turnbull + + * XEmacs 21.5.30 "garlic" is released. + +2010-06-14 Stephen J. Turnbull + + * compface.mak: More permission consistency. + +2010-06-13 Stephen J. Turnbull + + * tiff.mak: + * xemacs.rc: + * xpm.mak: + Correct FSF address in permission notice. + +2010-02-22 Ben Wing + + * xemacs.dsp: + * xemacs.mak: + * xemacs.mak (OPT_OBJS): + objects*.[ch] -> fontcolor*.[ch]. + +2010-03-29 Vin Shelton + + * xemacs.mak (TEMACS_COMMON_OBJS): Add array.obj and remove + dynarr.obj, to catch up with Ben's changes of 2010-03-28. + +2010-03-08 Vin Shelton + + * xemacs.mak (batch_test_emacs): The test harness no longer + resides in $(testdir), per Ben's changes of 2010-02-22. + +2010-03-02 Jerry James + + * xemacs.mak (INFO_FILES): Removed custom.info. + +2010-02-18 Vin Shelton + + * xemacs.mak (INFO_FILES): Removed term.info. + 2010-02-11 Vin Shelton * xemacs.mak (LIB_SRC_DEFINES): Added PROGRAM_DEFINES to lib_src @@ -2433,3 +2477,23 @@ * cpp.exe not used: cl.exe from VC++4.2 seems to handle everything properly. + + +ChangeLog entries synched from GNU Emacs are the property of the FSF. +Other ChangeLog entries are usually the property of the author of the +change. + +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 3 of the License, 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. If not, see . diff -r 861f2601a38b -r 1f0b15040456 nt/Emacs.ad.h --- a/nt/Emacs.ad.h Sat Feb 20 06:03:00 2010 -0600 +++ b/nt/Emacs.ad.h Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,21 @@ +/* Copyright (C) 1997 David Hobley + +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 3 of the License, 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. If not, see . */ + + (String) "Emacs.modeline*attributeForeground: Black", (String) "Emacs.modeline*attributeBackground: Gray75", (String) "Emacs.text-cursor*attributeBackground: Red3", diff -r 861f2601a38b -r 1f0b15040456 nt/Win32.cf --- a/nt/Win32.cf Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,131 +0,0 @@ -XCOMM platform: $XConsortium: Win32.cf /main/51 1996/12/19 14:20:08 lehors $ - -#ifndef OSName -#define OSName Microsoft Windows NT 4.0 -#endif -XCOMM operating system: OSName -#ifndef OSMajorVersion -#define OSMajorVersion 4 -#endif -#ifndef OSMinorVersion -#define OSMinorVersion 0 -#endif -#ifndef OSTeenyVersion -#define OSTeenyVersion 0 -#endif - -#ifndef CompilerMajorVersion -/* 0 == NT 3.1 Win32 SDK, 2 == MSVC++ 2, 4 == MSVC 4 */ -#define CompilerMajorVersion 4 -#endif - -#define BootstrapCFlags -DWIN32 -#ifdef _M_IX86 -#define CpuDefines -D_X86_ -#endif -/* brain-damaged windows headers will not compile with -Za */ -/*#define StandardDefines -DWIN32 -DWIN32_LEAN_AND_MEAN -D_DLL -D_MT -D__STDC__ CpuDefines*/ -/* Try with single threaded libc --marcpa */ -#define StandardDefines -DWIN32 -DWIN32_LEAN_AND_MEAN -D__STDC__ CpuDefines -#if CompilerMajorVersion < 4 -#define DefaultCCOptions -nologo -batch -G4 -W2 -#else -#define DefaultCCOptions -nologo -G4 -W2 -#endif -#if CompilerMajorVersion < 4 -#define DebuggableCDebugFlags -Zi -#else -#define DebuggableCDebugFlags -Zi -Od -#endif -#define ThreadedX NO -#define HasThreadSafeAPI NO -#define CpCmd copy -#define LnCmd copy -#define MvCmd ren -#define RmCmd del -#ifndef RmTreeCmd -/*#define RmTreeCmd del /q /s */ -#define RmTreeCmd rm -rf -#endif -#define CcCmd cl -#define HasCplusplus YES -#define CplusplusCmd cl -#if CompilerMajorVersion < 4 -#define PreProcessCmd CcCmd -nologo -batch -EP -#define CppCmd CcCmd -nologo -batch -E -#else -#define PreProcessCmd CcCmd -nologo -EP -#define CppCmd CcCmd -nologo -E -#endif -#define PatheticCpp YES -#define ConstructMFLAGS YES -#if (CompilerMajorVersion == 0) -#define ArCmdBase lib32 -#else -#define ArCmdBase lib -#endif -#define ArCmd ArCmdBase -#define CplusplusCmd cl -#define MkdirHierCmd mkdir -#define InstallCmd copy -#define InstPgmFlags /**/ -#define InstBinFlags /**/ -#define InstUidFlags /**/ -#define InstLibFlags /**/ -#define InstIncFlags /**/ -#define InstManFlags /**/ -#define InstDatFlags /**/ -#define InstallFlags /**/ -#if (CompilerMajorVersion == 0) -#define ExtraLibraries crtdll.lib kernel32.lib wsock32.lib -#elif (CompilerMajorVersion < 4) -#define ExtraLibraries msvcrt.lib kernel32.lib wsock32.lib -#else -/* Use LIBC.LIB instead of msvcrt.lib since we compile - with non-thread version. --marcpa */ -#define ExtraLibraries libc.lib kernel32.lib wsock32.lib -link -nodefaultlib:libc -#endif -#define MakeCmd nmake -nologo -#if (CompilerMajorVersion == 0) -#define LdCmd link32 -#else -#define LdCmd link -#endif -#define MathLibrary -#define HasSymLinks NO -#define HasPutenv YES -#define Osuf obj -#ifndef CCsuf -#define CCsuf cxx -#endif -#define BuildServer NO -#define ConnectionFlags -DTCPCONN - -/* override as necessary in site.def/host.def */ -#ifndef StdIncDir -#define StdIncDir C:/MSDEVSTD/INCLUDE -#endif -#define LdPreLib /**/ -#define LdPostLib /**/ -#ifndef UseInstalled -#define ImakeCmd $(IMAKESRC:/=\)\imake -#define DependCmd $(DEPENDSRC:/=\)\makedepend -#endif -#define DependFlags -D_WIN32 -#define FilesToClean *.bak *.obj *.lib make.log -#define ShLibDir $(BINDIR) - -#define XFileSearchPathBase Concat4($(LIBDIR)/;L/;T/;N;C,;S:$(LIBDIR)/;l/;T/;N;C,;S:$(LIBDIR)/;T/;N;C,;S:$(LIBDIR)/;L/;T/;N;S:$(LIBDIR)/;l/;T/;N;S:$(LIBDIR)/;T/;N;S) - -#define XawI18nDefines -DHAS_WCHAR_H -#define UseRgbTxt YES -#define HasCbrt NO -#define HasFfs NO -#define HasXdmAuth NO - -/* the following components haven't been ported yet */ -#define BuildLBX NO -#define BuildXprint NO -#define XprtServer NO - -#include diff -r 861f2601a38b -r 1f0b15040456 nt/Xpm.def --- a/nt/Xpm.def Sat Feb 20 06:03:00 2010 -0600 +++ b/nt/Xpm.def Sun May 01 18:44:03 2011 +0100 @@ -2,21 +2,19 @@ ; Copyright (C) 2000 Kirill 'Big K' Katsnelson ; ; This file is part of XEmacs. -; -; XEmacs is free software; you can redistribute it and/or modify it + +; 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. -; +; Free Software Foundation, either version 3 of the License, or (at your +; option) any later version. + ; XEmacs is distributed in the hope that it will be useful, but WITHOUT ; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ; for more details. -; + ; You should have received a copy of the GNU General Public License -; along with XEmacs; see the file COPYING. If not, write to -; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -; Boston, MA 02111-1307, USA. +; along with XEmacs. If not, see . ; ; Synched up with: Not in FSF. ; diff -r 861f2601a38b -r 1f0b15040456 nt/compface.mak --- a/nt/compface.mak Sat Feb 20 06:03:00 2010 -0600 +++ b/nt/compface.mak Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ ## This file is part of XEmacs. -## XEmacs is free software; you can redistribute it and/or modify it +## 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. +## Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ ## for more details. ## You should have received a copy of the GNU General Public License -## along with XEmacs; see the file COPYING. If not, write to -## the Free Software Foundation, Inc., 51 Franklin St - Fifth Floor, -## Boston, MA 02110-1301, USA. +## along with XEmacs. If not, see . !if !defined(DEBUG_XEMACS) DEBUG_XEMACS=0 diff -r 861f2601a38b -r 1f0b15040456 nt/config.inc.samp --- a/nt/config.inc.samp Sat Feb 20 06:03:00 2010 -0600 +++ b/nt/config.inc.samp Sun May 01 18:44:03 2011 +0100 @@ -1,5 +1,25 @@ # -*- mode: makefile -*- +# Copyright 2000-2003, 2005 Ben Wing +# Copyright 2003, 2009 Jerry James +# Copyright 2005, 2006 Marcus Crestani +# Copyright 2006, 2008 Vin Shelton + +# 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 3 of the License, 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. If not, see . + ############################################################################ # Install options # ############################################################################ diff -r 861f2601a38b -r 1f0b15040456 nt/make-build-dir --- a/nt/make-build-dir Sat Feb 20 06:03:00 2010 -0600 +++ b/nt/make-build-dir Sun May 01 18:44:03 2011 +0100 @@ -5,21 +5,19 @@ # Copyright (C) 2003 Ben Wing. # # This file is part of XEmacs. -# -# XEmacs is free software; you can redistribute it and/or modify it +# +# 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. -# +# Free Software Foundation, either version 3 of the License, or (at your +# option) any later version. +# # XEmacs is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License # for more details. -# +# # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. +# along with XEmacs. If not, see . # # Author: Ben Wing # diff -r 861f2601a38b -r 1f0b15040456 nt/make-nt-depend --- a/nt/make-nt-depend Sat Feb 20 06:03:00 2010 -0600 +++ b/nt/make-nt-depend Sun May 01 18:44:03 2011 +0100 @@ -5,21 +5,19 @@ # Copyright (C) 2000, 2002 Jonathan Harris. # # This file is part of XEmacs. -# -# XEmacs is free software; you can redistribute it and/or modify it +# +# 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. -# +# Free Software Foundation, either version 3 of the License, or (at your +# option) any later version. +# # XEmacs is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License # for more details. -# +# # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. +# along with XEmacs. If not, see . # # Author: Jonathan Harris # diff -r 861f2601a38b -r 1f0b15040456 nt/site.def --- a/nt/site.def Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,123 +0,0 @@ -XCOMM site: $XConsortium: site.def /main/revisionist/3 1996/10/15 09:31:04 swick $ - -/*************************************************************************** - * * - * SITE-SPECIFIC DEFINITIONS * - * * - * This file contains two halves, one included before the vendor-specific * - * configuration file (.cf file), and one included after the .cf file. * - * The before-half should be protected by #ifdef BeforeVendorCF, and the * - * after-half should be protected by #ifdef AfterVendorCF. * - * * - * The before-half should only set things that the .cf file depends on. * - * For the .cf files shipped in this release, the main variables in this * - * category are HasGcc, HasGcc2, HasCplusplus, OSMajorVersion, * - * OSMinorVersion, and OSTeenyVersion. * - * * - * The after-half should contain all other definitions. For example, * - * place your ProjectRoot definition here. * - * * - * OS Major and Minor version numbers should be changed directly in the * - * .cf file, not overridden in site.def. * - * * - ***************************************************************************/ - -/* if you want host-specific customization, this is one way to do it */ -/* -#ifndef SiteIConfigFiles -#define SiteIConfigFiles $(IRULESRC)/host.def -#define LocalConfigFiles host.def -#endif -*/ - - -#ifdef BeforeVendorCF - -/* #include */ - -/* On systems where cpp doesn't expand correctly macros in include directives - * the two following macros need to be defined directly (where "X11" is - * really whatever the TopLevelProject macro is defined to be). - */ -# ifndef ProjectRulesFile -# define ProjectRulesFile -# endif -# ifndef ProjectTmplFile -# define ProjectTmplFile -# endif - -/* -#ifndef HasGcc2 -#define HasGcc2 YES -#endif -*/ - -#endif /* BeforeVendorCF */ - -#ifdef AfterVendorCF - -#define ProjectRoot f:/utils/X11R6 - -/* Only set HasXdmAuth to YES if you have a Wraphelp.c file. */ -/* #define HasXdmAuth YES */ - -/* #define PreIncDir /usr/local/lib/gcc-lib/sparc-sun-solaris2.4/2.7.2/include */ - -/* -#if defined(SunArchitecture) && defined(SparcArchitecture) -#define HasCodeCenter YES -#ifndef SVR4Architecture -#define HasTestCenter YES -#endif -#endif -*/ - -/* -#ifdef __hp9000s800 -#define HasCodeCenter YES -#endif -*/ - -/* -#if defined(SunArchitecture) && defined(SparcArchitecture) && !defined(SVR4Architecture) -#define HasPurify YES -#endif -*/ - -/* -#define HasSentinel YES -*/ - -/* -#undef DefaultUserPath -#define DefaultUserPath /bin:/usr/bin:$(BINDIR):/usr/ucb:/usr/local/bin -*/ - - -/* You do NOT need SetUID if you only run the server under xdm */ -/* You MAY need SetUID if users run the server by hand or under xinit */ -/* Consult your system administrator before making the X server setuid */ -/* -#if defined(SunArchitecture) && OSMajorVersion > 4 -#define InstallXserverSetUID YES -#endif -*/ - -/* You do NOT need SetUID if you only run the server under xdm */ -/* You MAY need SetUID if users run the server by hand or under xinit */ -/* Consult your system administrator before making the X server setuid */ -/* -#ifdef XFree86Version -#define InstallXserverSetUID YES -#endif -*/ - -#ifndef XnestServer -#undef BuildServer -#define BuildServer YES -#define XnestServer YES -#endif - -/* #include */ - -#endif /* AfterVendorCF */ diff -r 861f2601a38b -r 1f0b15040456 nt/tiff.mak --- a/nt/tiff.mak Sat Feb 20 06:03:00 2010 -0600 +++ b/nt/tiff.mak Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ ## This file is part of XEmacs. -## XEmacs is free software; you can redistribute it and/or modify it +## 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. +## Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ ## for more details. ## You should have received a copy of the GNU General Public License -## along with XEmacs; see the file COPYING. If not, write to -## the Free Software Foundation, Inc., 51 Franklin St - Fifth Floor, -## Boston, MA 02110-1301, USA. +## along with XEmacs. If not, see . !if !defined(DEBUG_XEMACS) DEBUG_XEMACS=0 diff -r 861f2601a38b -r 1f0b15040456 nt/xemacs.dsp --- a/nt/xemacs.dsp Sat Feb 20 06:03:00 2010 -0600 +++ b/nt/xemacs.dsp Sun May 01 18:44:03 2011 +0100 @@ -1,5 +1,27 @@ # Microsoft Developer Studio Project File - Name="xemacs" - Package Owner=<4> # Microsoft Developer Studio Generated Build File, Format Version 6.00 + +# Copyright (C) 2000, 2002, 2003, 2010 Ben Wing +# Copyright (C) 2000 Jonathan Harris +# Copyright (C) 2004, 2009 Jerry James +# Copyright (C) 2005 Marcus Crestani +# Copyright (C) 2006 Adrian Aichner + +# 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 3 of the License, 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. If not, see . + # ** DO NOT EDIT ** # TARGTYPE "Win32 (x86) External Target" 0x0106 @@ -887,35 +909,35 @@ # End Source File # Begin Source File -SOURCE="..\src\objects-msw.c" +SOURCE="..\src\fontcolor-msw.c" # End Source File # Begin Source File -SOURCE="..\src\objects-msw.h" +SOURCE="..\src\fontcolor-msw.h" # End Source File # Begin Source File -SOURCE="..\src\objects-tty.c" +SOURCE="..\src\fontcolor-tty.c" # End Source File # Begin Source File -SOURCE="..\src\objects-tty.h" +SOURCE="..\src\fontcolor-tty.h" # End Source File # Begin Source File -SOURCE="..\src\objects-x.c" +SOURCE="..\src\fontcolor-x.c" # End Source File # Begin Source File -SOURCE="..\src\objects-x.h" +SOURCE="..\src\fontcolor-x.h" # End Source File # Begin Source File -SOURCE=..\src\objects.c +SOURCE=..\src\fontcolor.c # End Source File # Begin Source File -SOURCE=..\src\objects.h +SOURCE=..\src\fontcolor.h # End Source File # Begin Source File diff -r 861f2601a38b -r 1f0b15040456 nt/xemacs.mak --- a/nt/xemacs.mak Sat Feb 20 06:03:00 2010 -0600 +++ b/nt/xemacs.mak Sun May 01 18:44:03 2011 +0100 @@ -7,21 +7,19 @@ # Copyright (C) 1998 Free Software Foundation, Inc. # # This file is part of XEmacs. -# -# XEmacs is free software; you can redistribute it and/or modify it +# +# 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. -# +# Free Software Foundation, either version 3 of the License, or (at your +# option) any later version. +# # XEmacs is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License # for more details. -# +# # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. +# along with XEmacs. If not, see . # # Synched up with: Not in FSF. # @@ -515,7 +513,7 @@ $(OUTDIR)\frame-msw.obj \ $(OUTDIR)\glyphs-msw.obj \ $(OUTDIR)\gui-msw.obj \ - $(OUTDIR)\objects-msw.obj \ + $(OUTDIR)\fontcolor-msw.obj \ $(OUTDIR)\redisplay-msw.obj \ $(OUTDIR)\select-msw.obj \ $(OUTDIR)\dired-msw.obj @@ -840,6 +838,7 @@ $(OUTDIR)\abbrev.obj \ $(OUTDIR)\alloc.obj \ $(OUTDIR)\alloca.obj \ + $(OUTDIR)\array.obj \ $(OUTDIR)\blocktype.obj \ $(OUTDIR)\buffer.obj \ $(OUTDIR)\bytecode.obj \ @@ -857,7 +856,6 @@ $(OUTDIR)\doc.obj \ $(OUTDIR)\doprnt.obj \ $(OUTDIR)\dragdrop.obj \ - $(OUTDIR)\dynarr.obj \ $(OUTDIR)\editfns.obj \ $(OUTDIR)\elhash.obj \ $(OUTDIR)\emacs.obj \ @@ -903,7 +901,7 @@ # #### Leave the next one out when integrating my working ws $(OUTDIR)\nt.obj \ $(OUTDIR)\ntplay.obj \ - $(OUTDIR)\objects.obj \ + $(OUTDIR)\fontcolor.obj \ $(OUTDIR)\opaque.obj \ $(OUTDIR)\print.obj \ $(OUTDIR)\process.obj \ @@ -1488,7 +1486,6 @@ INFO_FILES= \ $(INFODIR)\beta.info \ $(INFODIR)\cl.info \ - $(INFODIR)\custom.info \ $(INFODIR)\emodules.info \ $(INFODIR)\external-widget.info \ $(INFODIR)\info.info \ @@ -1496,7 +1493,6 @@ $(INFODIR)\lispref.info \ $(INFODIR)\new-users-guide.info \ $(INFODIR)\standards.info \ - $(INFODIR)\term.info \ $(INFODIR)\termcap.info \ $(INFODIR)\texinfo.info \ $(INFODIR)\widget.info \ @@ -1660,7 +1656,7 @@ ########################### Automated tests testdir = ../tests/automated -batch_test_emacs = $(BATCH_PACKAGES) -l $(testdir)/test-harness.el -f batch-test-emacs $(testdir) +batch_test_emacs = $(BATCH_PACKAGES) -l test-harness -f batch-test-emacs $(testdir) check: cd $(BLDSRC) diff -r 861f2601a38b -r 1f0b15040456 nt/xemacs.rc --- a/nt/xemacs.rc Sat Feb 20 06:03:00 2010 -0600 +++ b/nt/xemacs.rc Sun May 01 18:44:03 2011 +0100 @@ -2,10 +2,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -13,9 +13,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin St. - Fifth Floor, -Boston, MA 02110-1301, USA. */ +along with XEmacs. If not, see . */ #ifdef INCLUDE_DUMP 101 DUMP "xemacs.dmp" diff -r 861f2601a38b -r 1f0b15040456 nt/xpm.mak --- a/nt/xpm.mak Sat Feb 20 06:03:00 2010 -0600 +++ b/nt/xpm.mak Sun May 01 18:44:03 2011 +0100 @@ -4,21 +4,19 @@ # Copyright (C) 1997 Free Software Foundation, Inc. # # This file is part of XEmacs. -# -# XEmacs is free software; you can redistribute it and/or modify it +# +# 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. -# +# Free Software Foundation, either version 3 of the License, or (at your +# option) any later version. +# # XEmacs is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License # for more details. -# +# # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 51 Franklin St. - Fifth Floor, -# Boston, MA 02110-1301, USA. +# along with XEmacs. If not, see . # !if !defined(DEBUG) !if defined(DEBUG_XEMACS) diff -r 861f2601a38b -r 1f0b15040456 src/.gdbinit.in.in --- a/src/.gdbinit.in.in Sat Feb 20 06:03:00 2010 -0600 +++ b/src/.gdbinit.in.in Sun May 01 18:44:03 2011 +0100 @@ -16,10 +16,10 @@ ## This file is part of XEmacs. -## XEmacs is free software; you can redistribute it and/or modify it +## 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. +## Free Software Foundation, either version 3 of the License, 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 @@ -27,9 +27,7 @@ ## for more details. ## You should have received a copy of the GNU General Public License -## along with XEmacs; see the file COPYING. If not, write to -## the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -## Boston, MA 02110-1301 USA +## along with XEmacs. If not, see . ## Author: Martin Buchholz @@ -159,7 +157,7 @@ end define check-xemacs-arg - run -vanilla -batch -l @srcdir@/../tests/automated/test-harness.el -f batch-test-emacs @srcdir@/../tests/$arg0 + run -vanilla -batch -l test-harness -f batch-test-emacs @srcdir@/../tests/$arg0 end define check-xemacs @@ -178,7 +176,7 @@ define check-temacs-arg environment-to-run-temacs - run -nd -no-packages -batch -l @srcdir@/../lisp/loadup.el run-temacs -q -batch -l @srcdir@/../tests/automated/test-harness.el -f batch-test-emacs @srcdir@/../tests/$arg0 + run -nd -no-packages -batch -l @srcdir@/../lisp/loadup.el run-temacs -q -batch -l test-harness -f batch-test-emacs @srcdir@/../tests/$arg0 define check-temacs if $argc == 0 @@ -411,9 +409,6 @@ if $lrecord_type == lrecord_type_opaque_ptr pptype Lisp_Opaque_Ptr else - if $lrecord_type == lrecord_type_popup_data - pptype popup_data - else if $lrecord_type == lrecord_type_process pptype Lisp_Process else @@ -456,9 +451,6 @@ if $lrecord_type == lrecord_type_window pstructtype window else - if $lrecord_type == lrecord_type_window_configuration - pstructtype window_config - else if $lrecord_type == lrecord_type_fc_pattern pstructtype fc_pattern else @@ -485,8 +477,6 @@ end end end - end - end ## Repeat after me... gdb sux, gdb sux, gdb sux... end end diff -r 861f2601a38b -r 1f0b15040456 src/ChangeLog --- a/src/ChangeLog Sat Feb 20 06:03:00 2010 -0600 +++ b/src/ChangeLog Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,4090 @@ +2011-05-01 Aidan Kehoe + + * lread.c (parse_integer): + GMP's mpz_set_string deals with a leading plus badly, make sure it + never sees one coming from this function. + +2010-12-31 Mike Kupfer + + * redisplay.c (pixel_to_glyph_translation): + Handle redisplay edge case. + With motion events when entering a frame and the minibuffer is + active, row and column can be zero, and there aren't any runes. + +2011-04-30 Stephen J. Turnbull + + * specifier.c (Fspecifier_matching_instance): + Add comment about backward-incompatibility of MATCHSPEC. + +2011-04-29 Stephen J. Turnbull + + * XEmacs 21.5.31 "ginger" is released. + +2011-04-26 Stephen J. Turnbull + + * XEmacs 21.5.30 "garlic" is released. + +2011-04-23 Aidan Kehoe + + * editfns.c: + * editfns.c (syms_of_editfns): + Implement #'char= in cl-extra.el, not here, accepting more than + two arguments as Common Lisp specifies. + +2011-04-17 Jeff Sparkes + + * device-tty.c (tty_device_system_metrics): Fix compile issues for + C89 compilers. Use log() instead of log2(). + +2011-04-04 Aidan Kehoe + + * fns.c (count_with_tail): + This can be legitimately called from #'delete* with a specified + COUNT keyword value, accept this in the assertion. + * fns.c (FdeleteX): + * fns.c (FremoveX): + If COUNT is specified and FROM-END is non-nil, set COUNT to nil in + the argument vector, so count_with_tail doesn't see it when + calculating the total number of times an item occurs. Fixes + problems with the interaction of :count and :from-end. + +2011-04-04 Aidan Kehoe + + * fns.c (FremoveX): + * fns.c (sublis): + Correct some nesting of GCPRO and UNGCPRO here, revealed by the + the C++ build compiling core Lisp. Thank you Mats' buildbot! + +2011-04-04 Aidan Kehoe + + * lisp.h (GC_EXTERNAL_LIST_LOOP_3, GC_EXTERNAL_LIST_LOOP_4): New. + * fns.c (count_with_tail, list_position_cons_before, FassocX): + * fns.c (FrassocX, position, FdeleteX, FremoveX): + * fns.c (list_delete_duplicates_from_end): + * fns.c (Fdelete_duplicates, Fremove_duplicates, Freduce): + * fns.c (Fnsubstitute, Fsubstitute, sublis, nsublis, Fnsublis): + * fns.c (venn, nvenn, Funion, Fset_exclusive_or, Fnset_exclusive_or): + Use GC_EXTERNAL_LIST_LOOP_* in the sequence functions in fns.c + where appropriate, there were some corner cases where my old + approach was unsafe (mainly if the circularity checking's tortoise + lost GCPRO protection. + Add GC_EXTERNAL_LIST_LOOP_{3,4}, analogous to + GC_EXTERNAL_LIST_LOOP_2. + +2011-03-28 Jeff Sparkes + + * console-tty-impl.h (struct tty_console): Add field for number of + displayable colors. + * device-tty.c (tty_device_system_metrics): Return metrics for + num-color-cells and num-bit-planes. Tracker issue 757. + * device.c: There are two required args for device-system-metric. + * redisplay-tty.c (init_tty_for_redisplay): Retrieve number of + colors from terminal description. Default to 2 if none found. + +2011-03-24 Jerry James + + * alloc.c (listu): Assemble the list in the right order so we don't + have to reverse it. + (listn): Ditto. + * dired.c (Ffile_attributes): Use listn instead of building an array + to pass to Flist. GC protect the mode string. + * editfns.c (Fdecode_time): Use listn instead of Flist. + * faces.c (vars_of_faces): Use listu instead of Flist. + +2011-03-24 Jerry James + + * README.kkcc: "occured" -> "occurred". + * alloc.c (malloced_storage_size): "supress" -> "suppress". + * buffer.c: "intial" -> "initial". + * elhash.c (Fdefine_hash_table_test): "analagous" -> "analogous". + * emacs.c: "targetting" -> "targeting". + (shut_down_emacs): "recurrance" -> "reoccurrence". + * event-stream.c: "accidentaly" -> "accidentally", and fix grammar. + * extents.c: "occuring" -> "occurring". + * faces.c (update_face_cachel_data): "appart" -> "apart", "begining" + -> "beginning". + * file-coding.c (Vkeyboard_coding_system): "interpet" -> "interpret". + * fileio.c (Fmake_temp_name): "analagous" -> "analogous". + * fontcolor-gtk.c: "sucess" -> "success". + * frame-gtk.c (gtk_init_frame_2): "carefull" -> "careful", fix + whitespace. + * frame.c: "negotation" -> "negotiation". + * glyphs-msw.c (mswindows_map_subwindow): "everytime" -> "every time". + * glyphs-widget.c: "accomodate" -> "accommodate". + (logical_unit_height): Ditto. + (Fwidget_logical_to_character_height): Ditto. + * gtk-xemacs.c (__nuke_background_items): "noticable" -> "noticeable". + * menubar-gtk.c: "inital" -> "initial". + * mule-ccl.c: "refered" -> "referred to". + * nt.c (mswindows_stat): "noticable" -> "noticeable". + * ntheap.c (recreate_heap): "commited" -> "committed". + * s/cygwin32.h: "konw" -> "know". + * sysdll.c: "dependant" -> "dependent". + * syswindows.h: "targetting" -> "targeting". + * text.c: "reversable" -> "reversible". + * unexcw.c (copy_executable_and_dump_data_section): "addres" -> + "address". + * unicode.c (Funicode_precedence_list): "occurrance" -> "occurrence". + * window.c (struct window_mirror_stats): "Ancilliary" -> "Ancillary". + +2011-03-20 Mats Lidell + + * alloca.c (find_stack_direction): + * alloca.c (xemacs_c_alloca): + Remove use of auto keyword. It is default and will be illegal in + C++0X. + +2011-03-17 Didier Verna + + * data.c (init_errors_once_early): Define Qextent_read_only error. + * lisp.h: Declare it. + * extents.c (verify_extent_mapper): Signal an extent-read-only + error instead of a buffer-read-only one. + +2011-03-15 Aidan Kehoe + + * config.h.in (SUPPORT_CONFOUNDING_FUNCTIONS): New #define, + equivalent NEED_TO_HANDLE_21_4_CODE by default, describing whether + this XEmacs should support the old-eq, old-equal and related + functions and byte codes. + * bytecode.c (UNUSED): + Only interpret old-eq, old-equal, old-memq if + SUPPORT_CONFOUNDING_FUNCTIONS is defined. + * data.c: + Move Fold_eq to fns.c with the rest of the Fold_* functions. + * fns.c: + * fns.c (Fmemq): + * fns.c (memq_no_quit): + * fns.c (assoc_no_quit): + * fns.c (Frassq): + * fns.c (Fequal): + * fns.c (Fold_equal): + * fns.c (syms_of_fns): + Group old-eq, old-equal, old-memq etc together, surround them with + #ifdef SUPPORT_CONFOUNDING_FUNCTIONS. + +2011-03-14 Aidan Kehoe + + * glyphs-eimage.c (png_instantiate): + Update the PNG handling code to work with versions of the library + where the png_info structure is no longer visible. Thank you for + the report, Robert Delius Royar. + +2011-03-12 Aidan Kehoe + + * event-stream.c (Fdispatch_event): + As documented, allow pre-command-hook to usefully modify + this-command even when this-command is nil (that is, we would + normally throw an undefined-keystroke-sequence error). Don't throw + that error if this-command was modified, instead try to execute + the new value. + Allow pre-command-hook to modify last-command-event in this + specific context. Don't document this, for the moment. + +2011-03-11 Aidan Kehoe + + * bytecode.c (optimize_byte_code): + Only transform assignments to keywords to Bdiscard if + NEED_TO_HANDLE_21_4_CODE is turned on. Cf. similar code in + reject_constant_symbols(). + +2011-02-24 Aidan Kehoe + + * fns.c (Fsubstring_no_properties): + Sigh, get_string_range_char checks the type of its START and END + arguments, but doesn't check the type of its STRING + argument. Thank you Raymond Toy! + +2011-02-19 Aidan Kehoe + + * fns.c (Fset_exclusive_or): + This function accepts the :stable keyword too, document this in + its arglist. + +2011-02-16 Aidan Kehoe + + * xemacs.def.in.in: + No longer export acons(), export Facons() instead, thank you Mats, + Jerry and Jeff Sparkes. + +2011-02-10 Aidan Kehoe + + * fns.c (shortest_length_among_sequences): + This was buggy, it always errored if the last argument was + circular, even if other arguments were non-circular. Correct that. + +2011-02-09 Aidan Kehoe + + * alloc.c (Facons): + * alloc.c (Fobject_memory_usage): + * alloc.c (syms_of_alloc): + * faces.c (complex_vars_of_faces): + * lisp.h: + * mc-alloc.c (Fmc_alloc_memory_usage): + Rename acons() to Facons(), make it visible to Lisp. Change uses + of the function in C accordingly. + +2011-02-07 Aidan Kehoe + + * keymap.c (describe_map_sort_predicate): Correct the order of + arguments to map_keymap_sort_predicate() here. Thanks again, Mats. + +2011-02-06 Aidan Kehoe + + * symbols.c (Fapropos_internal): + Supply check_string_lessp_nokey explicitly as the CHECK_MERGE + argument to list_sort(), NULL no longer works. Thank you Mats + Lidell in IRC! + +2011-02-05 Aidan Kehoe + + * fns.c: + * fns.c (check_lss_key, check_lss_key_car): New. + * fns.c (check_string_lessp_key check_string_lessp_key_car): New. + * fns.c (get_merge_predicate): New. + * fns.c (list_merge): + * fns.c (array_merge): + * fns.c (list_array_merge_into_list): + * fns.c (list_list_merge_into_array): + * fns.c (list_array_merge_into_array): + * fns.c (Fmerge): + * fns.c (list_sort): + * fns.c (array_sort): + * fns.c (FsortX): + * fns.c (syms_of_fns): + * lisp.h: + Move #'sort, #'merge to using the same test approach as is used in + the functions that take TEST, TEST-NOT and KEY arguments. This + allows us to avoid the Ffuncall() overhead when the most common + PREDICATE arguments are supplied, in particular #'< and + #'string-lessp. + + * fontcolor-msw.c (sort_font_list_function): + * fontcolor-msw.c (mswindows_enumerate_fonts): + * dired.c: + * dired.c (Fdirectory_files): + * fileio.c: + * fileio.c (build_annotations): + * fileio.c (syms_of_fileio): + * keymap.c: + * keymap.c (keymap_submaps): + * keymap.c (map_keymap_sort_predicate): + * keymap.c (describe_map_sort_predicate): + * keymap.c (describe_map): + Change the various C predicates passed to list_sort () and + list_merge () to fit the new calling convention, returning + non-zero if the first argument is less than the second, zero + otherwise. + +2011-01-30 Michael Sperber + + * redisplay.h: + * redisplay.c: + (redisplay_cancel_ritual_suicide): + * eval.c (throw_or_bomb_out_unsafe): + * device-x.c (x_IO_error_handler): Don't commit suicide when an X + device dies. + +2011-01-23 Aidan Kehoe + + * file-coding.c (complex_vars_of_file_coding): + * intl-win32.c (complex_vars_of_intl_win32): + * profile.c (Fget_profiling_info): + * unicode.c (complex_vars_of_unicode): + Replace various awkward calls to nconc2 () with list6 () with + analogous calls to Ben's relatively-recently introduced listu (), + constructing a list from an arbitrary number of C arguments. + +2011-01-18 Mike Sperber + + * s/freebsd.h: Zap. Not really needed anymore, and it has unclear + license status. + +2011-01-15 Aidan Kehoe + + * s/usg5-4.h (PTY_NAME_SPRINTF, PTY_TTY_NAME_SPRINTF): + That didn't work; attempt with qxestrcpy_ascii(), + qxestrncpy_ascii(). + +2011-01-14 Aidan Kehoe + + * s/hpux11.h (PTY_TTY_NAME_SPRINTF, PTY_NAME_SPRINTF): + * s/usg5-4.h (PTY_TTY_NAME_SPRINTF, PTY_NAME_SPRINTF): + Replace sprintf() with qxesprintf(), strcpy with qxestrpy(), + hopefully fixing some platform-specific C++ builds. + +2011-01-14 Aidan Kehoe + + * fns.c (Ffind): Use the correct subr information here, pass in + the DEFAULT keyword argument value correctly. + +2011-01-11 Aidan Kehoe + + * device-msw.c (Fmswindows_printer_list): Remove a Fdelete () + call here, remove the necessity for it. + * fns.c (Fdelete, Fdelq): + * lisp.h: + Move #'delete, #'delq to Lisp, implemented in terms of #'delete* + * select.c (Fown_selection_internal): + * select.c (handle_selection_clear): + Use delq_no_quit() in these functions, don't reimplement it or use + Fdelq(), which is now gone. + +2011-01-10 Aidan Kehoe + + * mc-alloc.c (get_used_list_index): + Replace some C++ comments with C-style /* comments. + +2011-01-02 Aidan Kehoe + + * fns.c (FdeleteX, FremoveX, Fnsubstitute, Fsubstitute, syms_of_fns): + Don't repeat the declaration and DEFSYMBOL() for Qnintersection in + this file; don't assume that bignums are always available. Fixes + some of the build problems the buildbot is showing me at the + moment. + (syms_of_fns): Remove a couple more duplicate symbol declarations. + +2011-01-01 Aidan Kehoe + + * data.c (print_ephemeron, print_weak_list, print_weak_box): + Be more helpful in printing these structures; show their contents, + print their UIDs so it's possible to distinguish between them. + +2010-12-30 Aidan Kehoe + + Move the heavy lifting from cl-seq.el to C, finally making those + functions first-class XEmacs citizens, with circularity checking, + built-in support for tests other than #'eql, and as much + compatibility with current Common Lisp as Paul Dietz' tests require. + + * fns.c (check_eq_nokey, check_eq_key, check_eql_nokey) + (check_eql_key, check_equal_nokey, check_equal_key) + (check_equalp_nokey, check_equalp_key, check_string_match_nokey) + (check_string_match_key, check_other_nokey, check_other_key) + (check_if_nokey, check_if_key, check_match_eq_key) + (check_match_eql_key, check_match_equal_key) + (check_match_equalp_key, check_match_other_key): New. These are + basically to provide function pointers to be used by Lisp + functions that take TEST, TEST-NOT and KEY arguments. + + (get_check_match_function_1, get_check_test_function) + (get_check_match_function): These functions work out which of the + previous list of functions to use, given the keywords supplied by + the user. + + (count_with_tail): New. This is the bones of #'count. + (list_count_from_end, string_count_from_end): Utility functions + for #'count. + (Fcount): New, moved from cl-seq.el. + (list_position_cons_before): New. The implementation of #'member*, + and important in implementing various other functions. + + (FmemberX, Fadjoin, FassocX, FrassocX, Fposition, Ffind) + (FdeleteX, FremoveX, Fdelete_duplicates, Fremove_duplicates) + (Fnsubstitute, Fsubstitute, Fsublis, Fnsublis, Fsubst, Fnsubst) + (Ftree_equal, Fmismatch, Fsearch, Fintersection, Fnintersection) + (Fsubsetp, Fset_difference, Fnset_difference, Fnunion, Funion) + (Fset_exclusive_or, Fnset_exclusive_or): New, moved here from + cl-seq.el. + + (position): New. The implementation of #'find and #'position. + (list_delete_duplicates_from_end, subst, sublis, nsublis) + (tree_equal, mismatch_from_end, mismatch_list_list) + (mismatch_list_string, mismatch_list_array) + (mismatch_string_array, mismatch_string_string) + (mismatch_array_array, get_mismatch_func): Helper C functions for + the Lisp-visible functions. + (venn, nvenn): New. The implementation of the main Lisp functions that + treat lists as sets. + +2010-12-30 Aidan Kehoe + + * lisp.h (DECLARE_N_KEYWORDS_8, DECLARE_N_KEYWORDS_9) + (CHECK_N_KEYWORDS_8, CHECK_N_KEYWORDS_9): + Support up to nine keywords in the PARSE_KEYWORDS() macro. + +2010-12-30 Aidan Kehoe + + * elhash.c (syms_of_elhash): + * chartab.c (syms_of_chartab): + * abbrev.c (syms_of_abbrev): + * general-slots.h: + Move Qcount, Q_default, Q_test to general-slots.h, they're about + to be used by other files. Rename Q_default to Q_default_, for the + sake of the PARSE_KEYWORDS macro (given that default is a reserved + identifier in C). Add SYMBOL_KEYWORD_GENERAL(), analogous to + SYMBOL_GENERAL() to make this easier. + +2010-12-29 Aidan Kehoe + + * floatfns.c (Ffloat): If we've been handed a bigfloat here, it's + appropriate to give the same bigfloat back. + +2010-11-30 Aidan Kehoe + + * fns.c (Ffill): + Move all declarations before statements, for the sake of the + Visual Studio build. Thank you Vin! + +2010-11-24 Aidan Kehoe + + * font-mgr.c (Ffc_pattern_get): Fix my last change when both + --with-union-type and --with-xft are specified, thank you Robert + Delius Royar! + +2010-11-20 Aidan Kehoe + + * abbrev.c (Fexpand_abbrev): + * alloc.c: + * alloc.c (Fmake_list): + * alloc.c (Fmake_vector): + * alloc.c (Fmake_bit_vector): + * alloc.c (Fmake_byte_code): + * alloc.c (Fmake_string): + * alloc.c (vars_of_alloc): + * bytecode.c (UNUSED): + * bytecode.c (Fbyte_code): + * chartab.c (decode_char_table_range): + * cmds.c (Fself_insert_command): + * data.c (check_integer_range): + * data.c (Fnatnump): + * data.c (Fnonnegativep): + * data.c (Fstring_to_number): + * elhash.c (hash_table_size_validate): + * elhash.c (decode_hash_table_size): + * eval.c (Fbacktrace_frame): + * event-stream.c (lisp_number_to_milliseconds): + * event-stream.c (Faccept_process_output): + * event-stream.c (Frecent_keys): + * event-stream.c (Fdispatch_event): + * events.c (Fmake_event): + * events.c (Fevent_timestamp): + * events.c (Fevent_timestamp_lessp): + * events.h: + * events.h (struct command_builder): + * file-coding.c (gzip_putprop): + * fns.c: + * fns.c (check_sequence_range): + * fns.c (Frandom): + * fns.c (Fnthcdr): + * fns.c (Flast): + * fns.c (Fnbutlast): + * fns.c (Fbutlast): + * fns.c (Fmember): + * fns.c (Ffill): + * fns.c (Freduce): + * fns.c (replace_string_range_1): + * fns.c (Freplace): + * font-mgr.c (Ffc_pattern_get): + * frame-msw.c (msprinter_set_frame_properties): + * glyphs.c (check_valid_xbm_inline): + * indent.c (Fmove_to_column): + * intl-win32.c (mswindows_multibyte_to_unicode_putprop): + * lisp.h: + * lisp.h (ARRAY_DIMENSION_LIMIT): + * lread.c (decode_mode_1): + * mule-ccl.c (ccl_get_compiled_code): + * number.h: + * process-unix.c (unix_open_multicast_group): + * process.c (Fset_process_window_size): + * profile.c (Fstart_profiling): + * unicode.c (Funicode_to_char): + Change NATNUMP to return 1 for positive bignums; changes uses of + it and of CHECK_NATNUM appropriately, usually by checking for an + integer in an appropriate range. + Add array-dimension-limit and use it in #'make-vector, + #'make-string. Add array-total-size-limit, array-rank-limit while + we're at it, for the sake of any Common Lisp-oriented code that + uses these limits. + Rename check_int_range to check_integer_range, have it take + Lisp_Objects (and thus bignums) instead. + Remove bignum_butlast(), just set int_n to an appropriately large + integer if N is a bignum. + Accept bignums in check_sequence_range(), change the functions + that use check_sequence_range() appropriately. + Move the definition of NATNUMP() to number.h; document why it's a + reasonable name, contradicting an old comment. + +2010-11-17 Aidan Kehoe + + * fns.c (bignum_butlast): New. + (Fnbutlast, Fbutlast): Use it. + In #'butlast and #'nbutlast, if N is a bignum, we should always + return nil. Bug revealed by Paul Dietz' test suite, thank you + Paul. + +2010-11-15 Aidan Kehoe + + * .gdbinit.in: Remove lrecord_type_popup_data, + lrecord_type_window_configuration from this file, they're not + used, and their presence breaks pobj in GDB at runtime for me. + +2010-11-14 Aidan Kehoe + + * fns.c (Fnreverse): + Check that non-list sequences are writable from Lisp before + modifying them. (There's an argument that we should do this for + list sequences too, but for the moment other code (e.g. #'setcar) + doesn't.) + (mapcarX): Initialise lisp_vals_staging, lisp_vals_type + explicitly, for the sake of compile warnings. Check if + lisp_vals_staging is non-NULL when deciding whether to replace a + string's range. + (Fsome): Cross-reference to #'find-if in the doc string for this + function. + (Freduce): GCPRO accum in this function, when a key argument is + specicified it can be silently garbage-collected. When deciding + whether to iterate across a string, check whether the cursor + exceeds the byte len; while iterating, increment an integer + counter. Don't ABORT() if check_sequence_range() returns when + handed a suspicious sequence; it is legal to supply the length of + SEQUENCE as the :end keyword value, and this will provoke our + suspicions, legitimately enough. (Problems with this function + revealed by Paul Dietz' ANSI test suite, thank you Paul Dietz.) + (Freplace): Check list sequence lengths using the arguments, not + the conses we're currently looking at, thank you Paul Dietz. + +2010-11-14 Aidan Kehoe + + * fns.c (Frandom): Correct the docstring here, the name of the + argument is LIMIT, not N. + +2010-11-06 Aidan Kehoe + + * bytecode.c (bytecode_nreverse): Call Fnreverse() if SEQUENCE is + not a cons in this function. + (Fnreverse, Freverse): + Accept sequences, not just lists, in these functions. + +2010-11-06 Aidan Kehoe + + * fns.c (Flist_length): Error if LIST is dotted in this function; + document this behaviour. + +2010-10-25 Aidan Kehoe + + * specifier.c (specifier_instance_from_inst_list): + Call call_with_suspended_errors() with ERROR_ME_WARN, explicitly; + avoids the problem Giacomo Boffi describes in + http://mid.gmane.org/19617.52517.341117.388679@aiuole.stru.polimi.it + , but the specifier instantiation bug that makes XEmacs fail for + him is still visible. + +2010-10-25 Aidan Kehoe + + * print.c (ulong_to_bit_string): If printing zero, actually print + a zero, don't return the empty string. + +2010-07-06 Stephen J. Turnbull + + * emodules.c (emodules_load): + Add one more dereference on f = dll_variable() in three places. + We then use EXTERNAL_TO_ITEXT on it, which returns an alloca'd + string, so I delete the unneeded alloca copy statements. + Fixes error reported by Anders Odberg, confirmed in + . + +2010-06-14 Stephen J. Turnbull + + * ui-byhand.c: + * gtk-glue.c: + Add copyright notice based on internal evidence. + +2010-06-14 Stephen J. Turnbull + + * number.h: Another permission consistency fix. + +2010-10-14 Aidan Kehoe + + * fns.c (Fnbutlast, Fbutlast): + Tighten up Common Lisp compatibility for these two functions; they + need to operate on dotted lists without erroring. + +2010-10-12 Aidan Kehoe + + * fns.c (list_merge): + Circularity checking here needs to be done independently for each + list, they can't share a loop counter. Thank you for the bug + report, Robert Pluim! + +2010-09-20 Aidan Kehoe + + * lisp.h (GET_DEFUN_LISP_OBJECT): Make the NEW_GC version of this + work, remove a needless and unhelpful semicolon. + (GET_DEFUN_LISP_OBJECT): Remove a needless semicolon from the + non-NEW_GC version of this. + (PARSE_KEYWORDS): Fix the indentation for the DEBUG_XEMACS + version of this macro. + (PARSE_KEYWORDS): Use GET_DEFUN_LISP_OBJECT() for both the NEW_GC + and non-NEW_GC versions of this macro, when working out the + function's min args. + +2010-09-18 Aidan Kehoe + + * lisp.h (PARSE_KEYWORDS): + Turns out #elsif is not valid preprocessor syntax, who knew! + +2010-09-18 Aidan Kehoe + + * lisp.h (PARSE_KEYWORDS): + Correct the NEW_GC non-DEBUG_XEMACS version of this macro; under + such builds S##function is a pointer, not a Lisp_Subr structure. + +2010-09-18 Aidan Kehoe + + Simplify the API of PARSE_KEYWORDS for callers. + + * lisp.h (PARSE_KEYWORDS): Simply the API, while making the + implementation a little more complex; work out KEYWORDS_OFFSET + from the appropriate Lisp_Subr struct, take the function name as + the C name of the DEFUN rather than a symbol visible as a + Lisp_Object, on debug builds assert that we're actually in the + function so we choke on badly-done copy-and-pasting, + + * lisp.h (PARSE_KEYWORDS_8): New. This is the old PARSE_KEYWORDS. + + * fns.c (Fmerge, FsortX, Ffill, Freduce, Freplace): + Change to use the new PARSE_KEYWORDS syntax. + * elhash.c (Fmake_hash_table): Chance to the new PARSE_KEYWORDS + syntax, rename a define to correspond to what other files use. + + * symbols.c (intern_massaging_name): + * buffer.c (ADD_INT): + Rename intern_converting_underscores_to_dashes() to + intern_massaging_name(), now it does a little more. + +2010-09-18 Aidan Kehoe + + * termcap.c: + Add a couple of missing includes here, which should fix builds + that use this file. (I have no access to such builds, but Mats' + buildbot shows output that indicates they fail at link time since + DEVICE_BAUD_RATE and IS_DIRECTORY_SEP are available.) + +2010-09-18 Aidan Kehoe + + * fns.c (Freduce): + Move statements outside of the braces surrounding the + EXTERNAL_LIST_LOOP_3 macro, fixing strict C89 builds. Thank you + for the report, Vin! + +2010-09-16 Aidan Kehoe + + * fns.c (Flist_length): New, moved here from cl-extra.el, needed + by the next function. + (shortest_length_among_sequences): New. + (Fmapconcat, FmapcarX, Fmapvector, Fmapcan, Fmapc, Fmap) + (Fmap_into, Fsome, Fevery): + Use shortest_length_among_sequences() when working out how many + iterations to do, only giving circular list errors if all + arguments are circular. + +2010-09-16 Aidan Kehoe + + * fns.c (Fsubseq): + Change the string code to better fit in with the rest of this + function (it still uses get_string_range_char(), though, which *may* + diverge algorithmically from what we're doing). + + If dealing with a cons, only call #'length if we have reason to + believe that the START and END arguments are badly specified, and + check for circular lists ourselves when that's appropriate. + + If dealing with a vector, call Fvector() on the appropriate subset + of the old vector's data directly, don't initialise the result + with nil and then copy. + + (Ffill): + Only check the range arguments for a cons SEQUENCE if we have good + reason to think they were badly specified. + + (Freduce): + Handle multiple values properly. Add bounds checking to this + function, as specificied by ANSI Common Lisp. + +2010-09-16 Aidan Kehoe + + * eval.c (Ffunction, Fquote): + Add argument information in the arguments: () format for these two + special operators. + +2010-09-07 Aidan Kehoe + + * fns.c (Freplace): + Replace an accidental double semi-colon with a single semi-colon, + hopefully fixing Vin's Visual Studio 6 build. (Visual Studio 2005 + had no problem with it, oddly.) + +2010-09-06 Aidan Kehoe + + Move #'replace to C; add bounds checking to it and to #'fill. + + * fns.c (Fsubseq, Ffill, mapcarX): + Don't #'nreverse in #'subseq, use fill_string_range and check + bounds in #'fill, use replace_string_range() in #'map-into + avoiding quadratic time when modfiying the string. + + * fns.c (check_sequence_range, fill_string_range) + (replace_string_range, replace_string_range_1, Freplace): + New functions; check that arguments fit sequence dimensions, fill + a string range with a given character, replace a string range from + an Ibyte pointer. + +2010-09-05 Aidan Kehoe + + * chartab.c (char_table_default_for_type, + chartab_default_validate): New. + (print_char_table, Freset_char_table, chartab_default_validate) + (chartab_instantiate, structure_type_create_chartab): + Accept keyword :default in the read syntax for char tables, and + print the default when it is not what was expected for the + time. Makes it a little easier to debug things. + +2010-09-05 Aidan Kehoe + + * editfns.c (Fformat_time_string): + Use two backslashes so that there is at least one present in the + output of describe function, when describing the Roman month + number syntax in this function's docstring. Thanks for provoking + me to look at this, Stephen Turnbull. + +2010-09-03 Aidan Kehoe + + * symsinit.h: Declare reinit_process_early() here, fixing the C++ + build; thank you for pointing this out, Adam Sjøgren! + * fontcolor-msw.c (mswindows_string_to_color): + Cast the result of bsearch() to a colormap_t pointer, fixing the + Visual Studio 2005 build. + +2010-09-02 Aidan Kehoe + + * strftime.c (roman_upper, roman_lower, strftime): + Implement Roman month numbers, as used in central and eastern + Europe. + * editfns.c (Fformat_time_string): + Document two new escapes, to allow uppercase and lowercase Roman + month numbers. Remove documentation of a bug that we didn't + actually have. + * text.h (Qtime_function_encoding): We know the text encoding + coming from strftime(), because we always use the one in + strftime.c. Don't use Qnative. + +2010-09-01 Aidan Kehoe + + * fns.c (list_merge, list_array_merge_into_list) + (list_array_merge_into_array): + Avoid algorithmic complexity surprises when checking for + circularity in these functions. + (Freduce): Fix some formatting, in passing. + + (mapcarX): Drop the SOME_OR_EVERY argument to this function; + instead, take CALLER, a symbol reflecting the Lisp-visible + function that called mapcarX(). Use CALLER with + mapping_interaction_error() when sequences are modified + illegally. Don't cons with #'some, #'every, not even a little. + (Fmapconcat, FmapcarX, Fmapvector, Fmapcan, Fmapc, Fmap) + (Fmap_into, Fsome, Fevery): Call mapcarX() with its new + arguments. + (Fmapcan): Don't unnecessarily complicate the nconc call. + + (maplist): Take CALLER, a symbol reflecting the Lisp-visible + function that called maplist(), rather than having separate + arguments to indicate mapl vs. mapcon. + Avoid algorithmic complexity surprises when checking for + circularity. In #'mapcon, check a given stretch of + result for well-formedness once, which was not previously the + case, despite what the comments said. + (Fmaplist, Fmapl, Fmapcon): + Call maplist() with its new arguments. + +2010-09-02 Aidan Kehoe + + * process.c (process_getprop, process_putprop, process_remprop) + (process_plist, process_setplist, reinit_process_early): + Add functions to modify a process's property list. + * process-slots.h (MARKED_SLOT): Add a plist slot. + + * fns.c (Fobject_setplist): New function, analogous to #'setplist, + but more general. + Update the documentation in the other plist functions to reflect + that processes now have property lists. + * emacs.c (main_1): Call reinit_process_early(), now processes have + plist methods that need to be initialised. + * symbols.c (reinit_symbol_objects_early): Fsetplist is the named + setplist method for symbols. + +2010-08-30 Aidan Kehoe + + * floatfns.c (ceiling_one_mundane_arg, floor_one_mundane_arg) + (round_one_mundane_arg, truncate_one_mundane_arg): + INTEGERP is always available, no need to wrap calls to it with + #ifdef HAVE_BIGNUM. + (Fceiling, Ffloor, Fround, Ftruncate, Ffceiling, Fffloor) + (Ffround, Fftruncate): + Correct some code formatting here. + * doprnt.c (emacs_doprnt_1): + Remove some needless #ifdef WITH_NUMBER_TYPES, now number.h is + always #included. + +2010-08-26 Adam Sjøgren + + * glyphs-eimage.c (gif_instantiate): Try harder to find an + appropriate GIF colormap and then flag an error if one can't be + found. + +2010-08-21 Aidan Kehoe + + * lread.c (read_escape): + Make error messages better reflect the text that was encountered, + when overlong hex character escapes or non-Latin-1 octal character + escapes are encountered. + +2010-08-15 Aidan Kehoe + + * print.c (print_symbol): + Escape any symbols that look like ratios, in the same way we do + symbols that look like floats or integers. Prevents confusion in + the Lisp reader. + * lread.c (isratio_string): Make this available even on builds + without HAVE_RATIO, so we can print symbols that look like ratios + with the appropriate escapes. + * lisp.h: + Make isratio_string available even if HAVE_RATIO is not defined. + +2010-07-24 Aidan Kehoe + + * lisp.h (PARSE_KEYWORDS): + Always accept a nil :allow-other-keys keyword argument, as + described in the ALLOW-OTHER-KEYS-NIL Common Lisp issue writeup, + and as necessary for Paul Dietz' tests for #'reduce. + + * fns.c (mapping_interaction_error): New. + (Freduce): Call mapping_interaction_error when KEY or FUNCTION + have modified a string SEQUENCE such that the byte length of the + string has changed, or such that the current cursor pointer + doesn't point to the beginning of a character. + Cf. the MAPPING-DESTRUCTIVE-INTERACTION Common Lisp issue + writeup. + When traversing a list, GCPRO the part of it we still have to + traverse, to avoid any crashes if FUNCTION or KEY amputate it + behind us and force a garbage collection. + +2010-06-05 Marcus Crestani + + * gc.c: + * mc-alloc.c: + Document the new allocator and the new garbage collector. + +2010-06-13 Stephen J. Turnbull + + * elhash.c: + * emacs.c: + * glade.c: + * gtk-glue.c: + * gtk-xemacs.c: + * gtk-xemacs.h: + * m/alpha.h: + * number-gmp.c: + * number-gmp.h: + * number-mp.c: + * number-mp.h: + * number.c: + * number.h: + * s/hpux11-shr.h: + * s/mach-bsd4-3.h: + * s/sco7.h: + * symsinit.h: + * ui-byhand.c: + * ui-gtk.c: + * ui-gtk.h: + Correct FSF address in permission notice. + +2010-06-08 Aidan Kehoe + + * alloc.c (Fpurecopy): + Moved to obsolete.el as an alias for #'identity, marked obsolete. + +2010-06-06 Aidan Kehoe + + * fns.c (Freduce): + Move this here from cl-seq.el, avoiding the need to cons. This + has been tested using Paul Dietz' test suite, and everything + applicable passes, with the exception that the + ALLOW-OTHER-KEYS-NIL Common Lisp issue (functions with &key must + *always* accept :allow-other-keys nil) hasn't been implemented. + +2010-06-02 Aidan Kehoe + + * lread.c (vars_of_lread): + * emacs.c: + (shut_down_emacs, vars_of_emacs, complex_vars_of_emacs): + * device-x.c (get_device_from_display) + (have_xemacs_resources_in_xrdb): + * device-gtk.c (Fgtk_init): + * config.h.in: + Remove all checks for InfoDock. + +2010-06-01 Aidan Kehoe + + * fns.c (Fsubstring_no_properties): + Add this function, API taken from GNU, though ours drops all + extent data, not just properties. + +2010-06-01 Aidan Kehoe + + * glyphs.c (syms_of_glyphs): + Remove the definition of Q_data from this file, now it's in + general-slots.h. Problem picked up by a C++ build. + +2010-05-31 Aidan Kehoe + + * rangetab.c (print_range_table, rangetab_instantiate) + (structure_type_create_rangetab): + * chartab.c (print_char_table, chartab_instantiate) + (structure_type_create_chartab): + * faces.c (syms_of_faces, print_face, face_validate): + + Move structure syntax in these files to using keywords by default, + as is done in Common Lisp and GNU Emacs, accepting for the moment + the older non-keywords syntax too. + + * glyphs.h: No need to have Q_data here. + * general-slots.h: Add Q_data, Q_type here. + + * config.h.in (NEED_TO_HANDLE_21_4_CODE): + New #define, always 1 for the moment, replacing the previous + never-really-used NO_NEED_TO_HANDLE_21_4_CODE, and avoiding + confusing syntax. + + * eval.c (Ffuncall): Wrap the hack that allows #'throw to be + funcalled in #ifdef NEED_TO_HANDLE_21_4_CODE. + * elhash.c (syms_of_elhash): Move Q_type, Q_data to + general-slots.h. Change to NEED_TO_HANDLE_21_4_CODE throughout + this file. + +2010-05-29 Aidan Kehoe + + * fontcolor-msw.c (mswindows_X_color_map): Sort this, case + insensitively, by the color name. + (colormap_t_compare): New function. + (mswindows_string_to_color): When using symbolic color names, use + binary search, not linear search. + (mswindows_color_list): No need to start from the beginning of the + array and call #'nreverse to get the colors in an intuitive order, + just build the list starting from the end of the array. + +2010-05-28 Marcus Crestani + + * window.c (compute_window_usage): Unbreak `show-memory-usage' for + NEW_GC. + +2010-05-28 Marcus Crestani + + * mc-alloc.c: + * mc-alloc.c (visit_all_used_page_headers): + * mc-alloc.c (install_page_in_used_list): + * mc-alloc.c (mc_alloc_1): + * mc-alloc.c (init_mc_allocator): + * mc-alloc.c (Fmc_alloc_memory_usage): Allocate lrecord arrays in + own size class. + +2010-05-24 Mike Sperber + + * lread.c (read1): Accept #B, #O, and #X, just + like GNU Emacs. + +2010-05-17 Jeff Sparkes + + * buffer.c (complex_vars_of_buffer): + Add buffer local variables buffer-display-count and + buffer-display-time. + (common_init_complex_vars_of_buffer): + Initialize them here. + + * bufslots.h: Add slots for buffer-display-count and buffer-display-time. + + * window.c (Fset_window_buffer): Update buffer-display-count and + buffer-display-time whenever a buffer is displayed. + +2010-05-16 Aidan Kehoe + + Move `default-file-system-ignore-case' to C; pay attention to it + in creating the directory hash tables for #'locate-file. Fix a bug + where #'eq was specified when creating directory hash tables in + dired.c. + + * config.h.in (DEFAULT_FILE_SYSTEM_IGNORE_CASE): This is 1 on + Darwin. + * dired.c (make_directory_hash_table): If + #'file-system-ignore-case-p gives non-nil for a directory, created + the associated hash table with #'equalp as its test. Never use + #'eq as a directory hash table test. + * fileio.c (vars_of_fileio): + Move `default-file-system-ignore-case' here, so it can be a + constant boolean reflecting a compile-time #define. + * lisp.h: Update the declaration of make_directory_hash_table; + remove the declaration of wasteful_word_to_lisp, which was + #ifdef'd out. + * lread.c (Flocate_file): Take out a debugging statement from + this function. + (locate_file_refresh_hashing): Call make_directory_hash_table with + a Lisp string, not an Ibyte pointer. + (vars_of_lread): If DEFAULT_FILE_SYSTEM_IGNORE_CASE is defined, + use #'equalp as the hash table test for locate-file-hash-table, + not #'equal. + * s/win32-common.h (DEFAULT_FILE_SYSTEM_IGNORE_CASE): + Case should normally be ignored in file names on Win32. + +2010-04-29 Aidan Kehoe + + * eval.c (Fquote, Ffunction): Error on more than one argument to + these special operators. + * data.c (syms_of_data): Move Qquote to general-slots.h from this + file, now it's used in eval.c + +2010-04-17 Aidan Kehoe + + * doc.c (Fdocumentation): + If we have a zero length doc string in DOC, as may happen for + undocumented compiled function objects which nonetheless have file + information stored, return nil. + (Fsnarf_documentation): + DOC info existing for compiled functions without docstrings is + perfectly legitimate, now the file is also used to store file names. + * bytecode.c (set_compiled_function_documentation): + Allow this function to set the documentation successfully for + compiled function objects that don't currently have documentation; + most relevant for functions without docstrings which have file + information stored in DOC. + +2010-04-15 Ben Wing + + * device-x.c (x_init_device): + Don't declare something const if we're going to modify it. + Clean up code to follow GNU coding standards. + +2010-04-12 Ben Wing + + * specifier.c (specifier_memory_usage): + Disable specifier memory-usage stats for now. Sometimes they can + end up with circularities in them and I'm not sure exactly whats + going on to produce them. + +2010-04-12 Ben Wing + + * charset.h: + * lisp.h: + * lisp.h (XREALLOC_ARRAY): + * text.h: + Port charset_codepoint_to_itext(), buffer_itext_to_charset_codepoint(), + EXTBYTE_STRING_TO_ALLOCA(), `enum converr' from ben-unicode-internal, + for use with the mule-wnnfns.c changes. + + * mule-wnnfns.c: + * mule-wnnfns.c (Fwnn_open): + * mule-wnnfns.c (Fwnn_dict_add): + * mule-wnnfns.c (Fwnn_dict_list): + * mule-wnnfns.c (Fwnn_get_zenkouho): + * mule-wnnfns.c (Fwnn_inspect): + * mule-wnnfns.c (Fwnn_bunsetu_kanji): + * mule-wnnfns.c (Fwnn_bunsetu_yomi): + * mule-wnnfns.c (Fwnn_word_info): + * mule-wnnfns.c (Fwnn_dict_search): + * mule-wnnfns.c (Fwnn_get_msg): + * mule-wnnfns.c (Fwnn_fuzokugo_set): + * mule-wnnfns.c (Fwnn_fuzokugo_get): + * mule-wnnfns.c (Fwnn_hinsi_list): + * mule-wnnfns.c (Fwnn_fisys_dict_add): + * mule-wnnfns.c (Fwnn_fiusr_dict_add): + * mule-wnnfns.c (Fwnn_notrans_dict_add): + * mule-wnnfns.c (Fwnn_bmodify_dict_add): + * mule-wnnfns.c (reinit_vars_of_mule_wnn): + * mule-wnnfns.c (vars_of_mule_wnn): + * mule-wnnfns.c (w2m): + * mule-wnnfns.c (m2w): + * mule-wnnfns.c (yes_or_no): + * mule-wnnfns.c (puts2): + * mule-wnnfns.c (check_wnn_server_type): + Mule-ize, borrowed from ben-unicode-internal. + +2010-04-09 Ben Wing + + * fileio.c (check_writable): + * fileio.c (Fdo_auto_save): + * redisplay-xlike-inc.c (separate_textual_runs_nomule): + * redisplay-xlike-inc.c (separate_textual_runs_xft_nomule): + * redisplay-xlike-inc.c (separate_textual_runs_xft_mule): + * redisplay-xlike-inc.c (separate_textual_runs_mule): + * redisplay-xlike-inc.c (XLIKE_output_string): + * redisplay-xlike-inc.c (XLIKE_output_vertical_divider): + * redisplay.c (create_text_block): + * redisplay.c (regenerate_window): + * redisplay.c (redisplay_window): + * redisplay.c (redisplay_device): + * redisplay.c (window_line_number): + * redisplay.c (point_would_be_visible): + * redisplay.c (compute_display_line_dynarr_usage): + * specifier.c (prune_specifiers): + * specifier.c (finalize_specifier): + * specifier.c (make_magic_specifier): + * specifier.c (charset_matches_specifier_tag_set_p): + * specifier.c (Fdefine_specifier_tag): + * specifier.c (setup_device_initial_specifier_tags): + * specifier.c (bodily_specifier): + * specifier.c (add_spec_to_ghost_specifier): + * specifier.c (remove_ghost_specifier): + * specifier.c (set_specifier_fallback): + * specifier.c (specifier_instance_from_inst_list): + * specifier.c (set_specifier_caching): + Fix coding style to correspond to GNU standard. + +2010-04-09 Didier Verna + + * fontcolor-xlike-inc.c (DEBUG_FONTS2): + * fontcolor-xlike-inc.c (DEBUG_FONTS3): + * fontcolor-xlike-inc.c (DEBUG_FONTS4): + * fontcolor-xlike-inc.c (DEBUG_FONTS_LISP1): + * fontcolor-xlike-inc.c (DEBUG_FONTS_LISP2): + * fontcolor-xlike-inc.c (DEBUG_FONTS_LISP3): + * fontcolor-xlike-inc.c (DEBUG_FONTS_LISP4): Conditionalize + definitions on DEBUG_XEMACS, provide empty definitions otherwise. + +2010-04-06 Ben Wing + + * elhash.c (Feq_hash): + Cast to EMACS_INT to fix warning. + + * elhash.c (internal_hash): + * elhash.c (Feql_hash): + Fix spacing before parens. + + * general-slots.h: + * xemacs.def.in.in: + Export Qfixnump to fix eldap.c link error. + +2010-04-06 Aidan Kehoe + + * toolbar-msw.c (allocate_toolbar_item_id) + (mswindows_output_toolbar): + * menubar-msw.c (allocate_menu_item_id, checksum_menu_item): + * glyphs-msw.c (mswindows_image_instance_hash): + * fontcolor-msw.c (mswindows_color_instance_equal): + * device-msw.c (hash_devmode): + Call internal_hash() with the correct number of arguments, declare + various hash methods with the correct number of arguments, fixing + the Win32 build. Thank you Vin. + +2010-04-06 Aidan Kehoe + + * frame.c (print_frame): + When printing a frame, print its device, making the output of + #'frame-list a lot more helpful if using gnuclient. + +2010-04-04 Ben Wing + + * font-mgr.c: + * font-mgr.c (fc_standard_properties): + * font-mgr.c (Ffc_pattern_p): + * font-mgr.c (Ffc_pattern_create): + * font-mgr.c (Ffc_name_parse): + * font-mgr.c (Ffc_name_unparse): + * font-mgr.c (Ffc_pattern_duplicate): + * font-mgr.c (Ffc_pattern_add): + * font-mgr.c (Ffc_pattern_del): + * font-mgr.c (Ffc_pattern_get): + * font-mgr.c (fc_config_create_using): + * font-mgr.c (fc_strlist_to_lisp_using): + * font-mgr.c (fontset_to_list): + * font-mgr.c (Ffc_config_p): + * font-mgr.c (Ffc_config_create): + * font-mgr.c (Ffc_config_destroy): + * font-mgr.c (Ffc_config_up_to_date): + * font-mgr.c (Ffc_config_build_fonts): + * font-mgr.c (Ffc_config_get_config_dirs): + * font-mgr.c (Ffc_config_get_font_dirs): + * font-mgr.c (Ffc_config_get_config_files): + * font-mgr.c (Ffc_config_get_cache): + * font-mgr.c (Ffc_config_get_fonts): + * font-mgr.c (Ffc_config_set_current): + * font-mgr.c (Ffc_config_get_blanks): + * font-mgr.c (Ffc_config_get_rescan_interval): + * font-mgr.c (Ffc_config_set_rescan_interval): + * font-mgr.c (Ffc_config_app_font_add_file): + * font-mgr.c (Ffc_config_app_font_add_dir): + * font-mgr.c (Ffc_config_app_font_clear): + * font-mgr.c (Ffc_init_load_config): + * font-mgr.c (Ffc_init_load_config_and_fonts): + * font-mgr.c (Ffc_config_get_current): + * font-mgr.c (size): + * font-mgr.c (Ffc_font_render_prepare): + * font-mgr.c (Ffc_font_match): + * font-mgr.c (Ffc_font_sort): + * font-mgr.c (Ffc_init): + * font-mgr.c (Ffc_get_version): + * font-mgr.c (Ffc_init_reinitialize): + * font-mgr.c (Ffc_init_bring_up_to_date): + * font-mgr.c (Fxlfd_font_name_p): + * font-mgr.c (make_xlfd_font_regexp): + * font-mgr.c (syms_of_font_mgr): + * font-mgr.c (vars_of_font_mgr): + * font-mgr.c (complex_vars_of_font_mgr): + Fix the code to conform to GNU style standards. + Rename xft-debug-level to debug-xft. + + * fontcolor-x.c: + * fontcolor-x.c (vars_of_fontcolor_x): + Rename debug-x-objects to debug-x-fonts. + + * fontcolor-xlike-inc.c: + * fontcolor-xlike-inc.c (DEBUG_FONTS1): + * fontcolor-xlike-inc.c (DEBUG_FONTS2): + * fontcolor-xlike-inc.c (DEBUG_FONTS3): + * fontcolor-xlike-inc.c (DEBUG_FONTS4): + * fontcolor-xlike-inc.c (DEBUG_FONTS_LISP1): + * fontcolor-xlike-inc.c (count_hyphens): + * fontcolor-xlike-inc.c (XFUN): + * fontcolor-xlike-inc.c (xlistfonts_checking_charset): + * fontcolor-xlike-inc.c (xft_find_charset_font): + Misc. code fixes, mostly cosmetic. Get rid of some warnings. + Fix the code to conform to GNU style standards. + + * lisp.h: + * print.c: + * print.c (debug_out_lisp): + New function for doing printf-like formatting involving Lisp objects + and outputting to the debug output. + +2010-04-03 Aidan Kehoe + + * fns.c (Ffill): + Be much more careful about resizing a string argument, update + pointers to within the string data that may have been relocated + with the string resize. Fixes a test hang reported by Vin Shelton; + thanks, Vin. + +2010-04-05 Aidan Kehoe + + * elhash.h: + * elhash.c (struct Hash_Table_Test, lisp_object_eql_equal) + (lisp_object_eql_hash, lisp_object_equal_equal) + (lisp_object_equal_hash, lisp_object_equalp_hash) + (lisp_object_equalp_equal, lisp_object_general_hash) + (lisp_object_general_equal, Feq_hash, Feql_hash, Fequal_hash) + (Fequalp_hash, define_hash_table_test, Fdefine_hash_table_test) + (init_elhash_once_early, mark_hash_table_tests, string_equalp_hash): + * glyphs.c (vars_of_glyphs): + Add a new hash table test in C, #'equalp. + Make it possible to specify new hash table tests with functions + define_hash_table_test, #'define-hash-table-test. + Use define_hash_table_test() in glyphs.c. + Expose the hash functions (besides that used for #'equal) to Lisp, + for people writing functions to be used with #'define-hash-table-test. + Call define_hash_table_test() very early in temacs, to create the + built-in hash table tests. + + * ui-gtk.c (emacs_gtk_boxed_hash): + * specifier.h (struct specifier_methods): + * specifier.c (specifier_hash): + * rangetab.c (range_table_entry_hash, range_table_hash): + * number.c (bignum_hash, ratio_hash, bigfloat_hash): + * marker.c (marker_hash): + * lrecord.h (struct lrecord_implementation): + * keymap.c (keymap_hash): + * gui.c (gui_item_id_hash, gui_item_hash): + * glyphs.c (image_instance_hash, glyph_hash): + * glyphs-x.c (x_image_instance_hash): + * glyphs-msw.c (mswindows_image_instance_hash): + * glyphs-gtk.c (gtk_image_instance_hash): + * frame-msw.c (mswindows_set_title_from_ibyte): + * fontcolor.c (color_instance_hash, font_instance_hash): + * fontcolor-x.c (x_color_instance_hash): + * fontcolor-tty.c (tty_color_instance_hash): + * fontcolor-msw.c (mswindows_color_instance_hash): + * fontcolor-gtk.c (gtk_color_instance_hash): + * fns.c (bit_vector_hash): + * floatfns.c (float_hash): + * faces.c (face_hash): + * extents.c (extent_hash): + * events.c (event_hash): + * data.c (weak_list_hash, weak_box_hash): + * chartab.c (char_table_entry_hash, char_table_hash): + * bytecode.c (compiled_function_hash): + * alloc.c (vector_hash): + Change the various object hash methods to take a new EQUALP + parameter, hashing appropriately for #'equalp if it is true. + +2010-04-02 Aidan Kehoe + + * fns.c (FsortX, Ffill): + Don't try to be clever with the ascii_begin string header slot in + these functions, just call init_string_ascii_begin(). + +2010-04-02 Aidan Kehoe + + Avoid build failure, Apple's g++-4.0.1, Mac OS 10.4. + * sysdll.c (search_linked_libs, dll_variable): Correct some casts + for the C++ build. + * regex.h (END_C_DECLS, BEGIN_C_DECLS): Wrap function declarations + in extern "C" { ... } on the C++ build. + * mule-ccl.c (ccl_driver): Initialise i, silencing a warning on + a C++ build. + * keymap.c (key_desc_list_to_event): + Work around a bug in Apple's g++-4.0.1. + +2010-03-31 Aidan Kehoe + + * fns.c (STRING_DATA_TO_OBJECT_ARRAY) + (BIT_VECTOR_TO_OBJECT_ARRAY, c_merge_predicate_key) + (c_merge_predicate_nokey, list_merge, array_merge) + (list_array_merge_into_list, list_list_merge_into_array) + (list_array_merge_into_array, CHECK_KEY_ARGUMENT, Fmerge) + (list_sort, array_sort, FsortX): + Move #'sort*, #'fill, #'merge from cl-seq.el to C, extending the + implementations of Fsort, Ffillarray, and merge() to do so. + + * keymap.c (keymap_submaps, map_keymap_sort_predicate) + (describe_map_sort_predicate): + Change the calling semantics of the C sort predicates to return a + non-nil Lisp object if the first argument is less than the second, + rather than C integers. + + * fontcolor-msw.c (sort_font_list_function): + * fileio.c (build_annotations): + * dired.c (Fdirectory_files): + * abbrev.c (Finsert_abbrev_table_description): + Call list_sort instead of Fsort, list_merge instead of merge() in + these functions. + +2010-03-29 Ben Wing + + * lisp.h (PRIVATE_UNVERIFIED_LIST_LOOP_7): + Need to cast 0 to void (so both parts of conditional expression + have void type) to fix C++ compilation. + +2010-03-29 Ben Wing + + * alloc.c: + * alloc.c (lisp_object_storage_size): + * alloc.c (Fobject_memory_usage): + * alloc.c (lisp_object_memory_usage_full): + Don't crash if passed a non-record object (int or char). + + * alloc.c (tree_memory_usage_1): + * lrecord.h: + New function tree_memory_usage() to return the memory usage of + a tree of conses and/or vectors. + + * lisp.h: + * lisp.h (PRIVATE_UNVERIFIED_LIST_LOOP_7): + Add SAFE_LIST_LOOP_* functions for looping over a list not known + to be correct or non-circular, but without signalling an error -- + instead, just stop enumerating when an error detected. + + * emacs.c (main_1): + * specifier.c: + * specifier.c (specifier_memory_usage): + * specifier.c (vars_of_specifier): + * symsinit.h: + Add memory usage info for specifiers. + +2010-03-28 Ben Wing + + * window.c (find_window_mirror_internal): + Stop looking if no window mirror, and return 0. + + * window.c (window_display_lines): + * window.c (window_display_buffer): + * window.c (set_window_display_buffer): + Don't need to update window mirror before calling find_window_mirror + because does the updating automatically. + +2010-03-25 Ben Wing + + * alloc.c: + * alloc.c (struct): + * alloc.c (finish_object_memory_usage_stats): + * alloc.c (object_memory_usage_stats): + * alloc.c (Fobject_memory_usage): + * alloc.c (lisp_object_memory_usage_full): + * alloc.c (compute_memusage_stats_length): + * lrecord.h: + * lrecord.h (struct lrecord_implementation): + Add fields to the `lrecord_implementation' structure to list an + offset into the array of extra statistics in a + `struct generic_usage_stats' and a length, listing the first slice + of ancillary Lisp-object memory. Compute automatically in + compute_memusage_stats_length(). Use to add an entry + `FOO-lisp-ancillary-storage' for object type FOO. + + Don't crash when an int or char is given to object-memory-usage, + signal an error instead. + + Add functions lisp_object_memory_usage_full() and + lisp_object_memory_usage() to compute the total memory usage of an + object (sum of object, non-Lisp attached, and Lisp ancillary + memory). + + * array.c: + * array.c (gap_array_memory_usage): + * array.h: + Add function to return memory usage of a gap array. + + * buffer.c (struct buffer_stats): + * buffer.c (compute_buffer_usage): + * buffer.c (vars_of_buffer): + * extents.c (compute_buffer_extent_usage): + * marker.c: + * marker.c (compute_buffer_marker_usage): + * extents.h: + * lisp.h: + Remove `struct usage_stats' arg from compute_buffer_marker_usage() + and compute_buffer_extent_usage() -- these are ancillary Lisp + objects and don't get accumulated into `struct usage_stats'; + change the value of `memusage_stats_list' so that `markers' and + `extents' memory is in Lisp-ancillary, where it belongs. + + In compute_buffer_marker_usage(), use lisp_object_memory_usage() + rather than lisp_object_storage_size(). + + * casetab.c: + * casetab.c (case_table_memory_usage): + * casetab.c (vars_of_casetab): + * emacs.c (main_1): + Add memory usage stats for case tables. + + * lisp.h: + Add comment explaining the `struct generic_usage_stats' more, + as well as the new fields in lrecord_implementation. + + * console-impl.h: + * console-impl.h (struct console_methods): + * scrollbar-gtk.c: + * scrollbar-gtk.c (gtk_compute_scrollbar_instance_usage): + * scrollbar-msw.c: + * scrollbar-msw.c (mswindows_compute_scrollbar_instance_usage): + * scrollbar-x.c: + * scrollbar-x.c (x_compute_scrollbar_instance_usage): + * scrollbar.c: + * scrollbar.c (struct scrollbar_instance_stats): + * scrollbar.c (compute_all_scrollbar_instance_usage): + * scrollbar.c (scrollbar_instance_memory_usage): + * scrollbar.c (scrollbar_objects_create): + * scrollbar.c (vars_of_scrollbar): + * scrollbar.h: + * symsinit.h: + * window.c: + * window.c (find_window_mirror_maybe): + * window.c (struct window_mirror_stats): + * window.c (compute_window_mirror_usage): + * window.c (window_mirror_memory_usage): + * window.c (compute_window_usage): + * window.c (window_objects_create): + * window.c (syms_of_window): + * window.c (vars_of_window): + Redo memory-usage associated with windows, window mirrors, and + scrollbar instances. Should fix crash in find_window_mirror, + among other things. Properly assign memo ry to object memory, + non-Lisp extra memory, and Lisp ancillary memory. For example, + redisplay structures are non-Lisp memory hanging off a window + mirror, not a window; make it an ancillary Lisp-object field. + Window mirrors and scrollbar instances have their own statistics, + among other things. + +2010-03-24 Ben Wing + + * array.h: + * array.h (XD_LISP_DYNARR_DESC): + * dumper.c (pdump_register_sub): + * dumper.c (pdump_store_new_pointer_offsets): + * dumper.c (pdump_reloc_one_mc): + * elhash.c: + * gc.c (lispdesc_one_description_line_size): + * gc.c (kkcc_marking): + * lrecord.h: + * lrecord.h (IF_NEW_GC): + * lrecord.h (enum memory_description_type): + * lrecord.h (enum data_description_entry_flags): + * lrecord.h (struct opaque_convert_functions): + Rename XD_LISP_OBJECT_BLOCK_PTR to XD_INLINE_LISP_OBJECT_BLOCK_PTR + and document it in lrecord.h. + + * data.c: + * data.c (finish_marking_weak_lists): + * data.c (continue_marking_ephemerons): + * data.c (finish_marking_ephemerons): + * elhash.c (MARK_OBJ): + * gc.c: + * gc.c (lispdesc_indirect_count_1): + * gc.c (struct): + * gc.c (kkcc_bt_push): + * gc.c (kkcc_gc_stack_push): + * gc.c (kkcc_gc_stack_push_lisp_object): + * gc.c (kkcc_gc_stack_repush_dirty_object): + * gc.c (KKCC_DO_CHECK_FREE): + * gc.c (mark_object_maybe_checking_free): + * gc.c (mark_struct_contents): + * gc.c (mark_lisp_object_block_contents): + * gc.c (register_for_finalization): + * gc.c (mark_object): + * gc.h: + * lisp.h: + * profile.c: + * profile.c (mark_profiling_info_maphash): + Clean up KKCC code related to DEBUG_XEMACS. Rename + kkcc_backtrace() to kkcc_backtrace_1() and add two params: a + `size' arg to control how many stack elements to print and a + `detailed' arg to control whether Lisp objects are printed using + `debug_print()'. Create front-ends to kkcc_backtrace_1() -- + kkcc_detailed_backtrace(), kkcc_short_backtrace(), + kkcc_detailed_backtrace_full(), kkcc_short_backtrace_full(), as + well as shortened versions kbt(), kbts(), kbtf(), kbtsf() -- to + call it with various parameter values. Add an `is_lisp' field to + the stack and backtrace structures and use it to keep track of + whether an object pushed onto the stack is a Lisp object or a + non-Lisp structure; in kkcc_backtrace_1(), don't try to print a + non-Lisp structure as a Lisp object. + + * elhash.c: + * extents.c: + * file-coding.c: + * lrecord.h: + * lrecord.h (IF_NEW_GC): + * marker.c: + * marker.c (Fmarker_buffer): + * mule-coding.c: + * number.c: + * rangetab.c: + * specifier.c: + New macros IF_OLD_GC(), IF_NEW_GC() to simplify declaration of + Lisp objects when a finalizer may exist in one but not the other. + Use them appropriately. + + * extents.c (finalize_extent_info): + Don't zero out data->soe and data->extents before trying to free, + else we get memory leaks. + + * lrecord.h (enum lrecord_type): + Make the first lrecord type have value 1 not 0 so that 0 remains + without implementation and attempts to interpret zeroed memory + as a Lisp object will be more obvious. + + * array.c (Dynarr_free): + * device-msw.c (msprinter_delete_device): + * device-tty.c (free_tty_device_struct): + * device-tty.c (tty_delete_device): + * dialog-msw.c (handle_directory_dialog_box): + * dialog-x.c: + * emacs.c (free_argc_argv): + * emodules.c (attempt_module_delete): + * file-coding.c (chain_finalize_coding_stream_1): + * file-coding.c (chain_finalize_coding_stream): + * glyphs-eimage.c: + * glyphs-eimage.c (jpeg_instantiate_unwind): + * glyphs-eimage.c (gif_instantiate_unwind): + * glyphs-eimage.c (png_instantiate_unwind): + * glyphs-eimage.c (tiff_instantiate_unwind): + * imgproc.c: + * imgproc.c (build_EImage_quantable): + * insdel.c (uninit_buffer_text): + * mule-coding.c (iso2022_finalize_detection_state): + * objects-tty.c (tty_finalize_color_instance): + * objects-tty.c (tty_finalize_font_instance): + * objects-tty.c (tty_font_list): + * process.c: + * process.c (finalize_process): + * redisplay.c (add_propagation_runes): + * scrollbar-gtk.c: + * scrollbar-gtk.c (gtk_free_scrollbar_instance): + * scrollbar-gtk.c (gtk_release_scrollbar_instance): + * scrollbar-msw.c: + * scrollbar-msw.c (mswindows_free_scrollbar_instance): + * scrollbar-msw.c (unshow_that_mofo): + * scrollbar-x.c (x_free_scrollbar_instance): + * scrollbar-x.c (x_release_scrollbar_instance): + * select-x.c: + * select-x.c (x_handle_selection_request): + * syntax.c: + * syntax.c (uninit_buffer_syntax_cache): + * text.h (eifree): + If possible, whenever we call xfree() on a field in a structure, + set the field to 0 afterwards. A lot of code is written so that + it checks the value being freed to see if it is non-zero before + freeing it -- doing this and setting the value to 0 afterwards + ensures (a) we won't try to free twice if the cleanup code is + called twice; (b) if the object itself stays around, KKCC won't + crash when attempting to mark the freed field. + + * rangetab.c: + Add a finalization method when not NEW_GC to avoid memory leaks. + (#### We still get memory leaks when NEW_GC; need to convert gap + array to Lisp object). + +2010-03-22 Ben Wing + + * Makefile.in.in (objs): + * array.c: + * array.c (gap_array_adjust_markers): + * array.c (gap_array_move_gap): + * array.c (gap_array_make_gap): + * array.c (gap_array_insert_els): + * array.c (gap_array_delete_els): + * array.c (gap_array_make_marker): + * array.c (gap_array_delete_marker): + * array.c (gap_array_delete_all_markers): + * array.c (gap_array_clone): + * array.h: + * depend: + * emacs.c (main_1): + * extents.c: + * extents.c (EXTENT_GAP_ARRAY_AT): + * extents.c (extent_list_num_els): + * extents.c (extent_list_locate): + * extents.c (extent_list_at): + * extents.c (extent_list_delete_all): + * extents.c (allocate_extent_list): + * extents.c (syms_of_extents): + * extents.h: + * extents.h (XEXTENT_LIST_MARKER): + * lisp.h: + * rangetab.c: + * rangetab.c (mark_range_table): + * rangetab.c (print_range_table): + * rangetab.c (range_table_equal): + * rangetab.c (range_table_hash): + * rangetab.c (verify_range_table): + * rangetab.c (get_range_table_pos): + * rangetab.c (Fmake_range_table): + * rangetab.c (Fcopy_range_table): + * rangetab.c (Fget_range_table): + * rangetab.c (put_range_table): + * rangetab.c (Fclear_range_table): + * rangetab.c (Fmap_range_table): + * rangetab.c (unified_range_table_bytes_needed): + * rangetab.c (unified_range_table_copy_data): + * rangetab.c (unified_range_table_lookup): + * rangetab.h: + * rangetab.h (struct range_table_entry): + * rangetab.h (struct Lisp_Range_Table): + * rangetab.h (rangetab_gap_array_at): + * symsinit.h: + Rename dynarr.c to array.c. Move gap array from extents.c to array.c. + Extract dynarr, gap array and stack-like malloc into new file array.h. + Rename GAP_ARRAY_NUM_ELS -> gap_array_length(). Add gap_array_at(), + gap_array_atp(). + + Rewrite range table code to use gap arrays. Make put_range_table() + smarter so that its operation is O(log n) for adding a localized + range. + + * gc.c (lispdesc_block_size_1): + Don't ABORT() when two elements are located at the same place. + This will happen with a size-0 gap array -- both parts of the array + (before and after gap) are in the same place. + +2010-03-21 Ben Wing + + * alloc.c: + * alloc.c (assert_proper_sizing): + * alloc.c (c_readonly): + * alloc.c (malloced_storage_size): + * alloc.c (fixed_type_block_overhead): + * alloc.c (lisp_object_storage_size): + * alloc.c (inc_lrecord_stats): + * alloc.c (dec_lrecord_stats): + * alloc.c (pluralize_word): + * alloc.c (object_memory_usage_stats): + * alloc.c (Fobject_memory_usage): + * alloc.c (compute_memusage_stats_length): + * alloc.c (disksave_object_finalization_1): + * alloc.c (Fgarbage_collect): + * mc-alloc.c: + * mc-alloc.c (mc_alloced_storage_size): + * mc-alloc.h: + No functionality change here. Collect the allocations-statistics + code that was scattered throughout alloc.c into one place. Add + remaining section headings so that all sections have headings + clearly identifying the start of the section and its purpose. + Expose mc_alloced_storage_size() even when not MEMORY_USAGE_STATS; + this fixes build problems and is related to the export of + lisp_object_storage_size() and malloced_storage_size() when + non-MEMORY_USAGE_STATS in the previous change set. + +2010-03-22 Vin Shelton + + * window.c (vars_of_window): Move HAVE_SCROLLBARS test so the code + can compile under Visual Studio 6. + +2010-03-21 Aidan Kehoe + + * alloc.c (tick_lrecord_stats): + Fix the union build after Ben's last change, don't assume that a + Lisp_Object will fit into a Bytecount. + +2010-03-20 Ben Wing + + * alloc.c: + * alloc.c (init_lrecord_stats): + * alloc.c (free_normal_lisp_object): + * alloc.c (struct): + * alloc.c (clear_lrecord_stats): + * alloc.c (tick_lrecord_stats): + * alloc.c (COUNT_FROB_BLOCK_USAGE): + * alloc.c (COPY_INTO_LRECORD_STATS): + * alloc.c (sweep_strings): + * alloc.c (UNMARK_string): + * alloc.c (gc_sweep_1): + * alloc.c (finish_object_memory_usage_stats): + * alloc.c (object_memory_usage_stats): + * alloc.c (object_dead_p): + * alloc.c (fixed_type_block_overhead): + * alloc.c (lisp_object_storage_size): + * emacs.c (main_1): + * lisp.h: + * lrecord.h: + Export lisp_object_storage_size() and malloced_storage_size() even + when not MEMORY_USAGE_STATS, to get the non-MEMORY_USAGE_STATS + build to compile. + + Don't export fixed_type_block_overhead() any more. + + Some code cleanup, rearrangement, add some section headers. + + Clean up various bugs especially involving computation of overhead + and double-counting certain usage in total_gc_usage. Add + statistics computing the overhead used by all types. Don't add a + special entry for string headers in the object-memory-usage-stats + because it's already present as just "string". But do count the + overhead used by long strings. Don't try to call the + memory_usage() methods when NEW_GC because there's nowhere obvious + in the sweep stage to make the calls. + + * marker.c (compute_buffer_marker_usage): + Just use lisp_object_storage_size() rather than trying to + reimplement it. + +2010-03-19 Ben Wing + + * alloc.c: + * alloc.c (struct): + * alloc.c (tick_lrecord_stats): + * alloc.c (gc_sweep_1): + * alloc.c (finish_object_memory_usage_stats): + * alloc.c (object_memory_usage_stats): + * alloc.c (compute_memusage_stats_length): + Call new memory-usage mechanism at sweep time to compute extra + memory utilization for all objects. Add up the values element-by- + element to get an aggregrate set of statistics, where each is the + sum of the values of a single statistic across different objects + of the same type. At end of sweep time, call + finish_object_memory_usage_stats() to add up all the aggreggrate + stats that are related to non-Lisp memory storage to compute + a single value, and add it to the list of values returned by + `garbage-collect' and `object-memory-usage-stats'. + + * buffer.c (compute_buffer_text_usage): + Don't crash on buffers without text (killed buffers?) and don't + double-count indirect buffers. + + * elhash.c: + * elhash.c (hash_table_objects_create): + * elhash.c (vars_of_elhash): + * symsinit.h: + Add memory-usage method to count the size of `hentries'. + + * emacs.c (main_1): + Call new functions in elhash.c, frame.c at init. + + * frame.c: + * frame.c (compute_frame_usage): + * frame.c (frame_memory_usage): + * frame.c (frame_objects_create): + * symsinit.h: + Add memory-usage method to count gutter display structures, + subwindow exposures. + + * gc.c (gc_finish): + * lisp.h: + Declare finish_object_memory_usage_stats(), call it in gc_finish(). + + * lrecord.h (struct lrecord_implementation): + * lrecord.h (INIT_MEMORY_USAGE_STATS): + New value in implementation struct to track number of non-Lisp-memory + statistics. Computed in alloc.c. + + +2010-03-18 Ben Wing + + * alloc.c: + * alloc.c (disksave_object_finalization_1): + * alloc.c (lisp_object_storage_size): + * alloc.c (listu): + * alloc.c (listn): + * alloc.c (Fobject_memory_usage_stats): + * alloc.c (compute_memusage_stats_length): + * alloc.c (Fobject_memory_usage): + * alloc.c (Ftotal_object_memory_usage): + * alloc.c (malloced_storage_size): + * alloc.c (common_init_alloc_early): + * alloc.c (reinit_alloc_objects_early): + * alloc.c (reinit_alloc_early): + * alloc.c (init_alloc_once_early): + * alloc.c (syms_of_alloc): + * alloc.c (reinit_vars_of_alloc): + * buffer.c: + * buffer.c (struct buffer_stats): + * buffer.c (compute_buffer_text_usage): + * buffer.c (compute_buffer_usage): + * buffer.c (buffer_memory_usage): + * buffer.c (buffer_objects_create): + * buffer.c (syms_of_buffer): + * buffer.c (vars_of_buffer): + * console-impl.h (struct console_methods): + * dynarr.c (Dynarr_memory_usage): + * emacs.c (main_1): + * events.c (clear_event_resource): + * extents.c: + * extents.c (compute_buffer_extent_usage): + * extents.c (extent_objects_create): + * extents.h: + * faces.c: + * faces.c (compute_face_cachel_usage): + * faces.c (face_objects_create): + * faces.h: + * general-slots.h: + * glyphs.c: + * glyphs.c (compute_glyph_cachel_usage): + * glyphs.c (glyph_objects_create): + * glyphs.h: + * lisp.h: + * lisp.h (struct usage_stats): + * lrecord.h: + * lrecord.h (enum lrecord_type): + * lrecord.h (struct lrecord_implementation): + * lrecord.h (MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE): + * lrecord.h (DEFINE_DUMPABLE_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_SIZABLE_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_INTERNAL_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT): + * lrecord.h (MAKE_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_MODULE_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT): + * lrecord.h (MAKE_MODULE_LISP_OBJECT): + * lrecord.h (INIT_LISP_OBJECT): + * lrecord.h (INIT_MODULE_LISP_OBJECT): + * lrecord.h (UNDEF_LISP_OBJECT): + * lrecord.h (UNDEF_MODULE_LISP_OBJECT): + * lrecord.h (DECLARE_LISP_OBJECT): + * lrecord.h (DECLARE_MODULE_API_LISP_OBJECT): + * lrecord.h (DECLARE_MODULE_LISP_OBJECT): + * lstream.c: + * lstream.c (syms_of_lstream): + * lstream.c (vars_of_lstream): + * marker.c: + * marker.c (compute_buffer_marker_usage): + * mc-alloc.c (mc_alloced_storage_size): + * mc-alloc.h: + * mule-charset.c: + * mule-charset.c (struct charset_stats): + * mule-charset.c (compute_charset_usage): + * mule-charset.c (charset_memory_usage): + * mule-charset.c (mule_charset_objects_create): + * mule-charset.c (syms_of_mule_charset): + * mule-charset.c (vars_of_mule_charset): + * redisplay.c: + * redisplay.c (compute_rune_dynarr_usage): + * redisplay.c (compute_display_block_dynarr_usage): + * redisplay.c (compute_glyph_block_dynarr_usage): + * redisplay.c (compute_display_line_dynarr_usage): + * redisplay.c (compute_line_start_cache_dynarr_usage): + * redisplay.h: + * scrollbar-gtk.c (gtk_compute_scrollbar_instance_usage): + * scrollbar-msw.c (mswindows_compute_scrollbar_instance_usage): + * scrollbar-x.c (x_compute_scrollbar_instance_usage): + * scrollbar.c (compute_scrollbar_instance_usage): + * scrollbar.h: + * symbols.c: + * symbols.c (reinit_symbol_objects_early): + * symbols.c (init_symbols_once_early): + * symbols.c (reinit_symbols_early): + * symbols.c (defsymbol_massage_name_1): + * symsinit.h: + * ui-gtk.c: + * ui-gtk.c (emacs_gtk_object_getprop): + * ui-gtk.c (emacs_gtk_object_putprop): + * ui-gtk.c (ui_gtk_objects_create): + * unicode.c (compute_from_unicode_table_size_1): + * unicode.c (compute_to_unicode_table_size_1): + * unicode.c (compute_from_unicode_table_size): + * unicode.c (compute_to_unicode_table_size): + * window.c: + * window.c (struct window_stats): + * window.c (compute_window_mirror_usage): + * window.c (compute_window_usage): + * window.c (window_memory_usage): + * window.c (window_objects_create): + * window.c (syms_of_window): + * window.c (vars_of_window): + * window.h: + Redo memory-usage mechanism, make it general; add way of dynamically + initializing Lisp object types -- OBJECT_HAS_METHOD(), similar to + CONSOLE_HAS_METHOD(). + + (1) Create OBJECT_HAS_METHOD(), OBJECT_HAS_PROPERTY() etc. for + specifying that a Lisp object type has a particular method or + property. Call such methods with OBJECT_METH, MAYBE_OBJECT_METH, + OBJECT_METH_OR_GIVEN; retrieve properties with OBJECT_PROPERTY. + Methods that formerly required a DEFINE_*GENERAL_LISP_OBJECT() to + specify them (getprop, putprop, remprop, plist, disksave) now + instead use the dynamic-method mechanism. The main benefit of + this is that new methods or properties can be added without + requiring that the declaration statements of all existing methods + be modified. We have to make the `struct lrecord_implementation' + non-const, but I don't think this should have any effect on speed -- + the only possible method that's really speed-critical is the + mark method, and we already extract those out into a separate + (non-const) array for increased cache locality. + + Object methods need to be reinitialized after pdump, so we put + them in separate functions such as face_objects_create(), + extent_objects_create() and call them appropriately from emacs.c + The only current object property (`memusage_stats_list') that + objects can specify is a Lisp object and gets staticpro()ed so it + only needs to be set during dump time, but because it references + symbols that might not exist in a syms_of_() function, we + initialize it in vars_of_(). There is also an object property + (`num_extra_memusage_stats') that is automatically initialized based + on `memusage_stats_list'; we do that in reinit_vars_of_alloc(), + which is called after all vars_of_() functions are called. + + `disksaver' method was renamed `disksave' to correspond with the + name normally given to the function (e.g. disksave_lstream()). + + (2) Generalize the memory-usage mechanism in `buffer-memory-usage', + `window-memory-usage', `charset-memory-usage' into an object-type- + specific mechanism called by a single function + `object-memory-usage'. (Former function `object-memory-usage' + renamed to `total-object-memory-usage'). Generalize the mechanism + of different "slices" so that we can have different "classes" of + memory described and different "slices" onto each class; `t' + separates classes, `nil' separates slices. Currently we have + three classes defined: the memory of an object itself, + non-Lisp-object memory associated with the object (e.g. arrays or + dynarrs stored as fields in the object), and Lisp-object memory + associated with the object (other internal Lisp objects stored in + the object). This isn't completely finished yet and we might need + to further separate the "other internal Lisp objects" class into + two classes. + + The memory-usage mechanism uses a `struct usage_stats' (renamed + from `struct overhead_stats') to describe a malloc-view onto a set + of allocated memory (listing how much was requested and various + types of overhead) and a more general `struct generic_usage_stats' + (with a `struct usage_stats' in it) to hold all statistics about + object memory. `struct generic_usage_stats' contains an array of + 32 Bytecounts, which are statistics of unspecified semantics. The + intention is that individual types declare a corresponding struct + (e.g. `struct window_stats') with the same structure but with + specific fields in place of the array, corresponding to specific + statistics. The number of such statistics is an object property + computed from the list of tags (Lisp symbols describing the + statistics) stored in `memusage_stats_list'. The idea here is to + allow particular object types to customize the number and + semantics of the statistics where completely avoiding consing. + This doesn't matter so much yet, but the intention is to have the + memory usage of all objects computed at the end of GC, at the same + time as other statistics are currently computed. The values for + all statistics for a single type would be added up to compute + aggregate values for all objects of a specific type. To make this + efficient, we can't allow any memory allocation at all. + + (3) Create some additional functions for creating lists that + specify the elements directly as args rather than indirectly through + an array: listn() (number of args given), listu() (list terminated + by Qunbound). + + (4) Delete a bit of remaining unused C window_config stuff, also + unused lrecord_type_popup_data. + + +2010-03-18 Ben Wing + + * tests.c: + * tests.c (Ftest_data_format_conversion): + Need to GCPRO newly created objects or we'll eventually get + a crash due to occurrence of call2(). + +2010-03-16 Ben Wing + + * alloc.c (make_lcrecord_list): + * alloc.c (alloc_managed_lcrecord): + Fix compilation problems identified by Robert Delius Royar. + +2010-03-15 Ben Wing + + * extents.c (Fprevious_single_property_change): + * extents.c (Fnext_single_char_property_change): + * extents.c (Fprevious_single_char_property_change): + Fix see-also portion of documentation string. + +2010-03-15 Ben Wing + + * alloc.c: + * alloc.c (c_readonly): + * alloc.c (deadbeef_memory): + * alloc.c (make_compiled_function): + * alloc.c (make_button_data): + * alloc.c (make_motion_data): + * alloc.c (make_process_data): + * alloc.c (make_timeout_data): + * alloc.c (make_magic_data): + * alloc.c (make_magic_eval_data): + * alloc.c (make_eval_data): + * alloc.c (make_misc_user_data): + * alloc.c (noseeum_make_marker): + * alloc.c (ADDITIONAL_FREE_string): + * alloc.c (common_init_alloc_early): + * alloc.c (init_alloc_once_early): + * bytecode.c (print_compiled_function): + * bytecode.c (mark_compiled_function): + * casetab.c: + * casetab.c (print_case_table): + * console.c: + * console.c (print_console): + * database.c (print_database): + * database.c (finalize_database): + * device-msw.c (sync_printer_with_devmode): + * device-msw.c (print_devmode): + * device-msw.c (finalize_devmode): + * device.c: + * device.c (print_device): + * elhash.c: + * elhash.c (print_hash_table): + * eval.c (print_multiple_value): + * eval.c (mark_multiple_value): + * events.c (deinitialize_event): + * events.c (print_event): + * events.c (event_equal): + * extents.c: + * extents.c (soe_dump): + * extents.c (soe_insert): + * extents.c (soe_delete): + * extents.c (soe_move): + * extents.c (extent_fragment_update): + * extents.c (print_extent_1): + * extents.c (print_extent): + * extents.c (vars_of_extents): + * frame.c: + * frame.c (print_frame): + * free-hook.c: + * free-hook.c (check_free): + * glyphs.c: + * glyphs.c (print_image_instance): + * glyphs.c (print_glyph): + * gui.c: + * gui.c (copy_gui_item): + * hash.c: + * hash.c (NULL_ENTRY): + * hash.c (KEYS_DIFFER_P): + * keymap.c (print_keymap): + * keymap.c (MARKED_SLOT): + * lisp.h: + * lrecord.h: + * lrecord.h (LISP_OBJECT_UID): + * lrecord.h (set_lheader_implementation): + * lrecord.h (struct old_lcrecord_header): + * lstream.c (print_lstream): + * lstream.c (finalize_lstream): + * marker.c (print_marker): + * marker.c (marker_equal): + * mc-alloc.c (visit_all_used_page_headers): + * mule-charset.c: + * mule-charset.c (print_charset): + * objects.c (print_color_instance): + * objects.c (print_font_instance): + * objects.c (finalize_font_instance): + * opaque.c (print_opaque): + * opaque.c (print_opaque_ptr): + * opaque.c (equal_opaque_ptr): + * print.c (internal_object_printer): + * print.c (enum printing_badness): + * rangetab.c (print_range_table): + * rangetab.c (range_table_equal): + * specifier.c (print_specifier): + * specifier.c (finalize_specifier): + * symbols.c: + * symbols.c (print_symbol_value_magic): + * tooltalk.c: + * tooltalk.c (print_tooltalk_message): + * tooltalk.c (print_tooltalk_pattern): + * window.c (print_window): + * window.c (debug_print_window): + (1) Make lrecord UID's have a separate UID space for each object. + Otherwise, with 20-bit UID's, we rapidly wrap around, especially + when common objects like conses and strings increment the UID value + for every object created. (Originally I tried making two UID spaces, + one for objects that always print readably and hence don't display + the UID, and one for other objects. But certain objects like markers + for which a UID is displayed are still generated rapidly enough that + UID overflow is a serious issue.) This also has the advantage of + making UID values smaller, hence easier to remember -- their main + purpose is to make it easier to keep track of different objects of + the same type when debugging code. Make sure we dump lrecord UID's + so that we don't have problems with pdumped and non-dumped objects + having the same UID. + + (2) Display UID's consistently whenever an object (a) doesn't + consistently print readably (objects like cons and string, which + always print readably, can't display a UID), and (b) doesn't + otherwise have a unique property that makes objects of a + particular type distinguishable. (E.g. buffers didn't and still + don't print an ID, but the buffer name uniquely identifies the + buffer.) Some types, such as event, extent, compiled-function, + didn't always (or didn't ever) display an ID; others (such as + marker, extent, lstream, opaque, opaque-ptr, any object using + internal_object_printer()) used to display the actual machine + pointer instead. + + (3) Rename NORMAL_LISP_OBJECT_UID to LISP_OBJECT_UID; make it work + over all Lisp objects and take a Lisp object, not a struct pointer. + + (4) Some misc cleanups in alloc.c, elhash.c. + + (5) Change code in events.c that "deinitializes" an event so that + it doesn't increment the event UID counter in the process. Also + use deadbeef_memory() to overwrite memory instead of doing the same + with custom code. In the process, make deadbeef_memory() in + alloc.c always available, and delete extraneous copy in mc-alloc.c. + Also capitalize all uses of 0xDEADBEEF. Similarly in elhash.c + call deadbeef_memory(). + + (6) Resurrect "debug SOE" code in extents.c. Make it conditional + on DEBUG_XEMACS and on a `debug-soe' variable, rather than on + SOE_DEBUG. Make it output to stderr, not stdout. + + (7) Delete some custom print methods that were identical to + external_object_printer(). + +2010-03-12 Ben Wing + + * lisp.h: + * lisp.h (redo-symbols): Removed. + Put the Lisp variables and symbols where they belong, with other + stuff related to the file they're in. + + * event-Xt.c (THIS_IS_X): + * event-Xt.c (syms_of_event_Xt): + * event-Xt.c (reinit_vars_of_event_Xt): + * event-gtk.c: + * event-gtk.c (syms_of_event_gtk): + * event-gtk.c (reinit_vars_of_event_gtk): + * event-stream.c: + * event-stream.c (syms_of_event_stream): + * event-stream.c (reinit_vars_of_event_stream): + * events.c (reinit_vars_of_events): + * events.c (vars_of_events): + `sans-modifiers' was defsymbol'ed more than once. Move it to + events-stream.c. `self-insert-command' was defsymbol'ed more than once. + Vevent_resource should be staticpro_nodump()ed as it's declared in + a reinit_*() method. + + * lread.c (vars_of_lread): + Vfile_domain wasn't staticpro'ed. + + * minibuf.c: + * minibuf.c (reinit_complex_vars_of_minibuf): + Vminibuffer_zero and Vecho_area_buffer weren't staticpro'ed. + +2010-03-12 Ben Wing + + * redisplay-msw.c: + * redisplay-msw.c (mswindows_output_dibitmap_region): + * redisplay-msw.c (mswindows_output_pixmap): + * redisplay-msw.c (mswindows_clear_region): + Have a crack at implementing the `absolute' property for + background pixmaps. It seems to work; however, things don't + work quite right in relation to window sizing/moving. In particular, + ideally when you move the window the background should stay in place + but it doesn't; instead it moves, and when you hit C-l it gets + redrawn in the "proper" place. When resizing you get some serious + jitter, apparently as first the image gets moved then redrawn in + the correct offset position. #### Not sure how to fix this. + +2010-03-13 Ben Wing + + * alloc.c (alloc_sized_lrecord_1): + * alloc.c (alloc_sized_lrecord_array): + * alloc.c (old_alloc_sized_lcrecord): + * alloc.c (disksave_object_finalization_1): + * alloc.c (mark_lcrecord_list): + * alloc.c (alloc_managed_lcrecord): + * alloc.c (free_managed_lcrecord): + * alloc.c (tick_lcrecord_stats): + * alloc.c (sweep_lcrecords_1): + * buffer.c (print_buffer): + * buffer.c (DEFVAR_BUFFER_LOCAL_1): + * casetab.c: + * casetab.c (print_case_table): + * console.c (print_console): + * console.c (DEFVAR_CONSOLE_LOCAL_1): + * data.c (print_weak_list): + * data.c (print_weak_box): + * data.c (print_ephemeron): + * data.c (ephemeron_equal): + * database.c (print_database): + * database.c (finalize_database): + * device-msw.c (sync_printer_with_devmode): + * device-msw.c (print_devmode): + * device-msw.c (finalize_devmode): + * device.c: + * device.c (print_device): + * elhash.c: + * elhash.c (print_hash_table): + * eval.c (print_subr): + * eval.c (print_multiple_value): + * event-stream.c (event_stream_resignal_wakeup): + * events.c (clear_event_resource): + * events.c (zero_event): + * events.c (print_event): + * extents.c: + * extents.c (print_extent): + * file-coding.c (print_coding_system): + * font-mgr.c: + * font-mgr.c (Ffc_init): + * frame.c: + * frame.c (print_frame): + * gc.c: + * gc.c (GC_CHECK_NOT_FREE): + * glyphs.c: + * glyphs.c (print_image_instance): + * glyphs.c (print_glyph): + * gui.c (print_gui_item): + * gui.c (copy_gui_item): + * keymap.c (print_keymap): + * keymap.c (MARKED_SLOT): + * lisp.h: + * lisp.h (struct Lisp_String): + * lisp.h (DEFUN): + * lisp.h (DEFUN_NORETURN): + * lrecord.h: + * lrecord.h (NORMAL_LISP_OBJECT_UID): + * lrecord.h (struct lrecord_header): + * lrecord.h (set_lheader_implementation): + * lrecord.h (struct old_lcrecord_header): + * lrecord.h (struct free_lcrecord_header): + * marker.c (print_marker): + * mule-charset.c: + * mule-charset.c (print_charset): + * objects.c (print_color_instance): + * objects.c (print_font_instance): + * objects.c (finalize_font_instance): + * print.c (print_cons): + * print.c (printing_unreadable_object_fmt): + * print.c (printing_unreadable_lisp_object): + * print.c (external_object_printer): + * print.c (internal_object_printer): + * print.c (debug_p4): + * print.c (ext_print_begin): + * process.c (print_process): + * rangetab.c (print_range_table): + * rangetab.c (range_table_equal): + * scrollbar.c (free_scrollbar_instance): + * specifier.c (print_specifier): + * specifier.c (finalize_specifier): + * symbols.c (guts_of_unbound_marker): + * symeval.h: + * symeval.h (DEFVAR_SYMVAL_FWD): + * tooltalk.c: + * tooltalk.c (print_tooltalk_message): + * tooltalk.c (print_tooltalk_pattern): + * ui-gtk.c (ffi_object_printer): + * ui-gtk.c (emacs_gtk_object_printer): + * ui-gtk.c (emacs_gtk_boxed_printer): + * window.c (print_window): + * window.c (free_window_mirror): + * window.c (debug_print_window): + * xemacs.def.in.in: + (1) printing_unreadable_object -> printing_unreadable_object_fmt. + (2) printing_unreadable_lcrecord -> printing_unreadable_lisp_object + and fix up so it no longer requires an lcrecord. + + These previous changes eliminate most of the remaining places where + the terms `lcrecord' and `lrecord' occurred outside of specialized + code. + + (3) Fairly major change: Reduce the number of words in an lcrecord + from 3 to 2. The third word consisted of a uid that duplicated the + lrecord uid, and a single free bit, which was moved into the lrecord + structure. This reduces the size of the `uid' slot from 21 bits to + 20 bits. Arguably this isn't enough -- we could easily have more than + 1,000,000 or so objects created in a session. The answer is + (a) It doesn't really matter if we overflow the uid field because + it's only used for debugging, to identify an object uniquely + (or pretty much so). + (b) If we cared about it overflowing and wanted to reduce this, + we could make it so that cons, string, float and certain other + frob-block types that never print out the uid simply don't + store a uid in them and don't increment the lrecord_uid_counter. + + (4) In conjunction with (3), create new macro NORMAL_LISP_OBJECT_UID() + and use it to abstract out the differences between NEWGC and old-GC + in accessing the `uid' value from a "normal Lisp Object pointer". + + (5) In events.c, use zero_nonsized_lisp_object() in place of custom- + written equivalent. In font-mgr.c use external_object_printer() + in place of custom-written equivalents. +2010-03-07 Ben Wing + + * number.c (bignum_finalize): + * number.c (ratio_finalize): + * number.c (bigfloat_finalize): + Fix the finalizers to go with the new calling sequence. Done + previously but somehow got lost. + +2010-03-06 Ben Wing + + * frame.c (change_frame_size_1): + Add a comment about where FRAME_PIXWIDTH/FRAME_PIXHEIGHT is set. + +2010-03-05 Ben Wing + + * frame.c: + * frame.c (Fframe_pixel_height): + * frame.c (Fframe_displayable_pixel_height): + * frame.c (Fframe_pixel_width): + * frame.c (Fframe_displayable_pixel_width): + * frame.c (Fset_frame_pixel_height): + * frame.c (Fset_frame_displayable_pixel_height): + * frame.c (Fset_frame_pixel_width): + * frame.c (Fset_frame_displayable_pixel_width): + * frame.c (get_frame_char_size): + * frame.c (change_frame_size_1): + Make it so that `frame-pixel-height', `set-frame-pixel-height', etc. + use updated values for the displayable or total pixel size that + will reflect what will happen as of the next redisplay. This + basically means using the character-cell height and converting + on-the-fly to pixel units. In the process, make sure FRAME_CHARWIDTH/ + FRAME_CHARHEIGHT are always correct and change + get_frame_char_size() to simply use them; the old logic in that + function was inlined into change_frame_size_1(), which is the only + place that needs the logic. + +2010-03-05 Ben Wing + + * frame.c: + * frame.c (frame_live_p): + * frame.c (Fframep): + * frame.c (Fdisable_frame): + * frame.c (Fenable_frame): + * frame.c (Fraise_frame): + * frame.c (Fframe_name): + * frame.c (Fset_frame_height): + * frame.c (internal_set_frame_size): + * frame.c (adjust_frame_size): + Add documentation on the different types of units used to measure + frame size. + + Add section headers to the various sections. + + Rearrange the location of some functions in the file to keep + related functions together. This especially goes for frame-sizing + functions (internal_set_frame_size() and adjust_frame_size()), + which have been moved so that they form a group with + change_frame_size() and change_frame_size_1(). + + No functionality should change. + +2010-03-05 Ben Wing + + * alloc.c: + * alloc.c (old_alloc_sized_lcrecord): + * alloc.c (very_old_free_lcrecord): + * alloc.c (copy_lisp_object): + * alloc.c (zero_sized_lisp_object): + * alloc.c (zero_nonsized_lisp_object): + * alloc.c (lisp_object_storage_size): + * alloc.c (free_normal_lisp_object): + * alloc.c (FREE_FIXED_TYPE_WHEN_NOT_IN_GC): + * alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT): + * alloc.c (Fcons): + * alloc.c (noseeum_cons): + * alloc.c (make_float): + * alloc.c (make_bignum): + * alloc.c (make_bignum_bg): + * alloc.c (make_ratio): + * alloc.c (make_ratio_bg): + * alloc.c (make_ratio_rt): + * alloc.c (make_bigfloat): + * alloc.c (make_bigfloat_bf): + * alloc.c (size_vector): + * alloc.c (make_compiled_function): + * alloc.c (Fmake_symbol): + * alloc.c (allocate_extent): + * alloc.c (allocate_event): + * alloc.c (make_key_data): + * alloc.c (make_button_data): + * alloc.c (make_motion_data): + * alloc.c (make_process_data): + * alloc.c (make_timeout_data): + * alloc.c (make_magic_data): + * alloc.c (make_magic_eval_data): + * alloc.c (make_eval_data): + * alloc.c (make_misc_user_data): + * alloc.c (Fmake_marker): + * alloc.c (noseeum_make_marker): + * alloc.c (size_string_direct_data): + * alloc.c (make_uninit_string): + * alloc.c (make_string_nocopy): + * alloc.c (mark_lcrecord_list): + * alloc.c (alloc_managed_lcrecord): + * alloc.c (free_managed_lcrecord): + * alloc.c (sweep_lcrecords_1): + * alloc.c (malloced_storage_size): + * buffer.c (allocate_buffer): + * buffer.c (compute_buffer_usage): + * buffer.c (DEFVAR_BUFFER_LOCAL_1): + * buffer.c (nuke_all_buffer_slots): + * buffer.c (common_init_complex_vars_of_buffer): + * buffer.h (struct buffer_text): + * buffer.h (struct buffer): + * bytecode.c: + * bytecode.c (make_compiled_function_args): + * bytecode.c (size_compiled_function_args): + * bytecode.h (struct compiled_function_args): + * casetab.c (allocate_case_table): + * casetab.h (struct Lisp_Case_Table): + * charset.h (struct Lisp_Charset): + * chartab.c (fill_char_table): + * chartab.c (Fmake_char_table): + * chartab.c (make_char_table_entry): + * chartab.c (copy_char_table_entry): + * chartab.c (Fcopy_char_table): + * chartab.c (put_char_table): + * chartab.h (struct Lisp_Char_Table_Entry): + * chartab.h (struct Lisp_Char_Table): + * console-gtk-impl.h (struct gtk_device): + * console-gtk-impl.h (struct gtk_frame): + * console-impl.h (struct console): + * console-msw-impl.h (struct Lisp_Devmode): + * console-msw-impl.h (struct mswindows_device): + * console-msw-impl.h (struct msprinter_device): + * console-msw-impl.h (struct mswindows_frame): + * console-msw-impl.h (struct mswindows_dialog_id): + * console-stream-impl.h (struct stream_console): + * console-stream.c (stream_init_console): + * console-tty-impl.h (struct tty_console): + * console-tty-impl.h (struct tty_device): + * console-tty.c (allocate_tty_console_struct): + * console-x-impl.h (struct x_device): + * console-x-impl.h (struct x_frame): + * console.c (allocate_console): + * console.c (nuke_all_console_slots): + * console.c (DEFVAR_CONSOLE_LOCAL_1): + * console.c (common_init_complex_vars_of_console): + * data.c (make_weak_list): + * data.c (make_weak_box): + * data.c (make_ephemeron): + * database.c: + * database.c (struct Lisp_Database): + * database.c (allocate_database): + * database.c (finalize_database): + * device-gtk.c (allocate_gtk_device_struct): + * device-impl.h (struct device): + * device-msw.c: + * device-msw.c (mswindows_init_device): + * device-msw.c (msprinter_init_device): + * device-msw.c (finalize_devmode): + * device-msw.c (allocate_devmode): + * device-tty.c (allocate_tty_device_struct): + * device-x.c (allocate_x_device_struct): + * device.c: + * device.c (nuke_all_device_slots): + * device.c (allocate_device): + * dialog-msw.c (handle_question_dialog_box): + * elhash.c: + * elhash.c (struct Lisp_Hash_Table): + * elhash.c (finalize_hash_table): + * elhash.c (make_general_lisp_hash_table): + * elhash.c (Fcopy_hash_table): + * elhash.h (htentry): + * emacs.c (main_1): + * eval.c: + * eval.c (size_multiple_value): + * event-stream.c (finalize_command_builder): + * event-stream.c (allocate_command_builder): + * event-stream.c (free_command_builder): + * event-stream.c (event_stream_generate_wakeup): + * event-stream.c (event_stream_resignal_wakeup): + * event-stream.c (event_stream_disable_wakeup): + * event-stream.c (event_stream_wakeup_pending_p): + * events.h (struct Lisp_Timeout): + * events.h (struct command_builder): + * extents-impl.h: + * extents-impl.h (struct extent_auxiliary): + * extents-impl.h (struct extent_info): + * extents-impl.h (set_extent_no_chase_aux_field): + * extents-impl.h (set_extent_no_chase_normal_field): + * extents.c: + * extents.c (gap_array_marker): + * extents.c (gap_array): + * extents.c (extent_list_marker): + * extents.c (extent_list): + * extents.c (stack_of_extents): + * extents.c (gap_array_make_marker): + * extents.c (extent_list_make_marker): + * extents.c (allocate_extent_list): + * extents.c (SLOT): + * extents.c (mark_extent_auxiliary): + * extents.c (allocate_extent_auxiliary): + * extents.c (attach_extent_auxiliary): + * extents.c (size_gap_array): + * extents.c (finalize_extent_info): + * extents.c (allocate_extent_info): + * extents.c (uninit_buffer_extents): + * extents.c (allocate_soe): + * extents.c (copy_extent): + * extents.c (vars_of_extents): + * extents.h: + * faces.c (allocate_face): + * faces.h (struct Lisp_Face): + * faces.h (struct face_cachel): + * file-coding.c: + * file-coding.c (finalize_coding_system): + * file-coding.c (sizeof_coding_system): + * file-coding.c (Fcopy_coding_system): + * file-coding.h (struct Lisp_Coding_System): + * file-coding.h (MARKED_SLOT): + * fns.c (size_bit_vector): + * font-mgr.c: + * font-mgr.c (finalize_fc_pattern): + * font-mgr.c (print_fc_pattern): + * font-mgr.c (Ffc_pattern_p): + * font-mgr.c (Ffc_pattern_create): + * font-mgr.c (Ffc_name_parse): + * font-mgr.c (Ffc_name_unparse): + * font-mgr.c (Ffc_pattern_duplicate): + * font-mgr.c (Ffc_pattern_add): + * font-mgr.c (Ffc_pattern_del): + * font-mgr.c (Ffc_pattern_get): + * font-mgr.c (fc_config_create_using): + * font-mgr.c (fc_strlist_to_lisp_using): + * font-mgr.c (fontset_to_list): + * font-mgr.c (Ffc_config_p): + * font-mgr.c (Ffc_config_up_to_date): + * font-mgr.c (Ffc_config_build_fonts): + * font-mgr.c (Ffc_config_get_cache): + * font-mgr.c (Ffc_config_get_fonts): + * font-mgr.c (Ffc_config_set_current): + * font-mgr.c (Ffc_config_get_blanks): + * font-mgr.c (Ffc_config_get_rescan_interval): + * font-mgr.c (Ffc_config_set_rescan_interval): + * font-mgr.c (Ffc_config_app_font_add_file): + * font-mgr.c (Ffc_config_app_font_add_dir): + * font-mgr.c (Ffc_config_app_font_clear): + * font-mgr.c (size): + * font-mgr.c (Ffc_config_substitute): + * font-mgr.c (Ffc_font_render_prepare): + * font-mgr.c (Ffc_font_match): + * font-mgr.c (Ffc_font_sort): + * font-mgr.c (finalize_fc_config): + * font-mgr.c (print_fc_config): + * font-mgr.h: + * font-mgr.h (struct fc_pattern): + * font-mgr.h (XFC_PATTERN): + * font-mgr.h (struct fc_config): + * font-mgr.h (XFC_CONFIG): + * frame-gtk.c (allocate_gtk_frame_struct): + * frame-impl.h (struct frame): + * frame-msw.c (mswindows_init_frame_1): + * frame-x.c (allocate_x_frame_struct): + * frame.c (nuke_all_frame_slots): + * frame.c (allocate_frame_core): + * gc.c: + * gc.c (GC_CHECK_NOT_FREE): + * glyphs.c (finalize_image_instance): + * glyphs.c (allocate_image_instance): + * glyphs.c (Fcolorize_image_instance): + * glyphs.c (allocate_glyph): + * glyphs.c (unmap_subwindow_instance_cache_mapper): + * glyphs.c (register_ignored_expose): + * glyphs.h (struct Lisp_Image_Instance): + * glyphs.h (struct Lisp_Glyph): + * glyphs.h (struct glyph_cachel): + * glyphs.h (struct expose_ignore): + * gui.c (allocate_gui_item): + * gui.h (struct Lisp_Gui_Item): + * keymap.c (struct Lisp_Keymap): + * keymap.c (make_keymap): + * lisp.h: + * lisp.h (struct Lisp_String_Direct_Data): + * lisp.h (struct Lisp_String_Indirect_Data): + * lisp.h (struct Lisp_Vector): + * lisp.h (struct Lisp_Bit_Vector): + * lisp.h (DECLARE_INLINE_LISP_BIT_VECTOR): + * lisp.h (struct weak_box): + * lisp.h (struct ephemeron): + * lisp.h (struct weak_list): + * lrecord.h: + * lrecord.h (struct lrecord_implementation): + * lrecord.h (MC_ALLOC_CALL_FINALIZER): + * lrecord.h (struct lcrecord_list): + * lstream.c (finalize_lstream): + * lstream.c (sizeof_lstream): + * lstream.c (Lstream_new): + * lstream.c (Lstream_delete): + * lstream.h (struct lstream): + * marker.c: + * marker.c (finalize_marker): + * marker.c (compute_buffer_marker_usage): + * mule-charset.c: + * mule-charset.c (make_charset): + * mule-charset.c (compute_charset_usage): + * objects-impl.h (struct Lisp_Color_Instance): + * objects-impl.h (struct Lisp_Font_Instance): + * objects-tty-impl.h (struct tty_color_instance_data): + * objects-tty-impl.h (struct tty_font_instance_data): + * objects-tty.c (tty_initialize_color_instance): + * objects-tty.c (tty_initialize_font_instance): + * objects.c (finalize_color_instance): + * objects.c (Fmake_color_instance): + * objects.c (finalize_font_instance): + * objects.c (Fmake_font_instance): + * objects.c (reinit_vars_of_objects): + * opaque.c: + * opaque.c (sizeof_opaque): + * opaque.c (make_opaque_ptr): + * opaque.c (free_opaque_ptr): + * opaque.h: + * opaque.h (Lisp_Opaque): + * opaque.h (Lisp_Opaque_Ptr): + * print.c (printing_unreadable_lcrecord): + * print.c (external_object_printer): + * print.c (debug_p4): + * process.c (finalize_process): + * process.c (make_process_internal): + * procimpl.h (struct Lisp_Process): + * rangetab.c (Fmake_range_table): + * rangetab.c (Fcopy_range_table): + * rangetab.h (struct Lisp_Range_Table): + * scrollbar.c: + * scrollbar.c (create_scrollbar_instance): + * scrollbar.c (compute_scrollbar_instance_usage): + * scrollbar.h (struct scrollbar_instance): + * specifier.c (finalize_specifier): + * specifier.c (sizeof_specifier): + * specifier.c (set_specifier_caching): + * specifier.h (struct Lisp_Specifier): + * specifier.h (struct specifier_caching): + * symeval.h: + * symeval.h (SYMBOL_VALUE_MAGIC_P): + * symeval.h (DEFVAR_SYMVAL_FWD): + * symsinit.h: + * syntax.c (init_buffer_syntax_cache): + * syntax.h (struct syntax_cache): + * toolbar.c: + * toolbar.c (allocate_toolbar_button): + * toolbar.c (update_toolbar_button): + * toolbar.h (struct toolbar_button): + * tooltalk.c (struct Lisp_Tooltalk_Message): + * tooltalk.c (make_tooltalk_message): + * tooltalk.c (struct Lisp_Tooltalk_Pattern): + * tooltalk.c (make_tooltalk_pattern): + * ui-gtk.c: + * ui-gtk.c (allocate_ffi_data): + * ui-gtk.c (emacs_gtk_object_finalizer): + * ui-gtk.c (allocate_emacs_gtk_object_data): + * ui-gtk.c (allocate_emacs_gtk_boxed_data): + * ui-gtk.h: + * window-impl.h (struct window): + * window-impl.h (struct window_mirror): + * window.c (finalize_window): + * window.c (allocate_window): + * window.c (new_window_mirror): + * window.c (mark_window_as_deleted): + * window.c (make_dummy_parent): + * window.c (compute_window_mirror_usage): + * window.c (compute_window_usage): + + Overall point of this change and previous ones in this repository: + + (1) Introduce new, clearer terminology: everything other than int + or char is a "record" object, which comes in two types: "normal + objects" and "frob-block objects". Fix up all places that + referred to frob-block objects as "simple", "basic", etc. + + (2) Provide an advertised interface for doing operations on Lisp + objects, including creating new types, that is clean and + consistent in its naming, uses the above-referenced terms and + avoids referencing "lrecords", "old lcrecords", etc., which should + hide under the surface. + + (3) Make the size_in_bytes and finalizer methods take a + Lisp_Object rather than a void * for consistency with other methods. + + (4) Separate finalizer method into finalizer and disksaver, so + that normal finalize methods don't have to worry about disksaving. + + Other specifics: + + (1) Renaming: + + LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER + ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT + implementation->basic_p -> implementation->frob_block_p + ALLOCATE_FIXED_TYPE_AND_SET_IMPL -> ALLOC_FROB_BLOCK_LISP_OBJECT + *FCCONFIG*, wrap_fcconfig -> *FC_CONFIG*, wrap_fc_config + *FCPATTERN*, wrap_fcpattern -> *FC_PATTERN*, wrap_fc_pattern + + (the last two changes make the naming of these macros consistent + with the naming of all other macros, since the objects are named + fc-config and fc-pattern with a hyphen) + + (2) Lots of documentation fixes in lrecord.h. + + (3) Eliminate macros for copying, freeing, zeroing objects, getting + their storage size. Instead, new functions: + + zero_sized_lisp_object() + zero_nonsized_lisp_object() + lisp_object_storage_size() + free_normal_lisp_object() + (copy_lisp_object() already exists) + LISP_OBJECT_FROB_BLOCK_P() (actually a macro) + + Eliminated: + + free_lrecord() + zero_lrecord() + copy_lrecord() + copy_sized_lrecord() + old_copy_lcrecord() + old_copy_sized_lcrecord() + old_zero_lcrecord() + old_zero_sized_lcrecord() + LISP_OBJECT_STORAGE_SIZE() + COPY_SIZED_LISP_OBJECT() + COPY_SIZED_LCRECORD() + COPY_LISP_OBJECT() + ZERO_LISP_OBJECT() + FREE_LISP_OBJECT() + + (4) Catch the remaining places where lrecord stuff was used directly + and use the advertised interface, e.g. alloc_sized_lrecord() -> + ALLOC_SIZED_LISP_OBJECT(). + + (5) Make certain statically-declared pseudo-objects + (buffer_local_flags, console_local_flags) have their lheader + initialized correctly, so things like copy_lisp_object() can work + on them. Make extent_auxiliary_defaults a proper heap object + Vextent_auxiliary_defaults, and make extent auxiliaries dumpable + so that this object can be dumped. allocate_extent_auxiliary() + now just creates the object, and attach_extent_auxiliary() + creates an extent auxiliary and attaches to an extent, like the + old allocate_extent_auxiliary(). + + (6) Create EXTENT_AUXILIARY_SLOTS macro, similar to the foo-slots.h + files but in a macro instead of a file. The purpose is to avoid + duplication when iterating over all the slots in an extent auxiliary. + Use it. + + (7) In lstream.c, don't zero out object after allocation because + allocation routines take care of this. + + (8) In marker.c, fix a mistake in computing marker overhead. + + (9) In print.c, clean up printing_unreadable_lcrecord(), + external_object_printer() to avoid lots of ifdef NEW_GC's. + + (10) Separate toolbar-button allocation into a separate + allocate_toolbar_button() function for use in the example code + in lrecord.h. + +2010-01-20 Ben Wing + + * alloc.c: + * alloc.c (very_old_free_lcrecord): + * alloc.c (disksave_object_finalization_1): + * alloc.c (make_lcrecord_list): + * alloc.c (alloc_managed_lcrecord): + * alloc.c (free_managed_lcrecord): + * alloc.c (sweep_lcrecords_1): + * buffer.c: + * bytecode.c: + * bytecode.c (Fcompiled_function_p): + * chartab.c: + * console-impl.h: + * console-impl.h (CONSOLE_TYPE_P): + * console.c: + * console.c (set_quit_events): + * data.c: + * data.c (Fmake_ephemeron): + * database.c: + * database.c (finalize_database): + * database.c (Fclose_database): + * device-msw.c: + * device-msw.c (finalize_devmode): + * device-msw.c (allocate_devmode): + * device.c: + * elhash.c: + * elhash.c (finalize_hash_table): + * eval.c: + * eval.c (bind_multiple_value_limits): + * event-stream.c: + * event-stream.c (finalize_command_builder): + * events.c: + * events.c (mark_event): + * extents.c: + * extents.c (finalize_extent_info): + * extents.c (uninit_buffer_extents): + * faces.c: + * file-coding.c: + * file-coding.c (finalize_coding_system): + * file-coding.h: + * file-coding.h (struct coding_system_methods): + * file-coding.h (struct detector): + * floatfns.c: + * floatfns.c (extract_float): + * fns.c: + * fns.c (Fidentity): + * font-mgr.c (finalize_fc_pattern): + * font-mgr.c (finalize_fc_config): + * frame.c: + * glyphs.c: + * glyphs.c (finalize_image_instance): + * glyphs.c (unmap_subwindow_instance_cache_mapper): + * gui.c: + * gui.c (gui_error): + * keymap.c: + * lisp.h (struct Lisp_Symbol): + * lrecord.h: + * lrecord.h (struct lrecord_implementation): + * lrecord.h (MC_ALLOC_CALL_FINALIZER): + * lrecord.h (MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE): + * lrecord.h (DEFINE_DUMPABLE_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_GENERAL_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_SIZABLE_GENERAL_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_GENERAL_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_SIZABLE_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_SIZABLE_GENERAL_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_FROB_BLOCK_GENERAL_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_INTERNAL_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT): + * lrecord.h (MAKE_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_MODULE_GENERAL_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_GENERAL_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_MODULE_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_MODULE_GENERAL_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_GENERAL_LISP_OBJECT): + * lrecord.h (MAKE_MODULE_LISP_OBJECT): + * lstream.c: + * lstream.c (finalize_lstream): + * lstream.c (disksave_lstream): + * marker.c: + * marker.c (finalize_marker): + * mule-charset.c (make_charset): + * number.c: + * objects.c: + * objects.c (finalize_color_instance): + * objects.c (finalize_font_instance): + * opaque.c: + * opaque.c (make_opaque_ptr): + * process-nt.c: + * process-nt.c (nt_finalize_process_data): + * process-nt.c (nt_deactivate_process): + * process.c: + * process.c (finalize_process): + * procimpl.h (struct process_methods): + * scrollbar.c: + * scrollbar.c (free_scrollbar_instance): + * specifier.c (finalize_specifier): + * symbols.c: + * toolbar.c: + * toolbar.c (Ftoolbar_button_p): + * tooltalk.c: + * ui-gtk.c: + * ui-gtk.c (emacs_gtk_object_finalizer): + * ui-gtk.c (allocate_emacs_gtk_boxed_data): + * window.c: + * window.c (finalize_window): + * window.c (mark_window_as_deleted): + + Separate out regular and disksave finalization. Instead of a + FOR_DISKSAVE argument to the finalizer, create a separate object + method `disksaver'. Make `finalizer' have only one argument. + + Go through and separate out all finalize methods into finalize + and disksave. Delete lots of thereby redundant disksave checking. + Delete places that signal an error if we attempt to disksave -- + all of these objects are non-dumpable and we will get an error + from pdump anyway if we attempt to dump them. After this is done, + only one object remains that has a disksave method -- lstream. + + Change DEFINE_*_LISP_OBJECT_WITH_PROPS to DEFINE_*_GENERAL_LISP_OBJECT, + which is used for specifying either property methods or disksave + methods (or in the future, any other less-used methods). + + Remove the for_disksave argument to finalize_process_data. Don't + provide a disksaver for processes because no one currently needs + it. + + Clean up various places where objects didn't provide a print method. + It was made mandatory in previous changes, and all methods now + either provide their own print method or use internal_object_printer + or external_object_printer. + + Change the definition of CONSOLE_LIVE_P to use the contype enum + rather than looking into the conmeths structure -- in some weird + situations with dead objects, the conmeths structure is NULL, + and printing such objects from debug_print() will crash if we try + to look into the conmeths structure. + + +2005-11-22 Ben Wing + + * alloc.c: + * alloc.c (assert_proper_sizing): + * alloc.c (alloc_sized_lrecord_1): + * alloc.c (alloc_sized_lrecord): + * alloc.c (noseeum_alloc_sized_lrecord): + * alloc.c (alloc_lrecord): + * alloc.c (old_alloc_sized_lcrecord): + * alloc.c (make_vector_internal): + * alloc.c (make_bit_vector_internal): + * alloc.c (alloc_automanaged_sized_lcrecord): + * buffer.c (allocate_buffer): + * buffer.c (DEFVAR_BUFFER_LOCAL_1): + * buffer.c (common_init_complex_vars_of_buffer): + * casetab.c (allocate_case_table): + * chartab.c (Fmake_char_table): + * chartab.c (make_char_table_entry): + * chartab.c (copy_char_table_entry): + * chartab.c (Fcopy_char_table): + * console.c (allocate_console): + * console.c (DEFVAR_CONSOLE_LOCAL_1): + * console.c (common_init_complex_vars_of_console): + * data.c (make_weak_list): + * data.c (make_weak_box): + * data.c (make_ephemeron): + * database.c (allocate_database): + * device-msw.c (allocate_devmode): + * device.c (allocate_device): + * dialog-msw.c (handle_question_dialog_box): + * elhash.c (make_general_lisp_hash_table): + * elhash.c (Fcopy_hash_table): + * emacs.c (main_1): + * event-stream.c: + * event-stream.c (allocate_command_builder): + * event-stream.c (free_command_builder): + * event-stream.c (mark_timeout): + * event-stream.c (event_stream_generate_wakeup): + * event-stream.c (event_stream_resignal_wakeup): + * event-stream.c (event_stream_disable_wakeup): + * event-stream.c (reinit_vars_of_event_stream): + * extents.c (allocate_extent_auxiliary): + * extents.c (allocate_extent_info): + * extents.c (copy_extent): + * faces.c (allocate_face): + * file-coding.c (allocate_coding_system): + * frame.c (allocate_frame_core): + * glyphs.c (allocate_image_instance): + * glyphs.c (allocate_glyph): + * gui.c (allocate_gui_item): + * keymap.c (make_keymap): + * lrecord.h: + * lrecord.h (ALLOC_LCRECORD): + * lrecord.h (ALLOC_SIZED_LCRECORD): + * lrecord.h (struct old_lcrecord_header): + * lrecord.h (old_alloc_lcrecord_type): + * lrecord.h (alloc_lrecord_type): + * lrecord.h (noseeum_alloc_lrecord_type): + * lstream.c (Lstream_new): + * mule-charset.c (make_charset): + * objects.c (Fmake_color_instance): + * objects.c (Fmake_font_instance): + * objects.c (reinit_vars_of_objects): + * opaque.c (make_opaque): + * opaque.c (make_opaque_ptr): + * process.c (make_process_internal): + * rangetab.c (Fmake_range_table): + * rangetab.c (Fcopy_range_table): + * scrollbar.c (create_scrollbar_instance): + * specifier.c (make_specifier_internal): + * symbols.c (Fdefvaralias): + * toolbar.c (update_toolbar_button): + * tooltalk.c (make_tooltalk_message): + * tooltalk.c (make_tooltalk_pattern): + * ui-gtk.c (allocate_ffi_data): + * ui-gtk.c (allocate_emacs_gtk_object_data): + * ui-gtk.c (allocate_emacs_gtk_boxed_data): + * window.c (allocate_window): + * window.c (new_window_mirror): + * window.c (make_dummy_parent): + Create a simpler interface for allocating/declaring Lisp objects; + documented in lrecord.h. + + ALLOC_LCRECORD_TYPE -> ALLOC_LISP_OBJECT (returns a Lisp object + rather than a pointer), + BASIC_ALLOC_LCRECORD -> ALLOC_SIZED_LISP_OBJECT + DEFINE_LRECORD_IMPLEMENTATION -> DEFINE_*_LISP_OBJECT + DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION -> DEFINE_*SIZABLE_*LISP_OBJECT + DEFINE_LRECORD_*IMPLEMENTATION_WITH_PROPS -> DEFINE_*GENERAL_LISP_OBJECT + DEFINE_BASIC_LRECORD_IMPLEMENTATION -> DEFINE_*FROB_BLOCK_LISP_OBJECT + DEFINE_DUMPABLE_*/DEFINE_NODUMP_* instead of a 0 or 1 dumpable flag + DEFINE_*INTERNAL_* for "internal" Lisp objects (shouldn't escape + to Lisp) + DEFINE_EXTERNAL_* -> DEFINE_MODULE_* + MAKE_LRECORD_IMPLEMENTATION -> MAKE_LISP_OBJECT + MAKE_EXTERNAL_LRECORD_IMPLEMENTATION -> MAKE_MODULE_LISP_OBJECT + DECLARE_LRECORD -> DECLARE_LISP_OBJECT + INIT_LRECORD_IMPLEMENTATION -> INIT_LISP_OBJECT + alloc_lrecord -> alloc_sized_lrecord (since it takes a size) + + Dynarr_newf, Dynarr_lisp_newf: takes a Bytecount instead of an int + +2010-03-05 Ben Wing + + * mule-coding.c: + * mule-coding.c (iso2022_encode): + Horrible bug: `escape-quoted' was failing to escape-quote special + characters in the 0x80 - 0x9F range. Who knows what breakage ensued? + SAME BUG IN XEMACS 21.4; MUST BE FIXED THERE TOO. + +2010-03-03 Ben Wing + + * lrecord.h: Fix outdated comment. + +2010-03-03 Ben Wing + + * emacs.c: + * emacs.c (assert_equal_failed): + * lisp.h: + * lisp.h (assert_equal): + New fun assert_equal, asserting that two values == each other, and + printing out both values upon failure. + + * frame-gtk.c (gtk_initialize_frame_size): + * frame-impl.h: + * frame-impl.h (FRAME_TOP_INTERNAL_BORDER_START): + * frame-impl.h (FRAME_BOTTOM_INTERNAL_BORDER_START): + * frame-impl.h (FRAME_LEFT_INTERNAL_BORDER_START): + * frame-impl.h (FRAME_PANED_TOP_EDGE): + * frame-impl.h (FRAME_NONPANED_SIZE): + * frame-x.c (x_initialize_frame_size): + * frame.c: + * gutter.c (get_gutter_coords): + * gutter.c (calculate_gutter_size): + * gutter.h: + * gutter.h (WINDOW_REAL_TOP_GUTTER_BOUNDS): + * gutter.h (FRAME_TOP_GUTTER_BOUNDS): + * input-method-xlib.c: + * input-method-xlib.c (XIM_SetGeometry): + * redisplay-output.c (clear_left_border): + * redisplay-output.c (clear_right_border): + * redisplay-output.c (redisplay_output_pixmap): + * redisplay-output.c (redisplay_clear_region): + * redisplay-output.c (redisplay_clear_top_of_window): + * redisplay-output.c (redisplay_clear_to_window_end): + * redisplay-xlike-inc.c (XLIKE_clear_frame): + * redisplay.c: + * redisplay.c (UPDATE_CACHE_RETURN): + * redisplay.c (pixel_to_glyph_translation): + * toolbar.c (update_frame_toolbars_geometry): + * window.c (Fwindow_pixel_edges): + Get rid of some redundant macros. Consistently use the + FRAME_TOP_*_START, FRAME_RIGHT_*_END, etc. format. Rename + FRAME_*_BORDER_* to FRAME_*_INTERNAL_BORDER_*. Comment out + FRAME_BOTTOM_* for gutters and the paned area due to the + uncertainty over where the paned area actually begins. (Eventually + we should probably move the gutters outside the minibuffer so that + the paned area is contiguous.) Use FRAME_PANED_* more often in the + code to make things clearer. + + Update the diagram to show that the bottom gutter is inside the + minibuffer (!) and that there are "junk boxes" when you have left + and/or right gutters (dead boxes that are mistakenly left uncleared, + unlike the corresponding scrollbar dead boxes). Update the text + appropriately to cover the bottom gutter position, etc. + + Rewrite gutter-geometry code to use the FRAME_*_GUTTER_* in place of + equivalent expressions referencing other frame elements, to make the + code more portable in case we move around the gutter location. + + Cleanup FRAME_*_GUTTER_BOUNDS() in gutter.h. + + Add some #### GEOM! comments where I think code is incorrect -- + typically, it wasn't fixed up properly when the gutter was added. + + Some cosmetic changes. + +2010-03-02 Ben Wing + + * lisp.h: + * text.h: + Move inclusion point of text.h earlier in lisp.h -- just before + the definition of characters, which needs some of the stuff in + text.h. With text.h later, some basic character properties had to + be defined in lisp.h -- put them back into text.h where they belong. + Move some text in lisp.h at the point of text.h inclusion into + text.h -- it serves as a mini-introduction. + +2010-03-02 Ben Wing + + * Makefile.in.in: + * Makefile.in.in (objs): + glyphs-shared.o, glyphs-eimage.o only needed when HAVE_WINDOW_SYSTEM. + glyphs-widget.o should be too, but we need a bit of work ifdeffing + out the subwindow stuff from redisplay.c et al. + + * bytecode.c (init_opcode_table_multi_op): + Change var name to avoid shadowing with `basename'. + + * emacs.c (main_1): + Don't call init/etc. routines for glyphs-shared, glyphs-eimage unless + HAVE_WINDOW_SYSTEM is defined. + + * linuxplay.c: + * linuxplay.c (sighandler): + * vdb-posix.c (vdb_fault_handler): + Use const for variables holding string constants to avoid C++ + warnings. + +2010-03-02 Jerry James + + * lread.c (read_atom): Signal a read error upon encountering a + ratio constant with a zero denominator. + +2010-03-03 Aidan Kehoe + + * fns.c (Fsubstring): Removed. + * search.c (Freplace_match): + * minibuf.c (Ftry_completion): + * lisp.h: + * keymap.c (ensure_meta_prefix_char_keymapp): + * dired.c (user_name_completion, file_name_completion): + * console-x.c (x_canonicalize_console_connection): + * bytecode.c (Bsubseq): + * bytecode-ops.h (subseq): + Move #'substring to Lisp, as an alias for #'subseq; change all + C Fsubstring() calls to Fsubseq(), change the Bsubstring bytecode + to Bsubseq. + + Motivation; not accepting vectors in #'substring is incompatible + with GNU, and Common Lisp prefers #'subseq, it has no #'substring. + +2010-03-02 Aidan Kehoe + + * eval.c (print_multiple_value): + Say # when printing these, for + consistency with the rest of the print code. + +2010-03-01 Aidan Kehoe + + * lisp.h (PARSE_KEYWORDS): New macro, for parsing keyword + arguments from C subrs. + * elhash.c (Fmake_hash_table): Use it. + * general-slots.h (Q_allow_other_keys): Add this symbol. + * eval.c (non_nil_allow_other_keys_p): + (invalid_keyword_argument): + New functions, called from the keyword argument parsing code. + * data.c (init_errors_once_early): + Add the new invalid-keyword-argument error here. + +2010-02-26 Aidan Kehoe + + * file-coding.c (Fmake_coding_system_internal): + Be somewhat clearer in this docstring, especially for the sake of + people running non-Mule builds who will see this docstring when + they do F1 f make-coding-system RET. + +2010-02-25 Didier Verna + + The background-placement face property. + * console-x-impl.h (struct x_frame): Add new slots x and y. + * console-x-impl.h (FRAME_X_X, FRAME_X_Y): New slot accessors. + * console-gtk-impl.h: Fake something similar for potential port. + * frame-x.c (x_get_frame_text_position): New function. + * frame-x.c (x_init_frame_3): Use it. + * event-Xt.c (emacs_Xt_handle_magic_event): Eat spurious + ConfigureNotify events, get the frame position and mark frame + faces changed. + * objects-impl.h: The face_background_placement_specifier + structure and its accessors. + * objects.c: New symbols Qabsolute and Qrelative. + * objects.c (face_background_placement_create): + * objects.c (face_background_placement_mark): + * objects.c (face_background_placement_instantiate): + * objects.c (face_background_placement_validate): + * objects.c (face_background_placement_after_change): + * objects.c (set_face_background_placement_attached_to): New. + * objects.h (set_face_background_palcement_attached_to): Declare + the one above. + * objects.c (syms_of_objects): + * objects.c (specifier_type_create_objects): + * objects.c (reinit_specifier_type_create_objects): + * objects.c (reinit_vars_of_objects): Update for the modifications + above. + * console-xlike-inc.h (XLIKE_GC_TS_X_ORIGIN, XLIKE_GC_TS_X_ORIGIN): + New X11/Gtk compatibility macros. + * redisplay-xlike-inc.c (XLIKE_get_gc): Add a background placement + argument and handle it. + * gtk-glue.c (face_to_gc): + * redisplay-xlike-inc.c (XLIKE_output_string): + * redisplay-xlike-inc.c (XLIKE_output_pixmap): + * redisplay-xlike-inc.c (XLIKE_output_blank): + * redisplay-xlike-inc.c (XLIKE_output_horizontal_line): + * redisplay-xlike-inc.c (XLIKE_output_eol_cursor): Update + accordingly. + * console-impl.h (struct console_methods): Add a background + placement (Lisp_Object) argument to the clear_region method. + * console-stream.c (stream_clear_region): + * redisplay-tty.c (tty_clear_region): + * redisplay-msw.c (mswindows_clear_region): + * redisplay-xlike-inc.c (XLIKE_clear_region): Update accordingly. + * redisplay-output.c (redisplay_clear_region): Handle the + background placement property and update the call to the + clear_region method. + * faces.h (struct Lisp_Face): + * faces.h (struct face_cachel): Add a background placement slot. + * faces.h (WINDOW_FACE_CACHEL_BACKGROUND_PLACEMENT): New accessor. + * faces.c (mark_face): + * faces.c (face_equal): + * faces.c (face_getprop): + * faces.c (face_putprop): + * faces.c (face_remprop): + * faces.c (face_plist): + * faces.c (reset_face): + * faces.c (mark_face_cachels): + * faces.c (update_face_cachel_data): + * faces.c (merge_face_cachel_data): + * faces.c (reset_face_cachel): + * faces.c (Fmake_face): + * faces.c (Fcopy_face): Handle the background placement property. + * faces.c (syms_of_faces): + * faces.c (vars_of_faces): + * faces.c (complex_vars_of_faces): Update accordingly. + +2010-02-25 Ben Wing + + * frame-impl.h: + Create some new macros for more clearly getting the size/edges + of various rectangles surrounding the paned area. + * frame.c (change_frame_size_1): + Use the new macros. Clean up change_frame_size_1 and make sure + the internal border width gets taken into account -- that was what + was causing the clipped bottom and right. + +2010-02-25 Ben Wing + + * EmacsFrame.c (EmacsFrameSetValues): + * frame-impl.h: + * frame-impl.h (struct frame): + * frame-impl.h (FRAME_THEORETICAL_TOP_TOOLBAR_HEIGHT): + * frame-impl.h (FRAME_THEORETICAL_TOP_TOOLBAR_BORDER_WIDTH): + * frame-impl.h (FRAME_REAL_TOP_TOOLBAR_HEIGHT): + * frame-impl.h (FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH): + * frame-impl.h (FRAME_REAL_TOP_TOOLBAR_VISIBLE): + * frame-impl.h (FRAME_REAL_TOP_TOOLBAR_BOUNDS): + * frame.h: + * frame.h (enum edge_pos): + * gutter.c: + * gutter.c (get_gutter_coords): + * gutter.c (display_boxes_in_gutter_p): + * gutter.c (construct_window_gutter_spec): + * gutter.c (calculate_gutter_size_from_display_lines): + * gutter.c (calculate_gutter_size): + * gutter.c (output_gutter): + * gutter.c (clear_gutter): + * gutter.c (mark_gutters): + * gutter.c (gutter_extent_signal_changed_region_maybe): + * gutter.c (update_gutter_geometry): + * gutter.c (update_frame_gutter_geometry): + * gutter.c (update_frame_gutters): + * gutter.c (reset_gutter_display_lines): + * gutter.c (redraw_exposed_gutter): + * gutter.c (redraw_exposed_gutters): + * gutter.c (free_frame_gutters): + * gutter.c (decode_gutter_position): + * gutter.c (Fset_default_gutter_position): + * gutter.c (Fgutter_pixel_width): + * gutter.c (Fgutter_pixel_height): + * gutter.c (recompute_overlaying_specifier): + * gutter.c (gutter_specs_changed_1): + * gutter.c (gutter_specs_changed): + * gutter.c (top_gutter_specs_changed): + * gutter.c (bottom_gutter_specs_changed): + * gutter.c (left_gutter_specs_changed): + * gutter.c (right_gutter_specs_changed): + * gutter.c (gutter_geometry_changed_in_window): + * gutter.c (init_frame_gutters): + * gutter.c (specifier_vars_of_gutter): + * gutter.h: + * gutter.h (WINDOW_REAL_TOP_GUTTER_BOUNDS): + * gutter.h (FRAME_TOP_GUTTER_BOUNDS): + * lisp.h (enum edge_style): + * native-gtk-toolbar.c: + * native-gtk-toolbar.c (gtk_output_toolbar): + * native-gtk-toolbar.c (gtk_clear_toolbar): + * native-gtk-toolbar.c (gtk_output_frame_toolbars): + * native-gtk-toolbar.c (gtk_initialize_frame_toolbars): + * toolbar-msw.c: + * toolbar-msw.c (TOOLBAR_HANDLE): + * toolbar-msw.c (allocate_toolbar_item_id): + * toolbar-msw.c (mswindows_clear_toolbar): + * toolbar-msw.c (mswindows_output_toolbar): + * toolbar-msw.c (mswindows_move_toolbar): + * toolbar-msw.c (mswindows_redraw_exposed_toolbars): + * toolbar-msw.c (mswindows_initialize_frame_toolbars): + * toolbar-msw.c (mswindows_output_frame_toolbars): + * toolbar-msw.c (mswindows_clear_frame_toolbars): + * toolbar-msw.c (DELETE_TOOLBAR): + * toolbar-msw.c (mswindows_free_frame_toolbars): + * toolbar-msw.c (mswindows_get_toolbar_button_text): + * toolbar-xlike.c: + * toolbar-xlike.c (__prepare_button_area): + * toolbar-xlike.c (XLIKE_OUTPUT_BUTTONS_LOOP): + * toolbar-xlike.c (xlike_output_toolbar): + * toolbar-xlike.c (xlike_clear_toolbar): + * toolbar-xlike.c (xlike_output_frame_toolbars): + * toolbar-xlike.c (xlike_clear_frame_toolbars): + * toolbar-xlike.c (xlike_redraw_exposed_toolbar): + * toolbar-xlike.c (xlike_redraw_exposed_toolbars): + * toolbar-xlike.c (xlike_redraw_frame_toolbars): + * toolbar.c: + * toolbar.c (decode_toolbar_position): + * toolbar.c (Fset_default_toolbar_position): + * toolbar.c (mark_frame_toolbar_buttons_dirty): + * toolbar.c (compute_frame_toolbar_buttons): + * toolbar.c (set_frame_toolbar): + * toolbar.c (compute_frame_toolbars_data): + * toolbar.c (update_frame_toolbars_geometry): + * toolbar.c (init_frame_toolbars): + * toolbar.c (get_toolbar_coords): + * toolbar.c (CHECK_TOOLBAR): + * toolbar.c (toolbar_buttons_at_pixpos): + * toolbar.c (CTB_ERROR): + * toolbar.c (recompute_overlaying_specifier): + * toolbar.c (specifier_vars_of_toolbar): + * toolbar.h: + * toolbar.h (SET_TOOLBAR_WAS_VISIBLE_FLAG): + Create new enum edge_pos with TOP_EDGE, BOTTOM_EDGE, LEFT_EDGE, + RIGHT_EDGE; subsume TOP_BORDER, TOP_GUTTER, enum toolbar_pos, + enum gutter_pos, etc. + + Create EDGE_POS_LOOP, subsuming GUTTER_POS_LOOP. + + Create NUM_EDGES, use in many places instead of hardcoded '4'. + + Instead of top_toolbar_was_visible, bottom_toolbar_was_visible, + etc. make an array toolbar_was_visible[NUM_EDGES]. This increases + the frame size by 15 bytes or so (could be 3 if we use Boolbytes) + but hardly seems w to matter -- frames are heavy weight objects + anyway. Same with top_gutter_was_visible, etc. + + Remove duplicated SET_TOOLBAR_WAS_VISIBLE_FLAG and put defn in + one place (toolbar.h). + +2010-02-24 Didier Verna + + Modify XLIKE_get_gc's prototype. + * redisplay-xlike-inc.c (XLIKE_get_gc): Take a frame instead of a + device as first argument. + * redisplay-xlike-inc.c (XLIKE_output_string): Update caller. + * redisplay-xlike-inc.c (XLIKE_output_pixmap): Ditto. + * redisplay-xlike-inc.c (XLIKE_output_blank): Ditto. + * redisplay-xlike-inc.c (XLIKE_output_horizontal_line): Ditto. + * redisplay-xlike-inc.c (XLIKE_clear_region): Ditto. + * redisplay-xlike-inc.c (XLIKE_output_eol_cursor): Ditto. + * console-gtk.h (gtk_get_gc): Take a frame instead of a device as + first argument. + * gtk-glue.c (face_to_gc): Update caller. + +2010-02-24 Didier Verna + + * glyphs.c: Clarify comment about potential_pixmap_file_instantiator. + * glyphs.c (xbm_mask_file_munging): Clarify comment, remove + unreachable condition and provide a cuple of assertions. + * glyphs.c (xbm_normalize): Clarify comments, error on mask file + not found. + * glyphs.c (xface_normalize): Ditto, and handle inline data properly. + +2010-02-22 Ben Wing + + * EmacsFrame.c: + * Makefile.in.in (x_objs): + * Makefile.in.in (mswindows_objs): + * Makefile.in.in (tty_objs): + * Makefile.in.in (gtk_objs): + * Makefile.in.in (objs): + * console-tty.h: + * console-x-impl.h: + * console-x-impl.h (struct x_device): + * console-x.h: + * console-xlike-inc.h: + * depend: + * device-gtk.c: + * device-msw.c: + * device-x.c: + * device-x.c (x_init_device): + * device-x.c (x_finish_init_device): + * device.c: + * devslots.h (MARKED_SLOT): + * emacs.c (main_1): + * event-Xt.c: + * event-gtk.c: + * event-msw.c: + * faces.c: + * font-mgr.c: + * fontcolor-gtk-impl.h: + * fontcolor-gtk.c: + * fontcolor-gtk.c (syms_of_fontcolor_gtk): + * fontcolor-gtk.c (console_type_create_fontcolor_gtk): + * fontcolor-gtk.c (vars_of_fontcolor_gtk): + * fontcolor-gtk.h: + * fontcolor-impl.h: + * fontcolor-msw-impl.h: + * fontcolor-msw.c: + * fontcolor-msw.c (syms_of_fontcolor_mswindows): + * fontcolor-msw.c (console_type_create_fontcolor_mswindows): + * fontcolor-msw.c (reinit_vars_of_fontcolor_mswindows): + * fontcolor-msw.c (vars_of_fontcolor_mswindows): + * fontcolor-msw.h: + * fontcolor-msw.h (mswindows_color_to_string): + * fontcolor-tty-impl.h: + * fontcolor-tty.c: + * fontcolor-tty.c (syms_of_fontcolor_tty): + * fontcolor-tty.c (console_type_create_fontcolor_tty): + * fontcolor-tty.c (vars_of_fontcolor_tty): + * fontcolor-tty.h: + * fontcolor-x-impl.h: + * fontcolor-x.c: + * fontcolor-x.c (syms_of_fontcolor_x): + * fontcolor-x.c (console_type_create_fontcolor_x): + * fontcolor-x.c (vars_of_fontcolor_x): + * fontcolor-x.c (Xatoms_of_fontcolor_x): + * fontcolor-x.h: + * fontcolor.c: + * fontcolor.c (syms_of_fontcolor): + * fontcolor.c (specifier_type_create_fontcolor): + * fontcolor.c (reinit_specifier_type_create_fontcolor): + * fontcolor.c (reinit_vars_of_fontcolor): + * fontcolor.c (vars_of_fontcolor): + * fontcolor.h: + * fontcolor.h (set_face_boolean_attached_to): + * frame-gtk.c: + * frame-x.c: + * glyphs-eimage.c: + * glyphs-gtk.c: + * glyphs-msw.c: + * glyphs-widget.c: + * glyphs-x.c: + * glyphs.c: + * gtk-glue.c: + * gtk-glue.c (xemacs_type_register): + * gtk-xemacs.c: + * inline.c: + * intl-win32.c: + * lisp.h: + * lrecord.h: + * mule-charset.c: + * native-gtk-toolbar.c: + * redisplay-msw.c: + * redisplay-tty.c: + * redisplay.c: + * select-x.c: + * select.c: + * symsinit.h: + * toolbar-msw.c: + * toolbar-msw.c (TOOLBAR_ITEM_ID_BITS): + * toolbar-x.c: + * ui-gtk.c: + * window.c: + Rename objects*.[ch] -> fontcolor*.[ch]. Fix up all references to + the old files (e.g. in #include statements, Makefiles, + functions like syms_of_objects_x(), etc.). + +2010-02-22 Ben Wing + + * .gdbinit.in.in: + * Makefile.in.in (batch_test_emacs): + test-harness.el is in lisp directory now so change how we call it. + +2010-02-22 Ben Wing + + * alloc.c (object_memory_usage_stats): + Remove unused var. + +2010-02-21 Ben Wing + + * alloc.c: + * alloc.c (FREE_FIXED_TYPE_WHEN_NOT_IN_GC): + * alloc.c (struct): + * alloc.c (tick_lrecord_stats): + * alloc.c (tick_lcrecord_stats): + * alloc.c (sweep_lcrecords_1): + * alloc.c (COUNT_FROB_BLOCK_USAGE): + * alloc.c (SWEEP_FIXED_TYPE_BLOCK_1): + * alloc.c (free_cons): + * alloc.c (free_key_data): + * alloc.c (free_button_data): + * alloc.c (free_motion_data): + * alloc.c (free_process_data): + * alloc.c (free_timeout_data): + * alloc.c (free_magic_data): + * alloc.c (free_magic_eval_data): + * alloc.c (free_eval_data): + * alloc.c (free_misc_user_data): + * alloc.c (free_marker): + * alloc.c (gc_sweep_1): + * alloc.c (HACK_O_MATIC): + * alloc.c (FROB): + * alloc.c (object_memory_usage_stats): + * alloc.c (Fgarbage_collect): + * dumper.c: + * dumper.c (pdump_objects_unmark): + * lrecord.h: + * lrecord.h (enum lrecord_alloc_status): + Fixes to memory-usage-tracking code, etc. + + (1) Incorporate NEW_GC stuff into FREE_FIXED_TYPE_WHEN_NOT_IN_GC + to avoid duplication. + + (2) Rewrite tick_lcrecord_stats() to include separate + tick_lrecord_stats(); use in dumper.c to note pdumped objects. + + (3) Instead of handling frob-block objects specially in + object_memory_usage_stats(), have SWEEP_FIXED_TYPE_BLOCK_1 + increment the stats in lrecord_stats[] so that they get handled + like other objects. + + (4) Pluralize entry as entries, etc. + +2010-02-21 Ben Wing + + * alloc.c: + * alloc.c (pluralize_word): + New function to pluralize a word. + * alloc.c (pluralize_and_append): New function. + * alloc.c (object_memory_usage_stats): + Clean up duplication. + +2010-02-21 Vin Shelton + + * events.c (event_pixel_translation): Simplify assertion for + Visual C 6. + +2010-02-21 Ben Wing + + * gc.c (kkcc_marking): Fix compile error. + * mc-alloc.c: + #if 0 out some unused functions. + +2010-02-21 Ben Wing + + * extents.c (process_extents_for_insertion_mapper): + Assertion wasn't quite set up correctly in previous patch. + +2010-02-20 Ben Wing + + * EmacsFrame.c: + * EmacsFrame.c (EmacsFrameRecomputeCellSize): + * alloca.c (i00afunc): + * buffer.c: + * buffer.c (MARKED_SLOT): + * buffer.c (complex_vars_of_buffer): + * cm.c: + * cm.c (cmcheckmagic): + * console.c: + * console.c (MARKED_SLOT): + * device-x.c: + * device-x.c (x_get_visual_depth): + * emacs.c (sort_args): + * eval.c (throw_or_bomb_out): + * event-stream.c: + * event-stream.c (Fadd_timeout): + * event-stream.c (Fadd_async_timeout): + * event-stream.c (Frecent_keys): + * events.c: + * events.c (Fdeallocate_event): + * events.c (event_pixel_translation): + * extents.c: + * extents.c (process_extents_for_insertion_mapper): + * fns.c (Fbase64_encode_region): + * fns.c (Fbase64_encode_string): + * fns.c (Fbase64_decode_region): + * fns.c (Fbase64_decode_string): + * font-lock.c: + * font-lock.c (find_context): + * frame-x.c: + * frame-x.c (x_wm_mark_shell_size_user_specified): + * frame-x.c (x_wm_mark_shell_position_user_specified): + * frame-x.c (x_wm_set_shell_iconic_p): + * frame-x.c (x_wm_set_cell_size): + * frame-x.c (x_wm_set_variable_size): + * frame-x.c (x_wm_store_class_hints): + * frame-x.c (x_wm_maybe_store_wm_command): + * frame-x.c (x_initialize_frame_size): + * frame.c (delete_frame_internal): + * frame.c (change_frame_size_1): + * free-hook.c (check_free): + * free-hook.c (note_block_input): + * free-hook.c (log_gcpro): + * gccache-gtk.c (gc_cache_lookup): + * gccache-x.c: + * gccache-x.c (gc_cache_lookup): + * glyphs-gtk.c: + * glyphs-gtk.c (init_image_instance_from_gdk_pixmap): + * glyphs-x.c: + * glyphs-x.c (extract_xpm_color_names): + * insdel.c: + * insdel.c (move_gap): + * keymap.c: + * keymap.c (keymap_lookup_directly): + * keymap.c (keymap_delete_inverse_internal): + * keymap.c (accessible_keymaps_mapper_1): + * keymap.c (where_is_recursive_mapper): + * lisp.h: + * lstream.c (make_lisp_buffer_stream_1): + * macros.c: + * macros.c (pop_kbd_macro_event): + * mc-alloc.c (remove_page_from_used_list): + * menubar-x.c: + * menubar-x.c (set_frame_menubar): + * ralloc.c: + * ralloc.c (obtain): + * ralloc.c (relinquish): + * ralloc.c (relocate_blocs): + * ralloc.c (resize_bloc): + * ralloc.c (r_alloc_free): + * ralloc.c (r_re_alloc): + * ralloc.c (r_alloc_thaw): + * ralloc.c (init_ralloc): + * ralloc.c (Free_Addr_Block): + * scrollbar-x.c: + * scrollbar-x.c (x_update_scrollbar_instance_status): + * sunplay.c (init_device): + * unexnt.c: + * unexnt.c (read_in_bss): + * unexnt.c (map_in_heap): + * window.c: + * window.c (real_window): + * window.c (window_display_lines): + * window.c (window_display_buffer): + * window.c (set_window_display_buffer): + * window.c (unshow_buffer): + * window.c (Fget_lru_window): + if (...) ABORT(); ---> assert(); + + More specifically: + + if (x == y) ABORT (); --> assert (x != y); + if (x != y) ABORT (); --> assert (x == y); + if (x > y) ABORT (); --> assert (x <= y); + etc. + if (!x) ABORT (); --> assert (x); + if (x) ABORT (); --> assert (!x); + + DeMorgan's Law's applied and manually simplified: + if (x && !y) ABORT (); --> assert (!x || y); + if (!x || y >= z) ABORT (); --> assert (x && y < z); + + Checked to make sure that assert() of an expression with side + effects ensures that the side effects get executed even when + asserts are disabled, and add a comment about this being a + requirement of any "disabled assert" expression. + + * depend: + * make-src-depend: + * make-src-depend (PrintDeps): + Fix broken code in make-src-depend so it does what it was always + supposed to do, which was separate out config.h and lisp.h and + all the files they include into separate variables in the + depend part of Makefile so that quick-build can turn off the + lisp.h/config.h/text.h/etc. dependencies of the source files, to + speed up recompilation. + + +2010-02-20 Ben Wing + + * EmacsFrame.c (EmacsFrameRecomputeCellSize): + * faces.c (default_face_font_info): + * faces.c (default_face_width_and_height): + * faces.c (Fface_list): + * faces.h: + * frame-gtk.c (gtk_set_initial_frame_size): + * frame-gtk.c (gtk_set_frame_size): + * frame-gtk.c (gtk_recompute_cell_sizes): + * frame.c: + * frame.c (frame_conversion_internal_1): + * frame.c (change_frame_size_1): + * frame.c (change_frame_size): + * glyphs-msw.c (mswindows_combo_box_instantiate): + * glyphs-widget.c (widget_instantiate): + * glyphs-widget.c (tree_view_query_geometry): + * glyphs-widget.c (Fwidget_logical_to_character_width): + * glyphs-widget.c (Fwidget_logical_to_character_height): + * indent.c (vmotion_pixels): + * redisplay-output.c (get_cursor_size_and_location): + * redisplay-xlike-inc.c (XLIKE_output_eol_cursor): + * redisplay-xlike-inc.c (XLIKE_flash): + * redisplay.c (calculate_baseline): + * redisplay.c (start_with_point_on_display_line): + * redisplay.c (glyph_to_pixel_translation): + * redisplay.c (pixel_to_glyph_translation): + * window.c (margin_width_internal): + * window.c (frame_size_valid_p): + * window.c (frame_pixsize_valid_p): + * window.c (check_frame_size): + * window.c (set_window_pixsize): + * window.c (window_pixel_height_to_char_height): + * window.c (window_char_height_to_pixel_height): + * window.c (window_displayed_height): + * window.c (window_pixel_width_to_char_width): + * window.c (window_char_width_to_pixel_width): + * window.c (change_window_height): + * window.c (window_scroll): + * window.h: + IMPORTANT: Aidan and Carbon Repo, please pay attention and fix + appropriately! + + Rename: default_face_height_and_width -> default_face_width_and_height + and reverse width/height arguments. + + Reverse width/height arguments to the following functions: + -- default_face_font_info + -- default_face_height_and_width (see above) + -- check_frame_size + -- frame_size_valid_p (made into a static function) + + Fix a redisplay bug where args to default_face_height_and_width + were in the wrong order. + + +2010-02-20 Ben Wing + + * syswindows.h: + Add table about GNU Emacs -> XEmacs Windows constants from + the internals manual. + + * frame.c: + Shrink size of diagram consistent with internals manual. + + * alloc.c: + * compiler.h: + * console.c: + * events.c: + * gc.c (gc_stat_start_new_gc): + * gc.c (gc_stat_resume_gc): + * gc.c (kkcc_marking): + * gc.c (gc_1): + * gc.c (gc): + * objects-tty.c: + * redisplay-msw.c: + * redisplay-msw.c (mswindows_clear_region): + * syntax.c: + * syntax.c (ST_COMMENT_STYLE): + * sysdep.c: + Fix various compiler warnings. + +2010-02-16 Ben Wing + + * frame-impl.h: + * frame-impl.h (FRAME_INTERNAL_BORDER_WIDTH): + * frame-impl.h (FRAME_REAL_TOOLBAR_BOUNDS): + * frame-impl.h (FRAME_REAL_TOP_TOOLBAR_BOUNDS): + * frame-impl.h (FRAME_BOTTOM_BORDER_START): + * frame-impl.h (FRAME_LEFT_BORDER_START): + * frame-impl.h (FRAME_RIGHT_BORDER_START): + * frame.c (frame_conversion_internal_1): + * frame.c (change_frame_size_1): + * redisplay-output.c (clear_left_border): + * redisplay-output.c (clear_right_border): + * redisplay-output.c (redisplay_clear_top_of_window): + * redisplay-output.c (redisplay_clear_to_window_end): + * redisplay-output.c (redisplay_clear_bottom_of_window): + Rename FRAME_BORDER_* to FRAME_INTERNAL_BORDER_*. Add + general FRAME_INTERNAL_BORDER_SIZE(). Add FRAME_REAL_TOOLBAR_BOUNDS() + to encompass the entire size of the toolbar including its border. + Add specific top/left/bottom/right versions of this macro. + Rewrite FRAME_*_BORDER_START and FRAME_*_BORDER_END to take into use + FRAME_REAL_*_TOOLBAR_BOUNDS(). Add some comments about existing + problems in frame sizing and how they might be fixed. Simplify + change_frame_size_1() using the macros just created. + +2010-02-15 Ben Wing + + * frame.c (change_frame_size_1): + Simplify the logic in this function. + + (1) Don't allow 0 as the value of height or width. The old code + that tried to allow this was totally broken, anyway, so obviously + this never happens any more. + + (2) Don't duplicate the code in frame_conversion_internal() that + converts displayable pixel size to total pixel size -- just call + that function. + +2010-02-15 Ben Wing + + * EmacsFrame.c: + * EmacsFrame.c (EmacsFrameResize): + * console-msw-impl.h: + * console-msw-impl.h (struct mswindows_frame): + * console-msw-impl.h (FRAME_MSWINDOWS_TARGET_RECT): + * device-tty.c: + * device-tty.c (tty_asynch_device_change): + * event-msw.c: + * event-msw.c (mswindows_wnd_proc): + * faces.c (Fface_list): + * faces.h: + * frame-gtk.c: + * frame-gtk.c (gtk_set_initial_frame_size): + * frame-gtk.c (gtk_set_frame_size): + * frame-msw.c: + * frame-msw.c (mswindows_init_frame_1): + * frame-msw.c (mswindows_set_frame_size): + * frame-msw.c (mswindows_size_frame_internal): + * frame-msw.c (msprinter_init_frame_3): + * frame.c: + * frame.c (enum): + * frame.c (Fmake_frame): + * frame.c (adjust_frame_size): + * frame.c (store_minibuf_frame_prop): + * frame.c (Fframe_property): + * frame.c (Fframe_properties): + * frame.c (Fframe_displayable_pixel_height): + * frame.c (Fframe_displayable_pixel_width): + * frame.c (internal_set_frame_size): + * frame.c (Fset_frame_height): + * frame.c (Fset_frame_pixel_height): + * frame.c (Fset_frame_displayable_pixel_height): + * frame.c (Fset_frame_width): + * frame.c (Fset_frame_pixel_width): + * frame.c (Fset_frame_displayable_pixel_width): + * frame.c (Fset_frame_size): + * frame.c (Fset_frame_pixel_size): + * frame.c (Fset_frame_displayable_pixel_size): + * frame.c (frame_conversion_internal_1): + * frame.c (get_frame_displayable_pixel_size): + * frame.c (change_frame_size_1): + * frame.c (change_frame_size): + * frame.c (generate_title_string): + * frame.h: + * gtk-xemacs.c: + * gtk-xemacs.c (gtk_xemacs_size_request): + * gtk-xemacs.c (gtk_xemacs_size_allocate): + * gtk-xemacs.c (gtk_xemacs_paint): + * gutter.c: + * gutter.c (update_gutter_geometry): + * redisplay.c (end_hold_frame_size_changes): + * redisplay.c (redisplay_frame): + * toolbar.c: + * toolbar.c (update_frame_toolbars_geometry): + * window.c: + * window.c (frame_pixsize_valid_p): + * window.c (check_frame_size): + Various fixes to frame geometry to make it a bit easier to understand + and fix some bugs. + + 1. IMPORTANT: Some renamings. Will need to be applied carefully to + the carbon repository, in the following order: + + -- pixel_to_char_size -> pixel_to_frame_unit_size + -- char_to_pixel_size -> frame_unit_to_pixel_size + -- pixel_to_real_char_size -> pixel_to_char_size + -- char_to_real_pixel_size -> char_to_pixel_size + -- Reverse second and third arguments of change_frame_size() and + change_frame_size_1() to try to make functions consistent in + putting width before height. + -- Eliminate old round_size_to_char, because it didn't really + do anything differently from round_size_to_real_char() + -- round_size_to_real_char -> round_size_to_char; any places that + called the old round_size_to_char should just call the new one. + + 2. IMPORTANT FOR CARBON: The set_frame_size() method is now passed + sizes in "frame units", like all other frame-sizing functions, + rather than some hacked-up combination of char-cell units and + total pixel size. This only affects window systems that use + "pixelated geometry", and I'm not sure if Carbon is one of them. + MS Windows is pixelated, X and GTK are not. For pixelated-geometry + systems, the size in set_frame_size() is in displayable pixels + rather than total pixels and needs to be converted appropriately; + take a look at the changes made to mswindows_set_frame_size() + method if necessary. + + 3. Add a big long comment in frame.c describing how frame geometry + works. + + 4. Remove MS Windows-specific character height and width fields, + duplicative and unused. + + 5. frame-displayable-pixel-* and set-frame-displayable-pixel-* + didn't use to work on MS Windows, but they do now. + + 6. In general, clean up the handling of "pixelated geometry" so + that fewer functions have to worry about this. This is really + an abomination that should be removed entirely but that will + have to happen later. Fix some buggy code in + frame_conversion_internal() that happened to "work" because it + was countered by oppositely buggy code in change_frame_size(). + + 7. Clean up some frame-size code in toolbar.c and use functions + already provided in frame.c instead of rolling its own. + + 8. Fix check_frame_size() in window.c, which formerly didn't take + pixelated geometry into account. + + +2010-02-15 Ben Wing + + * mc-alloc.c: + * mc-alloc.c (mc_realloc_1): + * mc-alloc.c (set_dirty_bit): + * mc-alloc.c (set_dirty_bit_for_address): + * mc-alloc.c (get_dirty_bit): + * mc-alloc.c (get_dirty_bit_for_address): + * mc-alloc.c (set_protection_bit): + * mc-alloc.c (set_protection_bit_for_address): + * mc-alloc.c (get_protection_bit): + * mc-alloc.c (get_protection_bit_for_address): + * mc-alloc.c (get_page_start): + * vdb-win32.c (win32_fault_handler): + * vdb.c: + Fix some compile warnings, make vdb test code conditional on + DEBUG_XEMACS. + +2010-02-15 Ben Wing + + * regex.c: + * regex.c (DEBUG_FAIL_PRINT1): + * regex.c (PUSH_FAILURE_POINT): + * regex.c (POP_FAILURE_POINT): + * regex.c (regex_compile): + * regex.c (re_match_2_internal): + * regex.h: + * search.c: + * search.c (search_buffer): + * search.c (debug_regexps_changed): + * search.c (vars_of_search): + Add an internal variable debug_regexps and a corresponding Lisp + variable `debug-regexps' that takes a list of areas in which to + display debugging info about regex compilation and matching + (currently three areas exist). Use existing debugging code + already in regex.c and modify it so that it recognizes the + debug_regexps variable and the flags in it. + + Rename variable `debug-xemacs-searches' to just `debug-searches', + consistent with other debug vars. + +2010-02-20 Ben Wing + + * device-x.c (Fx_get_resource): + * dynarr.c: + * dynarr.c (Dynarr_realloc): + * dynarr.c (Dynarr_newf): + * dynarr.c (Dynarr_lisp_realloc): + * dynarr.c (Dynarr_lisp_newf): + * dynarr.c (Dynarr_resize): + * dynarr.c (Dynarr_insert_many): + * dynarr.c (Dynarr_delete_many): + * dynarr.c (Dynarr_memory_usage): + * dynarr.c (stack_like_free): + * file-coding.c (coding_reader): + * file-coding.c (gzip_convert): + * gutter.c (output_gutter): + * lisp.h: + * lisp.h (Dynarr_declare): + * lisp.h (DYNARR_SET_LISP_IMP): + * lisp.h (CHECK_NATNUM): + * profile.c (create_timing_profile_table): + * redisplay-output.c (sync_rune_structs): + * redisplay-output.c (sync_display_line_structs): + * redisplay-output.c (redisplay_output_window): + * redisplay.c: + * redisplay.c (get_display_block_from_line): + * redisplay.c (add_ichar_rune_1): + * redisplay.c (ensure_modeline_generated): + * redisplay.c (generate_displayable_area): + * redisplay.c (regenerate_window): + * redisplay.c (update_line_start_cache): + * signal.c: + * signal.c (check_quit): + + Lots of rewriting of dynarr code. + + (1) Lots of documentation added. Also fix places that + referenced a now-bogus internals node concerning redisplay + critical sections. + + (2) Rename: + + Dynarr_add_lisp_string -> Dynarr_add_ext_lisp_string + Dynarr_set_length -> Dynarr_set_lengthr ("restricted") + Dynarr_increment -> Dynarr_incrementr + Dynarr_resize_if -> Dynarr_resize_to_add + + (3) New functions: + + Dynarr_elsize = dy->elsize_ + Dynarr_set_length(): Set length, resizing as necessary + Dynarr_set_length_and_zero(): Set length, resizing as necessary, + zeroing out new elements + Dynarr_increase_length(), Dynarr_increase_length_and_zero(): + Optimization of Dynarr_set_length(), Dynarr_set_length_and_zero() + when size is known to increase + Dynarr_resize_to_fit(): Resize as necessary to fit a given length. + Dynarr_set(): Set element at a given position, increasing length + as necessary and setting any newly created positions to 0 + + (4) Use Elemcount, Bytecount. + + (5) Rewrite many macros as inline functions. + +2010-02-20 Ben Wing + + * tests.c: + Fix operation of c-tests. + +2010-02-19 Aidan Kehoe + + * fns.c (split_string_by_ichar_1): + Use better types (e.g., not an Ichar for a buffer size) in this + function when dealing with ESCAPECHAR. + +2010-02-19 Aidan Kehoe + + * fns.c (mapcarX): + Correct this function, discarding multiple values when one + SEQUENCE is supplied, choosing a better label name. Correct the + comment describing the SOME_OR_EVERY argument. + +2010-02-12 Aidan Kehoe + + * syswindows.h: + Remove the PDWORD_PTR typedef; it's not used in + intl-auto-encap-win32.h , and it breaks the build with Visual C++ + 2005 Express Edition and a 2005 copy of the SDK. + 2010-02-20 Ben Wing * sysdep.c: @@ -3541,6 +7628,16 @@ reasons. +2010-02-07 Aidan Kehoe + + * fns.c (split_string_by_ichar_1): Extend this to take UNESCAPE + and ESCAPECHAR arguments. + (split_external_path, split_env_path, Fsplit_string_by_char) + (Fsplit_path): + Pass the new arguments to split_string_by_ichar_1(); take a new + optional argument, ESCAPE-CHAR, in #'split-string-by-char, + allowing SEPCHAR to be escaped. + 2010-01-09 Didier Verna * glyphs.c (query_string_font): Use proper domain for cachel @@ -54811,3 +58908,23 @@ Wed Dec 4 23:38:03 1996 Steven L Baur * redisplay.c: Allow column numbers in modeline to start from 1. + + +ChangeLog entries synched from GNU Emacs are the property of the FSF. +Other ChangeLog entries are usually the property of the author of the +change. + +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 3 of the License, 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. If not, see . diff -r 861f2601a38b -r 1f0b15040456 src/ChangeLog.GTK --- a/src/ChangeLog.GTK Sat Feb 20 06:03:00 2010 -0600 +++ b/src/ChangeLog.GTK Sun May 01 18:44:03 2011 +0100 @@ -866,3 +866,20 @@ * device-gtk.c (Fgtk_style_info): Attempt to expose the background pixmaps from a Gtk style. + +Copyright (C) 2000 William M. Perry + +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 3 of the License, 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. If not, see . diff -r 861f2601a38b -r 1f0b15040456 src/EmacsFrame.c --- a/src/EmacsFrame.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/EmacsFrame.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* The emacs frame widget. Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1993-1995 Sun Microsystems, Inc. - Copyright (C) 1995 Ben Wing. + Copyright (C) 1995, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -37,7 +35,7 @@ #include "console-x-impl.h" #include "glyphs-x.h" -#include "objects-x.h" +#include "fontcolor-x.h" #include #include @@ -324,8 +322,8 @@ update_various_frame_slots (ew); - pixel_to_char_size (f, ew->core.width, ew->core.height, &columns, &rows); - change_frame_size (f, rows, columns, 0); + pixel_to_frame_unit_size (f, ew->core.width, ew->core.height, &columns, &rows); + change_frame_size (f, columns, rows, 0); /* The code below is just plain wrong. If the EmacsShell or EmacsManager needs to know, they should just ask. If needed information is being @@ -411,49 +409,49 @@ if (cur->emacs_frame.top_toolbar_height != new_->emacs_frame.top_toolbar_height) Fadd_spec_to_specifier - (Vtoolbar_size[TOP_TOOLBAR], + (Vtoolbar_size[TOP_EDGE], make_int (new_->emacs_frame.top_toolbar_height), wrap_frame (f), Qnil, Qnil); if (cur->emacs_frame.bottom_toolbar_height != new_->emacs_frame.bottom_toolbar_height) Fadd_spec_to_specifier - (Vtoolbar_size[BOTTOM_TOOLBAR], + (Vtoolbar_size[BOTTOM_EDGE], make_int (new_->emacs_frame.bottom_toolbar_height), wrap_frame (f), Qnil, Qnil); if (cur->emacs_frame.left_toolbar_width != new_->emacs_frame.left_toolbar_width) Fadd_spec_to_specifier - (Vtoolbar_size[LEFT_TOOLBAR], + (Vtoolbar_size[LEFT_EDGE], make_int (new_->emacs_frame.left_toolbar_width), wrap_frame (f), Qnil, Qnil); if (cur->emacs_frame.right_toolbar_width != new_->emacs_frame.right_toolbar_width) Fadd_spec_to_specifier - (Vtoolbar_size[RIGHT_TOOLBAR], + (Vtoolbar_size[RIGHT_EDGE], make_int (new_->emacs_frame.right_toolbar_width), wrap_frame (f), Qnil, Qnil); if (cur->emacs_frame.top_toolbar_border_width != new_->emacs_frame.top_toolbar_border_width) Fadd_spec_to_specifier - (Vtoolbar_border_width[TOP_TOOLBAR], + (Vtoolbar_border_width[TOP_EDGE], make_int (new_->emacs_frame.top_toolbar_border_width), wrap_frame (f), Qnil, Qnil); if (cur->emacs_frame.bottom_toolbar_border_width != new_->emacs_frame.bottom_toolbar_border_width) Fadd_spec_to_specifier - (Vtoolbar_border_width[BOTTOM_TOOLBAR], + (Vtoolbar_border_width[BOTTOM_EDGE], make_int (new_->emacs_frame.bottom_toolbar_border_width), wrap_frame (f), Qnil, Qnil); if (cur->emacs_frame.left_toolbar_border_width != new_->emacs_frame.left_toolbar_border_width) Fadd_spec_to_specifier - (Vtoolbar_border_width[LEFT_TOOLBAR], + (Vtoolbar_border_width[LEFT_EDGE], make_int (new_->emacs_frame.left_toolbar_border_width), wrap_frame (f), Qnil, Qnil); if (cur->emacs_frame.right_toolbar_border_width != new_->emacs_frame.right_toolbar_border_width) Fadd_spec_to_specifier - (Vtoolbar_border_width[RIGHT_TOOLBAR], + (Vtoolbar_border_width[RIGHT_EDGE], make_int (new_->emacs_frame.right_toolbar_border_width), wrap_frame (f), Qnil, Qnil); #endif /* HAVE_TOOLBARS */ @@ -589,10 +587,9 @@ int cw, ch; struct frame *f = ew->emacs_frame.frame; - if (! XtIsSubclass (w, emacsFrameClass)) - ABORT (); + assert (XtIsSubclass (w, emacsFrameClass)); - default_face_height_and_width (wrap_frame (f), &ch, &cw); + default_face_width_and_height (wrap_frame (f), &cw, &ch); if (FRAME_X_TOP_LEVEL_FRAME_P (f)) x_wm_set_cell_size (FRAME_X_SHELL_WIDGET (f), cw, ch); } diff -r 861f2601a38b -r 1f0b15040456 src/EmacsFrame.h --- a/src/EmacsFrame.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/EmacsFrame.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/EmacsFrameP.h --- a/src/EmacsFrameP.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/EmacsFrameP.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/EmacsManager.c --- a/src/EmacsManager.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/EmacsManager.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/EmacsManager.h --- a/src/EmacsManager.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/EmacsManager.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/EmacsManagerP.h --- a/src/EmacsManagerP.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/EmacsManagerP.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/EmacsShell-sub.c --- a/src/EmacsShell-sub.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/EmacsShell-sub.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/EmacsShell.c --- a/src/EmacsShell.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/EmacsShell.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/EmacsShell.h --- a/src/EmacsShell.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/EmacsShell.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/EmacsShellP.h --- a/src/EmacsShellP.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/EmacsShellP.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/ExternalClient-Xlib.c --- a/src/ExternalClient-Xlib.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/ExternalClient-Xlib.c Sun May 01 18:44:03 2011 +0100 @@ -1,20 +1,18 @@ /* External client, raw Xlib version. Copyright (C) 1993, 1994 Sun Microsystems, Inc. -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. +This library 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 3 of the License, or (at your +option) any later version. -This library 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 -Library General Public License for more details. +This library 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 Library General Public -License along with this library; 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 this library. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/ExternalClient.c --- a/src/ExternalClient.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/ExternalClient.c Sun May 01 18:44:03 2011 +0100 @@ -1,20 +1,18 @@ /* External client widget. Copyright (C) 1993, 1994 Sun Microsystems, Inc. -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. +This library 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 3 of the License, or (at your +option) any later version. -This library 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 -Library General Public License for more details. +This library 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 Library General Public -License along with this library; 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 this library. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/ExternalClient.h --- a/src/ExternalClient.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/ExternalClient.h Sun May 01 18:44:03 2011 +0100 @@ -1,20 +1,18 @@ /* External client widget external header file. Copyright (C) 1993, 1994 Sun Microsystems, Inc. -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. +This library 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 3 of the License, or (at your +option) any later version. -This library 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 -Library General Public License for more details. +This library 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 Library General Public -License along with this library; 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 this library. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/ExternalClientP.h --- a/src/ExternalClientP.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/ExternalClientP.h Sun May 01 18:44:03 2011 +0100 @@ -1,20 +1,18 @@ /* External client widget internal header file. Copyright (C) 1993, 1994 Sun Microsystems, Inc. -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. +This library 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 3 of the License, or (at your +option) any later version. -This library 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 -Library General Public License for more details. +This library 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 Library General Public -License along with this library; 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 this library. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/ExternalShell.c --- a/src/ExternalShell.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/ExternalShell.c Sun May 01 18:44:03 2011 +0100 @@ -1,20 +1,18 @@ /* External shell widget. Copyright (C) 1993, 1994 Sun Microsystems, Inc. -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. +This library 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 3 of the License, or (at your +option) any later version. -This library 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 -Library General Public License for more details. +This library 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 Library General Public -License along with this library; 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 this library. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/ExternalShell.h --- a/src/ExternalShell.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/ExternalShell.h Sun May 01 18:44:03 2011 +0100 @@ -1,20 +1,18 @@ /* External shell widget external header file. Copyright (C) 1993, 1994 Sun Microsystems, Inc. -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. +This library 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 3 of the License, or (at your +option) any later version. -This library 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 -Library General Public License for more details. +This library 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 Library General Public -License along with this library; 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 this library. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/ExternalShellP.h --- a/src/ExternalShellP.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/ExternalShellP.h Sun May 01 18:44:03 2011 +0100 @@ -1,20 +1,18 @@ /* External shell widget internal header file. Copyright (C) 1993, 1994 Sun Microsystems, Inc. -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. +This library 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 3 of the License, or (at your +option) any later version. -This library 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 -Library General Public License for more details. +This library 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 Library General Public -License along with this library; 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 this library. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/Makefile.in.in --- a/src/Makefile.in.in Sat Feb 20 06:03:00 2010 -0600 +++ b/src/Makefile.in.in Sun May 01 18:44:03 2011 +0100 @@ -7,10 +7,10 @@ ## This file is part of XEmacs. -## XEmacs is free software; you can redistribute it and/or modify it +## 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. +## Free Software Foundation, either version 3 of the License, 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 @@ -18,9 +18,7 @@ ## for more details. ## You should have received a copy of the GNU General Public License -## along with XEmacs; see the file COPYING. If not, write to -## the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -## Boston, MA 02111-1307, USA. +## along with XEmacs. If not, see . ## Synched up with: Not synched with FSF. @@ -132,7 +130,7 @@ #ifdef HAVE_X_WINDOWS x_objs=console-x.o device-x.o event-Xt.o frame-x.o \ - glyphs-x.o objects-x.o redisplay-x.o select-x.o gccache-x.o intl-x.o + glyphs-x.o fontcolor-x.o redisplay-x.o select-x.o gccache-x.o intl-x.o #ifdef HAVE_XFT x_objs += font-mgr.o #endif @@ -144,18 +142,18 @@ #ifdef HAVE_MS_WINDOWS mswindows_objs=console-msw.o device-msw.o event-msw.o frame-msw.o \ - objects-msw.o select-msw.o redisplay-msw.o glyphs-msw.o + fontcolor-msw.o select-msw.o redisplay-msw.o glyphs-msw.o mswindows_gui_objs=$(gui_objs:.o=-msw.o) #endif #ifdef HAVE_TTY -tty_objs=console-tty.o device-tty.o event-tty.o frame-tty.o objects-tty.o \ +tty_objs=console-tty.o device-tty.o event-tty.o frame-tty.o fontcolor-tty.o \ redisplay-tty.o cm.o #endif #ifdef HAVE_GTK gtk_objs=console-gtk.o device-gtk.o event-gtk.o frame-gtk.o \ - objects-gtk.o redisplay-gtk.o glyphs-gtk.o select-gtk.o gccache-gtk.o \ + fontcolor-gtk.o redisplay-gtk.o glyphs-gtk.o select-gtk.o gccache-gtk.o \ gtk-xemacs.o ui-gtk.o gtk_gui_objs=$(gui_objs:.o=-gtk.o) #ifdef HAVE_TOOLBARS @@ -183,6 +181,10 @@ event_unixoid_objs=event-unixoid.o #endif +#ifdef HAVE_WINDOW_SYSTEM +glyphs_objs=glyphs-eimage.o glyphs-shared.o +#endif + #ifdef HAVE_GPM gpm_objs=gpmevent.o #endif @@ -270,25 +272,24 @@ ## if they all come out null. objs=\ - abbrev.o alloc.o alloca.o \ + abbrev.o alloc.o alloca.o array.o \ $(balloon_help_objs) blocktype.o buffer.o bytecode.o \ callint.o casefiddle.o casetab.o chartab.o \ $(clash_detection_objs) cmdloop.o cmds.o $(coding_system_objs) console.o \ console-stream.o\ data.o $(database_objs) $(debug_objs) device.o dired.o doc.o doprnt.o\ - dynarr.o \ editfns.o elhash.o emacs.o emodules.o eval.o events.o\ event-stream.o $(event_unixoid_objs) $(extra_objs) extents.o\ faces.o file-coding.o fileio.o $(LOCK_OBJ) filemode.o floatfns.o fns.o \ font-lock.o frame.o\ - gc.o general.o glyphs.o glyphs-eimage.o glyphs-shared.o\ - glyphs-widget.o $(gpm_objs) $(gtk_objs) $(gtk_gui_objs) $(gui_objs) \ + gc.o general.o glyphs.o $(glyphs_objs) glyphs-widget.o \ + $(gpm_objs) $(gtk_objs) $(gtk_gui_objs) $(gui_objs) \ gutter.o\ hash.o imgproc.o indent.o insdel.o intl.o\ keymap.o $(RTC_patch_objs) line-number.o $(ldap_objs) lread.o lstream.o\ $(new_gc_objs) $(vdb_objs) \ macros.o marker.o md5.o minibuf.o $(mswindows_objs) $(mswindows_gui_objs)\ - $(mule_objs) $(mule_canna_objs) $(mule_wnn_objs) $(number_objs) objects.o\ + $(mule_objs) $(mule_canna_objs) $(mule_wnn_objs) $(number_objs) fontcolor.o\ opaque.o $(postgresql_objs) print.o process.o $(process_objs) $(profile_objs)\ rangetab.o realpath.o redisplay.o redisplay-output.o regex.o\ search.o select.o $(sheap_objs) $(shlib_objs) signal.o sound.o\ @@ -882,7 +883,7 @@ ###################### Automated tests testdir = $(SRC)/../tests/automated -batch_test_emacs = $(BATCH_PACKAGES) -l $(testdir)/test-harness.el -f batch-test-emacs $(testdir) +batch_test_emacs = $(BATCH_PACKAGES) -l test-harness -f batch-test-emacs $(testdir) ## `config-changed' is useful if you are building both Unicode-internal ## and old-Mule workspaces using --srcdir and don't run configure before diff -r 861f2601a38b -r 1f0b15040456 src/README.global-renaming --- a/src/README.global-renaming Sat Feb 20 06:03:00 2010 -0600 +++ b/src/README.global-renaming Sun May 01 18:44:03 2011 +0100 @@ -71,20 +71,18 @@ ## Maintainer: Ben Wing ## Current Version: 1.2, March 12, 2002 -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# +# This program is free software: you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by the +# Free Software Foundation, either version 3 of the License, or (at your +# option) any later version. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to the Free -# Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -# 02111-1307, USA. +# along with this program. If not, see . eval 'exec perl -w -S $0 ${1+"$@"}' if 0; diff -r 861f2601a38b -r 1f0b15040456 src/README.kkcc --- a/src/README.kkcc Sat Feb 20 06:03:00 2010 -0600 +++ b/src/README.kkcc Sun May 01 18:44:03 2011 +0100 @@ -53,7 +53,7 @@ - Stack optimization (have one stack during runtime instead of malloc/free it for every garbage collect) - There are a few Lisp_Objects, where there occured differences and + There are a few Lisp_Objects, where there occurred differences and inexactness between the mark-method and the pdump description. All these Lisp_Objects get dumped (except image instances), so their descriptions have been written, before we started our work: diff -r 861f2601a38b -r 1f0b15040456 src/abbrev.c --- a/src/abbrev.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/abbrev.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. Note that there are many more functions in FSF's abbrev.c. These have been moved into Lisp in XEmacs. */ @@ -75,7 +73,7 @@ /* Hook to run before expanding any abbrev. */ Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook; -Lisp_Object Qsystem_type, Qcount; +Lisp_Object Qsystem_type; struct abbrev_match_mapper_closure { @@ -343,7 +341,7 @@ count = Qzero; else CHECK_NATNUM (count); - symbol_plist (abbrev_symbol) = make_int (1 + XINT (count)); + symbol_plist (abbrev_symbol) = Fadd1 (count); /* Count the case in the original text. */ abbrev_count_case (buf, abbrev_start, abbrev_length, &lccount, &uccount); @@ -524,7 +522,7 @@ map_obarray (table, record_symbol, &symbols); /* map_obarray (table, record_symbol, &closure); */ symbols = XCDR (symbols); - symbols = Fsort (symbols, Qstring_lessp); + symbols = list_sort (symbols, check_string_lessp_nokey, Qnil, Qnil); if (!NILP (readable)) { @@ -558,9 +556,6 @@ void syms_of_abbrev (void) { - DEFSYMBOL(Qcount); - Qcount = intern ("count"); - staticpro (&Qcount); DEFSYMBOL(Qsystem_type); Qsystem_type = intern ("system-type"); DEFSYMBOL (Qpre_abbrev_expand_hook); diff -r 861f2601a38b -r 1f0b15040456 src/alloc.c --- a/src/alloc.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/alloc.c Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.28, Mule 2.0. Substantially different from FSF. */ @@ -96,84 +94,33 @@ static Fixnum debug_allocation_backtrace_length; #endif +Fixnum Varray_dimension_limit, Varray_total_size_limit, Varray_rank_limit; + int need_to_check_c_alloca; int need_to_signal_post_gc; int funcall_allocation_flag; Bytecount __temp_alloca_size__; Bytecount funcall_alloca_count; -/* Determine now whether we need to garbage collect or not, to make - Ffuncall() faster */ -#define INCREMENT_CONS_COUNTER_1(size) \ -do \ -{ \ - consing_since_gc += (size); \ - total_consing += (size); \ - if (profiling_active) \ - profile_record_consing (size); \ - recompute_need_to_garbage_collect (); \ -} while (0) - -#define debug_allocation_backtrace() \ -do { \ - if (debug_allocation_backtrace_length > 0) \ - debug_short_backtrace (debug_allocation_backtrace_length); \ -} while (0) - -#ifdef DEBUG_XEMACS -#define INCREMENT_CONS_COUNTER(foosize, type) \ - do { \ - if (debug_allocation) \ - { \ - stderr_out ("allocating %s (size %ld)\n", type, \ - (long) foosize); \ - debug_allocation_backtrace (); \ - } \ - INCREMENT_CONS_COUNTER_1 (foosize); \ - } while (0) -#define NOSEEUM_INCREMENT_CONS_COUNTER(foosize, type) \ - do { \ - if (debug_allocation > 1) \ - { \ - stderr_out ("allocating noseeum %s (size %ld)\n", type, \ - (long) foosize); \ - debug_allocation_backtrace (); \ - } \ - INCREMENT_CONS_COUNTER_1 (foosize); \ - } while (0) -#else -#define INCREMENT_CONS_COUNTER(size, type) INCREMENT_CONS_COUNTER_1 (size) -#define NOSEEUM_INCREMENT_CONS_COUNTER(size, type) \ - INCREMENT_CONS_COUNTER_1 (size) -#endif - -#ifdef NEW_GC -/* The call to recompute_need_to_garbage_collect is moved to - free_lrecord, since DECREMENT_CONS_COUNTER is extensively called - during sweep and recomputing need_to_garbage_collect all the time - is not needed. */ -#define DECREMENT_CONS_COUNTER(size) do { \ - consing_since_gc -= (size); \ - total_consing -= (size); \ - if (profiling_active) \ - profile_record_unconsing (size); \ - if (consing_since_gc < 0) \ - consing_since_gc = 0; \ -} while (0) -#else /* not NEW_GC */ -#define DECREMENT_CONS_COUNTER(size) do { \ - consing_since_gc -= (size); \ - total_consing -= (size); \ - if (profiling_active) \ - profile_record_unconsing (size); \ - if (consing_since_gc < 0) \ - consing_since_gc = 0; \ - recompute_need_to_garbage_collect (); \ -} while (0) -#endif /*not NEW_GC */ - -/* This is just for use by the printer, to allow things to print uniquely */ -int lrecord_uid_counter; +/* All the built-in lisp object types are enumerated in `enum lrecord_type'. + Additional ones may be defined by a module (none yet). We leave some + room in `lrecord_implementations_table' for such new lisp object types. */ +struct lrecord_implementation *lrecord_implementations_table[(int)lrecord_type_last_built_in_type + MODULE_DEFINABLE_TYPE_COUNT]; +int lrecord_type_count = lrecord_type_last_built_in_type; + +/* This is just for use by the printer, to allow things to print uniquely. + We have a separate UID space for each object. (Important because the + UID is only 20 bits in old-GC, and 22 in NEW_GC.) */ +int lrecord_uid_counter[countof (lrecord_implementations_table)]; + +#ifndef USE_KKCC +/* Object marker functions are in the lrecord_implementation structure. + But copying them to a parallel array is much more cache-friendly. + This hack speeds up (garbage-collect) by about 5%. */ +Lisp_Object (*lrecord_markers[countof (lrecord_implementations_table)]) (Lisp_Object); +#endif /* not USE_KKCC */ + +struct gcpro *gcprolist; /* Non-zero means we're in the process of doing the dump */ int purify_flag; @@ -189,26 +136,73 @@ #endif +#ifdef MEMORY_USAGE_STATS +Lisp_Object Qobject_actually_requested, Qobject_malloc_overhead; +Lisp_Object Qother_memory_actually_requested, Qother_memory_malloc_overhead; +Lisp_Object Qother_memory_dynarr_overhead, Qother_memory_gap_overhead; +#endif /* MEMORY_USAGE_STATS */ + +#ifndef NEW_GC +static int gc_count_num_short_string_in_use; +static Bytecount gc_count_string_total_size; +static Bytecount gc_count_short_string_total_size; +static Bytecount gc_count_long_string_storage_including_overhead; +#endif /* not NEW_GC */ + +/* static int gc_count_total_records_used, gc_count_records_total_size; */ + +/* stats on objects in use */ + +#ifdef NEW_GC + +static struct +{ + int instances_in_use; + int bytes_in_use; + int bytes_in_use_including_overhead; +} lrecord_stats [countof (lrecord_implementations_table)]; + +#else /* not NEW_GC */ + +static struct +{ + Elemcount instances_in_use; + Bytecount bytes_in_use; + Bytecount bytes_in_use_overhead; + Elemcount instances_freed; + Bytecount bytes_freed; + Bytecount bytes_freed_overhead; + Elemcount instances_on_free_list; + Bytecount bytes_on_free_list; + Bytecount bytes_on_free_list_overhead; +#ifdef MEMORY_USAGE_STATS + Bytecount nonlisp_bytes_in_use; + Bytecount lisp_ancillary_bytes_in_use; + struct generic_usage_stats stats; +#endif +} lrecord_stats [countof (lrecord_implementations_table)]; + +#endif /* (not) NEW_GC */ + /* Very cheesy ways of figuring out how much memory is being used for data. #### Need better (system-dependent) ways. */ void *minimum_address_seen; void *maximum_address_seen; -#ifndef NEW_GC -int -c_readonly (Lisp_Object obj) -{ - return POINTER_TYPE_P (XTYPE (obj)) && C_READONLY (obj); -} -#endif /* not NEW_GC */ - -int -lisp_readonly (Lisp_Object obj) -{ - return POINTER_TYPE_P (XTYPE (obj)) && LISP_READONLY (obj); -} - +/************************************************************************/ +/* Low-level allocation */ +/************************************************************************/ + +void +recompute_funcall_allocation_flag (void) +{ + funcall_allocation_flag = + need_to_garbage_collect || + need_to_check_c_alloca || + need_to_signal_post_gc; +} + /* Maximum amount of C stack to save when a GC happens. */ #ifndef MAX_SAVE_STACK @@ -232,6 +226,22 @@ xfree (tmp); } } + +#if !defined(HAVE_MMAP) || defined(DOUG_LEA_MALLOC) +/* If we released our reserve (due to running out of memory), + and we have a fair amount free once again, + try to set aside another reserve in case we run out once more. + + This is called when a relocatable block is freed in ralloc.c. */ +void refill_memory_reserve (void); +void +refill_memory_reserve (void) +{ + if (breathing_space == 0) + breathing_space = (char *) malloc (4096 - MALLOC_OVERHEAD); +} +#endif /* !defined(HAVE_MMAP) || defined(DOUG_LEA_MALLOC) */ + #endif /* not NEW_GC */ static void @@ -436,10 +446,7 @@ MALLOC_END (); } -#ifdef ERROR_CHECK_GC - -#ifndef NEW_GC -static void +void deadbeef_memory (void *ptr, Bytecount size) { UINT_32_BIT *ptr4 = (UINT_32_BIT *) ptr; @@ -449,14 +456,6 @@ while (beefs--) (*ptr4++) = 0xDEADBEEF; /* -559038737 base 10 */ } -#endif /* not NEW_GC */ - -#else /* !ERROR_CHECK_GC */ - - -#define deadbeef_memory(ptr, size) - -#endif /* !ERROR_CHECK_GC */ #undef xstrdup char * @@ -478,6 +477,80 @@ #endif /* NEED_STRDUP */ +/************************************************************************/ +/* Lisp object allocation */ +/************************************************************************/ + +/* Determine now whether we need to garbage collect or not, to make + Ffuncall() faster */ +#define INCREMENT_CONS_COUNTER_1(size) \ +do \ +{ \ + consing_since_gc += (size); \ + total_consing += (size); \ + if (profiling_active) \ + profile_record_consing (size); \ + recompute_need_to_garbage_collect (); \ +} while (0) + +#define debug_allocation_backtrace() \ +do { \ + if (debug_allocation_backtrace_length > 0) \ + debug_short_backtrace (debug_allocation_backtrace_length); \ +} while (0) + +#ifdef DEBUG_XEMACS +#define INCREMENT_CONS_COUNTER(foosize, type) \ + do { \ + if (debug_allocation) \ + { \ + stderr_out ("allocating %s (size %ld)\n", type, \ + (long) foosize); \ + debug_allocation_backtrace (); \ + } \ + INCREMENT_CONS_COUNTER_1 (foosize); \ + } while (0) +#define NOSEEUM_INCREMENT_CONS_COUNTER(foosize, type) \ + do { \ + if (debug_allocation > 1) \ + { \ + stderr_out ("allocating noseeum %s (size %ld)\n", type, \ + (long) foosize); \ + debug_allocation_backtrace (); \ + } \ + INCREMENT_CONS_COUNTER_1 (foosize); \ + } while (0) +#else +#define INCREMENT_CONS_COUNTER(size, type) INCREMENT_CONS_COUNTER_1 (size) +#define NOSEEUM_INCREMENT_CONS_COUNTER(size, type) \ + INCREMENT_CONS_COUNTER_1 (size) +#endif + +#ifdef NEW_GC +/* [[ The call to recompute_need_to_garbage_collect is moved to + free_normal_lisp_object, since DECREMENT_CONS_COUNTER is extensively called + during sweep and recomputing need_to_garbage_collect all the time + is not needed. ]] -- not accurate! */ +#define DECREMENT_CONS_COUNTER(size) do { \ + consing_since_gc -= (size); \ + total_consing -= (size); \ + if (profiling_active) \ + profile_record_unconsing (size); \ + if (consing_since_gc < 0) \ + consing_since_gc = 0; \ +} while (0) +#else /* not NEW_GC */ +#define DECREMENT_CONS_COUNTER(size) do { \ + consing_since_gc -= (size); \ + total_consing -= (size); \ + if (profiling_active) \ + profile_record_unconsing (size); \ + if (consing_since_gc < 0) \ + consing_since_gc = 0; \ + recompute_need_to_garbage_collect (); \ +} while (0) +#endif /*not NEW_GC */ + #ifndef NEW_GC static void * allocate_lisp_storage (Bytecount size) @@ -505,62 +578,12 @@ } #endif /* not NEW_GC */ -#if defined (NEW_GC) && defined (ALLOC_TYPE_STATS) -static struct -{ - int instances_in_use; - int bytes_in_use; - int bytes_in_use_including_overhead; -} lrecord_stats [countof (lrecord_implementations_table)]; - -void -init_lrecord_stats () -{ - xzero (lrecord_stats); -} - -void -inc_lrecord_stats (Bytecount size, const struct lrecord_header *h) -{ - int type_index = h->type; - if (!size) - size = detagged_lisp_object_size (h); - - lrecord_stats[type_index].instances_in_use++; - lrecord_stats[type_index].bytes_in_use += size; - lrecord_stats[type_index].bytes_in_use_including_overhead -#ifdef MEMORY_USAGE_STATS - += mc_alloced_storage_size (size, 0); -#else /* not MEMORY_USAGE_STATS */ - += size; -#endif /* not MEMORY_USAGE_STATS */ -} - -void -dec_lrecord_stats (Bytecount size_including_overhead, - const struct lrecord_header *h) -{ - int type_index = h->type; - int size = detagged_lisp_object_size (h); - - lrecord_stats[type_index].instances_in_use--; - lrecord_stats[type_index].bytes_in_use -= size; - lrecord_stats[type_index].bytes_in_use_including_overhead - -= size_including_overhead; - - DECREMENT_CONS_COUNTER (size); -} - -int -lrecord_stats_heap_size (void) -{ - int i; - int size = 0; - for (i = 0; i < countof (lrecord_implementations_table); i++) - size += lrecord_stats[i].bytes_in_use; - return size; -} -#endif /* NEW_GC && ALLOC_TYPE_STATS */ +#define assert_proper_sizing(size) \ + type_checking_assert \ + (implementation->static_size == 0 ? \ + implementation->size_in_bytes_method != NULL : \ + implementation->size_in_bytes_method == NULL && \ + implementation->static_size == size) #ifndef NEW_GC /* lcrecords are chained together through their "next" field. @@ -571,40 +594,14 @@ #ifdef NEW_GC /* The basic lrecord allocation functions. See lrecord.h for details. */ -void * -alloc_lrecord (Bytecount size, - const struct lrecord_implementation *implementation) +static Lisp_Object +alloc_sized_lrecord_1 (Bytecount size, + const struct lrecord_implementation *implementation, + int noseeum) { struct lrecord_header *lheader; - type_checking_assert - ((implementation->static_size == 0 ? - implementation->size_in_bytes_method != NULL : - implementation->static_size == size)); - - lheader = (struct lrecord_header *) mc_alloc (size); - gc_checking_assert (LRECORD_FREE_P (lheader)); - set_lheader_implementation (lheader, implementation); -#ifdef ALLOC_TYPE_STATS - inc_lrecord_stats (size, lheader); -#endif /* ALLOC_TYPE_STATS */ - if (implementation->finalizer) - add_finalizable_obj (wrap_pointer_1 (lheader)); - INCREMENT_CONS_COUNTER (size, implementation->name); - return lheader; -} - - -void * -noseeum_alloc_lrecord (Bytecount size, - const struct lrecord_implementation *implementation) -{ - struct lrecord_header *lheader; - - type_checking_assert - ((implementation->static_size == 0 ? - implementation->size_in_bytes_method != NULL : - implementation->static_size == size)); + assert_proper_sizing (size); lheader = (struct lrecord_header *) mc_alloc (size); gc_checking_assert (LRECORD_FREE_P (lheader)); @@ -614,81 +611,113 @@ #endif /* ALLOC_TYPE_STATS */ if (implementation->finalizer) add_finalizable_obj (wrap_pointer_1 (lheader)); - NOSEEUM_INCREMENT_CONS_COUNTER (size, implementation->name); - return lheader; -} - -void * -alloc_lrecord_array (Bytecount size, int elemcount, + if (noseeum) + NOSEEUM_INCREMENT_CONS_COUNTER (size, implementation->name); + else + INCREMENT_CONS_COUNTER (size, implementation->name); + return wrap_pointer_1 (lheader); +} + +Lisp_Object +alloc_sized_lrecord (Bytecount size, const struct lrecord_implementation *implementation) { + return alloc_sized_lrecord_1 (size, implementation, 0); +} + +Lisp_Object +noseeum_alloc_sized_lrecord (Bytecount size, + const struct lrecord_implementation * + implementation) +{ + return alloc_sized_lrecord_1 (size, implementation, 1); +} + +Lisp_Object +alloc_lrecord (const struct lrecord_implementation *implementation) +{ + type_checking_assert (implementation->static_size > 0); + return alloc_sized_lrecord (implementation->static_size, implementation); +} + +Lisp_Object +noseeum_alloc_lrecord (const struct lrecord_implementation *implementation) +{ + type_checking_assert (implementation->static_size > 0); + return noseeum_alloc_sized_lrecord (implementation->static_size, implementation); +} + +Lisp_Object +alloc_sized_lrecord_array (Bytecount size, int elemcount, + const struct lrecord_implementation *implementation) +{ struct lrecord_header *lheader; Rawbyte *start, *stop; - type_checking_assert - ((implementation->static_size == 0 ? - implementation->size_in_bytes_method != NULL : - implementation->static_size == size)); + assert_proper_sizing (size); lheader = (struct lrecord_header *) mc_alloc_array (size, elemcount); gc_checking_assert (LRECORD_FREE_P (lheader)); - + for (start = (Rawbyte *) lheader, - stop = ((Rawbyte *) lheader) + (size * elemcount -1); + /* #### FIXME: why is this -1 present? */ + stop = ((Rawbyte *) lheader) + (size * elemcount -1); start < stop; start += size) { struct lrecord_header *lh = (struct lrecord_header *) start; set_lheader_implementation (lh, implementation); - lh->uid = lrecord_uid_counter++; #ifdef ALLOC_TYPE_STATS inc_lrecord_stats (size, lh); #endif /* not ALLOC_TYPE_STATS */ if (implementation->finalizer) add_finalizable_obj (wrap_pointer_1 (lh)); } + INCREMENT_CONS_COUNTER (size * elemcount, implementation->name); - return lheader; -} - -void -free_lrecord (Lisp_Object UNUSED (lrecord)) -{ - /* Manual frees are not allowed with asynchronous finalization */ - return; -} + return wrap_pointer_1 (lheader); +} + +Lisp_Object +alloc_lrecord_array (int elemcount, + const struct lrecord_implementation *implementation) +{ + type_checking_assert (implementation->static_size > 0); + return alloc_sized_lrecord_array (implementation->static_size, elemcount, + implementation); +} + #else /* not NEW_GC */ /* The most basic of the lcrecord allocation functions. Not usually called directly. Allocates an lrecord not managed by any lcrecord-list, of a specified size. See lrecord.h. */ -void * -old_basic_alloc_lcrecord (Bytecount size, +Lisp_Object +old_alloc_sized_lcrecord (Bytecount size, const struct lrecord_implementation *implementation) { struct old_lcrecord_header *lcheader; + assert_proper_sizing (size); type_checking_assert - ((implementation->static_size == 0 ? - implementation->size_in_bytes_method != NULL : - implementation->static_size == size) + (!implementation->frob_block_p && - (! implementation->basic_p) - && - (! (implementation->hash == NULL && implementation->equal != NULL))); + !(implementation->hash == NULL && implementation->equal != NULL)); lcheader = (struct old_lcrecord_header *) allocate_lisp_storage (size); set_lheader_implementation (&lcheader->lheader, implementation); lcheader->next = all_lcrecords; -#if 1 /* mly prefers to see small ID numbers */ - lcheader->uid = lrecord_uid_counter++; -#else /* jwz prefers to see real addrs */ - lcheader->uid = (int) &lcheader; -#endif - lcheader->free = 0; all_lcrecords = lcheader; INCREMENT_CONS_COUNTER (size, implementation->name); - return lcheader; + return wrap_pointer_1 (lcheader); +} + +Lisp_Object +old_alloc_lcrecord (const struct lrecord_implementation *implementation) +{ + type_checking_assert (implementation->static_size > 0); + return old_alloc_sized_lcrecord (implementation->static_size, + implementation); } #if 0 /* Presently unused */ @@ -723,31 +752,13 @@ } } if (lrecord->implementation->finalizer) - lrecord->implementation->finalizer (lrecord, 0); + lrecord->implementation->finalizer (wrap_pointer_1 (lrecord)); xfree (lrecord); return; } #endif /* Unused */ #endif /* not NEW_GC */ - -static void -disksave_object_finalization_1 (void) -{ -#ifdef NEW_GC - mc_finalize_for_disksave (); -#else /* not NEW_GC */ - struct old_lcrecord_header *header; - - for (header = all_lcrecords; header; header = header->next) - { - if (LHEADER_IMPLEMENTATION (&header->lheader)->finalizer && - !header->free) - LHEADER_IMPLEMENTATION (&header->lheader)->finalizer (header, 1); - } -#endif /* not NEW_GC */ -} - /* Bitwise copy all parts of a Lisp object other than the header */ void @@ -765,7 +776,7 @@ (char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header), size - sizeof (struct lrecord_header)); #else /* not NEW_GC */ - if (imp->basic_p) + if (imp->frob_block_p) memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lrecord_header), (char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header), size - sizeof (struct lrecord_header)); @@ -778,9 +789,98 @@ #endif /* not NEW_GC */ } +/* Zero out all parts of a Lisp object other than the header, for a + variable-sized object. The size needs to be given explicitly because + at the time this is called, the contents of the object may not be + defined, or may not be set up in such a way that we can reliably + retrieve the size, since it may depend on settings inside of the object. */ + +void +zero_sized_lisp_object (Lisp_Object obj, Bytecount size) +{ +#ifndef NEW_GC + const struct lrecord_implementation *imp = + XRECORD_LHEADER_IMPLEMENTATION (obj); +#endif /* not NEW_GC */ + +#ifdef NEW_GC + memset ((char *) XRECORD_LHEADER (obj) + sizeof (struct lrecord_header), 0, + size - sizeof (struct lrecord_header)); +#else /* not NEW_GC */ + if (imp->frob_block_p) + memset ((char *) XRECORD_LHEADER (obj) + sizeof (struct lrecord_header), 0, + size - sizeof (struct lrecord_header)); + else + memset ((char *) XRECORD_LHEADER (obj) + + sizeof (struct old_lcrecord_header), 0, + size - sizeof (struct old_lcrecord_header)); +#endif /* not NEW_GC */ +} + +/* Zero out all parts of a Lisp object other than the header, for an object + that isn't variable-size. Objects that are variable-size need to use + zero_sized_lisp_object(). + */ + +void +zero_nonsized_lisp_object (Lisp_Object obj) +{ + const struct lrecord_implementation *imp = + XRECORD_LHEADER_IMPLEMENTATION (obj); + assert (!imp->size_in_bytes_method); + + zero_sized_lisp_object (obj, lisp_object_size (obj)); +} + +void +free_normal_lisp_object (Lisp_Object obj) +{ +#ifndef NEW_GC + const struct lrecord_implementation *imp = + XRECORD_LHEADER_IMPLEMENTATION (obj); +#endif /* not NEW_GC */ + +#ifdef NEW_GC + /* Manual frees are not allowed with asynchronous finalization */ + return; +#else + assert (!imp->frob_block_p); + assert (!imp->size_in_bytes_method); + old_free_lcrecord (obj); +#endif +} + +#ifndef NEW_GC +int +c_readonly (Lisp_Object obj) +{ + return POINTER_TYPE_P (XTYPE (obj)) && C_READONLY (obj); +} +#endif /* not NEW_GC */ + +int +lisp_readonly (Lisp_Object obj) +{ + return POINTER_TYPE_P (XTYPE (obj)) && LISP_READONLY (obj); +} + +/* #### Should be made into an object method */ + +int +object_dead_p (Lisp_Object obj) +{ + return ((BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj))) || + (FRAMEP (obj) && !FRAME_LIVE_P (XFRAME (obj))) || + (WINDOWP (obj) && !WINDOW_LIVE_P (XWINDOW (obj))) || + (DEVICEP (obj) && !DEVICE_LIVE_P (XDEVICE (obj))) || + (CONSOLEP (obj) && !CONSOLE_LIVE_P (XCONSOLE (obj))) || + (EVENTP (obj) && !EVENT_LIVE_P (XEVENT (obj))) || + (EXTENTP (obj) && !EXTENT_LIVE_P (XEXTENT (obj)))); +} + /************************************************************************/ -/* Debugger support */ +/* Debugger support */ /************************************************************************/ /* Give gdb/dbx enough information to decode Lisp Objects. We make sure certain symbols are always defined, so gdb doesn't complain @@ -827,7 +927,7 @@ #define DECLARE_FIXED_TYPE_ALLOC(type, structture) struct __foo__ #else /************************************************************************/ -/* Fixed-size type macros */ +/* Fixed-size type macros */ /************************************************************************/ /* For fixed-size types that are commonly used, we malloc() large blocks @@ -967,21 +1067,6 @@ remain free for the next 1000 (or whatever) times that an object of that type is allocated. */ -#if !defined(HAVE_MMAP) || defined(DOUG_LEA_MALLOC) -/* If we released our reserve (due to running out of memory), - and we have a fair amount free once again, - try to set aside another reserve in case we run out once more. - - This is called when a relocatable block is freed in ralloc.c. */ -void refill_memory_reserve (void); -void -refill_memory_reserve (void) -{ - if (breathing_space == 0) - breathing_space = (char *) malloc (4096 - MALLOC_OVERHEAD); -} -#endif - #ifdef ALLOC_NO_POOLS # define TYPE_ALLOC_SIZE(type, structtype) 1 #else @@ -1150,7 +1235,12 @@ PUT_FIXED_TYPE_ON_FREE_LIST (type, structtype, FFT_ptr); \ MARK_LRECORD_AS_FREE (FFT_ptr); \ } while (0) - +#endif /* NEW_GC */ + +#ifdef NEW_GC +#define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(lo, type, structtype, ptr) \ + free_normal_lisp_object (lo) +#else /* not NEW_GC */ /* Like FREE_FIXED_TYPE() but used when we are explicitly freeing a structure through free_cons(), free_marker(), etc. rather than through the normal process of sweeping. @@ -1165,34 +1255,34 @@ set, which is used for Purify and the like. */ #ifndef ALLOC_NO_POOLS -#define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(type, structtype, ptr) \ -do { FREE_FIXED_TYPE (type, structtype, ptr); \ - DECREMENT_CONS_COUNTER (sizeof (structtype)); \ - gc_count_num_##type##_freelist++; \ +#define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(lo, type, structtype, ptr) \ +do { FREE_FIXED_TYPE (type, structtype, ptr); \ + DECREMENT_CONS_COUNTER (sizeof (structtype)); \ + gc_count_num_##type##_freelist++; \ } while (0) #else -#define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(type, structtype, ptr) +#define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(lo, type, structtype, ptr) #endif -#endif /* NEW_GC */ +#endif /* (not) NEW_GC */ #ifdef NEW_GC -#define ALLOCATE_FIXED_TYPE_AND_SET_IMPL(type, lisp_type, var, lrec_ptr) \ +#define ALLOC_FROB_BLOCK_LISP_OBJECT(type, lisp_type, var, lrec_ptr)\ do { \ - (var) = alloc_lrecord_type (lisp_type, lrec_ptr); \ + (var) = (lisp_type *) XPNTR (ALLOC_NORMAL_LISP_OBJECT (type)); \ } while (0) -#define NOSEEUM_ALLOCATE_FIXED_TYPE_AND_SET_IMPL(type, lisp_type, var, \ +#define NOSEEUM_ALLOC_FROB_BLOCK_LISP_OBJECT(type, lisp_type, var, \ lrec_ptr) \ do { \ - (var) = noseeum_alloc_lrecord_type (lisp_type, lrec_ptr); \ + (var) = (lisp_type *) XPNTR (noseeum_alloc_lrecord (lrec_ptr)); \ } while (0) #else /* not NEW_GC */ -#define ALLOCATE_FIXED_TYPE_AND_SET_IMPL(type, lisp_type, var, lrec_ptr) \ +#define ALLOC_FROB_BLOCK_LISP_OBJECT(type, lisp_type, var, lrec_ptr) \ do \ { \ ALLOCATE_FIXED_TYPE (type, lisp_type, var); \ set_lheader_implementation (&(var)->lheader, lrec_ptr); \ } while (0) -#define NOSEEUM_ALLOCATE_FIXED_TYPE_AND_SET_IMPL(type, lisp_type, var, \ +#define NOSEEUM_ALLOC_FROB_BLOCK_LISP_OBJECT(type, lisp_type, var, \ lrec_ptr) \ do \ { \ @@ -1242,18 +1332,14 @@ { XD_END } }; -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("cons", cons, - 1, /*dumpable-flag*/ - mark_cons, print_cons, 0, - cons_equal, - /* - * No `hash' method needed. - * internal_hash knows how to - * handle conses. - */ - 0, - cons_description, - Lisp_Cons); +DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("cons", cons, + mark_cons, print_cons, 0, cons_equal, + /* + * No `hash' method needed. + * internal_hash knows how to + * handle conses. + */ + 0, cons_description, Lisp_Cons); DEFUN ("cons", Fcons, 2, 2, 0, /* Create a new cons cell, give it CAR and CDR as components, and return it. @@ -1273,7 +1359,7 @@ Lisp_Object val; Lisp_Cons *c; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (cons, Lisp_Cons, c, &lrecord_cons); + ALLOC_FROB_BLOCK_LISP_OBJECT (cons, Lisp_Cons, c, &lrecord_cons); val = wrap_cons (c); XSETCAR (val, car); XSETCDR (val, cdr); @@ -1289,7 +1375,7 @@ Lisp_Object val; Lisp_Cons *c; - NOSEEUM_ALLOCATE_FIXED_TYPE_AND_SET_IMPL (cons, Lisp_Cons, c, &lrecord_cons); + NOSEEUM_ALLOC_FROB_BLOCK_LISP_OBJECT (cons, Lisp_Cons, c, &lrecord_cons); val = wrap_cons (c); XCAR (val) = car; XCDR (val) = cdr; @@ -1340,8 +1426,10 @@ return Fcons (obj0, Fcons (obj1, obj2)); } -Lisp_Object -acons (Lisp_Object key, Lisp_Object value, Lisp_Object alist) +DEFUN ("acons", Facons, 3, 3, 0, /* +Return a new alist created by prepending (KEY . VALUE) to ALIST. +*/ + (key, value, alist)) { return Fcons (Fcons (key, value), alist); } @@ -1369,21 +1457,73 @@ return Fcons (obj0, Fcons (obj1, Fcons (obj2, Fcons (obj3, Fcons (obj4, Fcons (obj5, Qnil)))))); } +/* Return a list of arbitrary length, terminated by Qunbound. */ + +Lisp_Object +listu (Lisp_Object first, ...) +{ + Lisp_Object obj = Qnil; + + if (!UNBOUNDP (first)) + { + va_list va; + Lisp_Object last, val; + + last = obj = Fcons (first, Qnil); + va_start (va, first); + val = va_arg (va, Lisp_Object); + while (!UNBOUNDP (val)) + { + last = XCDR (last) = Fcons (val, Qnil); + val = va_arg (va, Lisp_Object); + } + va_end (va); + } + return obj; +} + +/* Return a list of arbitrary length, with length specified and remaining + args making up the list. */ + +Lisp_Object +listn (int num_args, ...) +{ + Lisp_Object obj = Qnil; + + if (num_args > 0) + { + va_list va; + Lisp_Object last; + int i; + + va_start (va, num_args); + last = obj = Fcons (va_arg (va, Lisp_Object), Qnil); + for (i = 1; i < num_args; i++) + last = XCDR (last) = Fcons (va_arg (va, Lisp_Object), Qnil); + va_end (va); + } + return obj; +} + +/* Return a list of arbitrary length, with length specified and an array + of elements. */ + DEFUN ("make-list", Fmake_list, 2, 2, 0, /* Return a new list of length LENGTH, with each element being OBJECT. */ (length, object)) { - CHECK_NATNUM (length); - - { - Lisp_Object val = Qnil; - EMACS_INT size = XINT (length); - - while (size--) - val = Fcons (object, val); - return val; - } + Lisp_Object val = Qnil; + Elemcount size; + + check_integer_range (length, Qzero, make_integer (EMACS_INT_MAX)); + + size = XINT (length); + + while (size--) + val = Fcons (object, val); + + return val; } @@ -1401,11 +1541,11 @@ { Lisp_Float *f; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (float, Lisp_Float, f, &lrecord_float); + ALLOC_FROB_BLOCK_LISP_OBJECT (float, Lisp_Float, f, &lrecord_float); /* Avoid dump-time `uninitialized memory read' purify warnings. */ if (sizeof (struct lrecord_header) + sizeof (double) != sizeof (*f)) - zero_lrecord (f); + zero_nonsized_lisp_object (wrap_float (f)); float_data (f) = float_value; return wrap_float (f); @@ -1428,7 +1568,7 @@ { Lisp_Bignum *b; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (bignum, Lisp_Bignum, b, &lrecord_bignum); + ALLOC_FROB_BLOCK_LISP_OBJECT (bignum, Lisp_Bignum, b, &lrecord_bignum); bignum_init (bignum_data (b)); bignum_set_long (bignum_data (b), bignum_value); return wrap_bignum (b); @@ -1441,7 +1581,7 @@ { Lisp_Bignum *b; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (bignum, Lisp_Bignum, b, &lrecord_bignum); + ALLOC_FROB_BLOCK_LISP_OBJECT (bignum, Lisp_Bignum, b, &lrecord_bignum); bignum_init (bignum_data (b)); bignum_set (bignum_data (b), bg); return wrap_bignum (b); @@ -1458,7 +1598,7 @@ { Lisp_Ratio *r; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (ratio, Lisp_Ratio, r, &lrecord_ratio); + ALLOC_FROB_BLOCK_LISP_OBJECT (ratio, Lisp_Ratio, r, &lrecord_ratio); ratio_init (ratio_data (r)); ratio_set_long_ulong (ratio_data (r), numerator, denominator); ratio_canonicalize (ratio_data (r)); @@ -1470,7 +1610,7 @@ { Lisp_Ratio *r; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (ratio, Lisp_Ratio, r, &lrecord_ratio); + ALLOC_FROB_BLOCK_LISP_OBJECT (ratio, Lisp_Ratio, r, &lrecord_ratio); ratio_init (ratio_data (r)); ratio_set_bignum_bignum (ratio_data (r), numerator, denominator); ratio_canonicalize (ratio_data (r)); @@ -1482,7 +1622,7 @@ { Lisp_Ratio *r; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (ratio, Lisp_Ratio, r, &lrecord_ratio); + ALLOC_FROB_BLOCK_LISP_OBJECT (ratio, Lisp_Ratio, r, &lrecord_ratio); ratio_init (ratio_data (r)); ratio_set (ratio_data (r), rat); return wrap_ratio (r); @@ -1501,7 +1641,7 @@ { Lisp_Bigfloat *f; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (bigfloat, Lisp_Bigfloat, f, &lrecord_bigfloat); + ALLOC_FROB_BLOCK_LISP_OBJECT (bigfloat, Lisp_Bigfloat, f, &lrecord_bigfloat); if (precision == 0UL) bigfloat_init (bigfloat_data (f)); else @@ -1516,7 +1656,7 @@ { Lisp_Bigfloat *f; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (bigfloat, Lisp_Bigfloat, f, &lrecord_bigfloat); + ALLOC_FROB_BLOCK_LISP_OBJECT (bigfloat, Lisp_Bigfloat, f, &lrecord_bigfloat); bigfloat_init_prec (bigfloat_data (f), bigfloat_get_prec (float_value)); bigfloat_set (bigfloat_data (f), float_value); return wrap_bigfloat (f); @@ -1540,10 +1680,11 @@ } static Bytecount -size_vector (const void *lheader) -{ +size_vector (Lisp_Object obj) +{ + return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object, contents, - ((Lisp_Vector *) lheader)->size); + XVECTOR (obj)->size); } static int @@ -1564,12 +1705,12 @@ } static Hashcode -vector_hash (Lisp_Object obj, int depth) +vector_hash (Lisp_Object obj, int depth, Boolint equalp) { return HASH2 (XVECTOR_LENGTH (obj), internal_array_hash (XVECTOR_DATA (obj), XVECTOR_LENGTH (obj), - depth + 1)); + depth + 1, equalp)); } static const struct memory_description vector_description[] = { @@ -1578,13 +1719,12 @@ { XD_END } }; -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("vector", vector, - 1, /*dumpable-flag*/ - mark_vector, print_vector, 0, - vector_equal, - vector_hash, - vector_description, - size_vector, Lisp_Vector); +DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("vector", vector, + mark_vector, print_vector, 0, + vector_equal, + vector_hash, + vector_description, + size_vector, Lisp_Vector); /* #### should allocate `small' vectors from a frob-block */ static Lisp_Vector * make_vector_internal (Elemcount sizei) @@ -1592,8 +1732,8 @@ /* no `next' field; we use lcrecords */ Bytecount sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object, contents, sizei); - Lisp_Vector *p = - (Lisp_Vector *) BASIC_ALLOC_LCRECORD (sizem, &lrecord_vector); + Lisp_Object obj = ALLOC_SIZED_LISP_OBJECT (sizem, vector); + Lisp_Vector *p = XVECTOR (obj); p->size = sizei; return p; @@ -1617,7 +1757,7 @@ */ (length, object)) { - CONCHECK_NATNUM (length); + check_integer_range (length, Qzero, make_int (ARRAY_DIMENSION_LIMIT)); return make_vector (XINT (length), object); } @@ -1751,8 +1891,8 @@ Bytecount sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, unsigned long, bits, num_longs); - Lisp_Bit_Vector *p = (Lisp_Bit_Vector *) - BASIC_ALLOC_LCRECORD (sizem, &lrecord_bit_vector); + Lisp_Object obj = ALLOC_SIZED_LISP_OBJECT (sizem, bit_vector); + Lisp_Bit_Vector *p = XBIT_VECTOR (obj); bit_vector_length (p) = sizei; return p; @@ -1799,8 +1939,7 @@ */ (length, bit)) { - CONCHECK_NATNUM (length); - + check_integer_range (length, Qzero, make_int (ARRAY_DIMENSION_LIMIT)); return make_bit_vector (XINT (length), bit); } @@ -1838,8 +1977,8 @@ { Lisp_Compiled_Function *f; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (compiled_function, Lisp_Compiled_Function, - f, &lrecord_compiled_function); + ALLOC_FROB_BLOCK_LISP_OBJECT (compiled_function, Lisp_Compiled_Function, + f, &lrecord_compiled_function); f->stack_depth = 0; f->specpdl_depth = 0; @@ -1926,7 +2065,7 @@ CHECK_VECTOR (constants); f->constants = constants; - CHECK_NATNUM (stack_depth); + check_integer_range (stack_depth, Qzero, make_int (USHRT_MAX)); f->stack_depth = (unsigned short) XINT (stack_depth); #ifdef COMPILED_FUNCTION_ANNOTATION_HACK @@ -1976,7 +2115,7 @@ CHECK_STRING (name); - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (symbol, Lisp_Symbol, p, &lrecord_symbol); + ALLOC_FROB_BLOCK_LISP_OBJECT (symbol, Lisp_Symbol, p, &lrecord_symbol); p->name = name; p->plist = Qnil; p->value = Qunbound; @@ -1998,7 +2137,7 @@ { struct extent *e; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (extent, struct extent, e, &lrecord_extent); + ALLOC_FROB_BLOCK_LISP_OBJECT (extent, struct extent, e, &lrecord_extent); extent_object (e) = Qnil; set_extent_start (e, -1); set_extent_end (e, -1); @@ -2026,7 +2165,7 @@ { Lisp_Event *e; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (event, Lisp_Event, e, &lrecord_event); + ALLOC_FROB_BLOCK_LISP_OBJECT (event, Lisp_Event, e, &lrecord_event); return wrap_event (e); } @@ -2040,9 +2179,9 @@ { Lisp_Key_Data *d; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (key_data, Lisp_Key_Data, d, + ALLOC_FROB_BLOCK_LISP_OBJECT (key_data, Lisp_Key_Data, d, &lrecord_key_data); - zero_lrecord (d); + zero_nonsized_lisp_object (wrap_key_data (d)); d->keysym = Qnil; return wrap_key_data (d); @@ -2056,8 +2195,9 @@ { Lisp_Button_Data *d; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (button_data, Lisp_Button_Data, d, &lrecord_button_data); - zero_lrecord (d); + ALLOC_FROB_BLOCK_LISP_OBJECT (button_data, Lisp_Button_Data, d, + &lrecord_button_data); + zero_nonsized_lisp_object (wrap_button_data (d)); return wrap_button_data (d); } @@ -2069,8 +2209,9 @@ { Lisp_Motion_Data *d; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (motion_data, Lisp_Motion_Data, d, &lrecord_motion_data); - zero_lrecord (d); + ALLOC_FROB_BLOCK_LISP_OBJECT (motion_data, Lisp_Motion_Data, d, + &lrecord_motion_data); + zero_nonsized_lisp_object (wrap_motion_data (d)); return wrap_motion_data (d); } @@ -2083,8 +2224,9 @@ { Lisp_Process_Data *d; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (process_data, Lisp_Process_Data, d, &lrecord_process_data); - zero_lrecord (d); + ALLOC_FROB_BLOCK_LISP_OBJECT (process_data, Lisp_Process_Data, d, + &lrecord_process_data); + zero_nonsized_lisp_object (wrap_process_data (d)); d->process = Qnil; return wrap_process_data (d); @@ -2098,8 +2240,9 @@ { Lisp_Timeout_Data *d; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (timeout_data, Lisp_Timeout_Data, d, &lrecord_timeout_data); - zero_lrecord (d); + ALLOC_FROB_BLOCK_LISP_OBJECT (timeout_data, Lisp_Timeout_Data, d, + &lrecord_timeout_data); + zero_nonsized_lisp_object (wrap_timeout_data (d)); d->function = Qnil; d->object = Qnil; @@ -2114,8 +2257,9 @@ { Lisp_Magic_Data *d; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (magic_data, Lisp_Magic_Data, d, &lrecord_magic_data); - zero_lrecord (d); + ALLOC_FROB_BLOCK_LISP_OBJECT (magic_data, Lisp_Magic_Data, d, + &lrecord_magic_data); + zero_nonsized_lisp_object (wrap_magic_data (d)); return wrap_magic_data (d); } @@ -2128,8 +2272,9 @@ { Lisp_Magic_Eval_Data *d; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (magic_eval_data, Lisp_Magic_Eval_Data, d, &lrecord_magic_eval_data); - zero_lrecord (d); + ALLOC_FROB_BLOCK_LISP_OBJECT (magic_eval_data, Lisp_Magic_Eval_Data, d, + &lrecord_magic_eval_data); + zero_nonsized_lisp_object (wrap_magic_eval_data (d)); d->object = Qnil; return wrap_magic_eval_data (d); @@ -2143,8 +2288,9 @@ { Lisp_Eval_Data *d; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (eval_data, Lisp_Eval_Data, d, &lrecord_eval_data); - zero_lrecord (d); + ALLOC_FROB_BLOCK_LISP_OBJECT (eval_data, Lisp_Eval_Data, d, + &lrecord_eval_data); + zero_nonsized_lisp_object (wrap_eval_data (d)); d->function = Qnil; d->object = Qnil; @@ -2159,8 +2305,9 @@ { Lisp_Misc_User_Data *d; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (misc_user_data, Lisp_Misc_User_Data, d, &lrecord_misc_user_data); - zero_lrecord (d); + ALLOC_FROB_BLOCK_LISP_OBJECT (misc_user_data, Lisp_Misc_User_Data, d, + &lrecord_misc_user_data); + zero_nonsized_lisp_object (wrap_misc_user_data (d)); d->function = Qnil; d->object = Qnil; @@ -2183,7 +2330,7 @@ { Lisp_Marker *p; - ALLOCATE_FIXED_TYPE_AND_SET_IMPL (marker, Lisp_Marker, p, &lrecord_marker); + ALLOC_FROB_BLOCK_LISP_OBJECT (marker, Lisp_Marker, p, &lrecord_marker); p->buffer = 0; p->membpos = 0; marker_next (p) = 0; @@ -2197,8 +2344,8 @@ { Lisp_Marker *p; - NOSEEUM_ALLOCATE_FIXED_TYPE_AND_SET_IMPL (marker, Lisp_Marker, p, - &lrecord_marker); + NOSEEUM_ALLOC_FROB_BLOCK_LISP_OBJECT (marker, Lisp_Marker, p, + &lrecord_marker); p->buffer = 0; p->membpos = 0; marker_next (p) = 0; @@ -2214,7 +2361,7 @@ /* The data for "short" strings generally resides inside of structs of type string_chars_block. The Lisp_String structure is allocated just like any - other basic lrecord, and these are freelisted when they get garbage + other frob-block lrecord, and these are freelisted when they get garbage collected. The data for short strings get compacted, but the data for large strings do not. @@ -2315,16 +2462,11 @@ standard way to do finalization when using SWEEP_FIXED_TYPE_BLOCK(). */ -DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string, - 1, /*dumpable-flag*/ - mark_string, print_string, - 0, string_equal, 0, - string_description, - string_getprop, - string_putprop, - string_remprop, - string_plist, - Lisp_String); +DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("string", string, + mark_string, print_string, + 0, string_equal, 0, + string_description, + Lisp_String); #endif /* not NEW_GC */ #ifdef NEW_GC @@ -2365,17 +2507,9 @@ #endif /* not NEW_GC */ #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string, - 1, /*dumpable-flag*/ - mark_string, print_string, - 0, - string_equal, 0, - string_description, - string_getprop, - string_putprop, - string_remprop, - string_plist, - Lisp_String); +DEFINE_DUMPABLE_LISP_OBJECT ("string", string, mark_string, print_string, + 0, string_equal, 0, + string_description, Lisp_String); static const struct memory_description string_direct_data_description[] = { @@ -2384,19 +2518,18 @@ }; static Bytecount -size_string_direct_data (const void *lheader) -{ - return STRING_FULLSIZE (((Lisp_String_Direct_Data *) lheader)->size); -} - - -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("string-direct-data", - string_direct_data, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - string_direct_data_description, - size_string_direct_data, - Lisp_String_Direct_Data); +size_string_direct_data (Lisp_Object obj) +{ + return STRING_FULLSIZE (XSTRING_DIRECT_DATA (obj)->size); +} + + +DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT ("string-direct-data", + string_direct_data, + 0, + string_direct_data_description, + size_string_direct_data, + Lisp_String_Direct_Data); static const struct memory_description string_indirect_data_description[] = { @@ -2406,12 +2539,11 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("string-indirect-data", - string_indirect_data, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - string_indirect_data_description, - Lisp_String_Indirect_Data); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("string-indirect-data", + string_indirect_data, + 0, + string_indirect_data_description, + Lisp_String_Indirect_Data); #endif /* NEW_GC */ #ifndef NEW_GC @@ -2515,7 +2647,7 @@ assert (length >= 0 && fullsize > 0); #ifdef NEW_GC - s = alloc_lrecord_type (Lisp_String, &lrecord_string); + s = XSTRING (ALLOC_NORMAL_LISP_OBJECT (string)); #else /* not NEW_GC */ /* Allocate the string header */ ALLOCATE_FIXED_TYPE (string, Lisp_String, s); @@ -2530,8 +2662,7 @@ #ifdef NEW_GC set_lispstringp_direct (s); STRING_DATA_OBJECT (s) = - wrap_string_direct_data (alloc_lrecord (fullsize, - &lrecord_string_direct_data)); + alloc_sized_lrecord (fullsize, &lrecord_string_direct_data); #else /* not NEW_GC */ set_lispstringp_data (s, BIG_STRING_FULLSIZE_P (fullsize) ? allocate_big_string_chars (length + 1) @@ -2766,7 +2897,7 @@ */ (length, character)) { - CHECK_NATNUM (length); + check_integer_range (length, Qzero, make_int (ARRAY_DIMENSION_LIMIT)); CHECK_CHAR_COERCE_INT (character); { Ibyte init_str[MAX_ICHAR_LEN]; @@ -2978,7 +3109,7 @@ #endif #ifdef NEW_GC - s = alloc_lrecord_type (Lisp_String, &lrecord_string); + s = XSTRING (ALLOC_NORMAL_LISP_OBJECT (string)); mcpro (wrap_pointer_1 (s)); /* otherwise nocopy_strings get collected and static data is tried to be freed. */ @@ -2993,10 +3124,7 @@ s->plist = Qnil; #ifdef NEW_GC set_lispstringp_indirect (s); - STRING_DATA_OBJECT (s) = - wrap_string_indirect_data - (alloc_lrecord_type (Lisp_String_Indirect_Data, - &lrecord_string_indirect_data)); + STRING_DATA_OBJECT (s) = ALLOC_NORMAL_LISP_OBJECT (string_indirect_data); XSTRING_INDIRECT_DATA_DATA (STRING_DATA_OBJECT (s)) = (Ibyte *) contents; XSTRING_INDIRECT_DATA_SIZE (STRING_DATA_OBJECT (s)) = length; #else /* not NEW_GC */ @@ -3017,7 +3145,7 @@ /************************************************************************/ /* Lcrecord lists are used to manage the allocation of particular - sorts of lcrecords, to avoid calling BASIC_ALLOC_LCRECORD() (and thus + sorts of lcrecords, to avoid calling ALLOC_NORMAL_LISP_OBJECT() (and thus malloc() and garbage-collection junk) as much as possible. It is similar to the Blocktype class. @@ -3030,11 +3158,8 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("free", free, - 0, /*dumpable-flag*/ - 0, internal_object_printer, - 0, 0, 0, free_description, - struct free_lcrecord_header); +DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("free", free, 0, free_description, + struct free_lcrecord_header); const struct memory_description lcrecord_list_description[] = { { XD_LISP_OBJECT, offsetof (struct lcrecord_list, free), 0, { 0 }, @@ -3059,10 +3184,10 @@ ! MARKED_RECORD_HEADER_P (lheader) && /* Only lcrecords should be here. */ - ! list->implementation->basic_p + ! list->implementation->frob_block_p && /* Only free lcrecords should be here. */ - free_header->lcheader.free + lheader->free && /* The type of the lcrecord must be right. */ lheader->type == lrecord_type_free @@ -3079,21 +3204,19 @@ return Qnil; } -DEFINE_LRECORD_IMPLEMENTATION ("lcrecord-list", lcrecord_list, - 0, /*dumpable-flag*/ - mark_lcrecord_list, internal_object_printer, - 0, 0, 0, lcrecord_list_description, - struct lcrecord_list); +DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("lcrecord-list", lcrecord_list, + mark_lcrecord_list, + lcrecord_list_description, + struct lcrecord_list); Lisp_Object make_lcrecord_list (Elemcount size, const struct lrecord_implementation *implementation) { - /* Don't use old_alloc_lcrecord_type() avoid infinite recursion - allocating this, */ - struct lcrecord_list *p = (struct lcrecord_list *) - old_basic_alloc_lcrecord (sizeof (struct lcrecord_list), - &lrecord_lcrecord_list); + /* Don't use alloc_automanaged_lcrecord() avoid infinite recursion + allocating this. */ + struct lcrecord_list *p = + XLCRECORD_LIST (old_alloc_lcrecord (&lrecord_lcrecord_list)); p->implementation = implementation; p->size = size; @@ -3117,10 +3240,10 @@ /* There should be no other pointers to the free list. */ assert (! MARKED_RECORD_HEADER_P (lheader)); /* Only free lcrecords should be here. */ - assert (free_header->lcheader.free); + assert (lheader->free); assert (lheader->type == lrecord_type_free); /* Only lcrecords should be here. */ - assert (! (list->implementation->basic_p)); + assert (! (list->implementation->frob_block_p)); #if 0 /* Not used anymore, now that we set the type of the header to lrecord_type_free. */ /* The type of the lcrecord must be right. */ @@ -3132,15 +3255,14 @@ #endif /* ERROR_CHECK_GC */ list->free = free_header->chain; - free_header->lcheader.free = 0; + lheader->free = 0; /* Put back the correct type, as we set it to lrecord_type_free. */ lheader->type = list->implementation->lrecord_type_index; - old_zero_sized_lcrecord (free_header, list->size); + zero_sized_lisp_object (val, list->size); return val; } else - return wrap_pointer_1 (old_basic_alloc_lcrecord (list->size, - list->implementation)); + return old_alloc_sized_lcrecord (list->size, list->implementation); } /* "Free" a Lisp object LCRECORD by placing it on its associated free list @@ -3184,15 +3306,15 @@ /* Make sure the size is correct. This will catch, for example, putting a window configuration on the wrong free list. */ - gc_checking_assert (detagged_lisp_object_size (lheader) == list->size); + gc_checking_assert (lisp_object_size (lcrecord) == list->size); /* Make sure the object isn't already freed. */ - gc_checking_assert (!free_header->lcheader.free); + gc_checking_assert (!lheader->free); /* Freeing stuff in dumped memory is bad. If you trip this, you may need to check for this before freeing. */ gc_checking_assert (!OBJECT_DUMPED_P (lcrecord)); if (implementation->finalizer) - implementation->finalizer (lheader, 0); + implementation->finalizer (lcrecord); /* Yes, there are two ways to indicate freeness -- the type is lrecord_type_free or the ->free flag is set. We used to do only the latter; now we do the former as well for KKCC purposes. Probably @@ -3200,22 +3322,28 @@ around an lrecord of apparently correct type but bogus junk in it. */ MARK_LRECORD_AS_FREE (lheader); free_header->chain = list->free; - free_header->lcheader.free = 1; + lheader->free = 1; list->free = lcrecord; } static Lisp_Object all_lcrecord_lists[countof (lrecord_implementations_table)]; -void * -alloc_automanaged_lcrecord (Bytecount size, - const struct lrecord_implementation *imp) +Lisp_Object +alloc_automanaged_sized_lcrecord (Bytecount size, + const struct lrecord_implementation *imp) { if (EQ (all_lcrecord_lists[imp->lrecord_type_index], Qzero)) all_lcrecord_lists[imp->lrecord_type_index] = make_lcrecord_list (size, imp); - return XPNTR (alloc_managed_lcrecord - (all_lcrecord_lists[imp->lrecord_type_index])); + return alloc_managed_lcrecord (all_lcrecord_lists[imp->lrecord_type_index]); +} + +Lisp_Object +alloc_automanaged_lcrecord (const struct lrecord_implementation *imp) +{ + type_checking_assert (imp->static_size > 0); + return alloc_automanaged_sized_lcrecord (imp->static_size, imp); } void @@ -3230,37 +3358,10 @@ #endif /* not NEW_GC */ -DEFUN ("purecopy", Fpurecopy, 1, 1, 0, /* -Kept for compatibility, returns its argument. -Old: -Make a copy of OBJECT in pure storage. -Recursively copies contents of vectors and cons cells. -Does not copy symbols. -*/ - (object)) -{ - return object; -} - - /************************************************************************/ -/* Garbage Collection */ +/* Staticpro, MCpro */ /************************************************************************/ -/* All the built-in lisp object types are enumerated in `enum lrecord_type'. - Additional ones may be defined by a module (none yet). We leave some - room in `lrecord_implementations_table' for such new lisp object types. */ -const struct lrecord_implementation *lrecord_implementations_table[(int)lrecord_type_last_built_in_type + MODULE_DEFINABLE_TYPE_COUNT]; -int lrecord_type_count = lrecord_type_last_built_in_type; -#ifndef USE_KKCC -/* Object marker functions are in the lrecord_implementation structure. - But copying them to a parallel array is much more cache-friendly. - This hack speeds up (garbage-collect) by about 5%. */ -Lisp_Object (*lrecord_markers[countof (lrecord_implementations_table)]) (Lisp_Object); -#endif /* not USE_KKCC */ - -struct gcpro *gcprolist; - /* We want the staticpro list relocated, but not the pointers found therein, because they refer to locations in the global data segment, not in the heap; we only dump heap objects. Hence we use a trivial @@ -3398,10 +3499,6 @@ #endif /* not DEBUG_XEMACS */ - - - - #ifdef NEW_GC static const struct memory_description mcpro_description_1[] = { { XD_END } @@ -3438,6 +3535,8 @@ Dynarr_add (mcpro_names, varname); } +const Ascbyte *mcpro_name (int count); + /* External debugging function: Return the name of the variable at offset COUNT. */ const Ascbyte * @@ -3461,55 +3560,905 @@ #endif /* not DEBUG_XEMACS */ #endif /* NEW_GC */ - -#ifndef NEW_GC -static int gc_count_num_short_string_in_use; -static Bytecount gc_count_string_total_size; -static Bytecount gc_count_short_string_total_size; - -/* static int gc_count_total_records_used, gc_count_records_total_size; */ +#ifdef ALLOC_TYPE_STATS -/* stats on lcrecords in use - kinda kludgy */ - -static struct -{ - int instances_in_use; - int bytes_in_use; - int instances_freed; - int bytes_freed; - int instances_on_free_list; -} lcrecord_stats [countof (lrecord_implementations_table)]; - -static void -tick_lcrecord_stats (const struct lrecord_header *h, int free_p) -{ - int type_index = h->type; - - if (((struct old_lcrecord_header *) h)->free) +/************************************************************************/ +/* Determining allocation overhead */ +/************************************************************************/ + +/* Attempt to determine the actual amount of space that is used for + the block allocated starting at PTR, supposedly of size "CLAIMED_SIZE". + + It seems that the following holds: + + 1. When using the old allocator (malloc.c): + + -- blocks are always allocated in chunks of powers of two. For + each block, there is an overhead of 8 bytes if rcheck is not + defined, 20 bytes if it is defined. In other words, a + one-byte allocation needs 8 bytes of overhead for a total of + 9 bytes, and needs to have 16 bytes of memory chunked out for + it. + + 2. When using the new allocator (gmalloc.c): + + -- blocks are always allocated in chunks of powers of two up + to 4096 bytes. Larger blocks are allocated in chunks of + an integral multiple of 4096 bytes. The minimum block + size is 2*sizeof (void *), or 16 bytes if SUNOS_LOCALTIME_BUG + is defined. There is no per-block overhead, but there + is an overhead of 3*sizeof (size_t) for each 4096 bytes + allocated. + + 3. When using the system malloc, anything goes, but they are + generally slower and more space-efficient than the GNU + allocators. One possibly reasonable assumption to make + for want of better data is that sizeof (void *), or maybe + 2 * sizeof (void *), is required as overhead and that + blocks are allocated in the minimum required size except + that some minimum block size is imposed (e.g. 16 bytes). */ + +Bytecount +malloced_storage_size (void * UNUSED (ptr), Bytecount claimed_size, + struct usage_stats *stats) +{ + Bytecount orig_claimed_size = claimed_size; + +#ifndef SYSTEM_MALLOC + if (claimed_size < (Bytecount) (2 * sizeof (void *))) + claimed_size = 2 * sizeof (void *); +# ifdef SUNOS_LOCALTIME_BUG + if (claimed_size < 16) + claimed_size = 16; +# endif + if (claimed_size < 4096) { - gc_checking_assert (!free_p); - lcrecord_stats[type_index].instances_on_free_list++; + /* fxg: rename log->log2 to suppress gcc3 shadow warning */ + int log2 = 1; + + /* compute the log base two, more or less, then use it to compute + the block size needed. */ + claimed_size--; + /* It's big, it's heavy, it's wood! */ + while ((claimed_size /= 2) != 0) + ++log2; + claimed_size = 1; + /* It's better than bad, it's good! */ + while (log2 > 0) + { + claimed_size *= 2; + log2--; + } + /* We have to come up with some average about the amount of + blocks used. */ + if ((Bytecount) (rand () & 4095) < claimed_size) + claimed_size += 3 * sizeof (void *); } else { - Bytecount sz = detagged_lisp_object_size (h); - - if (free_p) + claimed_size += 4095; + claimed_size &= ~4095; + claimed_size += (claimed_size / 4096) * 3 * sizeof (size_t); + } + +#else + + if (claimed_size < 16) + claimed_size = 16; + claimed_size += 2 * sizeof (void *); + +#endif /* system allocator */ + + if (stats) + { + stats->was_requested += orig_claimed_size; + stats->malloc_overhead += claimed_size - orig_claimed_size; + } + return claimed_size; +} + +#ifndef NEW_GC +static Bytecount +fixed_type_block_overhead (Bytecount size, Bytecount per_block) +{ + Bytecount overhead = 0; + Bytecount storage_size = malloced_storage_size (0, per_block, 0); + while (size >= per_block) + { + size -= per_block; + overhead += storage_size - per_block; + } + if (rand () % per_block < size) + overhead += storage_size - per_block; + return overhead; +} +#endif /* not NEW_GC */ + +Bytecount +lisp_object_storage_size (Lisp_Object obj, struct usage_stats *ustats) +{ +#ifndef NEW_GC + const struct lrecord_implementation *imp; +#endif /* not NEW_GC */ + Bytecount size; + + if (!LRECORDP (obj)) + return 0; + + size = lisp_object_size (obj); + +#ifdef NEW_GC + return mc_alloced_storage_size (size, ustats); +#else + imp = XRECORD_LHEADER_IMPLEMENTATION (obj); + if (imp->frob_block_p) + { + Bytecount overhead = + /* #### Always using cons_block is incorrect but close; only + string_chars_block is significantly different in size, and + it won't ever be seen in this function */ + fixed_type_block_overhead (size, sizeof (struct cons_block)); + if (ustats) { - lcrecord_stats[type_index].instances_freed++; - lcrecord_stats[type_index].bytes_freed += sz; + ustats->was_requested += size; + ustats->malloc_overhead += overhead; } - else + return size + overhead; + } + else + return malloced_storage_size (XPNTR (obj), size, ustats); +#endif +} + + +/************************************************************************/ +/* Allocation Statistics: Accumulate */ +/************************************************************************/ + +#ifdef NEW_GC + +void +init_lrecord_stats (void) +{ + xzero (lrecord_stats); +} + +void +inc_lrecord_stats (Bytecount size, const struct lrecord_header *h) +{ + int type_index = h->type; + if (!size) + size = detagged_lisp_object_size (h); + + lrecord_stats[type_index].instances_in_use++; + lrecord_stats[type_index].bytes_in_use += size; + lrecord_stats[type_index].bytes_in_use_including_overhead +#ifdef MEMORY_USAGE_STATS + += mc_alloced_storage_size (size, 0); +#else /* not MEMORY_USAGE_STATS */ + += size; +#endif /* not MEMORY_USAGE_STATS */ +} + +void +dec_lrecord_stats (Bytecount size_including_overhead, + const struct lrecord_header *h) +{ + int type_index = h->type; + int size = detagged_lisp_object_size (h); + + lrecord_stats[type_index].instances_in_use--; + lrecord_stats[type_index].bytes_in_use -= size; + lrecord_stats[type_index].bytes_in_use_including_overhead + -= size_including_overhead; + + DECREMENT_CONS_COUNTER (size); +} + +int +lrecord_stats_heap_size (void) +{ + int i; + int size = 0; + for (i = 0; i < countof (lrecord_implementations_table); i++) + size += lrecord_stats[i].bytes_in_use; + return size; +} + +#else /* not NEW_GC */ + +static void +clear_lrecord_stats (void) +{ + xzero (lrecord_stats); + gc_count_num_short_string_in_use = 0; + gc_count_string_total_size = 0; + gc_count_short_string_total_size = 0; + gc_count_long_string_storage_including_overhead = 0; +} + +/* Keep track of extra statistics for strings -- length of the string + characters for short and long strings, number of short and long strings. */ +static void +tick_string_stats (Lisp_String *p, int from_sweep) +{ + Bytecount size = p->size_; + gc_count_string_total_size += size; + if (!BIG_STRING_SIZE_P (size)) + { + gc_count_short_string_total_size += size; + gc_count_num_short_string_in_use++; + } + else + gc_count_long_string_storage_including_overhead += + malloced_storage_size (p->data_, p->size_, NULL); + /* During the sweep stage, we count the total number of strings in use. + This gets those not stored in pdump storage. For pdump storage, we + need to bump the number of strings in use so as to get an accurate + count of all strings in use (pdump or not). But don't do this when + called from the sweep stage, or we will double-count. */ + if (!from_sweep) + gc_count_num_string_in_use++; +} + +/* As objects are sweeped, we record statistics about their memory usage. + Currently, all lcrecords are processed this way as well as any frob-block + objects that were saved and restored as a result of the pdump process. + (See pdump_objects_unmark().) Other frob-block objects do NOT get their + statistics noted this way -- instead, as the frob blocks are swept, + COPY_INTO_LRECORD_STATS() is called, and notes statistics about the + frob blocks. */ + +void +tick_lrecord_stats (const struct lrecord_header *h, + enum lrecord_alloc_status status) +{ + int type_index = h->type; + Lisp_Object obj = wrap_pointer_1 (h); + Bytecount sz = lisp_object_size (obj); + Bytecount sz_with_overhead = lisp_object_storage_size (obj, NULL); + Bytecount overhead = sz_with_overhead - sz; + + switch (status) + { + case ALLOC_IN_USE: + lrecord_stats[type_index].instances_in_use++; + lrecord_stats[type_index].bytes_in_use += sz; + lrecord_stats[type_index].bytes_in_use_overhead += overhead; + if (STRINGP (obj)) + tick_string_stats (XSTRING (obj), 0); +#ifdef MEMORY_USAGE_STATS + { + struct generic_usage_stats stats; + if (HAS_OBJECT_METH_P (obj, memory_usage)) + { + int i; + int total_stats = OBJECT_PROPERTY (obj, num_extra_memusage_stats); + xzero (stats); + OBJECT_METH (obj, memory_usage, (obj, &stats)); + for (i = 0; i < total_stats; i++) + lrecord_stats[type_index].stats.othervals[i] += + stats.othervals[i]; + } + } +#endif + break; + case ALLOC_FREE: + lrecord_stats[type_index].instances_freed++; + lrecord_stats[type_index].bytes_freed += sz; + lrecord_stats[type_index].bytes_freed_overhead += overhead; + break; + case ALLOC_ON_FREE_LIST: + lrecord_stats[type_index].instances_on_free_list++; + lrecord_stats[type_index].bytes_on_free_list += sz; + lrecord_stats[type_index].bytes_on_free_list_overhead += overhead; + break; + default: + ABORT (); + } +} + +inline static void +tick_lcrecord_stats (const struct lrecord_header *h, int free_p) +{ + if (h->free) + { + gc_checking_assert (!free_p); + tick_lrecord_stats (h, ALLOC_ON_FREE_LIST); + } + else + tick_lrecord_stats (h, free_p ? ALLOC_FREE : ALLOC_IN_USE); +} + +#endif /* (not) NEW_GC */ + +void +finish_object_memory_usage_stats (void) +{ + /* Here we add up the aggregate values for each statistic, previously + computed during tick_lrecord_stats(), to get a single combined value + of non-Lisp memory usage for all objects of each type. We can't + do this if NEW_GC because nothing like tick_lrecord_stats() gets + called -- instead, statistics are computed when objects are allocated, + which is too early to be calling the memory_usage() method. */ +#if defined (MEMORY_USAGE_STATS) && !defined (NEW_GC) + int i; + for (i = 0; i < countof (lrecord_implementations_table); i++) + { + struct lrecord_implementation *imp = lrecord_implementations_table[i]; + if (imp && imp->num_extra_nonlisp_memusage_stats) { - lcrecord_stats[type_index].instances_in_use++; - lcrecord_stats[type_index].bytes_in_use += sz; + int j; + for (j = 0; j < imp->num_extra_nonlisp_memusage_stats; j++) + lrecord_stats[i].nonlisp_bytes_in_use += + lrecord_stats[i].stats.othervals[j]; + } + if (imp && imp->num_extra_lisp_ancillary_memusage_stats) + { + int j; + for (j = 0; j < imp->num_extra_lisp_ancillary_memusage_stats; j++) + lrecord_stats[i].lisp_ancillary_bytes_in_use += + lrecord_stats[i].stats.othervals + [j + imp->offset_lisp_ancillary_memusage_stats]; + } + } +#endif /* defined (MEMORY_USAGE_STATS) && !defined (NEW_GC) */ +} + +#define COUNT_FROB_BLOCK_USAGE(type) \ + EMACS_INT s = 0; \ + EMACS_INT s_overhead = 0; \ + struct type##_block *x = current_##type##_block; \ + while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; } \ + s_overhead = fixed_type_block_overhead (s, sizeof (struct type##_block)); \ + DO_NOTHING + +#define COPY_INTO_LRECORD_STATS(type) \ +do { \ + COUNT_FROB_BLOCK_USAGE (type); \ + lrecord_stats[lrecord_type_##type].bytes_in_use += s; \ + lrecord_stats[lrecord_type_##type].bytes_in_use_overhead += \ + s_overhead; \ + lrecord_stats[lrecord_type_##type].instances_on_free_list += \ + gc_count_num_##type##_freelist; \ + lrecord_stats[lrecord_type_##type].instances_in_use += \ + gc_count_num_##type##_in_use; \ +} while (0) + + +/************************************************************************/ +/* Allocation statistics: format nicely */ +/************************************************************************/ + +static Lisp_Object +gc_plist_hack (const Ascbyte *name, EMACS_INT value, Lisp_Object tail) +{ + /* C doesn't have local functions (or closures, or GC, or readable syntax, + or portable numeric datatypes, or bit-vectors, or characters, or + arrays, or exceptions, or ...) */ + return cons3 (intern (name), make_int (value), tail); +} + +/* Pluralize a lowercase English word stored in BUF, assuming BUF has + enough space to hold the extra letters (at most 2). */ +static void +pluralize_word (Ascbyte *buf) +{ + Bytecount len = strlen (buf); + int upper = 0; + Ascbyte d, e; + + if (len == 0 || len == 1) + goto pluralize_apostrophe_s; + e = buf[len - 1]; + d = buf[len - 2]; + upper = isupper (e); + e = tolower (e); + d = tolower (d); + if (e == 'y') + { + switch (d) + { + case 'a': + case 'e': + case 'i': + case 'o': + case 'u': + goto pluralize_s; + default: + buf[len - 1] = (upper ? 'I' : 'i'); + goto pluralize_es; } } -} + else if (e == 's' || e == 'x' || (e == 'h' && (d == 's' || d == 'c'))) + { + pluralize_es: + buf[len++] = (upper ? 'E' : 'e'); + } + pluralize_s: + buf[len++] = (upper ? 'S' : 's'); + buf[len] = '\0'; + return; + + pluralize_apostrophe_s: + buf[len++] = '\''; + goto pluralize_s; +} + +static void +pluralize_and_append (Ascbyte *buf, const Ascbyte *name, const Ascbyte *suffix) +{ + strcpy (buf, name); + pluralize_word (buf); + strcat (buf, suffix); +} + +static Lisp_Object +object_memory_usage_stats (int set_total_gc_usage) +{ + Lisp_Object pl = Qnil; + int i; + EMACS_INT tgu_val = 0; + +#ifdef NEW_GC + for (i = 0; i < countof (lrecord_implementations_table); i++) + { + if (lrecord_stats[i].instances_in_use != 0) + { + Ascbyte buf[255]; + const Ascbyte *name = lrecord_implementations_table[i]->name; + + if (lrecord_stats[i].bytes_in_use_including_overhead != + lrecord_stats[i].bytes_in_use) + { + sprintf (buf, "%s-storage-including-overhead", name); + pl = gc_plist_hack (buf, + lrecord_stats[i] + .bytes_in_use_including_overhead, + pl); + } + + sprintf (buf, "%s-storage", name); + pl = gc_plist_hack (buf, + lrecord_stats[i].bytes_in_use, + pl); + tgu_val += lrecord_stats[i].bytes_in_use_including_overhead; + + pluralize_and_append (buf, name, "-used"); + pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl); + } + } + +#else /* not NEW_GC */ + + for (i = 0; i < lrecord_type_count; i++) + { + if (lrecord_stats[i].bytes_in_use != 0 + || lrecord_stats[i].bytes_freed != 0 + || lrecord_stats[i].instances_on_free_list != 0) + { + Ascbyte buf[255]; + const Ascbyte *name = lrecord_implementations_table[i]->name; + + sprintf (buf, "%s-storage-overhead", name); + pl = gc_plist_hack (buf, lrecord_stats[i].bytes_in_use_overhead, pl); + tgu_val += lrecord_stats[i].bytes_in_use_overhead; + sprintf (buf, "%s-storage", name); + pl = gc_plist_hack (buf, lrecord_stats[i].bytes_in_use, pl); + tgu_val += lrecord_stats[i].bytes_in_use; +#ifdef MEMORY_USAGE_STATS + if (lrecord_stats[i].nonlisp_bytes_in_use) + { + sprintf (buf, "%s-non-lisp-storage", name); + pl = gc_plist_hack (buf, lrecord_stats[i].nonlisp_bytes_in_use, + pl); + tgu_val += lrecord_stats[i].nonlisp_bytes_in_use; + } + if (lrecord_stats[i].lisp_ancillary_bytes_in_use) + { + sprintf (buf, "%s-lisp-ancillary-storage", name); + pl = gc_plist_hack (buf, lrecord_stats[i]. + lisp_ancillary_bytes_in_use, + pl); + tgu_val += lrecord_stats[i].lisp_ancillary_bytes_in_use; + } +#endif /* MEMORY_USAGE_STATS */ + pluralize_and_append (buf, name, "-freed"); + if (lrecord_stats[i].instances_freed != 0) + pl = gc_plist_hack (buf, lrecord_stats[i].instances_freed, pl); + pluralize_and_append (buf, name, "-on-free-list"); + if (lrecord_stats[i].instances_on_free_list != 0) + pl = gc_plist_hack (buf, lrecord_stats[i].instances_on_free_list, + pl); + pluralize_and_append (buf, name, "-used"); + pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl); + } + } + + pl = gc_plist_hack ("long-string-chars-storage-overhead", + gc_count_long_string_storage_including_overhead - + (gc_count_string_total_size + - gc_count_short_string_total_size), pl); + pl = gc_plist_hack ("long-string-chars-storage", + gc_count_string_total_size + - gc_count_short_string_total_size, pl); + do + { + COUNT_FROB_BLOCK_USAGE (string_chars); + tgu_val += s + s_overhead; + pl = gc_plist_hack ("short-string-chars-storage-overhead", s_overhead, pl); + pl = gc_plist_hack ("short-string-chars-storage", s, pl); + } + while (0); + + pl = gc_plist_hack ("long-strings-total-length", + gc_count_string_total_size + - gc_count_short_string_total_size, pl); + pl = gc_plist_hack ("short-strings-total-length", + gc_count_short_string_total_size, pl); + pl = gc_plist_hack ("long-strings-used", + gc_count_num_string_in_use + - gc_count_num_short_string_in_use, pl); + pl = gc_plist_hack ("short-strings-used", + gc_count_num_short_string_in_use, pl); + +#endif /* NEW_GC */ + + if (set_total_gc_usage) + { + total_gc_usage = tgu_val; + total_gc_usage_set = 1; + } + + return pl; +} + +static Lisp_Object +garbage_collection_statistics (void) +{ + /* The things we do for backwards-compatibility */ +#ifdef NEW_GC + return + list6 + (Fcons (make_int (lrecord_stats[lrecord_type_cons].instances_in_use), + make_int (lrecord_stats[lrecord_type_cons] + .bytes_in_use_including_overhead)), + Fcons (make_int (lrecord_stats[lrecord_type_symbol].instances_in_use), + make_int (lrecord_stats[lrecord_type_symbol] + .bytes_in_use_including_overhead)), + Fcons (make_int (lrecord_stats[lrecord_type_marker].instances_in_use), + make_int (lrecord_stats[lrecord_type_marker] + .bytes_in_use_including_overhead)), + make_int (lrecord_stats[lrecord_type_string] + .bytes_in_use_including_overhead), + make_int (lrecord_stats[lrecord_type_vector] + .bytes_in_use_including_overhead), + object_memory_usage_stats (1)); +#else /* not NEW_GC */ + return + list6 (Fcons (make_int (gc_count_num_cons_in_use), + make_int (gc_count_num_cons_freelist)), + Fcons (make_int (gc_count_num_symbol_in_use), + make_int (gc_count_num_symbol_freelist)), + Fcons (make_int (gc_count_num_marker_in_use), + make_int (gc_count_num_marker_freelist)), + make_int (gc_count_string_total_size), + make_int (lrecord_stats[lrecord_type_vector].bytes_in_use + + lrecord_stats[lrecord_type_vector].bytes_freed + + lrecord_stats[lrecord_type_vector].bytes_on_free_list), + object_memory_usage_stats (1)); #endif /* not NEW_GC */ +} + +DEFUN ("object-memory-usage-stats", Fobject_memory_usage_stats, 0, 0, 0, /* +Return statistics about memory usage of Lisp objects. +*/ + ()) +{ + return object_memory_usage_stats (0); +} + +#endif /* ALLOC_TYPE_STATS */ + +#ifdef MEMORY_USAGE_STATS + +DEFUN ("object-memory-usage", Fobject_memory_usage, 1, 1, 0, /* +Return stats about the memory usage of OBJECT. +The values returned are in the form of an alist of usage types and byte +counts. The byte counts attempt to encompass all the memory used +by the object (separate from the memory logically associated with any +other object), including internal structures and any malloc() +overhead associated with them. In practice, the byte counts are +underestimated because certain memory usage is very hard to determine +\(e.g. the amount of memory used inside the Xt library or inside the +X server). + +Multiple slices of the total memory usage may be returned, separated +by a nil. Each slice represents a particular view of the memory, a +particular way of partitioning it into groups. Within a slice, there +is no overlap between the groups of memory, and each slice collectively +represents all the memory concerned. The rightmost slice typically +represents the total memory used plus malloc and dynarr overhead. + +Slices describing other Lisp objects logically associated with the +object may be included, separated from other slices by `t' and from +each other by nil if there is more than one. + +#### We have to figure out how to handle the memory used by the object +itself vs. the memory used by substructures. Probably the memory_usage +method should return info only about substructures and related Lisp +objects, since the caller can always find and all info about the object +itself. +*/ + (object)) +{ + struct generic_usage_stats gustats; + struct usage_stats object_stats; + int i; + Lisp_Object val = Qnil; + Lisp_Object stats_list; + + if (!LRECORDP (object)) + invalid_argument + ("No memory associated with immediate objects (int or char)", object); + + stats_list = OBJECT_PROPERTY (object, memusage_stats_list); + + xzero (object_stats); + lisp_object_storage_size (object, &object_stats); + + val = Facons (Qobject_actually_requested, + make_int (object_stats.was_requested), val); + val = Facons (Qobject_malloc_overhead, + make_int (object_stats.malloc_overhead), val); + assert (!object_stats.dynarr_overhead); + assert (!object_stats.gap_overhead); + + if (!NILP (stats_list)) + { + xzero (gustats); + MAYBE_OBJECT_METH (object, memory_usage, (object, &gustats)); + + val = Fcons (Qt, val); + val = Facons (Qother_memory_actually_requested, + make_int (gustats.u.was_requested), val); + val = Facons (Qother_memory_malloc_overhead, + make_int (gustats.u.malloc_overhead), val); + if (gustats.u.dynarr_overhead) + val = Facons (Qother_memory_dynarr_overhead, + make_int (gustats.u.dynarr_overhead), val); + if (gustats.u.gap_overhead) + val = Facons (Qother_memory_gap_overhead, + make_int (gustats.u.gap_overhead), val); + val = Fcons (Qnil, val); + + i = 0; + { + LIST_LOOP_2 (item, stats_list) + { + if (NILP (item) || EQ (item, Qt)) + val = Fcons (item, val); + else + { + val = Facons (item, make_int (gustats.othervals[i]), val); + i++; + } + } + } + } + + return Fnreverse (val); +} + +/* Compute total memory usage associated with an object, including + + (a) Storage (including overhead) allocated to the object itself + (b) Storage (including overhead) for ancillary non-Lisp structures attached + to the object + (c) Storage (including overhead) for ancillary Lisp objects attached + to the object + + Store the three types of memory into the return values provided they + aren't NULL, and return a sum of the three values. Also store the + structure of individual statistics into STATS if non-zero. + + Note that the value for type (c) is the sum of all three types of + memory associated with the ancillary Lisp objects. +*/ + +Bytecount +lisp_object_memory_usage_full (Lisp_Object object, Bytecount *storage_size, + Bytecount *extra_nonlisp_storage, + Bytecount *extra_lisp_ancillary_storage, + struct generic_usage_stats *stats) +{ + Bytecount total; + + total = lisp_object_storage_size (object, NULL); + if (storage_size) + *storage_size = total; + + if (LRECORDP (object) && HAS_OBJECT_METH_P (object, memory_usage)) + { + int i; + struct generic_usage_stats gustats; + Bytecount sum; + struct lrecord_implementation *imp = + XRECORD_LHEADER_IMPLEMENTATION (object); + + xzero (gustats); + OBJECT_METH (object, memory_usage, (object, &gustats)); + + if (stats) + *stats = gustats; + + sum = 0; + for (i = 0; i < imp->num_extra_nonlisp_memusage_stats; i++) + sum += gustats.othervals[i]; + total += sum; + if (extra_nonlisp_storage) + *extra_nonlisp_storage = sum; + + sum = 0; + for (i = 0; i < imp->num_extra_lisp_ancillary_memusage_stats; i++) + sum += gustats.othervals[imp->offset_lisp_ancillary_memusage_stats + + i]; + total += sum; + if (extra_lisp_ancillary_storage) + *extra_lisp_ancillary_storage = sum; + } + else + { + if (extra_nonlisp_storage) + *extra_nonlisp_storage = 0; + if (extra_lisp_ancillary_storage) + *extra_lisp_ancillary_storage = 0; + } + + return total; +} + + +Bytecount +lisp_object_memory_usage (Lisp_Object object) +{ + return lisp_object_memory_usage_full (object, NULL, NULL, NULL, NULL); +} + +static Bytecount +tree_memory_usage_1 (Lisp_Object arg, int vectorp, int depth) +{ + Bytecount total = 0; + + if (depth > 200) + return total; + + if (CONSP (arg)) + { + SAFE_LIST_LOOP_3 (elt, arg, tail) + { + total += lisp_object_memory_usage (tail); + if (CONSP (elt) || VECTORP (elt)) + total += tree_memory_usage_1 (elt, vectorp, depth + 1); + if (VECTORP (XCDR (tail))) /* hack for (a b . [c d]) */ + total += tree_memory_usage_1 (XCDR (tail), vectorp, depth +1); + } + } + else if (VECTORP (arg) && vectorp) + { + int i = XVECTOR_LENGTH (arg); + int j; + total += lisp_object_memory_usage (arg); + for (j = 0; j < i; j++) + { + Lisp_Object elt = XVECTOR_DATA (arg) [j]; + if (CONSP (elt) || VECTORP (elt)) + total += tree_memory_usage_1 (elt, vectorp, depth + 1); + } + } + return total; +} + +Bytecount +tree_memory_usage (Lisp_Object arg, int vectorp) +{ + return tree_memory_usage_1 (arg, vectorp, 0); +} + +#endif /* MEMORY_USAGE_STATS */ + +#ifdef ALLOC_TYPE_STATS + +DEFUN ("total-object-memory-usage", Ftotal_object_memory_usage, 0, 0, 0, /* +Return total number of bytes used for object storage in XEmacs. +This may be helpful in debugging XEmacs's memory usage. +See also `consing-since-gc' and `object-memory-usage-stats'. +*/ + ()) +{ + return make_int (total_gc_usage + consing_since_gc); +} + +#endif /* ALLOC_TYPE_STATS */ +/************************************************************************/ +/* Allocation statistics: Initialization */ +/************************************************************************/ +#ifdef MEMORY_USAGE_STATS + +/* Compute the number of extra memory-usage statistics associated with an + object. We can't compute this at the time INIT_LISP_OBJECT() is called + because the value of the `memusage_stats_list' property is generally + set afterwards. So we compute the values for all types of objects + after all objects have been initialized. */ + +static void +compute_memusage_stats_length (void) +{ + int i; + + for (i = 0; i < countof (lrecord_implementations_table); i++) + { + struct lrecord_implementation *imp = lrecord_implementations_table[i]; + + if (!imp) + continue; + /* For some of the early objects, Qnil was not yet initialized at + the time of object initialization, so it came up as Qnull_pointer. + Fix that now. */ + if (EQ (imp->memusage_stats_list, Qnull_pointer)) + imp->memusage_stats_list = Qnil; + { + Elemcount len = 0; + Elemcount nonlisp_len = 0; + Elemcount lisp_len = 0; + Elemcount lisp_offset = 0; + int group_num = 0; + int slice_num = 0; + + LIST_LOOP_2 (item, imp->memusage_stats_list) + { + if (EQ (item, Qt)) + { + group_num++; + if (group_num == 1) + lisp_offset = len; + slice_num = 0; + } + else if (EQ (item, Qnil)) + { + slice_num++; + } + else + { + if (slice_num == 0) + { + if (group_num == 0) + nonlisp_len++; + else if (group_num == 1) + lisp_len++; + } + len++; + } + } + + imp->num_extra_memusage_stats = len; + imp->num_extra_nonlisp_memusage_stats = nonlisp_len; + imp->num_extra_lisp_ancillary_memusage_stats = lisp_len; + imp->offset_lisp_ancillary_memusage_stats = lisp_offset; + } + } +} + +#endif /* MEMORY_USAGE_STATS */ + + +/************************************************************************/ +/* Garbage Collection -- Sweep/Compact */ +/************************************************************************/ + #ifndef NEW_GC /* Free all unmarked records */ static void @@ -3519,8 +4468,6 @@ int num_used = 0; /* int total_size = 0; */ - xzero (lcrecord_stats); /* Reset all statistics to 0. */ - /* First go through and call all the finalize methods. Then go through and free the objects. There used to be only one loop here, with the call to the finalizer @@ -3537,10 +4484,10 @@ GC_CHECK_LHEADER_INVARIANTS (h); - if (! MARKED_RECORD_HEADER_P (h) && ! header->free) + if (! MARKED_RECORD_HEADER_P (h) && !h->free) { if (LHEADER_IMPLEMENTATION (h)->finalizer) - LHEADER_IMPLEMENTATION (h)->finalizer (h, 0); + LHEADER_IMPLEMENTATION (h)->finalizer (wrap_pointer_1 (h)); } } @@ -3619,86 +4566,88 @@ \ gc_count_num_##typename##_in_use = num_used; \ gc_count_num_##typename##_freelist = num_free; \ + COPY_INTO_LRECORD_STATS (typename); \ } while (0) #else /* !ERROR_CHECK_GC */ -#define SWEEP_FIXED_TYPE_BLOCK_1(typename, obj_type, lheader) \ -do { \ - struct typename##_block *SFTB_current; \ - struct typename##_block **SFTB_prev; \ - int SFTB_limit; \ - int num_free = 0, num_used = 0; \ - \ - typename##_free_list = 0; \ - \ - for (SFTB_prev = ¤t_##typename##_block, \ - SFTB_current = current_##typename##_block, \ - SFTB_limit = current_##typename##_block_index; \ - SFTB_current; \ - ) \ - { \ - int SFTB_iii; \ - int SFTB_empty = 1; \ - Lisp_Free *SFTB_old_free_list = typename##_free_list; \ - \ - for (SFTB_iii = 0; SFTB_iii < SFTB_limit; SFTB_iii++) \ - { \ - obj_type *SFTB_victim = &(SFTB_current->block[SFTB_iii]); \ - \ - if (LRECORD_FREE_P (SFTB_victim)) \ - { \ - num_free++; \ +#define SWEEP_FIXED_TYPE_BLOCK_1(typename, obj_type, lheader) \ +do { \ + struct typename##_block *SFTB_current; \ + struct typename##_block **SFTB_prev; \ + int SFTB_limit; \ + int num_free = 0, num_used = 0; \ + \ + typename##_free_list = 0; \ + \ + for (SFTB_prev = ¤t_##typename##_block, \ + SFTB_current = current_##typename##_block, \ + SFTB_limit = current_##typename##_block_index; \ + SFTB_current; \ + ) \ + { \ + int SFTB_iii; \ + int SFTB_empty = 1; \ + Lisp_Free *SFTB_old_free_list = typename##_free_list; \ + \ + for (SFTB_iii = 0; SFTB_iii < SFTB_limit; SFTB_iii++) \ + { \ + obj_type *SFTB_victim = &(SFTB_current->block[SFTB_iii]); \ + \ + if (LRECORD_FREE_P (SFTB_victim)) \ + { \ + num_free++; \ PUT_FIXED_TYPE_ON_FREE_LIST (typename, obj_type, SFTB_victim); \ - } \ - else if (C_READONLY_RECORD_HEADER_P (&SFTB_victim->lheader)) \ - { \ - SFTB_empty = 0; \ - num_used++; \ - } \ - else if (! MARKED_RECORD_HEADER_P (&SFTB_victim->lheader)) \ - { \ - num_free++; \ - FREE_FIXED_TYPE (typename, obj_type, SFTB_victim); \ - } \ - else \ - { \ - SFTB_empty = 0; \ - num_used++; \ - UNMARK_##typename (SFTB_victim); \ - } \ - } \ - if (!SFTB_empty) \ - { \ - SFTB_prev = &(SFTB_current->prev); \ - SFTB_current = SFTB_current->prev; \ - } \ - else if (SFTB_current == current_##typename##_block \ - && !SFTB_current->prev) \ - { \ - /* No real point in freeing sole allocation block */ \ - break; \ - } \ - else \ - { \ - struct typename##_block *SFTB_victim_block = SFTB_current; \ - if (SFTB_victim_block == current_##typename##_block) \ - current_##typename##_block_index \ - = countof (current_##typename##_block->block); \ - SFTB_current = SFTB_current->prev; \ - { \ - *SFTB_prev = SFTB_current; \ - xfree (SFTB_victim_block); \ - /* Restore free list to what it was before victim was swept */ \ - typename##_free_list = SFTB_old_free_list; \ - num_free -= SFTB_limit; \ - } \ - } \ - SFTB_limit = countof (current_##typename##_block->block); \ - } \ - \ - gc_count_num_##typename##_in_use = num_used; \ - gc_count_num_##typename##_freelist = num_free; \ + } \ + else if (C_READONLY_RECORD_HEADER_P (&SFTB_victim->lheader)) \ + { \ + SFTB_empty = 0; \ + num_used++; \ + } \ + else if (! MARKED_RECORD_HEADER_P (&SFTB_victim->lheader)) \ + { \ + num_free++; \ + FREE_FIXED_TYPE (typename, obj_type, SFTB_victim); \ + } \ + else \ + { \ + SFTB_empty = 0; \ + num_used++; \ + UNMARK_##typename (SFTB_victim); \ + } \ + } \ + if (!SFTB_empty) \ + { \ + SFTB_prev = &(SFTB_current->prev); \ + SFTB_current = SFTB_current->prev; \ + } \ + else if (SFTB_current == current_##typename##_block \ + && !SFTB_current->prev) \ + { \ + /* No real point in freeing sole allocation block */ \ + break; \ + } \ + else \ + { \ + struct typename##_block *SFTB_victim_block = SFTB_current; \ + if (SFTB_victim_block == current_##typename##_block) \ + current_##typename##_block_index \ + = countof (current_##typename##_block->block); \ + SFTB_current = SFTB_current->prev; \ + { \ + *SFTB_prev = SFTB_current; \ + xfree (SFTB_victim_block); \ + /* Restore free list to what it was before victim was swept */ \ + typename##_free_list = SFTB_old_free_list; \ + num_free -= SFTB_limit; \ + } \ + } \ + SFTB_limit = countof (current_##typename##_block->block); \ + } \ + \ + gc_count_num_##typename##_in_use = num_used; \ + gc_count_num_##typename##_freelist = num_free; \ + COPY_INTO_LRECORD_STATS (typename); \ } while (0) #endif /* !ERROR_CHECK_GC */ @@ -3746,11 +4695,7 @@ ASSERT_VALID_POINTER (XPNTR (cons_car (ptr))); #endif /* ERROR_CHECK_GC */ -#ifdef NEW_GC - free_lrecord (cons); -#else /* not NEW_GC */ - FREE_FIXED_TYPE_WHEN_NOT_IN_GC (cons, Lisp_Cons, ptr); -#endif /* not NEW_GC */ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (cons, cons, Lisp_Cons, ptr); } /* explicitly free a list. You **must make sure** that you have @@ -3885,11 +4830,8 @@ void free_key_data (Lisp_Object ptr) { -#ifdef NEW_GC - free_lrecord (ptr); -#else /* not NEW_GC */ - FREE_FIXED_TYPE_WHEN_NOT_IN_GC (key_data, Lisp_Key_Data, XKEY_DATA (ptr)); -#endif /* not NEW_GC */ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, key_data, Lisp_Key_Data, + XKEY_DATA (ptr)); } #ifndef NEW_GC @@ -3906,11 +4848,8 @@ void free_button_data (Lisp_Object ptr) { -#ifdef NEW_GC - free_lrecord (ptr); -#else /* not NEW_GC */ - FREE_FIXED_TYPE_WHEN_NOT_IN_GC (button_data, Lisp_Button_Data, XBUTTON_DATA (ptr)); -#endif /* not NEW_GC */ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, button_data, Lisp_Button_Data, + XBUTTON_DATA (ptr)); } #ifndef NEW_GC @@ -3927,11 +4866,8 @@ void free_motion_data (Lisp_Object ptr) { -#ifdef NEW_GC - free_lrecord (ptr); -#else /* not NEW_GC */ - FREE_FIXED_TYPE_WHEN_NOT_IN_GC (motion_data, Lisp_Motion_Data, XMOTION_DATA (ptr)); -#endif /* not NEW_GC */ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, motion_data, Lisp_Motion_Data, + XMOTION_DATA (ptr)); } #ifndef NEW_GC @@ -3948,11 +4884,8 @@ void free_process_data (Lisp_Object ptr) { -#ifdef NEW_GC - free_lrecord (ptr); -#else /* not NEW_GC */ - FREE_FIXED_TYPE_WHEN_NOT_IN_GC (process_data, Lisp_Process_Data, XPROCESS_DATA (ptr)); -#endif /* not NEW_GC */ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, process_data, Lisp_Process_Data, + XPROCESS_DATA (ptr)); } #ifndef NEW_GC @@ -3969,11 +4902,8 @@ void free_timeout_data (Lisp_Object ptr) { -#ifdef NEW_GC - free_lrecord (ptr); -#else /* not NEW_GC */ - FREE_FIXED_TYPE_WHEN_NOT_IN_GC (timeout_data, Lisp_Timeout_Data, XTIMEOUT_DATA (ptr)); -#endif /* not NEW_GC */ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, timeout_data, Lisp_Timeout_Data, + XTIMEOUT_DATA (ptr)); } #ifndef NEW_GC @@ -3990,11 +4920,8 @@ void free_magic_data (Lisp_Object ptr) { -#ifdef NEW_GC - free_lrecord (ptr); -#else /* not NEW_GC */ - FREE_FIXED_TYPE_WHEN_NOT_IN_GC (magic_data, Lisp_Magic_Data, XMAGIC_DATA (ptr)); -#endif /* not NEW_GC */ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, magic_data, Lisp_Magic_Data, + XMAGIC_DATA (ptr)); } #ifndef NEW_GC @@ -4011,11 +4938,8 @@ void free_magic_eval_data (Lisp_Object ptr) { -#ifdef NEW_GC - free_lrecord (ptr); -#else /* not NEW_GC */ - FREE_FIXED_TYPE_WHEN_NOT_IN_GC (magic_eval_data, Lisp_Magic_Eval_Data, XMAGIC_EVAL_DATA (ptr)); -#endif /* not NEW_GC */ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, magic_eval_data, Lisp_Magic_Eval_Data, + XMAGIC_EVAL_DATA (ptr)); } #ifndef NEW_GC @@ -4032,11 +4956,8 @@ void free_eval_data (Lisp_Object ptr) { -#ifdef NEW_GC - free_lrecord (ptr); -#else /* not NEW_GC */ - FREE_FIXED_TYPE_WHEN_NOT_IN_GC (eval_data, Lisp_Eval_Data, XEVAL_DATA (ptr)); -#endif /* not NEW_GC */ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, eval_data, Lisp_Eval_Data, + XEVAL_DATA (ptr)); } #ifndef NEW_GC @@ -4053,11 +4974,8 @@ void free_misc_user_data (Lisp_Object ptr) { -#ifdef NEW_GC - free_lrecord (ptr); -#else /* not NEW_GC */ - FREE_FIXED_TYPE_WHEN_NOT_IN_GC (misc_user_data, Lisp_Misc_User_Data, XMISC_USER_DATA (ptr)); -#endif /* not NEW_GC */ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, misc_user_data, Lisp_Misc_User_Data, + XMISC_USER_DATA (ptr)); } #endif /* EVENT_DATA_AS_OBJECTS */ @@ -4081,11 +4999,7 @@ void free_marker (Lisp_Object ptr) { -#ifdef NEW_GC - free_lrecord (ptr); -#else /* not NEW_GC */ - FREE_FIXED_TYPE_WHEN_NOT_IN_GC (marker, Lisp_Marker, XMARKER (ptr)); -#endif /* not NEW_GC */ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, marker, Lisp_Marker, XMARKER (ptr)); } @@ -4267,34 +5181,22 @@ static void sweep_strings (void) { - int num_small_used = 0; - Bytecount num_small_bytes = 0, num_bytes = 0; int debug = debug_string_purity; #define UNMARK_string(ptr) do { \ Lisp_String *p = (ptr); \ - Bytecount size = p->size_; \ UNMARK_RECORD_HEADER (&(p->u.lheader)); \ - num_bytes += size; \ - if (!BIG_STRING_SIZE_P (size)) \ - { \ - num_small_bytes += size; \ - num_small_used++; \ - } \ + tick_string_stats (p, 1); \ if (debug) \ debug_string_purity_print (wrap_string (p)); \ } while (0) #define ADDITIONAL_FREE_string(ptr) do { \ Bytecount size = ptr->size_; \ if (BIG_STRING_SIZE_P (size)) \ - xfree (ptr->data_); \ + xfree (ptr->data_); \ } while (0) SWEEP_FIXED_TYPE_BLOCK_1 (string, Lisp_String, u.lheader); - - gc_count_num_short_string_in_use = num_small_used; - gc_count_string_total_size = num_bytes; - gc_count_short_string_total_size = num_small_bytes; } #endif /* not NEW_GC */ @@ -4302,6 +5204,10 @@ void gc_sweep_1 (void) { + /* Reset all statistics to 0. They will be incremented when + sweeping lcrecords, frob-block lrecords and dumped objects. */ + clear_lrecord_stats (); + /* Free all unmarked records. Do this at the very beginning, before anything else, so that the finalize methods can safely examine items in the objects. sweep_lcrecords_1() makes @@ -4376,16 +5282,42 @@ sweep_eval_data (); sweep_misc_user_data (); #endif /* EVENT_DATA_AS_OBJECTS */ -#endif /* not NEW_GC */ - -#ifndef NEW_GC + #ifdef PDUMP pdump_objects_unmark (); #endif } #endif /* not NEW_GC */ + -/* Clearing for disksave. */ +/************************************************************************/ +/* "Disksave Finalization" -- Preparing for Dumping */ +/************************************************************************/ + +static void +disksave_object_finalization_1 (void) +{ +#ifdef NEW_GC + mc_finalize_for_disksave (); +#else /* not NEW_GC */ + struct old_lcrecord_header *header; + + for (header = all_lcrecords; header; header = header->next) + { + struct lrecord_header *objh = &header->lheader; + const struct lrecord_implementation *imp = LHEADER_IMPLEMENTATION (objh); +#if 0 /* possibly useful for debugging */ + if (!RECORD_DUMPABLE (objh) && !objh->free) + { + stderr_out ("Disksaving a non-dumpable object: "); + debug_print (wrap_pointer_1 (header)); + } +#endif + if (imp->disksave && !objh->free) + (imp->disksave) (wrap_pointer_1 (header)); + } +#endif /* not NEW_GC */ +} void disksave_object_finalization (void) @@ -4453,180 +5385,10 @@ } -#ifdef ALLOC_TYPE_STATS - -static Lisp_Object -gc_plist_hack (const Ascbyte *name, EMACS_INT value, Lisp_Object tail) -{ - /* C doesn't have local functions (or closures, or GC, or readable syntax, - or portable numeric datatypes, or bit-vectors, or characters, or - arrays, or exceptions, or ...) */ - return cons3 (intern (name), make_int (value), tail); -} - -static Lisp_Object -object_memory_usage_stats (int set_total_gc_usage) -{ - Lisp_Object pl = Qnil; - int i; - EMACS_INT tgu_val = 0; - -#ifdef NEW_GC - - for (i = 0; i < countof (lrecord_implementations_table); i++) - { - if (lrecord_stats[i].instances_in_use != 0) - { - Ascbyte buf[255]; - const Ascbyte *name = lrecord_implementations_table[i]->name; - int len = strlen (name); - - if (lrecord_stats[i].bytes_in_use_including_overhead != - lrecord_stats[i].bytes_in_use) - { - sprintf (buf, "%s-storage-including-overhead", name); - pl = gc_plist_hack (buf, - lrecord_stats[i] - .bytes_in_use_including_overhead, - pl); - } - - sprintf (buf, "%s-storage", name); - pl = gc_plist_hack (buf, - lrecord_stats[i].bytes_in_use, - pl); - tgu_val += lrecord_stats[i].bytes_in_use_including_overhead; - - if (name[len-1] == 's') - sprintf (buf, "%ses-used", name); - else - sprintf (buf, "%ss-used", name); - pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl); - } - } - -#else /* not NEW_GC */ - -#define HACK_O_MATIC(type, name, pl) do { \ - EMACS_INT s = 0; \ - struct type##_block *x = current_##type##_block; \ - while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; } \ - tgu_val += s; \ - (pl) = gc_plist_hack ((name), s, (pl)); \ -} while (0) - - for (i = 0; i < lrecord_type_count; i++) - { - if (lcrecord_stats[i].bytes_in_use != 0 - || lcrecord_stats[i].bytes_freed != 0 - || lcrecord_stats[i].instances_on_free_list != 0) - { - Ascbyte buf[255]; - const Ascbyte *name = lrecord_implementations_table[i]->name; - int len = strlen (name); - - sprintf (buf, "%s-storage", name); - pl = gc_plist_hack (buf, lcrecord_stats[i].bytes_in_use, pl); - tgu_val += lcrecord_stats[i].bytes_in_use; - /* Okay, simple pluralization check for `symbol-value-varalias' */ - if (name[len-1] == 's') - sprintf (buf, "%ses-freed", name); - else - sprintf (buf, "%ss-freed", name); - if (lcrecord_stats[i].instances_freed != 0) - pl = gc_plist_hack (buf, lcrecord_stats[i].instances_freed, pl); - if (name[len-1] == 's') - sprintf (buf, "%ses-on-free-list", name); - else - sprintf (buf, "%ss-on-free-list", name); - if (lcrecord_stats[i].instances_on_free_list != 0) - pl = gc_plist_hack (buf, lcrecord_stats[i].instances_on_free_list, - pl); - if (name[len-1] == 's') - sprintf (buf, "%ses-used", name); - else - sprintf (buf, "%ss-used", name); - pl = gc_plist_hack (buf, lcrecord_stats[i].instances_in_use, pl); - } - } - - HACK_O_MATIC (extent, "extent-storage", pl); - pl = gc_plist_hack ("extents-free", gc_count_num_extent_freelist, pl); - pl = gc_plist_hack ("extents-used", gc_count_num_extent_in_use, pl); - HACK_O_MATIC (event, "event-storage", pl); - pl = gc_plist_hack ("events-free", gc_count_num_event_freelist, pl); - pl = gc_plist_hack ("events-used", gc_count_num_event_in_use, pl); - HACK_O_MATIC (marker, "marker-storage", pl); - pl = gc_plist_hack ("markers-free", gc_count_num_marker_freelist, pl); - pl = gc_plist_hack ("markers-used", gc_count_num_marker_in_use, pl); - HACK_O_MATIC (float, "float-storage", pl); - pl = gc_plist_hack ("floats-free", gc_count_num_float_freelist, pl); - pl = gc_plist_hack ("floats-used", gc_count_num_float_in_use, pl); -#ifdef HAVE_BIGNUM - HACK_O_MATIC (bignum, "bignum-storage", pl); - pl = gc_plist_hack ("bignums-free", gc_count_num_bignum_freelist, pl); - pl = gc_plist_hack ("bignums-used", gc_count_num_bignum_in_use, pl); -#endif /* HAVE_BIGNUM */ -#ifdef HAVE_RATIO - HACK_O_MATIC (ratio, "ratio-storage", pl); - pl = gc_plist_hack ("ratios-free", gc_count_num_ratio_freelist, pl); - pl = gc_plist_hack ("ratios-used", gc_count_num_ratio_in_use, pl); -#endif /* HAVE_RATIO */ -#ifdef HAVE_BIGFLOAT - HACK_O_MATIC (bigfloat, "bigfloat-storage", pl); - pl = gc_plist_hack ("bigfloats-free", gc_count_num_bigfloat_freelist, pl); - pl = gc_plist_hack ("bigfloats-used", gc_count_num_bigfloat_in_use, pl); -#endif /* HAVE_BIGFLOAT */ - HACK_O_MATIC (string, "string-header-storage", pl); - pl = gc_plist_hack ("long-strings-total-length", - gc_count_string_total_size - - gc_count_short_string_total_size, pl); - HACK_O_MATIC (string_chars, "short-string-storage", pl); - pl = gc_plist_hack ("short-strings-total-length", - gc_count_short_string_total_size, pl); - pl = gc_plist_hack ("strings-free", gc_count_num_string_freelist, pl); - pl = gc_plist_hack ("long-strings-used", - gc_count_num_string_in_use - - gc_count_num_short_string_in_use, pl); - pl = gc_plist_hack ("short-strings-used", - gc_count_num_short_string_in_use, pl); - - HACK_O_MATIC (compiled_function, "compiled-function-storage", pl); - pl = gc_plist_hack ("compiled-functions-free", - gc_count_num_compiled_function_freelist, pl); - pl = gc_plist_hack ("compiled-functions-used", - gc_count_num_compiled_function_in_use, pl); - - HACK_O_MATIC (symbol, "symbol-storage", pl); - pl = gc_plist_hack ("symbols-free", gc_count_num_symbol_freelist, pl); - pl = gc_plist_hack ("symbols-used", gc_count_num_symbol_in_use, pl); - - HACK_O_MATIC (cons, "cons-storage", pl); - pl = gc_plist_hack ("conses-free", gc_count_num_cons_freelist, pl); - pl = gc_plist_hack ("conses-used", gc_count_num_cons_in_use, pl); - -#undef HACK_O_MATIC - -#endif /* NEW_GC */ - - if (set_total_gc_usage) - { - total_gc_usage = tgu_val; - total_gc_usage_set = 1; - } - - return pl; -} - -DEFUN("object-memory-usage-stats", Fobject_memory_usage_stats, 0, 0 ,"", /* -Return statistics about memory usage of Lisp objects. -*/ - ()) -{ - return object_memory_usage_stats (0); -} - -#endif /* ALLOC_TYPE_STATS */ + +/************************************************************************/ +/* Lisp interface onto garbage collection */ +/************************************************************************/ /* Debugging aids. */ @@ -4654,40 +5416,10 @@ call to object_memory_usage_stats() -- if ALLOC_TYPE_STATS is enabled. */ total_gc_usage_set = 0; #ifdef ALLOC_TYPE_STATS - /* The things we do for backwards-compatibility */ -#ifdef NEW_GC - return - list6 - (Fcons (make_int (lrecord_stats[lrecord_type_cons].instances_in_use), - make_int (lrecord_stats[lrecord_type_cons] - .bytes_in_use_including_overhead)), - Fcons (make_int (lrecord_stats[lrecord_type_symbol].instances_in_use), - make_int (lrecord_stats[lrecord_type_symbol] - .bytes_in_use_including_overhead)), - Fcons (make_int (lrecord_stats[lrecord_type_marker].instances_in_use), - make_int (lrecord_stats[lrecord_type_marker] - .bytes_in_use_including_overhead)), - make_int (lrecord_stats[lrecord_type_string] - .bytes_in_use_including_overhead), - make_int (lrecord_stats[lrecord_type_vector] - .bytes_in_use_including_overhead), - object_memory_usage_stats (1)); -#else /* not NEW_GC */ - return - list6 (Fcons (make_int (gc_count_num_cons_in_use), - make_int (gc_count_num_cons_freelist)), - Fcons (make_int (gc_count_num_symbol_in_use), - make_int (gc_count_num_symbol_freelist)), - Fcons (make_int (gc_count_num_marker_in_use), - make_int (gc_count_num_marker_freelist)), - make_int (gc_count_string_total_size), - make_int (lcrecord_stats[lrecord_type_vector].bytes_in_use + - lcrecord_stats[lrecord_type_vector].bytes_freed), - object_memory_usage_stats (1)); -#endif /* not NEW_GC */ -#else /* not ALLOC_TYPE_STATS */ + return garbage_collection_statistics (); +#else return Qnil; -#endif /* ALLOC_TYPE_STATS */ +#endif } DEFUN ("consing-since-gc", Fconsing_since_gc, 0, 0, "", /* @@ -4726,18 +5458,6 @@ return make_int (total_data_usage ()); } -#ifdef ALLOC_TYPE_STATS -DEFUN ("object-memory-usage", Fobject_memory_usage, 0, 0, 0, /* -Return total number of bytes used for object storage in XEmacs. -This may be helpful in debugging XEmacs's memory usage. -See also `consing-since-gc' and `object-memory-usage-stats'. -*/ - ()) -{ - return make_int (total_gc_usage + consing_since_gc); -} -#endif /* ALLOC_TYPE_STATS */ - #ifdef USE_VALGRIND DEFUN ("valgrind-leak-check", Fvalgrind_leak_check, 0, 0, "", /* Ask valgrind to perform a memory leak check. @@ -4761,141 +5481,11 @@ } #endif /* USE_VALGRIND */ -void -recompute_funcall_allocation_flag (void) -{ - funcall_allocation_flag = - need_to_garbage_collect || - need_to_check_c_alloca || - need_to_signal_post_gc; -} - -int -object_dead_p (Lisp_Object obj) -{ - return ((BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj))) || - (FRAMEP (obj) && !FRAME_LIVE_P (XFRAME (obj))) || - (WINDOWP (obj) && !WINDOW_LIVE_P (XWINDOW (obj))) || - (DEVICEP (obj) && !DEVICE_LIVE_P (XDEVICE (obj))) || - (CONSOLEP (obj) && !CONSOLE_LIVE_P (XCONSOLE (obj))) || - (EVENTP (obj) && !EVENT_LIVE_P (XEVENT (obj))) || - (EXTENTP (obj) && !EXTENT_LIVE_P (XEXTENT (obj)))); -} - -#ifdef MEMORY_USAGE_STATS - -/* Attempt to determine the actual amount of space that is used for - the block allocated starting at PTR, supposedly of size "CLAIMED_SIZE". - - It seems that the following holds: - - 1. When using the old allocator (malloc.c): - - -- blocks are always allocated in chunks of powers of two. For - each block, there is an overhead of 8 bytes if rcheck is not - defined, 20 bytes if it is defined. In other words, a - one-byte allocation needs 8 bytes of overhead for a total of - 9 bytes, and needs to have 16 bytes of memory chunked out for - it. - - 2. When using the new allocator (gmalloc.c): - - -- blocks are always allocated in chunks of powers of two up - to 4096 bytes. Larger blocks are allocated in chunks of - an integral multiple of 4096 bytes. The minimum block - size is 2*sizeof (void *), or 16 bytes if SUNOS_LOCALTIME_BUG - is defined. There is no per-block overhead, but there - is an overhead of 3*sizeof (size_t) for each 4096 bytes - allocated. - - 3. When using the system malloc, anything goes, but they are - generally slower and more space-efficient than the GNU - allocators. One possibly reasonable assumption to make - for want of better data is that sizeof (void *), or maybe - 2 * sizeof (void *), is required as overhead and that - blocks are allocated in the minimum required size except - that some minimum block size is imposed (e.g. 16 bytes). */ - -Bytecount -malloced_storage_size (void *UNUSED (ptr), Bytecount claimed_size, - struct overhead_stats *stats) -{ - Bytecount orig_claimed_size = claimed_size; - -#ifndef SYSTEM_MALLOC - if (claimed_size < (Bytecount) (2 * sizeof (void *))) - claimed_size = 2 * sizeof (void *); -# ifdef SUNOS_LOCALTIME_BUG - if (claimed_size < 16) - claimed_size = 16; -# endif - if (claimed_size < 4096) - { - /* fxg: rename log->log2 to supress gcc3 shadow warning */ - int log2 = 1; - - /* compute the log base two, more or less, then use it to compute - the block size needed. */ - claimed_size--; - /* It's big, it's heavy, it's wood! */ - while ((claimed_size /= 2) != 0) - ++log2; - claimed_size = 1; - /* It's better than bad, it's good! */ - while (log2 > 0) - { - claimed_size *= 2; - log2--; - } - /* We have to come up with some average about the amount of - blocks used. */ - if ((Bytecount) (rand () & 4095) < claimed_size) - claimed_size += 3 * sizeof (void *); - } - else - { - claimed_size += 4095; - claimed_size &= ~4095; - claimed_size += (claimed_size / 4096) * 3 * sizeof (size_t); - } - -#else - - if (claimed_size < 16) - claimed_size = 16; - claimed_size += 2 * sizeof (void *); - -#endif /* system allocator */ - - if (stats) - { - stats->was_requested += orig_claimed_size; - stats->malloc_overhead += claimed_size - orig_claimed_size; - } - return claimed_size; -} - -#ifndef NEW_GC -Bytecount -fixed_type_block_overhead (Bytecount size) -{ - Bytecount per_block = TYPE_ALLOC_SIZE (cons, unsigned char); - Bytecount overhead = 0; - Bytecount storage_size = malloced_storage_size (0, per_block, 0); - while (size >= per_block) - { - size -= per_block; - overhead += sizeof (void *) + per_block - storage_size; - } - if (rand () % per_block < size) - overhead += sizeof (void *) + per_block - storage_size; - return overhead; -} -#endif /* not NEW_GC */ -#endif /* MEMORY_USAGE_STATS */ - - +/************************************************************************/ +/* Initialization */ +/************************************************************************/ + /* Initialization */ static void common_init_alloc_early (void) @@ -4925,6 +5515,7 @@ #ifndef NEW_GC init_string_chars_alloc (); init_string_alloc (); + /* #### Is it intentional that this is called twice? --ben */ init_string_chars_alloc (); init_cons_alloc (); init_symbol_alloc (); @@ -4986,7 +5577,6 @@ funcall_allocation_flag = 0; funcall_alloca_count = 0; - lrecord_uid_counter = 259; #ifndef NEW_GC debug_string_purity = 0; #endif /* not NEW_GC */ @@ -5034,6 +5624,15 @@ #endif /* defined (__cplusplus) && defined (ERROR_CHECK_GC) */ } +static void +reinit_alloc_objects_early (void) +{ + OBJECT_HAS_METHOD (string, getprop); + OBJECT_HAS_METHOD (string, putprop); + OBJECT_HAS_METHOD (string, remprop); + OBJECT_HAS_METHOD (string, plist); +} + void reinit_alloc_early (void) { @@ -5041,6 +5640,7 @@ #ifndef NEW_GC init_lcrecord_lists (); #endif /* not NEW_GC */ + reinit_alloc_objects_early (); } void @@ -5054,17 +5654,7 @@ lrecord_implementations_table[i] = 0; } - INIT_LRECORD_IMPLEMENTATION (cons); - INIT_LRECORD_IMPLEMENTATION (vector); - INIT_LRECORD_IMPLEMENTATION (string); -#ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (string_indirect_data); - INIT_LRECORD_IMPLEMENTATION (string_direct_data); -#endif /* NEW_GC */ -#ifndef NEW_GC - INIT_LRECORD_IMPLEMENTATION (lcrecord_list); - INIT_LRECORD_IMPLEMENTATION (free); -#endif /* not NEW_GC */ + dump_add_opaque (lrecord_uid_counter, sizeof (lrecord_uid_counter)); staticpros = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *); Dynarr_resize (staticpros, 1410); /* merely a small optimization */ @@ -5089,6 +5679,21 @@ #else /* not NEW_GC */ init_lcrecord_lists (); #endif /* not NEW_GC */ + + INIT_LISP_OBJECT (cons); + INIT_LISP_OBJECT (vector); + INIT_LISP_OBJECT (string); + +#ifdef NEW_GC + INIT_LISP_OBJECT (string_indirect_data); + INIT_LISP_OBJECT (string_direct_data); +#endif /* NEW_GC */ +#ifndef NEW_GC + INIT_LISP_OBJECT (lcrecord_list); + INIT_LISP_OBJECT (free); +#endif /* not NEW_GC */ + + reinit_alloc_objects_early (); } void @@ -5096,8 +5701,18 @@ { DEFSYMBOL (Qgarbage_collecting); +#ifdef MEMORY_USAGE_STATS + DEFSYMBOL (Qobject_actually_requested); + DEFSYMBOL (Qobject_malloc_overhead); + DEFSYMBOL (Qother_memory_actually_requested); + DEFSYMBOL (Qother_memory_malloc_overhead); + DEFSYMBOL (Qother_memory_dynarr_overhead); + DEFSYMBOL (Qother_memory_gap_overhead); +#endif /* MEMORY_USAGE_STATS */ + DEFSUBR (Fcons); DEFSUBR (Flist); + DEFSUBR (Facons); DEFSUBR (Fvector); DEFSUBR (Fbit_vector); DEFSUBR (Fmake_byte_code); @@ -5108,11 +5723,13 @@ DEFSUBR (Fstring); DEFSUBR (Fmake_symbol); DEFSUBR (Fmake_marker); - DEFSUBR (Fpurecopy); #ifdef ALLOC_TYPE_STATS DEFSUBR (Fobject_memory_usage_stats); + DEFSUBR (Ftotal_object_memory_usage); +#endif /* ALLOC_TYPE_STATS */ +#ifdef MEMORY_USAGE_STATS DEFSUBR (Fobject_memory_usage); -#endif /* ALLOC_TYPE_STATS */ +#endif /* MEMORY_USAGE_STATS */ DEFSUBR (Fgarbage_collect); #if 0 DEFSUBR (Fmemory_limit); @@ -5126,8 +5743,44 @@ } void +reinit_vars_of_alloc (void) +{ +#ifdef MEMORY_USAGE_STATS + compute_memusage_stats_length (); +#endif /* MEMORY_USAGE_STATS */ +} + +void vars_of_alloc (void) { + DEFVAR_CONST_INT ("array-rank-limit", &Varray_rank_limit /* +The exclusive upper bound on the number of dimensions an array may have. + +XEmacs does not support multidimensional arrays, meaning this constant is, +for the moment, 2. +*/); + Varray_rank_limit = 2; + + DEFVAR_CONST_INT ("array-dimension-limit", &Varray_dimension_limit /* +The exclusive upper bound of an array's dimension. +Note that XEmacs may not have enough memory available to create an array +with this dimension. +*/); + Varray_dimension_limit = ARRAY_DIMENSION_LIMIT; + + DEFVAR_CONST_INT ("array-total-size-limit", &Varray_total_size_limit /* +The exclusive upper bound on the number of elements an array may contain. + +In Common Lisp, this is distinct from `array-dimension-limit', because +arrays can have more than one dimension. In XEmacs this is not the case, +and multi-dimensional arrays need to be implemented by the user with arrays +of arrays. + +Note that XEmacs may not have enough memory available to create an array +with this dimension. +*/); + Varray_total_size_limit = ARRAY_DIMENSION_LIMIT; + #ifdef DEBUG_XEMACS DEFVAR_INT ("debug-allocation", &debug_allocation /* If non-zero, print out information to stderr about all objects allocated. diff -r 861f2601a38b -r 1f0b15040456 src/alloca.c --- a/src/alloca.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/alloca.c Sun May 01 18:44:03 2011 +0100 @@ -78,7 +78,7 @@ find_stack_direction (void) { static char *addr = NULL; /* Address of first `dummy', once known. */ - auto char dummy; /* To get stack address. */ + char dummy; /* To get stack address. */ if (addr == NULL) { /* Initial entry. */ @@ -131,7 +131,7 @@ pointer xemacs_c_alloca (unsigned int size) { - auto char probe; /* Probes stack depth: */ + char probe; /* Probes stack depth: */ register char *depth = ADDRESS_FUNCTION (probe); #if STACK_DIRECTION == 0 @@ -338,8 +338,7 @@ /* There must be at least one stack segment. Therefore it is a fatal error if "trailer" is null. */ - if (trailer == 0) - ABORT (); + assert (trailer != 0); /* Discard segments that do not contain our argument address. */ @@ -366,8 +365,7 @@ do { - if (trailer->this_size <= 0) - ABORT (); + assert (trailer->this_size > 0); result += trailer->this_size; trailer = (struct stk_trailer *) trailer->link; } diff -r 861f2601a38b -r 1f0b15040456 src/alloca.s --- a/src/alloca.s Sat Feb 20 06:03:00 2010 -0600 +++ b/src/alloca.s Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ diff -r 861f2601a38b -r 1f0b15040456 src/alsaplay.c --- a/src/alsaplay.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/alsaplay.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/array.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/array.c Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,1007 @@ +/* Support for dynarrs and other types of dynamic arrays. + Copyright (c) 1994, 1995 Free Software Foundation, Inc. + Copyright (c) 1993, 1995 Sun Microsystems, Inc. + Copyright (c) 1995, 1996, 2000, 2002, 2003, 2004, 2005, 2010 Ben Wing. + +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 3 of the License, 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. If not, see . */ + +/* Synched up with: Not in FSF. */ + +/* Written by Ben Wing, December 1993. */ + +#include +#include "lisp.h" + +#include "insdel.h" + + +/*****************************************************************************/ +/* "dynarr" a.k.a. dynamic array */ +/*****************************************************************************/ + +/* +A "dynamic array" or "dynarr" is a contiguous array of fixed-size elements +where there is no upper limit (except available memory) on the number of +elements in the array. Because the elements are maintained contiguously, +space is used efficiently (no per-element pointers necessary) and random +access to a particular element is in constant time. At any one point, the +block of memory that holds the array has an upper limit; if this limit is +exceeded, the memory is realloc()ed into a new array that is twice as big. +Assuming that the time to grow the array is on the order of the new size of +the array block, this scheme has a provably constant amortized time +\(i.e. average time over all additions). + +When you add elements or retrieve elements, pointers are used. Note that +the element itself (of whatever size it is), and not the pointer to it, +is stored in the array; thus you do not have to allocate any heap memory +on your own. Also, returned pointers are only guaranteed to be valid +until the next operation that changes the length of the array. + +This is a container object. Declare a dynamic array of a specific type +as follows: + + typedef struct + { + Dynarr_declare (mytype); + } mytype_dynarr; + +Use the following functions/macros: + + + ************* Dynarr creation ************* + + void *Dynarr_new(type) + [MACRO] Create a new dynamic-array object, with each element of the + specified type. The return value is cast to (type##_dynarr). + This requires following the convention that types are declared in + such a way that this type concatenation works. In particular, TYPE + must be a symbol, not an arbitrary C type. To make dynarrs of + complex types, a typedef must be declared, e.g. + + typedef unsigned char *unsigned_char_ptr; + + and then you can say + + unsigned_char_ptr_dynarr *dyn = Dynarr_new (unsigned_char_ptr); + + void *Dynarr_new2(dynarr_type, type) + [MACRO] Create a new dynamic-array object, with each element of the + specified type. The array itself is of type DYNARR_TYPE. This makes + it possible to create dynarrs over complex types without the need + to create typedefs, as described above. Use is as follows: + + ucharptr_dynarr *dyn = Dynarr_new2 (ucharptr_dynarr *, unsigned char *); + + Dynarr_free(d) + Destroy a dynamic array and the memory allocated to it. + + ************* Dynarr access ************* + + type Dynarr_at(d, i) + [MACRO] Return the element at the specified index. The index must be + between 0 and Dynarr_largest(d), inclusive. With error-checking + enabled, bounds checking on the index is in the form of asserts() -- + an out-of-bounds index causes an abort. The element itself is + returned, not a pointer to it. + + type *Dynarr_atp(d, i) + [MACRO] Return a pointer to the element at the specified index. + Restrictions and bounds checking on the index is as for Dynarr_at. + The pointer may not be valid after an element is added to or + (conceivably) removed from the array, because this may trigger a + realloc() performed on the underlying dynarr storage, which may + involve moving the entire underlying storage to a new location in + memory. + + type *Dynarr_begin(d) + [MACRO] Return a pointer to the first element in the dynarr. See + Dynarr_atp() for warnings about when the pointer might become invalid. + + type *Dynarr_lastp(d) + [MACRO] Return a pointer to the last element in the dynarr. See + Dynarr_atp() for warnings about when the pointer might become invalid. + + type *Dynarr_past_lastp(d) + [MACRO] Return a pointer to the beginning of the element just past the + last one. WARNING: This may not point to valid memory; however, the + byte directly before will be pointer will be valid memory. This macro + might be useful for various reasons, e.g. as a stopping point in a loop + (although Dynarr_lastp() could be used just as well) or as a place to + start writing elements if Dynarr_length() < Dynarr_largest(). + + ************* Dynarr length/size retrieval and setting ************* + + int Dynarr_length(d) + [MACRO] Return the number of elements currently in a dynamic array. + + int Dynarr_largest(d) + [MACRO] Return the maximum value that Dynarr_length(d) would + ever have returned. This is used esp. in the redisplay code, + which reuses dynarrs for performance reasons. + + int Dynarr_max(d) + [MACRO] Return the maximum number of elements that can fit in the + dynarr before it needs to be resized. + + Note that Dynarr_length(d) <= Dynarr_largest(d) <= Dynarr_max(d). + + Bytecount Dynarr_sizeof(d) + [MACRO] Return the total size of the elements currently in dynarr + D. This + + Dynarr_set_lengthr(d, len) + [MACRO] Set the length of D to LEN, which must be between 0 and + Dynarr_largest(d), inclusive. With error-checking enabled, an + assertion failure will result from trying to set the length + to less than zero or greater than Dynarr_largest(d). The + restriction to Dynarr_largest() is to ensure that + + Dynarr_set_length(d, len) + [MACRO] Set the length of D to LEN, resizing the dynarr as + necessary to make sure enough space is available. there are no + restrictions on LEN other than available memory and that it must + be at least 0. Note that + + Dynarr_set_length_and_zero(d, len) + [MACRO] Like Dynarr_set_length(d, len) but also, if increasing + the length, zero out the memory between the old and new lengths, + i.e. starting just past the previous last element and up through + the new last element. + + Dynarr_incrementr(d) + [MACRO] Increments the length of D by 1. Equivalent to + Dynarr_set_lengthr(d, Dynarr_length(d) + 1). + + Dynarr_increment(d) + [MACRO] Increments the length of D by 1. Equivalent to + Dynarr_set_length(d, Dynarr_length(d) + 1). + + Dynarr_reset(d) + [MACRO] Reset the length of a dynamic array to 0. + + Dynarr_resize(d, maxval) + Resize the internal dynarr storage to so that it can hold at least + MAXVAL elements. Resizing is done using a geometric series + (repeatedly multiply the old maximum by a constant, normally 1.5, + till a large enough size is reached), so this will be efficient + even if resizing larger by one element at a time. This is mostly + an internal function. + + + + ************* Adding/deleting elements to/from a dynarr ************* + + Dynarr_add(d, el) + [MACRO] Add an element to the end of a dynamic array. EL is a pointer + to the element; the element itself is stored in the array, however. + No function call is performed unless the array needs to be resized. + + Dynarr_add_many(d, base, len) + [MACRO] Add LEN elements to the end of the dynamic array. The elements + should be contiguous in memory, starting at BASE. If BASE if NULL, + just make space for the elements; don't actually add them. + + Dynarr_prepend_many(d, base, len) + [MACRO] Prepend LEN elements to the beginning of the dynamic array. + The elements should be contiguous in memory, starting at BASE. + If BASE if NULL, just make space for the elements; don't actually + add them. + + Dynarr_insert_many(d, base, len, pos) + Insert LEN elements to the dynamic array starting at position + POS. The elements should be contiguous in memory, starting at BASE. + If BASE if NULL, just make space for the elements; don't actually + add them. + + type Dynarr_pop(d) + [MACRO] Pop the last element off the dynarr and return it. + + Dynarr_delete(d, i) + [MACRO] Delete an element from the dynamic array at position I. + + Dynarr_delete_many(d, pos, len) + Delete LEN elements from the dynamic array starting at position + POS. + + Dynarr_zero_many(d, pos, len) + Zero out LEN elements in the dynarr D starting at position POS. + + Dynarr_delete_by_pointer(d, p) + [MACRO] Delete an element from the dynamic array at pointer P, + which must point within the block of memory that stores the data. + P should be obtained using Dynarr_atp(). + + ************* Dynarr locking ************* + + Dynarr_lock(d) + Lock the dynarr against further locking or writing. With error-checking + enabled, any attempts to write into a locked dynarr or re-lock an + already locked one will cause an assertion failure and abort. + + Dynarr_unlock(d) + Unlock a locked dynarr, allowing writing into it. + + ************* Dynarr global variables ************* + + Dynarr_min_size + Minimum allowable size for a dynamic array when it is resized. + +*/ + +static const struct memory_description const_Ascbyte_ptr_description_1[] = { + { XD_ASCII_STRING, 0 }, + { XD_END } +}; + +const struct sized_memory_description const_Ascbyte_ptr_description = { + sizeof (const Ascbyte *), + const_Ascbyte_ptr_description_1 +}; + +static const struct memory_description const_Ascbyte_ptr_dynarr_description_1[] = { + XD_DYNARR_DESC (const_Ascbyte_ptr_dynarr, &const_Ascbyte_ptr_description), + { XD_END } +}; + +const struct sized_memory_description const_Ascbyte_ptr_dynarr_description = { + sizeof (const_Ascbyte_ptr_dynarr), + const_Ascbyte_ptr_dynarr_description_1 +}; + + +static Elemcount Dynarr_min_size = 8; + +static void +Dynarr_realloc (Dynarr *dy, Elemcount new_size) +{ + if (DUMPEDP (dy->base)) + { + void *new_base = malloc (new_size * Dynarr_elsize (dy)); + memcpy (new_base, dy->base, + (Dynarr_max (dy) < new_size ? Dynarr_max (dy) : new_size) * + Dynarr_elsize (dy)); + dy->base = new_base; + } + else + dy->base = xrealloc (dy->base, new_size * Dynarr_elsize (dy)); +} + +void * +Dynarr_newf (Bytecount elsize) +{ + Dynarr *d = xnew_and_zero (Dynarr); + d->elsize_ = elsize; + + return d; +} + +#ifdef NEW_GC +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("dynarr", dynarr, + 0, 0, + Dynarr); + +static void +Dynarr_lisp_realloc (Dynarr *dy, Elemcount new_size) +{ + void *new_base = + XPNTR (alloc_sized_lrecord_array (Dynarr_elsize (dy), new_size, + dy->lisp_imp)); + if (dy->base) + memcpy (new_base, dy->base, + (Dynarr_max (dy) < new_size ? Dynarr_max (dy) : new_size) * + Dynarr_elsize (dy)); + dy->base = new_base; +} + +void * +Dynarr_lisp_newf (Bytecount elsize, + const struct lrecord_implementation *dynarr_imp, + const struct lrecord_implementation *imp) +{ + Dynarr *d = (Dynarr *) XPNTR (alloc_sized_lrecord (sizeof (Dynarr), + dynarr_imp)); + d->elsize_ = elsize; + d->lisp_imp = imp; + + return d; +} +#endif /* not NEW_GC */ + +void +Dynarr_resize (void *d, Elemcount size) +{ + Elemcount newsize; + double multiplier; + Dynarr *dy = (Dynarr *) Dynarr_verify (d); + + if (Dynarr_max (dy) <= 8) + multiplier = 2; + else + multiplier = 1.5; + + for (newsize = Dynarr_max (dy); newsize < size;) + newsize = max (Dynarr_min_size, (Elemcount) (multiplier * newsize)); + + /* Don't do anything if the array is already big enough. */ + if (newsize > Dynarr_max (dy)) + { +#ifdef NEW_GC + if (dy->lisp_imp) + Dynarr_lisp_realloc (dy, newsize); + else + Dynarr_realloc (dy, newsize); +#else /* not NEW_GC */ + Dynarr_realloc (dy, newsize); +#endif /* not NEW_GC */ + dy->max_ = newsize; + } +} + +/* Add a number of contiguous elements to the array starting at POS. */ + +void +Dynarr_insert_many (void *d, const void *base, Elemcount len, Elemcount pos) +{ + Dynarr *dy = Dynarr_verify_mod (d); + Elemcount old_len = Dynarr_length (dy); + + /* #### This could conceivably be wrong, if code wants to access stuff + between len and largest. */ + dynarr_checking_assert (pos >= 0 && pos <= old_len); + dynarr_checking_assert (len >= 0); + Dynarr_increase_length (dy, old_len + len); + + if (pos != old_len) + { + memmove ((Rawbyte *) dy->base + (pos + len)*Dynarr_elsize (dy), + (Rawbyte *) dy->base + pos*Dynarr_elsize (dy), + (old_len - pos)*Dynarr_elsize (dy)); + } + /* Some functions call us with a value of 0 to mean "reserve space but + don't write into it" */ + if (base) + memcpy ((Rawbyte *) dy->base + pos*Dynarr_elsize (dy), base, + len*Dynarr_elsize (dy)); +} + +void +Dynarr_delete_many (void *d, Elemcount pos, Elemcount len) +{ + Dynarr *dy = Dynarr_verify_mod (d); + + dynarr_checking_assert (pos >= 0 && len >= 0 && + pos + len <= Dynarr_length (dy)); + + memmove ((Rawbyte *) dy->base + pos*Dynarr_elsize (dy), + (Rawbyte *) dy->base + (pos + len)*Dynarr_elsize (dy), + (Dynarr_length (dy) - pos - len)*Dynarr_elsize (dy)); + + Dynarr_set_length_1 (dy, Dynarr_length (dy) - len); +} + +void +Dynarr_free (void *d) +{ + Dynarr *dy = (Dynarr *) d; + +#ifdef NEW_GC + if (dy->base && !DUMPEDP (dy->base)) + { + if (!dy->lisp_imp) + { + xfree (dy->base); + dy->base = 0; + } + } + if (!DUMPEDP (dy)) + { + if (!dy->lisp_imp) + xfree (dy); + } +#else /* not NEW_GC */ + if (dy->base && !DUMPEDP (dy->base)) + { + xfree (dy->base); + dy->base = 0; + } + if(!DUMPEDP (dy)) + xfree (dy); +#endif /* not NEW_GC */ +} + +#ifdef MEMORY_USAGE_STATS + +/* Return memory usage for dynarr D. The returned value is the total + amount of bytes actually being used for the dynarr, including all + overhead. The extra amount of space in the dynarr that is + allocated beyond what was requested is returned in DYNARR_OVERHEAD + in STATS. The extra amount of space that malloc() allocates beyond + what was requested of it is returned in MALLOC_OVERHEAD in STATS. + See the comment above the definition of this structure. */ + +Bytecount +Dynarr_memory_usage (void *d, struct usage_stats *stats) +{ + Bytecount total = 0; + Dynarr *dy = (Dynarr *) d; + + /* We have to be a bit tricky here because not all of the + memory that malloc() will claim as "requested" was actually + requested. */ + + if (dy->base) + { + Bytecount malloc_used = + malloced_storage_size (dy->base, Dynarr_elsize (dy) * Dynarr_max (dy), + 0); + /* #### This may or may not be correct. Some dynarrs would + prefer that we use dy->len instead of dy->largest here. */ + Bytecount was_requested = Dynarr_elsize (dy) * Dynarr_largest (dy); + Bytecount dynarr_overhead = + Dynarr_elsize (dy) * (Dynarr_max (dy) - Dynarr_largest (dy)); + + total += malloc_used; + stats->was_requested += was_requested; + stats->dynarr_overhead += dynarr_overhead; + /* And the remainder must be malloc overhead. */ + stats->malloc_overhead += + malloc_used - was_requested - dynarr_overhead; + } + + total += malloced_storage_size (d, sizeof (*dy), stats); + + return total; +} + +#endif /* MEMORY_USAGE_STATS */ + + +/*****************************************************************************/ +/* stack-like allocation */ +/*****************************************************************************/ + +/* Version of malloc() that will be extremely efficient when allocation + nearly always occurs in LIFO (stack) order. + + #### Perhaps shouldn't be in this file, but where else? */ + +typedef struct +{ + Dynarr_declare (char_dynarr *); +} char_dynarr_dynarr; + +char_dynarr_dynarr *stack_like_free_list; +char_dynarr_dynarr *stack_like_in_use_list; + +void * +stack_like_malloc (Bytecount size) +{ + char_dynarr *this_one; + if (!stack_like_free_list) + { + stack_like_free_list = Dynarr_new2 (char_dynarr_dynarr, + char_dynarr *); + stack_like_in_use_list = Dynarr_new2 (char_dynarr_dynarr, + char_dynarr *); + } + + if (Dynarr_length (stack_like_free_list) > 0) + this_one = Dynarr_pop (stack_like_free_list); + else + this_one = Dynarr_new (char); + Dynarr_add (stack_like_in_use_list, this_one); + Dynarr_reset (this_one); + Dynarr_add_many (this_one, 0, size); + return Dynarr_begin (this_one); +} + +void +stack_like_free (void *val) +{ + Elemcount len = Dynarr_length (stack_like_in_use_list); + assert (len > 0); + /* The vast majority of times, we will be called in a last-in first-out + order, and the item at the end of the list will be the one we're + looking for, so just check for this first and avoid any function + calls. */ + if (Dynarr_begin (Dynarr_at (stack_like_in_use_list, len - 1)) == val) + { + char_dynarr *this_one = Dynarr_pop (stack_like_in_use_list); + Dynarr_add (stack_like_free_list, this_one); + } + else + { + /* Find the item and delete it. */ + int i; + assert (len >= 2); + for (i = len - 2; i >= 0; i--) + if (Dynarr_begin (Dynarr_at (stack_like_in_use_list, i)) == + val) + { + char_dynarr *this_one = Dynarr_at (stack_like_in_use_list, i); + Dynarr_add (stack_like_free_list, this_one); + Dynarr_delete (stack_like_in_use_list, i); + return; + } + + ABORT (); + } +} + + +/*****************************************************************************/ +/* Generalized gap array */ +/*****************************************************************************/ + +/* A "gap array" is an array that has a "gap" somewhere in the middle of it, + so that insertions and deletions near the gap -- or in general, highly + localized insertions and deletions -- are very fast. Inserting or + deleting works by first moving the gap to the insertion or deletion + position and then shortening or lengthening the gap as necessary. The + idea comes from the gap used in storing text in a buffer. + + The gap array interface differs in a number of ways from dynarrs (#### + and should be changed so that it works the same as dynarrs): + + (1) There aren't separate type-specific gap array types. As a result, + operations like gap_array_at() require that the type be specified as + one of the arguments. It is often more convenient to use a macro + wrapper around this operation. + + (2) The gap array type is itself a stretchy array rather than using a + separate block of memory to store the array. This means that certain + operations (especially insertions) may relocate the the gap array, + and as a result return a pointer to the (possibly) moved gap array, + which must be stored back into the location where the gap array + pointer resides. This also means that the caller must worry about + cloning the gap array in the case where it has been dumped, or you + will get an ABORT() inside of xrealloc(). + + (3) Fewer operations are available than for dynarrs, and may have + different names and/or different calling conventions. + + (4) The mechanism for creating "Lisp-object gap arrays" isn't completely + developed. Currently it's only possible to create a gap-array Lisp + object that wraps Lisp_Object pointers (not Lisp object structures + directly), and only under NEW_GC. + + (5) Gap arrays have a concept of a "gap array marker" that properly + tracks insertions and deletions; no such thing exists in dynarrs. + It exists in gap arrays because it's necessary for their use in + implementing extent lists. + */ + +extern const struct sized_memory_description gap_array_marker_description; + +static const struct memory_description gap_array_marker_description_1[] = { +#ifdef NEW_GC + { XD_LISP_OBJECT, offsetof (Gap_Array_Marker, next) }, +#else /* not NEW_GC */ + { XD_BLOCK_PTR, offsetof (Gap_Array_Marker, next), 1, + { &gap_array_marker_description } }, +#endif /* not NEW_GC */ + { XD_END } +}; + +#ifdef NEW_GC +DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("gap-array-marker", gap_array_marker, + 0, gap_array_marker_description_1, + struct gap_array_marker); +#else /* not NEW_GC */ +const struct sized_memory_description gap_array_marker_description = { + sizeof (Gap_Array_Marker), + gap_array_marker_description_1 +}; +#endif /* not NEW_GC */ + +static const struct memory_description lispobj_gap_array_description_1[] = { + XD_GAP_ARRAY_DESC (&lisp_object_description), + { XD_END } +}; + +#ifdef NEW_GC + +static Bytecount +size_gap_array (Lisp_Object obj) +{ + Gap_Array *ga = XGAP_ARRAY (obj); + return gap_array_byte_size (ga); +} + +DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT ("gap-array", gap_array, + 0, + lispobj_gap_array_description_1, + size_gap_array, + struct gap_array); +#else /* not NEW_GC */ +const struct sized_memory_description lispobj_gap_array_description = { + 0, lispobj_gap_array_description_1 +}; +#endif /* (not) NEW_GC */ + +#ifndef NEW_GC +static Gap_Array_Marker *gap_array_marker_freelist; +#endif /* not NEW_GC */ + +/* This generalizes the "array with a gap" model used to store buffer + characters. This is based on the stuff in insdel.c and should + probably be merged with it. This is not extent-specific and should + perhaps be moved into a separate file. */ + +/* ------------------------------- */ +/* internal functions */ +/* ------------------------------- */ + +/* Adjust the gap array markers in the range (FROM, TO]. Parallel to + adjust_markers() in insdel.c. */ + +static void +gap_array_adjust_markers (Gap_Array *ga, Memxpos from, + Memxpos to, Elemcount amount) +{ + Gap_Array_Marker *m; + + for (m = ga->markers; m; m = m->next) + m->pos = do_marker_adjustment (m->pos, from, to, amount); +} + +static void +gap_array_recompute_derived_values (Gap_Array *ga) +{ + ga->offset_past_gap = ga->elsize * (ga->gap + ga->gapsize); + ga->els_past_gap = ga->numels - ga->gap; +} + +/* Move the gap to array position POS. Parallel to move_gap() in + insdel.c but somewhat simplified. */ + +static void +gap_array_move_gap (Gap_Array *ga, Elemcount pos) +{ + Elemcount gap = ga->gap; + Elemcount gapsize = ga->gapsize; + + if (pos < gap) + { + memmove (GAP_ARRAY_MEMEL_ADDR (ga, pos + gapsize), + GAP_ARRAY_MEMEL_ADDR (ga, pos), + (gap - pos)*ga->elsize); + gap_array_adjust_markers (ga, (Memxpos) pos, (Memxpos) gap, + gapsize); + } + else if (pos > gap) + { + memmove (GAP_ARRAY_MEMEL_ADDR (ga, gap), + GAP_ARRAY_MEMEL_ADDR (ga, gap + gapsize), + (pos - gap)*ga->elsize); + gap_array_adjust_markers (ga, (Memxpos) (gap + gapsize), + (Memxpos) (pos + gapsize), - gapsize); + } + ga->gap = pos; + + gap_array_recompute_derived_values (ga); +} + +/* Make the gap INCREMENT characters longer. Parallel to make_gap() in + insdel.c. The gap array may be moved, so assign the return value back + to the array pointer. */ + +static Gap_Array * +gap_array_make_gap (Gap_Array *ga, Elemcount increment) +{ + Elemcount real_gap_loc; + Elemcount old_gap_size; + + /* If we have to get more space, get enough to last a while. We use + a geometric progression that saves on realloc space. */ + increment += 100 + ga->numels / 8; + +#ifdef NEW_GC + if (ga->is_lisp) + ga = (Gap_Array *) mc_realloc (ga, + offsetof (Gap_Array, array) + + (ga->numels + ga->gapsize + increment) * + ga->elsize); + else +#endif /* not NEW_GC */ + ga = (Gap_Array *) xrealloc (ga, + offsetof (Gap_Array, array) + + (ga->numels + ga->gapsize + increment) * + ga->elsize); + if (ga == 0) + memory_full (); + + real_gap_loc = ga->gap; + old_gap_size = ga->gapsize; + + /* Call the newly allocated space a gap at the end of the whole space. */ + ga->gap = ga->numels + ga->gapsize; + ga->gapsize = increment; + + /* Move the new gap down to be consecutive with the end of the old one. + This adjusts the markers properly too. */ + gap_array_move_gap (ga, real_gap_loc + old_gap_size); + + /* Now combine the two into one large gap. */ + ga->gapsize += old_gap_size; + ga->gap = real_gap_loc; + + gap_array_recompute_derived_values (ga); + + return ga; +} + +/* ------------------------------- */ +/* external functions */ +/* ------------------------------- */ + +Bytecount +gap_array_byte_size (Gap_Array *ga) +{ + return offsetof (Gap_Array, array) + (ga->numels + ga->gapsize) * ga->elsize; +} + +/* Insert NUMELS elements (pointed to by ELPTR) into the specified + gap array at POS. The gap array may be moved, so assign the + return value back to the array pointer. */ + +Gap_Array * +gap_array_insert_els (Gap_Array *ga, Elemcount pos, void *elptr, + Elemcount numels) +{ + assert (pos >= 0 && pos <= ga->numels); + if (ga->gapsize < numels) + ga = gap_array_make_gap (ga, numels - ga->gapsize); + if (pos != ga->gap) + gap_array_move_gap (ga, pos); + + memcpy (GAP_ARRAY_MEMEL_ADDR (ga, ga->gap), (char *) elptr, + numels*ga->elsize); + ga->gapsize -= numels; + ga->gap += numels; + ga->numels += numels; + gap_array_recompute_derived_values (ga); + /* This is the equivalent of insert-before-markers. + + #### Should only happen if marker is "moves forward at insert" type. + */ + + gap_array_adjust_markers (ga, pos - 1, pos, numels); + return ga; +} + +/* Delete NUMELS elements from the specified gap array, starting at FROM. */ + +void +gap_array_delete_els (Gap_Array *ga, Elemcount from, Elemcount numdel) +{ + Elemcount to = from + numdel; + Elemcount gapsize = ga->gapsize; + + assert (from >= 0); + assert (numdel >= 0); + assert (to <= ga->numels); + + /* Make sure the gap is somewhere in or next to what we are deleting. */ + if (to < ga->gap) + gap_array_move_gap (ga, to); + if (from > ga->gap) + gap_array_move_gap (ga, from); + + /* Relocate all markers pointing into the new, larger gap + to point at the end of the text before the gap. */ + gap_array_adjust_markers (ga, to + gapsize, to + gapsize, + - numdel - gapsize); + + ga->gapsize += numdel; + ga->numels -= numdel; + ga->gap = from; + gap_array_recompute_derived_values (ga); +} + +Gap_Array_Marker * +gap_array_make_marker (Gap_Array *ga, Elemcount pos) +{ + Gap_Array_Marker *m; + + assert (pos >= 0 && pos <= ga->numels); +#ifdef NEW_GC + m = XGAP_ARRAY_MARKER (ALLOC_NORMAL_LISP_OBJECT (gap_array_marker)); +#else /* not NEW_GC */ + if (gap_array_marker_freelist) + { + m = gap_array_marker_freelist; + gap_array_marker_freelist = gap_array_marker_freelist->next; + } + else + m = xnew (Gap_Array_Marker); +#endif /* not NEW_GC */ + + m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos); + m->next = ga->markers; + ga->markers = m; + return m; +} + +void +gap_array_delete_marker (Gap_Array *ga, Gap_Array_Marker *m) +{ + Gap_Array_Marker *p, *prev; + + for (prev = 0, p = ga->markers; p && p != m; prev = p, p = p->next) + ; + assert (p); + if (prev) + prev->next = p->next; + else + ga->markers = p->next; +#ifndef NEW_GC + m->next = gap_array_marker_freelist; + m->pos = 0xDEADBEEF; /* -559038737 base 10 */ + gap_array_marker_freelist = m; +#endif /* not NEW_GC */ +} + +#ifndef NEW_GC +void +gap_array_delete_all_markers (Gap_Array *ga) +{ + Gap_Array_Marker *p, *next; + + for (p = ga->markers; p; p = next) + { + next = p->next; + p->next = gap_array_marker_freelist; + p->pos = 0xDEADBEEF; /* -559038737 as an int */ + gap_array_marker_freelist = p; + } +} +#endif /* not NEW_GC */ + +void +gap_array_move_marker (Gap_Array *ga, Gap_Array_Marker *m, Elemcount pos) +{ + assert (pos >= 0 && pos <= ga->numels); + m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos); +} + +Gap_Array * +make_gap_array (Elemcount elsize, int USED_IF_NEW_GC (do_lisp)) +{ + Gap_Array *ga; +#ifdef NEW_GC + /* #### I don't quite understand why it's necessary to make all these + internal objects into Lisp objects under NEW_GC. It's a pain in the + ass to code around this. I'm proceeding on the assumption that it's + not really necessary to do it after all, and so we only make a Lisp- + object gap array when the object being held is a Lisp_Object, i.e. a + pointer to a Lisp object. In the case where instead we hold a `struct + range_table_entry', just blow it off. Otherwise we either need to do + a bunch of painful and/or boring rewriting. --ben */ + if (do_lisp) + { + ga = XGAP_ARRAY (ALLOC_SIZED_LISP_OBJECT (sizeof (Gap_Array), + gap_array)); + ga->is_lisp = 1; + } + else +#endif /* not NEW_GC */ + ga = xnew_and_zero (Gap_Array); + ga->elsize = elsize; + return ga; +} + +Gap_Array * +gap_array_clone (Gap_Array *ga) +{ + Bytecount size = gap_array_byte_size (ga); + Gap_Array *ga2; + Gap_Array_Marker *m; + +#ifdef NEW_GC + if (ga->is_lisp) + { + ga2 = XGAP_ARRAY (ALLOC_SIZED_LISP_OBJECT (size, gap_array)); + copy_lisp_object (wrap_gap_array (ga2), wrap_gap_array (ga)); + } + else +#endif + { + ga2 = (Gap_Array *) xmalloc (size); + memcpy (ga2, ga, size); + } + ga2->markers = NULL; + for (m = ga->markers; m; m = m->next) + gap_array_make_marker (ga2, m->pos); + return ga2; +} + +#ifndef NEW_GC +void +free_gap_array (Gap_Array *ga) +{ + gap_array_delete_all_markers (ga); + xfree (ga); +} +#endif /* not NEW_GC */ + +#ifdef MEMORY_USAGE_STATS + +/* Return memory usage for gap array GA. The returned value is the total + amount of bytes actually being used for the gap array, including all + overhead. The extra amount of space in the gap array that is used + for the gap is counted in GAP_OVERHEAD, not in WAS_REQUESTED. + If NEW_GC, space for gap-array markers is returned through MARKER_ANCILLARY; + otherwise it's added into the gap array usage. */ + +Bytecount +gap_array_memory_usage (Gap_Array *ga, struct usage_stats *stats, + Bytecount *marker_ancillary) +{ + Bytecount total = 0; + + /* We have to be a bit tricky here because not all of the + memory that malloc() will claim as "requested" was actually + requested -- some of it makes up the gap. */ + + Bytecount size = gap_array_byte_size (ga); + Bytecount gap_size = ga->gapsize * ga->elsize; + Bytecount malloc_used = malloced_storage_size (ga, size, 0); + total += malloc_used; + stats->was_requested += size - gap_size; + stats->gap_overhead += gap_size; + stats->malloc_overhead += malloc_used - size; + +#ifdef NEW_GC + { + Bytecount marker_usage = 0; + Gap_Array_Marker *p; + + for (p = ga->markers; p; p = p->next) + marker_usage += lisp_object_memory_usage (wrap_gap_array_marker (p)); + if (marker_ancillary) + *marker_ancillary = marker_usage; + } +#else + { + Gap_Array_Marker *p; + + for (p = ga->markers; p; p = p->next) + total += malloced_storage_size (p, sizeof (p), stats); + if (marker_ancillary) + *marker_ancillary = 0; + } +#endif /* (not) NEW_GC */ + + return total; +} + +#endif /* MEMORY_USAGE_STATS */ + + +/*****************************************************************************/ +/* Initialization */ +/*****************************************************************************/ + +void +syms_of_array (void) +{ +#ifdef NEW_GC + INIT_LISP_OBJECT (gap_array_marker); + INIT_LISP_OBJECT (gap_array); +#endif /* NEW_GC */ +} + diff -r 861f2601a38b -r 1f0b15040456 src/array.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/array.h Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,767 @@ +/* Header for arrays (dynarrs, gap arrays, etc.). + Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. + Copyright (C) 1996, 2001, 2002, 2004, 2005, 2009, 2010 Ben Wing. + +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 3 of the License, 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. If not, see . */ + +/* Synched up with: Not in FSF. */ + +/* This file has been Mule-ized, Ben Wing, 10-13-04. */ + +#ifndef INCLUDED_array_h_ +#define INCLUDED_array_h_ + +/************************************************************************/ +/** Definition of dynamic arrays (dynarrs) **/ +/************************************************************************/ + +BEGIN_C_DECLS + +/************* Dynarr declaration *************/ + +#ifdef NEW_GC +#define DECLARE_DYNARR_LISP_IMP() \ + const struct lrecord_implementation *lisp_imp; +#else +#define DECLARE_DYNARR_LISP_IMP() +#endif + +#ifdef ERROR_CHECK_DYNARR +#define DECLARE_DYNARR_LOCKED() \ + int locked; +#else +#define DECLARE_DYNARR_LOCKED() +#endif + +#define Dynarr_declare(type) \ + struct lrecord_header header; \ + type *base; \ + DECLARE_DYNARR_LISP_IMP () \ + DECLARE_DYNARR_LOCKED () \ + int elsize_; \ + int len_; \ + int largest_; \ + int max_ + +typedef struct dynarr +{ + Dynarr_declare (void); +} Dynarr; + +#define XD_DYNARR_DESC(base_type, sub_desc) \ + { XD_BLOCK_PTR, offsetof (base_type, base), \ + XD_INDIRECT(1, 0), {sub_desc} }, \ + { XD_INT, offsetof (base_type, len_) }, \ + { XD_INT_RESET, offsetof (base_type, largest_), XD_INDIRECT(1, 0) }, \ + { XD_INT_RESET, offsetof (base_type, max_), XD_INDIRECT(1, 0) } + +#ifdef NEW_GC +#define XD_LISP_DYNARR_DESC(base_type, sub_desc) \ + { XD_INLINE_LISP_OBJECT_BLOCK_PTR, offsetof (base_type, base), \ + XD_INDIRECT(1, 0), {sub_desc} }, \ + { XD_INT, offsetof (base_type, len_) }, \ + { XD_INT_RESET, offsetof (base_type, largest_), XD_INDIRECT(1, 0) }, \ + { XD_INT_RESET, offsetof (base_type, max_), XD_INDIRECT(1, 0) } +#endif /* NEW_GC */ + +/************* Dynarr verification *************/ + +/* Dynarr locking and verification. + + [I] VERIFICATION + + Verification routines simply return their basic argument, possibly + casted, but in the process perform some verification on it, aborting if + the verification fails. The verification routines take FILE and LINE + parameters, and use them to output the file and line of the caller + when an abort occurs, rather than the file and line of the inline + function, which is less than useful. + + There are three basic types of verification routines: + + (1) Verify the dynarr itself. This verifies the basic invariant + involving the length/size values: + + 0 <= Dynarr_length(d) <= Dynarr_largest(d) <= Dynarr_max(d) + + (2) Verify the dynarr itself prior to modifying it. This performs + the same verification as previously, but also checks that the + dynarr is not locked (see below). + + (3) Verify a dynarr position. Unfortunately we have to have + different verification routines depending on which kind of operation + is being performed: + + (a) For Dynarr_at(), we check that the POS is bounded by Dynarr_largest(), + i.e. 0 <= POS < Dynarr_largest(). + (b) For Dynarr_atp_allow_end(), we also have to allow + POS == Dynarr_largest(). + (c) For Dynarr_atp(), we behave largely like Dynarr_at() but make a + special exception when POS == 0 and Dynarr_largest() == 0 -- see + comment below. + (d) Some other routines contain the POS verification within their code, + and make the check 0 <= POS < Dynarr_length() or + 0 <= POS <= Dynarr_length(). + + #### It is not well worked-out whether and in what circumstances it's + allowed to use a position that is between Dynarr_length() and + Dynarr_largest(). The ideal solution is to never allow this, and require + instead that code first change the length before accessing higher + positions. That would require looking through all the code that accesses + dynarrs and fixing it appropriately (especially redisplay code, and + especially redisplay code in the vicinity of a reference to + Dynarr_largest(), since such code usually checks explicitly to see whether + there is extra stuff between Dynarr_length() and Dynarr_largest().) + + [II] LOCKING + + The idea behind dynarr locking is simple: Locking a dynarr prevents + any modification from occurring, or rather, leads to an abort upon + any attempt to modify a dynarr. + + Dynarr locking was originally added to catch some sporadic and hard-to- + debug crashes in the redisplay code where dynarrs appeared to be getting + corrupted in an unexpected fashion. The solution was to lock the + dynarrs that were getting corrupted (in this case, the display-line + dynarrs) around calls to routines that weren't supposed to be changing + these dynarrs but might somehow be calling code that modified them. + This eventually revealed that there was a reentrancy problem with + redisplay that involved the QUIT mechanism and the processing done in + order to determine whether C-g had been pressed -- this processing + involves retrieving, processing and queueing pending events to see + whether any of them result in a C-g keypress. However, at least under + MS Windows this can result in redisplay being called reentrantly. + For more info:-- + + (Info-goto-node "(internals)Critical Redisplay Sections") + +*/ + +#ifdef ERROR_CHECK_DYNARR +DECLARE_INLINE_HEADER ( +int +Dynarr_verify_pos_at (void *d, Elemcount pos, const Ascbyte *file, int line) +) +{ + Dynarr *dy = (Dynarr *) d; + /* We use `largest', not `len', because the redisplay code often + accesses stuff between len and largest. */ + assert_at_line (pos >= 0 && pos < dy->largest_, file, line); + return pos; +} + +DECLARE_INLINE_HEADER ( +int +Dynarr_verify_pos_atp (void *d, Elemcount pos, const Ascbyte *file, int line) +) +{ + Dynarr *dy = (Dynarr *) d; + /* We use `largest', not `len', because the redisplay code often + accesses stuff between len and largest. */ + /* [[ Code will often do something like ... + + val = make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0), + Dynarr_length (dyn)); + + which works fine when the Dynarr_length is non-zero, but when zero, + the result of Dynarr_atp() not only points past the end of the + allocated array, but the array may not have ever been allocated and + hence the return value is NULL. But the length of 0 causes the + pointer to never get checked. These can occur throughout the code + so we put in a special check. --ben ]] + + Update: The common idiom `Dynarr_atp (dyn, 0)' has been changed to + `Dynarr_begin (dyn)'. Possibly this special check at POS 0 can be + done only for Dynarr_begin() not for general Dynarr_atp(). --ben */ + if (pos == 0 && dy->len_ == 0) + return pos; + /* #### It's vaguely possible that some code could legitimately want to + retrieve a pointer to the position just past the end of dynarr memory. + This could happen with Dynarr_atp() but not Dynarr_at(). If so, it + will trigger this assert(). In such cases, it should be obvious that + the code wants to do this; rather than relaxing the assert, we should + probably create a new macro Dynarr_atp_allow_end() which is like + Dynarr_atp() but which allows for pointing at invalid addresses -- we + really want to check for cases of accessing just past the end of + memory, which is a likely off-by-one problem to occur and will usually + not trigger a protection fault (instead, you'll just get random + behavior, possibly overwriting other memory, which is bad). --ben */ + assert_at_line (pos >= 0 && pos < dy->largest_, file, line); + return pos; +} + +DECLARE_INLINE_HEADER ( +int +Dynarr_verify_pos_atp_allow_end (void *d, Elemcount pos, const Ascbyte *file, + int line) +) +{ + Dynarr *dy = (Dynarr *) d; + /* We use `largest', not `len', because the redisplay code often + accesses stuff between len and largest. + We also allow referencing the very end, past the end of allocated + legitimately space. See comments in Dynarr_verify_pos_atp.()*/ + assert_at_line (pos >= 0 && pos <= dy->largest_, file, line); + return pos; +} + +#else +#define Dynarr_verify_pos_at(d, pos, file, line) (pos) +#define Dynarr_verify_pos_atp(d, pos, file, line) (pos) +#define Dynarr_verify_pos_atp_allow_end(d, pos, file, line) (pos) +#endif /* ERROR_CHECK_DYNARR */ + +#ifdef ERROR_CHECK_DYNARR +DECLARE_INLINE_HEADER ( +Dynarr * +Dynarr_verify_1 (void *d, const Ascbyte *file, int line) +) +{ + Dynarr *dy = (Dynarr *) d; + assert_at_line (dy->len_ >= 0 && dy->len_ <= dy->largest_ && + dy->largest_ <= dy->max_, file, line); + return dy; +} + +DECLARE_INLINE_HEADER ( +Dynarr * +Dynarr_verify_mod_1 (void *d, const Ascbyte *file, int line) +) +{ + Dynarr *dy = (Dynarr *) d; + assert_at_line (!dy->locked, file, line); + return Dynarr_verify_1 (d, file, line); +} + +#define Dynarr_verify(d) Dynarr_verify_1 (d, __FILE__, __LINE__) +#define Dynarr_verify_mod(d) Dynarr_verify_mod_1 (d, __FILE__, __LINE__) + +DECLARE_INLINE_HEADER ( +void +Dynarr_lock (void *d) +) +{ + Dynarr *dy = Dynarr_verify_mod (d); + dy->locked = 1; +} + +DECLARE_INLINE_HEADER ( +void +Dynarr_unlock (void *d) +) +{ + Dynarr *dy = Dynarr_verify (d); + assert (dy->locked); + dy->locked = 0; +} + +#else /* not ERROR_CHECK_DYNARR */ + +#define Dynarr_verify(d) ((Dynarr *) d) +#define Dynarr_verify_mod(d) ((Dynarr *) d) +#define Dynarr_lock(d) DO_NOTHING +#define Dynarr_unlock(d) DO_NOTHING + +#endif /* ERROR_CHECK_DYNARR */ + +/************* Dynarr creation *************/ + +MODULE_API void *Dynarr_newf (Bytecount elsize); +MODULE_API void Dynarr_free (void *d); + +#ifdef NEW_GC +MODULE_API void *Dynarr_lisp_newf (Bytecount elsize, + const struct lrecord_implementation + *dynarr_imp, + const struct lrecord_implementation *imp); + +#define Dynarr_lisp_new(type, dynarr_imp, imp) \ + ((type##_dynarr *) Dynarr_lisp_newf (sizeof (type), dynarr_imp, imp)) +#define Dynarr_lisp_new2(dynarr_type, type, dynarr_imp, imp) \ + ((dynarr_type *) Dynarr_lisp_newf (sizeof (type)), dynarr_imp, imp) +#endif /* NEW_GC */ +#define Dynarr_new(type) ((type##_dynarr *) Dynarr_newf (sizeof (type))) +#define Dynarr_new2(dynarr_type, type) \ + ((dynarr_type *) Dynarr_newf (sizeof (type))) + +/************* Dynarr access *************/ + +#ifdef ERROR_CHECK_DYNARR +#define Dynarr_at(d, pos) \ + ((d)->base[Dynarr_verify_pos_at (d, pos, __FILE__, __LINE__)]) +#define Dynarr_atp_allow_end(d, pos) \ + (&((d)->base[Dynarr_verify_pos_atp_allow_end (d, pos, __FILE__, __LINE__)])) +#define Dynarr_atp(d, pos) \ + (&((d)->base[Dynarr_verify_pos_atp (d, pos, __FILE__, __LINE__)])) +#else +#define Dynarr_at(d, pos) ((d)->base[pos]) +#define Dynarr_atp(d, pos) (&Dynarr_at (d, pos)) +#define Dynarr_atp_allow_end(d, pos) Dynarr_atp (d, pos) +#endif + +/* Old #define Dynarr_atp(d, pos) (&Dynarr_at (d, pos)) */ +#define Dynarr_begin(d) Dynarr_atp (d, 0) +#define Dynarr_lastp(d) Dynarr_atp (d, Dynarr_length (d) - 1) +#define Dynarr_past_lastp(d) Dynarr_atp_allow_end (d, Dynarr_length (d)) + + +/************* Dynarr length/size retrieval and setting *************/ + +/* Retrieve the length of a dynarr. The `+ 0' is to ensure that this cannot + be used as an lvalue. */ +#define Dynarr_length(d) (Dynarr_verify (d)->len_ + 0) +/* Retrieve the largest ever length seen of a dynarr. The `+ 0' is to + ensure that this cannot be used as an lvalue. */ +#define Dynarr_largest(d) (Dynarr_verify (d)->largest_ + 0) +/* Retrieve the number of elements that fit in the currently allocated + space. The `+ 0' is to ensure that this cannot be used as an lvalue. */ +#define Dynarr_max(d) (Dynarr_verify (d)->max_ + 0) +/* Return the size in bytes of an element in a dynarr. */ +#define Dynarr_elsize(d) (Dynarr_verify (d)->elsize_ + 0) +/* Retrieve the advertised memory usage of a dynarr, i.e. the number of + bytes occupied by the elements in the dynarr, not counting any overhead. */ +#define Dynarr_sizeof(d) (Dynarr_length (d) * Dynarr_elsize (d)) + +/* Actually set the length of a dynarr. This is a low-level routine that + should not be directly used; use Dynarr_set_length() or + Dynarr_set_lengthr() instead. */ +DECLARE_INLINE_HEADER ( +void +Dynarr_set_length_1 (void *d, Elemcount len) +) +{ + Dynarr *dy = Dynarr_verify_mod (d); + dynarr_checking_assert (len >= 0 && len <= Dynarr_max (dy)); + /* Use the raw field references here otherwise we get a crash because + we've set the length but not yet fixed up the largest value. */ + dy->len_ = len; + if (dy->len_ > dy->largest_) + dy->largest_ = dy->len_; + (void) Dynarr_verify_mod (d); +} + +/* "Restricted set-length": Set the length of dynarr D to LEN, + which must be in the range [0, Dynarr_largest(d)]. */ + +DECLARE_INLINE_HEADER ( +void +Dynarr_set_lengthr (void *d, Elemcount len) +) +{ + Dynarr *dy = Dynarr_verify_mod (d); + dynarr_checking_assert (len >= 0 && len <= Dynarr_largest (dy)); + Dynarr_set_length_1 (dy, len); +} + +/* "Restricted increment": Increment the length of dynarr D by 1; the resulting + length must be in the range [0, Dynarr_largest(d)]. */ + +#define Dynarr_incrementr(d) Dynarr_set_lengthr (d, Dynarr_length (d) + 1) + + +MODULE_API void Dynarr_resize (void *d, Elemcount size); + +DECLARE_INLINE_HEADER ( +void +Dynarr_resize_to_fit (void *d, Elemcount size) +) +{ + Dynarr *dy = Dynarr_verify_mod (d); + if (size > Dynarr_max (dy)) + Dynarr_resize (dy, size); +} + +#define Dynarr_resize_to_add(d, numels) \ + Dynarr_resize_to_fit (d, Dynarr_length (d) + numels) + +/* This is an optimization. This is like Dynarr_set_length() but the length + is guaranteed to be at least as big as the existing length. */ + +DECLARE_INLINE_HEADER ( +void +Dynarr_increase_length (void *d, Elemcount len) +) +{ + Dynarr *dy = Dynarr_verify_mod (d); + dynarr_checking_assert (len >= Dynarr_length (dy)); + Dynarr_resize_to_fit (dy, len); + Dynarr_set_length_1 (dy, len); +} + +/* Set the length of dynarr D to LEN. If the length increases, resize as + necessary to fit. (NOTE: This will leave uninitialized memory. If you + aren't planning on immediately overwriting the memory, use + Dynarr_set_length_and_zero() to zero out all the memory that would + otherwise be uninitialized.) */ + +DECLARE_INLINE_HEADER ( +void +Dynarr_set_length (void *d, Elemcount len) +) +{ + Dynarr *dy = Dynarr_verify_mod (d); + Elemcount old_len = Dynarr_length (dy); + if (old_len >= len) + Dynarr_set_lengthr (dy, len); + else + Dynarr_increase_length (d, len); +} + +#define Dynarr_increment(d) Dynarr_increase_length (d, Dynarr_length (d) + 1) + +/* Zero LEN contiguous elements starting at POS. */ + +DECLARE_INLINE_HEADER ( +void +Dynarr_zero_many (void *d, Elemcount pos, Elemcount len) +) +{ + Dynarr *dy = Dynarr_verify_mod (d); + memset ((Rawbyte *) dy->base + pos*Dynarr_elsize (dy), 0, + len*Dynarr_elsize (dy)); +} + +/* This is an optimization. This is like Dynarr_set_length_and_zero() but + the length is guaranteed to be at least as big as the existing + length. */ + +DECLARE_INLINE_HEADER ( +void +Dynarr_increase_length_and_zero (void *d, Elemcount len) +) +{ + Dynarr *dy = Dynarr_verify_mod (d); + Elemcount old_len = Dynarr_length (dy); + Dynarr_increase_length (dy, len); + Dynarr_zero_many (dy, old_len, len - old_len); +} + +/* Set the length of dynarr D to LEN. If the length increases, resize as + necessary to fit and zero out all the elements between the old and new + lengths. */ + +DECLARE_INLINE_HEADER ( +void +Dynarr_set_length_and_zero (void *d, Elemcount len) +) +{ + Dynarr *dy = Dynarr_verify_mod (d); + Elemcount old_len = Dynarr_length (dy); + if (old_len >= len) + Dynarr_set_lengthr (dy, len); + else + Dynarr_increase_length_and_zero (d, len); +} + +/* Reset the dynarr's length to 0. */ +#define Dynarr_reset(d) Dynarr_set_lengthr (d, 0) + +#ifdef MEMORY_USAGE_STATS +struct usage_stats; +Bytecount Dynarr_memory_usage (void *d, struct usage_stats *stats); +#endif + +/************* Adding/deleting elements to/from a dynarr *************/ + +/* Set the Lisp implementation of the element at POS in dynarr D. Only + does this if the dynarr holds Lisp objects of a particular type (the + objects themselves, not pointers to them), and only under NEW_GC. */ + +#ifdef NEW_GC +#define DYNARR_SET_LISP_IMP(d, pos) \ +do { \ + if ((d)->lisp_imp) \ + set_lheader_implementation \ + ((struct lrecord_header *)&(((d)->base)[pos]), (d)->lisp_imp); \ +} while (0) +#else +#define DYNARR_SET_LISP_IMP(d, pos) DO_NOTHING +#endif /* (not) NEW_GC */ + +/* Add Element EL to the end of dynarr D. */ + +#define Dynarr_add(d, el) \ +do { \ + Elemcount _da_pos = Dynarr_length (d); \ + (void) Dynarr_verify_mod (d); \ + Dynarr_increment (d); \ + ((d)->base)[_da_pos] = (el); \ + DYNARR_SET_LISP_IMP (d, _da_pos); \ +} while (0) + +/* Set EL as the element at position POS in dynarr D. + Expand the dynarr as necessary so that its length is enough to include + position POS within it, and zero out any new elements created as a + result of expansion, other than the one at POS. */ + +#define Dynarr_set(d, pos, el) \ +do { \ + Elemcount _ds_pos = (pos); \ + (void) Dynarr_verify_mod (d); \ + if (Dynarr_length (d) < _ds_pos + 1) \ + Dynarr_increase_length_and_zero (d, _ds_pos + 1); \ + ((d)->base)[_ds_pos] = (el); \ + DYNARR_SET_LISP_IMP (d, _ds_pos); \ +} while (0) + +/* Add LEN contiguous elements, stored at BASE, to dynarr D. If BASE is + NULL, reserve space but don't store anything. */ + +DECLARE_INLINE_HEADER ( +void +Dynarr_add_many (void *d, const void *base, Elemcount len) +) +{ + /* This duplicates Dynarr_insert_many to some extent; but since it is + called so often, it seemed useful to remove the unnecessary stuff + from that function and to make it inline */ + Dynarr *dy = Dynarr_verify_mod (d); + Elemcount pos = Dynarr_length (dy); + Dynarr_increase_length (dy, Dynarr_length (dy) + len); + if (base) + memcpy ((Rawbyte *) dy->base + pos*Dynarr_elsize (dy), base, + len*Dynarr_elsize (dy)); +} + +/* Insert LEN elements, currently pointed to by BASE, into dynarr D + starting at position POS. */ + +MODULE_API void Dynarr_insert_many (void *d, const void *base, Elemcount len, + Elemcount pos); + +/* Prepend LEN elements, currently pointed to by BASE, to the beginning. */ + +#define Dynarr_prepend_many(d, base, len) Dynarr_insert_many (d, base, len, 0) + +/* Add literal string S to dynarr D, which should hold chars or unsigned + chars. The final zero byte is not stored. */ + +#define Dynarr_add_literal_string(d, s) Dynarr_add_many (d, s, sizeof (s) - 1) + +/* Convert Lisp string S to an external encoding according to CODESYS and + add to dynarr D, which should hold chars or unsigned chars. No final + zero byte is appended. */ + +/* #### This should be an inline function but LISP_STRING_TO_SIZED_EXTERNAL + isn't declared yet. */ + +#define Dynarr_add_ext_lisp_string(d, s, codesys) \ +do { \ + Lisp_Object dyna_ls_s = (s); \ + Lisp_Object dyna_ls_cs = (codesys); \ + Extbyte *dyna_ls_eb; \ + Bytecount dyna_ls_bc; \ + \ + LISP_STRING_TO_SIZED_EXTERNAL (dyna_ls_s, dyna_ls_eb, \ + dyna_ls_bc, dyna_ls_cs); \ + Dynarr_add_many (d, dyna_ls_eb, dyna_ls_bc); \ +} while (0) + +/* Delete LEN elements starting at position POS. */ + +MODULE_API void Dynarr_delete_many (void *d, Elemcount pos, Elemcount len); + +/* Pop off (i.e. delete) the last element from the dynarr and return it */ + +#define Dynarr_pop(d) \ + (dynarr_checking_assert (Dynarr_length (d) > 0), \ + Dynarr_verify_mod (d)->len_--, \ + Dynarr_at (d, Dynarr_length (d))) + +/* Delete the item at POS */ + +#define Dynarr_delete(d, pos) Dynarr_delete_many (d, pos, 1) + +/* Delete the item located at memory address P, which must be a `type *' + pointer, where `type' is the type of the elements of the dynarr. */ +#define Dynarr_delete_by_pointer(d, p) \ + Dynarr_delete_many (d, (p) - ((d)->base), 1) + +/* Delete all elements that are numerically equal to EL. */ + +#define Dynarr_delete_object(d, el) \ +do \ +{ \ + REGISTER int i; \ + for (i = Dynarr_length (d) - 1; i >= 0; i--) \ + { \ + if (el == Dynarr_at (d, i)) \ + Dynarr_delete_many (d, i, 1); \ + } \ +} while (0) + + +/************************************************************************/ +/** Stack-like malloc/free **/ +/************************************************************************/ + +void *stack_like_malloc (Bytecount size); +void stack_like_free (void *val); + + + +/************************************************************************/ +/** Gap array **/ +/************************************************************************/ + +/* Holds a marker that moves as elements in the array are inserted and + deleted, similar to standard markers. */ + +typedef struct gap_array_marker +{ +#ifdef NEW_GC + NORMAL_LISP_OBJECT_HEADER header; +#endif /* NEW_GC */ + int pos; + struct gap_array_marker *next; +} Gap_Array_Marker; + + +/* Holds a "gap array", which is an array of elements with a gap located + in it. Insertions and deletions with a high degree of locality + are very fast, essentially in constant time. Array positions as + used and returned in the gap array functions are independent of + the gap. */ + +/* Layout of gap array: + + <------ gap ------><---- gapsize ----><----- numels - gap ----> + <---------------------- numels + gapsize ---------------------> + + For marking purposes, we use two extra variables computed from + the others -- the offset to the data past the gap, plus the number + of elements in that data: + + offset_past_gap = elsize * (gap + gapsize) + els_past_gap = numels - gap +*/ + + +typedef struct gap_array +{ +#ifdef NEW_GC + NORMAL_LISP_OBJECT_HEADER header; + int is_lisp; +#endif /* NEW_GC */ + Elemcount gap; + Elemcount gapsize; + Elemcount numels; + Bytecount elsize; + /* Redundant numbers computed from the others, for marking purposes */ + Bytecount offset_past_gap; + Elemcount els_past_gap; + Gap_Array_Marker *markers; + /* this is a stretchy array */ + char array[1]; +} Gap_Array; + +#ifdef NEW_GC +struct gap_array_marker; + +DECLARE_LISP_OBJECT (gap_array_marker, struct gap_array_marker); +#define XGAP_ARRAY_MARKER(x) \ + XRECORD (x, gap_array_marker, struct gap_array_marker) +#define wrap_gap_array_marker(p) wrap_record (p, gap_array_marker) +#define GAP_ARRAY_MARKERP(x) RECORDP (x, gap_array_marker) +#define CHECK_GAP_ARRAY_MARKER(x) CHECK_RECORD (x, gap_array_marker) +#define CONCHECK_GAP_ARRAY_MARKER(x) CONCHECK_RECORD (x, gap_array_marker) + +struct gap_array; + +DECLARE_LISP_OBJECT (gap_array, struct gap_array); +#define XGAP_ARRAY(x) XRECORD (x, gap_array, struct gap_array) +#define wrap_gap_array(p) wrap_record (p, gap_array) +#define GAP_ARRAYP(x) RECORDP (x, gap_array) +#define CHECK_GAP_ARRAY(x) CHECK_RECORD (x, gap_array) +#define CONCHECK_GAP_ARRAY(x) CONCHECK_RECORD (x, gap_array) +#endif /* NEW_GC */ + +#ifdef NEW_GC +#define XD_GAP_ARRAY_MARKER_DESC \ + { XD_LISP_OBJECT, offsetof (Gap_Array, markers) } +#else /* not NEW_GC */ +#define XD_GAP_ARRAY_MARKER_DESC \ + { XD_BLOCK_PTR, offsetof (Gap_Array, markers), 1, \ + { &gap_array_marker_description }, XD_FLAG_NO_KKCC } +#endif /* not NEW_GC */ + +#define XD_GAP_ARRAY_DESC(sub_desc) \ + { XD_ELEMCOUNT, offsetof (Gap_Array, gap) }, \ + { XD_BYTECOUNT, offsetof (Gap_Array, offset_past_gap) }, \ + { XD_ELEMCOUNT, offsetof (Gap_Array, els_past_gap) }, \ + XD_GAP_ARRAY_MARKER_DESC, \ + { XD_BLOCK_ARRAY, offsetof (Gap_Array, array), XD_INDIRECT (0, 0), \ + { sub_desc } }, \ + { XD_BLOCK_ARRAY, XD_INDIRECT (1, offsetof (Gap_Array, array)), \ + XD_INDIRECT (2, 0), { sub_desc } } + +/* Convert a "memory position" (i.e. taking the gap into account) into + the address of the element at (i.e. after) that position. "Memory + positions" are only used internally and are of type Memxpos. + "Array positions" are used externally and are of type Elemcount. */ +#define GAP_ARRAY_MEMEL_ADDR(ga, memel) ((ga)->array + (ga)->elsize*(memel)) + +/* Number of elements currently in a gap array */ +#define gap_array_length(ga) ((ga)->numels) + +#define gap_array_gappos(ga) ((ga)->gap) +#define gap_array_gapsize(ga) ((ga)->gapsize) + +#define GAP_ARRAY_ARRAY_TO_MEMORY_POS_1(pos, gappos, gapsize) \ + ((pos) < gappos ? (pos) : (pos) + gapsize) + +#define GAP_ARRAY_ARRAY_TO_MEMORY_POS(ga, pos) \ + GAP_ARRAY_ARRAY_TO_MEMORY_POS_1 (pos, (ga)->gap, (ga)->gapsize) + +#define GAP_ARRAY_MEMORY_TO_ARRAY_POS(ga, pos) \ + ((pos) <= (ga)->gap ? (pos) : (pos) - (ga)->gapsize) + +/* Return a pointer to the element at a given position. */ +#define gap_array_atp(ga, pos, type) \ + ((type *) GAP_ARRAY_MEMEL_ADDR (ga, GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos))) + +/* Return the element at a given position. */ +#define gap_array_at(ga, pos, type) (*gap_array_atp (ga, pos, type)) + +/* Return a pointer to the beginning of memory storage for the gap array. + Note this is NOT the same as gap_array_atp(ga, 0, type) because that + will skip forward past the gap if the gap is at position 0. */ +#define gap_array_begin(ga, type) ((type *) ((ga)->array)) + +#ifndef NEW_GC +extern const struct sized_memory_description lispobj_gap_array_description; +extern const struct sized_memory_description gap_array_marker_description; +#endif + +Bytecount gap_array_byte_size (Gap_Array *ga); +Gap_Array *gap_array_insert_els (Gap_Array *ga, Elemcount pos, void *elptr, + Elemcount numels); +void gap_array_delete_els (Gap_Array *ga, Elemcount from, Elemcount numdel); +#define gap_array_delete_all_els(ga) \ + gap_array_delete_els (ga, 0, gap_array_length (ga)) +Gap_Array_Marker *gap_array_make_marker (Gap_Array *ga, Elemcount pos); +void gap_array_delete_marker (Gap_Array *ga, Gap_Array_Marker *m); +void gap_array_delete_all_markers (Gap_Array *ga); +void gap_array_move_marker (Gap_Array *ga, Gap_Array_Marker *m, Elemcount pos); +#define gap_array_marker_pos(ga, m) \ + GAP_ARRAY_MEMORY_TO_ARRAY_POS (ga, (m)->pos) +Gap_Array *make_gap_array (Elemcount elsize, int USED_IF_NEW_GC (do_lisp)); +Gap_Array *gap_array_clone (Gap_Array *ga); +void free_gap_array (Gap_Array *ga); +Bytecount gap_array_memory_usage (Gap_Array *ga, struct usage_stats *stats, + Bytecount *marker_ancillary); + +#endif /* INCLUDED_array_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/backtrace.h --- a/src/backtrace.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/backtrace.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. Contained redundantly in various C files in FSFmacs. */ diff -r 861f2601a38b -r 1f0b15040456 src/balloon-x.c --- a/src/balloon-x.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/balloon-x.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/balloon_help.c --- a/src/balloon_help.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/balloon_help.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/balloon_help.h --- a/src/balloon_help.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/balloon_help.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/bitmaps.h --- a/src/bitmaps.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/bitmaps.h Sun May 01 18:44:03 2011 +0100 @@ -1,9 +1,9 @@ /* This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -11,9 +11,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/blocktype.c --- a/src/blocktype.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/blocktype.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,10 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. -*/ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/blocktype.h --- a/src/blocktype.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/blocktype.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,10 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. -*/ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/buffer.c --- a/src/buffer.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/buffer.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* Buffer manipulation primitives for XEmacs. Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004 Ben Wing. + Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.0, FSF 19.30. */ @@ -30,7 +28,7 @@ A few changes for buffer-local vars by Richard Mlynarik for 19.8 or 19.9, c. 1993. Many changes by Ben Wing: changes and cleanups for Mule, esp. the - macros in buffer.h and the intial version of the coding-system + macros in buffer.h and the initial version of the coding-system conversion macros (in buffer.h) and associated fns. (in this file), 19.12 (c. 1995); synch. to FSF 19.30 c. 1994; memory usage stats c. 1996; generated-modeline-string c. 1996 for mousable modeline in @@ -234,11 +232,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("buffer-text", buffer_text, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - buffer_text_description_1, - Lisp_Buffer_Text); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("buffer-text", buffer_text, + 0, buffer_text_description_1, + Lisp_Buffer_Text); #endif /* NEW_GC */ static const struct sized_memory_description buffer_text_description = { @@ -304,9 +300,9 @@ if (print_readably) { if (!BUFFER_LIVE_P (b)) - printing_unreadable_object ("#"); + printing_unreadable_object_fmt ("#"); else - printing_unreadable_object ("#", XSTRING_DATA (b->name)); + printing_unreadable_object_fmt ("#", XSTRING_DATA (b->name)); } else if (!BUFFER_LIVE_P (b)) write_ascstring (printcharfun, "#"); @@ -333,11 +329,10 @@ /* We do not need a finalize method to handle a buffer's children list because all buffers have `kill-buffer' applied to them before they disappear, and the children removal happens then. */ -DEFINE_LRECORD_IMPLEMENTATION ("buffer", buffer, - 0, /*dumpable-flag*/ - mark_buffer, print_buffer, 0, 0, 0, - buffer_description, - struct buffer); +DEFINE_NODUMP_LISP_OBJECT ("buffer", buffer, mark_buffer, + print_buffer, 0, 0, 0, + buffer_description, + struct buffer); DEFUN ("bufferp", Fbufferp, 1, 1, 0, /* Return t if OBJECT is an editor buffer. @@ -603,11 +598,11 @@ static struct buffer * allocate_buffer (void) { - struct buffer *b = ALLOC_LCRECORD_TYPE (struct buffer, &lrecord_buffer); - - COPY_LCRECORD (b, XBUFFER (Vbuffer_defaults)); - - return b; + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (buffer); + + copy_lisp_object (obj, Vbuffer_defaults); + + return XBUFFER (obj); } static Lisp_Object @@ -643,7 +638,7 @@ b->generated_modeline_string = Fmake_string (make_int (84), make_int (' ')); b->modeline_extent_table = make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, - HASH_TABLE_EQ); + Qeq); return buf; @@ -1755,76 +1750,52 @@ struct buffer_stats { - int text; - int markers; - int extents; - int other; + struct usage_stats u; + Bytecount text; + /* Ancillary Lisp */ + Bytecount markers; + Bytecount extents; }; static Bytecount -compute_buffer_text_usage (struct buffer *b, struct overhead_stats *ovstats) +compute_buffer_text_usage (struct buffer *b, struct usage_stats *ustats) { - int was_requested = b->text->z - 1; - Bytecount gap = b->text->gap_size + b->text->end_gap_size; - Bytecount malloc_use = malloced_storage_size (b->text->beg, was_requested + gap, 0); - - ovstats->gap_overhead += gap; - ovstats->was_requested += was_requested; - ovstats->malloc_overhead += malloc_use - (was_requested + gap); + Bytecount was_requested, gap, malloc_use; + + /* Killed buffer? */ + if (!b->text) + return 0; + + /* Indirect buffer shares its text with someone else, so don't double- + count the text */ + if (b->base_buffer) + return 0; + + was_requested = b->text->z - 1; + gap = b->text->gap_size + b->text->end_gap_size; + malloc_use = malloced_storage_size (b->text->beg, was_requested + gap, 0); + + ustats->gap_overhead += gap; + ustats->was_requested += was_requested; + ustats->malloc_overhead += malloc_use - (was_requested + gap); return malloc_use; } static void compute_buffer_usage (struct buffer *b, struct buffer_stats *stats, - struct overhead_stats *ovstats) + struct usage_stats *ustats) { - xzero (*stats); - stats->other += LISPOBJ_STORAGE_SIZE (b, sizeof (*b), ovstats); - stats->text += compute_buffer_text_usage (b, ovstats); - stats->markers += compute_buffer_marker_usage (b, ovstats); - stats->extents += compute_buffer_extent_usage (b, ovstats); + stats->text += compute_buffer_text_usage (b, ustats); + stats->markers += compute_buffer_marker_usage (b); + stats->extents += compute_buffer_extent_usage (b); } -DEFUN ("buffer-memory-usage", Fbuffer_memory_usage, 1, 1, 0, /* -Return stats about the memory usage of buffer BUFFER. -The values returned are in the form of an alist of usage types and byte -counts. The byte counts attempt to encompass all the memory used -by the buffer (separate from the memory logically associated with a -buffer or frame), including internal structures and any malloc() -overhead associated with them. In practice, the byte counts are -underestimated because certain memory usage is very hard to determine -\(e.g. the amount of memory used inside the Xt library or inside the -X server) and because there is other stuff that might logically -be associated with a window, buffer, or frame (e.g. window configurations, -glyphs) but should not obviously be included in the usage counts. - -Multiple slices of the total memory usage may be returned, separated -by a nil. Each slice represents a particular view of the memory, a -particular way of partitioning it into groups. Within a slice, there -is no overlap between the groups of memory, and each slice collectively -represents all the memory concerned. -*/ - (buffer)) +static void +buffer_memory_usage (Lisp_Object buffer, struct generic_usage_stats *gustats) { - struct buffer_stats stats; - struct overhead_stats ovstats; - Lisp_Object val = Qnil; - - CHECK_BUFFER (buffer); /* dead buffers should be allowed, no? */ - xzero (ovstats); - compute_buffer_usage (XBUFFER (buffer), &stats, &ovstats); - - val = acons (Qtext, make_int (stats.text), val); - val = acons (Qmarkers, make_int (stats.markers), val); - val = acons (Qextents, make_int (stats.extents), val); - val = acons (Qother, make_int (stats.other), val); - val = Fcons (Qnil, val); - val = acons (Qactually_requested, make_int (ovstats.was_requested), val); - val = acons (Qmalloc_overhead, make_int (ovstats.malloc_overhead), val); - val = acons (Qgap_overhead, make_int (ovstats.gap_overhead), val); - val = acons (Qdynarr_overhead, make_int (ovstats.dynarr_overhead), val); - - return Fnreverse (val); + struct buffer_stats *stats = (struct buffer_stats *) gustats; + + compute_buffer_usage (XBUFFER (buffer), stats, &stats->u); } #endif /* MEMORY_USAGE_STATS */ @@ -1846,10 +1817,10 @@ #define ADD_INT(field) \ plist = cons3 (make_int (b->text->field), \ - intern_converting_underscores_to_dashes (#field), plist) + intern_massaging_name (#field), plist) #define ADD_BOOL(field) \ plist = cons3 (b->text->field ? Qt : Qnil, \ - intern_converting_underscores_to_dashes (#field), plist) + intern_massaging_name (#field), plist) ADD_INT (bufz); ADD_INT (z); #ifdef OLD_BYTE_CHAR @@ -1908,11 +1879,19 @@ void +buffer_objects_create (void) +{ +#ifdef MEMORY_USAGE_STATS + OBJECT_HAS_METHOD (buffer, memory_usage); +#endif +} + +void syms_of_buffer (void) { - INIT_LRECORD_IMPLEMENTATION (buffer); + INIT_LISP_OBJECT (buffer); #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (buffer_text); + INIT_LISP_OBJECT (buffer_text); #endif /* NEW_GC */ DEFSYMBOL (Qbuffer_live_p); @@ -1972,9 +1951,6 @@ DEFSUBR (Fbarf_if_buffer_read_only); DEFSUBR (Fbury_buffer); DEFSUBR (Fkill_all_local_variables); -#ifdef MEMORY_USAGE_STATS - DEFSUBR (Fbuffer_memory_usage); -#endif #if defined (DEBUG_XEMACS) && defined (MULE) DEFSUBR (Fbuffer_char_byte_converion_info); DEFSUBR (Fstring_char_byte_converion_info); @@ -1997,6 +1973,11 @@ vars_of_buffer (void) { /* This function can GC */ +#ifdef MEMORY_USAGE_STATS + OBJECT_HAS_PROPERTY + (buffer, memusage_stats_list, list4 (Qtext, Qt, Qmarkers, Qextents)); +#endif /* MEMORY_USAGE_STATS */ + staticpro (&QSFundamental); staticpro (&QSscratch); @@ -2143,9 +2124,8 @@ do \ { \ struct symbol_value_forward *I_hate_C = \ - alloc_lrecord_type (struct symbol_value_forward, \ - &lrecord_symbol_value_forward); \ - /*mcpro ((Lisp_Object) I_hate_C);*/ \ + XSYMBOL_VALUE_FORWARD (ALLOC_NORMAL_LISP_OBJECT (symbol_value_forward)); \ + /*mcpro ((Lisp_Object) I_hate_C);*/ \ \ I_hate_C->magic.value = &(buffer_local_flags.field_name); \ I_hate_C->magic.type = forward_type; \ @@ -2179,8 +2159,6 @@ 1 /* lisp_readonly bit */ \ }, \ 0, /* next */ \ - 0, /* uid */ \ - 0 /* free */ \ }, \ &(buffer_local_flags.field_name), \ forward_type \ @@ -2219,7 +2197,7 @@ static void nuke_all_buffer_slots (struct buffer *b, Lisp_Object zap) { - ZERO_LCRECORD (b); + zero_nonsized_lisp_object (wrap_buffer (b)); b->extent_info = Qnil; b->indirect_children = Qnil; @@ -2234,13 +2212,15 @@ { /* Make sure all markable slots in buffer_defaults are initialized reasonably, so mark_buffer won't choke. */ - struct buffer *defs = ALLOC_LCRECORD_TYPE (struct buffer, &lrecord_buffer); - struct buffer *syms = ALLOC_LCRECORD_TYPE (struct buffer, &lrecord_buffer); + Lisp_Object defobj = ALLOC_NORMAL_LISP_OBJECT (buffer); + struct buffer *defs = XBUFFER (defobj); + Lisp_Object symobj = ALLOC_NORMAL_LISP_OBJECT (buffer); + struct buffer *syms = XBUFFER (symobj); staticpro_nodump (&Vbuffer_defaults); staticpro_nodump (&Vbuffer_local_symbols); - Vbuffer_defaults = wrap_buffer (defs); - Vbuffer_local_symbols = wrap_buffer (syms); + Vbuffer_defaults = defobj; + Vbuffer_local_symbols = symobj; nuke_all_buffer_slots (syms, Qnil); nuke_all_buffer_slots (defs, Qnil); @@ -2297,6 +2277,8 @@ The local flag bits are in the local_var_flags slot of the buffer. */ + set_lheader_implementation ((struct lrecord_header *) + &buffer_local_flags, &lrecord_buffer); nuke_all_buffer_slots (&buffer_local_flags, make_int (-2)); buffer_local_flags.filename = always_local_no_default; buffer_local_flags.directory = always_local_no_default; @@ -2323,6 +2305,8 @@ #ifdef MULE buffer_local_flags.category_table = resettable; #endif + buffer_local_flags.display_time = always_local_no_default; + buffer_local_flags.display_count = make_int (0); buffer_local_flags.modeline_format = make_int (1<<0); buffer_local_flags.abbrev_mode = make_int (1<<1); @@ -2816,6 +2800,18 @@ set when a file is visited. Automatically local in all buffers. */ ); + DEFVAR_BUFFER_LOCAL ("buffer-display-count", display_count /* +A number incremented each time this buffer is displayed in a window. +The function `set-window-buffer' updates it. +*/ ); + + DEFVAR_BUFFER_LOCAL ("buffer-display-time", display_time /* +Time stamp updated each time this buffer is displayed in a window. +The function `set-window-buffer' updates this variable +to the value obtained by calling `current-time'. +If the buffer has never been shown in a window, the value is nil. +*/); + DEFVAR_BUFFER_LOCAL_MAGIC ("buffer-invisibility-spec", invisibility_spec /* Invisibility spec of this buffer. The default is t, which means that text is invisible @@ -2871,10 +2867,9 @@ slot of buffer_local_flags and vice-versa. Must be done after all DEFVAR_BUFFER_LOCAL() calls. */ #define MARKED_SLOT(slot) \ - if ((XINT (buffer_local_flags.slot) != -2 && \ - XINT (buffer_local_flags.slot) != -3) \ - != !(NILP (XBUFFER (Vbuffer_local_symbols)->slot))) \ - ABORT (); + assert ((XINT (buffer_local_flags.slot) != -2 && \ + XINT (buffer_local_flags.slot) != -3) \ + == !(NILP (XBUFFER (Vbuffer_local_symbols)->slot))); #include "bufslots.h" { diff -r 861f2601a38b -r 1f0b15040456 src/buffer.h --- a/src/buffer.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/buffer.h Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ @@ -80,7 +78,7 @@ struct buffer_text { #ifdef NEW_GC - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; #endif /* NEW_GC */ Ibyte *beg; /* Actual address of buffer contents. */ Bytebpos gpt; /* Index of gap in buffer. */ @@ -144,7 +142,7 @@ #ifdef NEW_GC typedef struct buffer_text Lisp_Buffer_Text; -DECLARE_LRECORD (buffer_text, Lisp_Buffer_Text); +DECLARE_LISP_OBJECT (buffer_text, Lisp_Buffer_Text); #define XBUFFER_TEXT(x) \ XRECORD (x, buffer_text, Lisp_Buffer_Text) @@ -157,7 +155,7 @@ struct buffer { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; /* This structure holds the coordinates of the buffer contents in ordinary buffers. In indirect buffers, this is not used. */ @@ -268,7 +266,7 @@ #undef MARKED_SLOT }; -DECLARE_LRECORD (buffer, struct buffer); +DECLARE_LISP_OBJECT (buffer, struct buffer); #define XBUFFER(x) XRECORD (x, buffer, struct buffer) #define wrap_buffer(p) wrap_record (p, buffer) #define BUFFERP(x) RECORDP (x, buffer) diff -r 861f2601a38b -r 1f0b15040456 src/bufslots.h --- a/src/bufslots.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/bufslots.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.0, FSF 19.30. Split out of buffer.h. */ @@ -216,6 +214,12 @@ /* The string generated by formatting the modeline in this buffer. */ MARKED_SLOT (generated_modeline_string) + /* Incremented each time a buffer is displayed using set-window-buffer. */ + MARKED_SLOT (display_count) + + /* Last time this buffer was displayed using set-window-buffer. */ + MARKED_SLOT (display_time) + /* A hash table that maps from a "generic extent" (an extent in `modeline-format') into a buffer-specific extent. */ MARKED_SLOT (modeline_extent_table) diff -r 861f2601a38b -r 1f0b15040456 src/bytecode-ops.h --- a/src/bytecode-ops.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/bytecode-ops.h Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.0, FSF 19.30. */ @@ -57,7 +55,7 @@ OPCODE (set, 0114) OPCODE (fset, 0115) OPCODE (get, 0116) - OPCODE (substring, 0117) + OPCODE (subseq, 0117) OPCODE (concat2, 0120) OPCODE (concat3, 0121) OPCODE (concat4, 0122) diff -r 861f2601a38b -r 1f0b15040456 src/bytecode.c --- a/src/bytecode.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/bytecode.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* Execution of byte code produced by bytecomp.el. Implementation of compiled-function objects. Copyright (C) 1992, 1993 Free Software Foundation, Inc. - Copyright (C) 1995, 2002 Ben Wing. + Copyright (C) 1995, 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.0, FSF 19.30. */ @@ -65,22 +63,21 @@ make_compiled_function_args (int totalargs) { Lisp_Compiled_Function_Args *args; - args = (Lisp_Compiled_Function_Args *) - alloc_lrecord - (FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Compiled_Function_Args, - Lisp_Object, args, totalargs), - &lrecord_compiled_function_args); + args = XCOMPILED_FUNCTION_ARGS + (ALLOC_SIZED_LISP_OBJECT + (FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Compiled_Function_Args, + Lisp_Object, args, totalargs), + compiled_function_args)); args->size = totalargs; return wrap_compiled_function_args (args); } static Bytecount -size_compiled_function_args (const void *lheader) +size_compiled_function_args (Lisp_Object obj) { return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Compiled_Function_Args, Lisp_Object, args, - ((Lisp_Compiled_Function_Args *) - lheader)->size); + XCOMPILED_FUNCTION_ARGS (obj)->size); } static const struct memory_description compiled_function_args_description[] = { @@ -90,13 +87,12 @@ { XD_END } }; -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("compiled-function-args", - compiled_function_args, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - compiled_function_args_description, - size_compiled_function_args, - Lisp_Compiled_Function_Args); +DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT ("compiled-function-args", + compiled_function_args, + 0, + compiled_function_args_description, + size_compiled_function_args, + Lisp_Compiled_Function_Args); #endif /* NEW_GC */ EXFUN (Ffetch_bytecode, 1); @@ -253,21 +249,28 @@ } static Lisp_Object -bytecode_nreverse (Lisp_Object list) +bytecode_nreverse (Lisp_Object sequence) { - REGISTER Lisp_Object prev = Qnil; - REGISTER Lisp_Object tail = list; - - while (!NILP (tail)) + if (LISTP (sequence)) { - REGISTER Lisp_Object next; - CHECK_CONS (tail); - next = XCDR (tail); - XCDR (tail) = prev; - prev = tail; - tail = next; + REGISTER Lisp_Object prev = Qnil; + REGISTER Lisp_Object tail = sequence; + + while (!NILP (tail)) + { + REGISTER Lisp_Object next; + CHECK_CONS (tail); + next = XCDR (tail); + XCDR (tail) = prev; + prev = tail; + tail = next; + } + return prev; } - return prev; + else + { + return Fnreverse (sequence); + } } @@ -1573,11 +1576,11 @@ break; } - case Bsubstring: + case Bsubseq: { Lisp_Object arg2 = POP; Lisp_Object arg1 = POP; - TOP_LVALUE = Fsubstring (TOP, arg1, arg2); + TOP_LVALUE = Fsubseq (TOP, arg1, arg2); break; } @@ -1687,6 +1690,8 @@ break; } +#ifdef SUPPORT_CONFOUNDING_FUNCTIONS + case Bold_eq: { Lisp_Object arg = POP; @@ -1722,12 +1727,15 @@ break; } +#endif + case Bbind_multiple_value_limits: { Lisp_Object upper = POP, first = TOP, speccount; - CHECK_NATNUM (upper); - CHECK_NATNUM (first); + check_integer_range (upper, Qzero, + make_integer (Vmultiple_values_limit)); + check_integer_range (first, Qzero, upper); speccount = make_int (bind_multiple_value_limits (XINT (first), XINT (upper))); @@ -1955,11 +1963,14 @@ wtaerror ("attempt to set non-symbol", val); if (EQ (val, Qnil) || EQ (val, Qt)) signal_error (Qsetting_constant, 0, val); +#ifdef NEED_TO_HANDLE_21_4_CODE /* Ignore assignments to keywords by converting to Bdiscard. - For backward compatibility only - we'd like to make this an error. */ + For backward compatibility only - we'd like to make this an + error. */ if (SYMBOL_IS_KEYWORD (val)) REWRITE_OPCODE (Bdiscard); else +#endif WRITE_NARGS (Bvarset); break; @@ -2247,7 +2258,8 @@ struct gcpro gcpro1, gcpro2; GCPRO2 (obj, printcharfun); - write_ascstring (printcharfun, print_readably ? "#[" : "#"); + if (print_readably) + write_ascstring (printcharfun, "]"); + else + write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); } @@ -2346,14 +2361,14 @@ } static Hashcode -compiled_function_hash (Lisp_Object obj, int depth) +compiled_function_hash (Lisp_Object obj, int depth, Boolint UNUSED (equalp)) { Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (obj); return HASH3 ((f->flags.documentationp << 2) + (f->flags.interactivep << 1) + f->flags.domainp, - internal_hash (f->instructions, depth + 1), - internal_hash (f->constants, depth + 1)); + internal_hash (f->instructions, depth + 1, 0), + internal_hash (f->constants, depth + 1, 0)); } static const struct memory_description compiled_function_description[] = { @@ -2374,14 +2389,13 @@ { XD_END } }; -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("compiled-function", compiled_function, - 1, /*dumpable_flag*/ - mark_compiled_function, - print_compiled_function, 0, - compiled_function_equal, - compiled_function_hash, - compiled_function_description, - Lisp_Compiled_Function); +DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("compiled-function", compiled_function, + mark_compiled_function, + print_compiled_function, 0, + compiled_function_equal, + compiled_function_hash, + compiled_function_description, + Lisp_Compiled_Function); DEFUN ("compiled-function-p", Fcompiled_function_p, 1, 1, 0, /* @@ -2561,22 +2575,36 @@ #endif -/* used only by Snarf-documentation; there must be doc already. */ +/* used only by Snarf-documentation. */ void set_compiled_function_documentation (Lisp_Compiled_Function *f, Lisp_Object new_doc) { - assert (f->flags.documentationp); assert (INTP (new_doc) || STRINGP (new_doc)); - if (f->flags.interactivep && f->flags.domainp) - XCAR (f->doc_and_interactive) = new_doc; - else if (f->flags.interactivep) - XCAR (f->doc_and_interactive) = new_doc; - else if (f->flags.domainp) - XCAR (f->doc_and_interactive) = new_doc; + if (f->flags.documentationp) + { + if (f->flags.interactivep && f->flags.domainp) + XCAR (f->doc_and_interactive) = new_doc; + else if (f->flags.interactivep) + XCAR (f->doc_and_interactive) = new_doc; + else if (f->flags.domainp) + XCAR (f->doc_and_interactive) = new_doc; + else + f->doc_and_interactive = new_doc; + } else - f->doc_and_interactive = new_doc; + { + f->flags.documentationp = 1; + if (f->flags.interactivep || f->flags.domainp) + { + f->doc_and_interactive = Fcons (new_doc, f->doc_and_interactive); + } + else + { + f->doc_and_interactive = new_doc; + } + } } @@ -2735,7 +2763,7 @@ CHECK_STRING (instructions); CHECK_VECTOR (constants); - CHECK_NATNUM (stack_depth); + check_integer_range (stack_depth, Qzero, make_int (USHRT_MAX)); /* Optimize the `instructions' string, just like when executing a regular compiled function, but don't save it for later since this is @@ -2756,9 +2784,9 @@ void syms_of_bytecode (void) { - INIT_LRECORD_IMPLEMENTATION (compiled_function); + INIT_LISP_OBJECT (compiled_function); #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (compiled_function_args); + INIT_LISP_OBJECT (compiled_function_args); #endif /* NEW_GC */ DEFERROR_STANDARD (Qinvalid_byte_code, Qinvalid_state); @@ -2823,14 +2851,14 @@ static void init_opcode_table_multi_op (Opcode op) { - const Ascbyte *basename = opcode_name_table[op]; + const Ascbyte *base = opcode_name_table[op]; Ascbyte temp[300]; int i; for (i = 1; i < 7; i++) { assert (!opcode_name_table[op + i]); - sprintf (temp, "%s+%d", basename, i); + sprintf (temp, "%s+%d", base, i); opcode_name_table[op + i] = xstrdup (temp); } } diff -r 861f2601a38b -r 1f0b15040456 src/bytecode.h --- a/src/bytecode.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/bytecode.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -34,14 +32,14 @@ #ifdef NEW_GC struct compiled_function_args { - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; long size; Lisp_Object args[1]; }; typedef struct compiled_function_args Lisp_Compiled_Function_Args; -DECLARE_LRECORD (compiled_function_args, Lisp_Compiled_Function_Args); +DECLARE_LISP_OBJECT (compiled_function_args, Lisp_Compiled_Function_Args); #define XCOMPILED_FUNCTION_ARGS(x) \ XRECORD (x, compiled_function_args, Lisp_Compiled_Function_Args) @@ -83,7 +81,7 @@ struct Lisp_Compiled_Function { - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; unsigned short stack_depth; unsigned short specpdl_depth; struct @@ -148,7 +146,7 @@ int stack_depth, Lisp_Object *constants_data); -DECLARE_LRECORD (compiled_function, Lisp_Compiled_Function); +DECLARE_LISP_OBJECT (compiled_function, Lisp_Compiled_Function); #define XCOMPILED_FUNCTION(x) XRECORD (x, compiled_function, \ Lisp_Compiled_Function) #define wrap_compiled_function(p) wrap_record (p, compiled_function) diff -r 861f2601a38b -r 1f0b15040456 src/callint.c --- a/src/callint.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/callint.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30, Mule 2.0. */ diff -r 861f2601a38b -r 1f0b15040456 src/casefiddle.c --- a/src/casefiddle.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/casefiddle.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.34, but substantially rewritten by Martin. */ diff -r 861f2601a38b -r 1f0b15040456 src/casetab.c --- a/src/casetab.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/casetab.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* XEmacs routines to deal with case tables. Copyright (C) 1987, 1992, 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2002 Ben Wing. + Copyright (C) 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.28. Between FSF 19.28 and 19.30, casetab.c was rewritten to use junky FSF char tables. Meanwhile I rewrote it @@ -105,12 +103,12 @@ { Lisp_Case_Table *ct = XCASE_TABLE (obj); if (print_readably) - printing_unreadable_lcrecord (obj, 0); + printing_unreadable_lisp_object (obj, 0); write_fmt_string_lisp (printcharfun, "#", ct->header.uid); + write_fmt_string (printcharfun, "0x%x>", LISP_OBJECT_UID (obj)); } static const struct memory_description case_table_description [] = { @@ -122,16 +120,15 @@ }; -DEFINE_LRECORD_IMPLEMENTATION("case-table", case_table, - 1, /*dumpable-flag*/ - mark_case_table, print_case_table, 0, - 0, 0, case_table_description, Lisp_Case_Table); +DEFINE_DUMPABLE_LISP_OBJECT ("case-table", case_table, + mark_case_table, print_case_table, 0, + 0, 0, case_table_description, Lisp_Case_Table); static Lisp_Object allocate_case_table (int init_tables) { - Lisp_Case_Table *ct = - ALLOC_LCRECORD_TYPE (Lisp_Case_Table, &lrecord_case_table); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (case_table); + Lisp_Case_Table *ct = XCASE_TABLE (obj); if (init_tables) { @@ -147,7 +144,7 @@ SET_CASE_TABLE_CANON (ct, Qnil); SET_CASE_TABLE_EQV (ct, Qnil); } - return wrap_case_table (ct); + return obj; } DEFUN ("make-case-table", Fmake_case_table, 0, 0, 0, /* @@ -509,10 +506,42 @@ } +#ifdef MEMORY_USAGE_STATS + +struct case_table_stats +{ + struct usage_stats u; + /* Ancillary Lisp */ + Bytecount downcase, upcase, case_canon, case_eqv; +}; + +static void +case_table_memory_usage (Lisp_Object casetab, + struct generic_usage_stats *gustats) +{ + struct case_table_stats *stats = (struct case_table_stats *) gustats; + + stats->downcase = lisp_object_memory_usage (XCASE_TABLE_DOWNCASE (casetab)); + stats->upcase = lisp_object_memory_usage (XCASE_TABLE_UPCASE (casetab)); + stats->case_canon = lisp_object_memory_usage (XCASE_TABLE_CANON (casetab)); + stats->case_eqv = lisp_object_memory_usage (XCASE_TABLE_EQV (casetab)); +} + +#endif /* MEMORY_USAGE_STATS */ + + +void +casetab_objects_create (void) +{ +#ifdef MEMORY_USAGE_STATS + OBJECT_HAS_METHOD (case_table, memory_usage); +#endif +} + void syms_of_casetab (void) { - INIT_LRECORD_IMPLEMENTATION (case_table); + INIT_LISP_OBJECT (case_table); DEFSYMBOL_MULTIWORD_PREDICATE (Qcase_tablep); DEFSYMBOL (Qdowncase); @@ -531,6 +560,19 @@ } void +vars_of_casetab (void) +{ +#ifdef MEMORY_USAGE_STATS + OBJECT_HAS_PROPERTY (case_table, memusage_stats_list, + list5 (Qt, + intern ("downcase"), + intern ("upcase"), + intern ("case-canon"), + intern ("case-eqv"))); +#endif /* MEMORY_USAGE_STATS */ +} + +void complex_vars_of_casetab (void) { REGISTER Ichar i; diff -r 861f2601a38b -r 1f0b15040456 src/casetab.h --- a/src/casetab.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/casetab.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ Copyright (C) 2002 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -25,7 +23,7 @@ struct Lisp_Case_Table { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; Lisp_Object downcase_table; Lisp_Object upcase_table; Lisp_Object case_canon_table; @@ -34,7 +32,7 @@ }; typedef struct Lisp_Case_Table Lisp_Case_Table; -DECLARE_LRECORD (case_table, Lisp_Case_Table); +DECLARE_LISP_OBJECT (case_table, Lisp_Case_Table); #define XCASE_TABLE(x) XRECORD (x, case_table, Lisp_Case_Table) #define wrap_case_table(p) wrap_record (p, case_table) #define CASE_TABLEP(x) RECORDP (x, case_table) diff -r 861f2601a38b -r 1f0b15040456 src/charset.h --- a/src/charset.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/charset.h Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* Header for charsets. Copyright (C) 1992, 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2001, 2002 Ben Wing. + Copyright (C) 2001, 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.3. Not in FSF. */ @@ -185,7 +183,7 @@ struct Lisp_Charset { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; int id; Lisp_Object name; @@ -246,7 +244,7 @@ }; typedef struct Lisp_Charset Lisp_Charset; -DECLARE_LRECORD (charset, Lisp_Charset); +DECLARE_LISP_OBJECT (charset, Lisp_Charset); #define XCHARSET(x) XRECORD (x, charset, Lisp_Charset) #define wrap_charset(p) wrap_record (p, charset) #define CHARSETP(x) RECORDP (x, charset) @@ -555,6 +553,46 @@ #define BREAKUP_ICHAR(c, charset, c1, c2) \ breakup_ichar_1 (c, &(charset), &(c1), &(c2)) +/* Forward compatibility from ben-unicode-internal: Convert a charset + codepoint into a character in the internal string representation. + Return number of bytes written out. FAIL controls failure mode when + charset conversion to Unicode is not possible (unused as of yet). */ +DECLARE_INLINE_HEADER ( +Bytecount +charset_codepoint_to_itext (Lisp_Object charset, int c1, int c2, Ibyte *ptr, + enum converr UNUSED (fail)) +) +{ + Ichar ch; + + if (EQ (charset, Vcharset_ascii)) + { + ptr[0] = (Ibyte) c2; + return 1; + } + + ch = make_ichar (charset, c1, c2); + + /* We can't rely on the converted character being non-ASCII. For + example, JISX0208 codepoint (33, 64) == Unicode 0x5C (ASCII + backslash). */ + return set_itext_ichar (ptr, ch); +} + +/* Forward compatibility from ben-unicode-internal */ + +DECLARE_INLINE_HEADER ( +void +buffer_itext_to_charset_codepoint (const Ibyte *ptr, + struct buffer *UNUSED (buf), + Lisp_Object *charset, int *c1, int *c2, + enum converr UNUSED (fail)) +) +{ + Ichar ch = itext_ichar (ptr); + breakup_ichar_1 (ch, charset, c1, c2); +} + void get_charset_limits (Lisp_Object charset, int *low, int *high); int ichar_to_unicode (Ichar chr); diff -r 861f2601a38b -r 1f0b15040456 src/chartab.c --- a/src/chartab.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/chartab.c Sun May 01 18:44:03 2011 +0100 @@ -7,10 +7,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -18,9 +18,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.3. Not synched with FSF. @@ -128,11 +126,11 @@ } static Hashcode -char_table_entry_hash (Lisp_Object obj, int depth) +char_table_entry_hash (Lisp_Object obj, int depth, Boolint equalp) { Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); - return internal_array_hash (cte->level2, 96, depth + 1); + return internal_array_hash (cte->level2, 96, depth + 1, equalp); } static const struct memory_description char_table_entry_description[] = { @@ -140,13 +138,12 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry, - 1, /* dumpable flag */ - mark_char_table_entry, internal_object_printer, - 0, char_table_entry_equal, - char_table_entry_hash, - char_table_entry_description, - Lisp_Char_Table_Entry); +DEFINE_DUMPABLE_LISP_OBJECT ("char-table-entry", char_table_entry, + mark_char_table_entry, internal_object_printer, + 0, char_table_entry_equal, + char_table_entry_hash, + char_table_entry_description, + Lisp_Char_Table_Entry); #endif /* MULE */ @@ -258,10 +255,12 @@ sferror ("Charset in row vector must be multi-byte", outrange->charset); case CHARSET_TYPE_94X94: - check_int_range (outrange->row, 33, 126); + check_integer_range (make_int (outrange->row), make_int (33), + make_int (126)); break; case CHARSET_TYPE_96X96: - check_int_range (outrange->row, 32, 127); + check_integer_range (make_int (outrange->row), make_int (32), + make_int (127)); break; default: ABORT (); @@ -302,6 +301,30 @@ return Qnil; /* not reached */ } +static Lisp_Object +char_table_default_for_type (enum char_table_type type) +{ + switch (type) + { + case CHAR_TABLE_TYPE_CHAR: + return make_char (0); + break; + case CHAR_TABLE_TYPE_DISPLAY: + case CHAR_TABLE_TYPE_GENERIC: +#ifdef MULE + case CHAR_TABLE_TYPE_CATEGORY: +#endif /* MULE */ + return Qnil; + break; + + case CHAR_TABLE_TYPE_SYNTAX: + return make_integer (Sinherit); + break; + } + ABORT(); + return Qzero; +} + struct ptemap { Lisp_Object printcharfun; @@ -337,8 +360,15 @@ arg.printcharfun = printcharfun; arg.first = 1; - write_fmt_string_lisp (printcharfun, "#s(char-table type %s data (", - 1, char_table_type_to_symbol (ct->type)); + write_fmt_string_lisp (printcharfun, + "#s(char-table :type %s", 1, + char_table_type_to_symbol (ct->type)); + if (!(EQ (ct->default_, char_table_default_for_type (ct->type)))) + { + write_fmt_string_lisp (printcharfun, " :default %S", 1, ct->default_); + } + + write_ascstring (printcharfun, " :data ("); map_char_table (obj, &range, print_table_entry, &arg); write_ascstring (printcharfun, "))"); @@ -370,17 +400,17 @@ } static Hashcode -char_table_hash (Lisp_Object obj, int depth) +char_table_hash (Lisp_Object obj, int depth, Boolint equalp) { Lisp_Char_Table *ct = XCHAR_TABLE (obj); Hashcode hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS, - depth + 1); + depth + 1, equalp); #ifdef MULE hashval = HASH2 (hashval, internal_array_hash (ct->level1, NUM_LEADING_BYTES, - depth + 1)); + depth + 1, equalp)); #endif /* MULE */ - return HASH2 (hashval, internal_hash (ct->default_, depth + 1)); + return HASH2 (hashval, internal_hash (ct->default_, depth + 1, equalp)); } static const struct memory_description char_table_description[] = { @@ -395,12 +425,11 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table, - 1, /*dumpable-flag*/ - mark_char_table, print_char_table, 0, - char_table_equal, char_table_hash, - char_table_description, - Lisp_Char_Table); +DEFINE_DUMPABLE_LISP_OBJECT ("char-table", char_table, + mark_char_table, print_char_table, 0, + char_table_equal, char_table_hash, + char_table_description, + Lisp_Char_Table); DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /* Return non-nil if OBJECT is a char table. @@ -479,7 +508,7 @@ if (!EQ (ct->level1[i], Qnull_pointer) && CHAR_TABLE_ENTRYP (ct->level1[i]) && !OBJECT_DUMPED_P (ct->level1[1])) - FREE_LCRECORD (ct->level1[i]); + free_normal_lisp_object (ct->level1[i]); ct->level1[i] = value; } #endif /* MULE */ @@ -494,37 +523,13 @@ (char_table)) { Lisp_Char_Table *ct; - Lisp_Object def; CHECK_CHAR_TABLE (char_table); ct = XCHAR_TABLE (char_table); - switch (ct->type) - { - case CHAR_TABLE_TYPE_CHAR: - def = make_char (0); - break; - case CHAR_TABLE_TYPE_DISPLAY: - case CHAR_TABLE_TYPE_GENERIC: -#ifdef MULE - case CHAR_TABLE_TYPE_CATEGORY: -#endif /* MULE */ - def = Qnil; - break; - - case CHAR_TABLE_TYPE_SYNTAX: - def = make_int (Sinherit); - break; - - default: - ABORT (); - def = Qnil; - break; - } - /* Avoid doubly updating the syntax table by setting the default ourselves, since set_char_table_default() also updates. */ - ct->default_ = def; + ct->default_ = char_table_default_for_type (ct->type); fill_char_table (ct, Qunbound); return Qnil; @@ -598,13 +603,11 @@ */ (type)) { - Lisp_Char_Table *ct; - Lisp_Object obj; + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (char_table); + Lisp_Char_Table *ct = XCHAR_TABLE (obj); enum char_table_type ty = symbol_to_char_table_type (type); - ct = ALLOC_LCRECORD_TYPE (Lisp_Char_Table, &lrecord_char_table); ct->type = ty; - obj = wrap_char_table (ct); if (ty == CHAR_TABLE_TYPE_SYNTAX) { /* Qgeneric not Qsyntax because a syntax table has a mirror table @@ -634,13 +637,13 @@ make_char_table_entry (Lisp_Object initval) { int i; - Lisp_Char_Table_Entry *cte = - ALLOC_LCRECORD_TYPE (Lisp_Char_Table_Entry, &lrecord_char_table_entry); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (char_table_entry); + Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); for (i = 0; i < 96; i++) cte->level2[i] = initval; - return wrap_char_table_entry (cte); + return obj; } static Lisp_Object @@ -648,8 +651,8 @@ { Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry); int i; - Lisp_Char_Table_Entry *ctenew = - ALLOC_LCRECORD_TYPE (Lisp_Char_Table_Entry, &lrecord_char_table_entry); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (char_table_entry); + Lisp_Char_Table_Entry *ctenew = XCHAR_TABLE_ENTRY (obj); for (i = 0; i < 96; i++) { @@ -660,7 +663,7 @@ ctenew->level2[i] = new_; } - return wrap_char_table_entry (ctenew); + return obj; } #endif /* MULE */ @@ -679,12 +682,12 @@ CHECK_CHAR_TABLE (char_table); ct = XCHAR_TABLE (char_table); assert(!ct->mirror_table_p); - ctnew = ALLOC_LCRECORD_TYPE (Lisp_Char_Table, &lrecord_char_table); + obj = ALLOC_NORMAL_LISP_OBJECT (char_table); + ctnew = XCHAR_TABLE (obj); ctnew->type = ct->type; ctnew->parent = ct->parent; ctnew->default_ = ct->default_; ctnew->mirror_table_p = 0; - obj = wrap_char_table (ctnew); for (i = 0; i < NUM_ASCII_CHARS; i++) { @@ -1075,7 +1078,7 @@ int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE; if (CHAR_TABLE_ENTRYP (ct->level1[lb]) && !OBJECT_DUMPED_P (ct->level1[lb])) - FREE_LCRECORD (ct->level1[lb]); + free_normal_lisp_object (ct->level1[lb]); ct->level1[lb] = val; } break; @@ -1547,36 +1550,93 @@ return 1; } +static int +chartab_default_validate (Lisp_Object UNUSED (keyword), + Lisp_Object UNUSED (value), + Error_Behavior UNUSED (errb)) +{ + /* We can't yet validate this, since we don't know what the type of the + char table is. We do the validation below in chartab_instantiate(). */ + return 1; +} + static Lisp_Object -chartab_instantiate (Lisp_Object data) +chartab_instantiate (Lisp_Object plist) { Lisp_Object chartab; Lisp_Object type = Qgeneric; - Lisp_Object dataval = Qnil; - - while (!NILP (data)) - { - Lisp_Object keyw = Fcar (data); - Lisp_Object valw; + Lisp_Object dataval = Qnil, default_ = Qunbound; - data = Fcdr (data); - valw = Fcar (data); - data = Fcdr (data); - if (EQ (keyw, Qtype)) - type = valw; - else if (EQ (keyw, Qdata)) - dataval = valw; + if (KEYWORDP (Fcar (plist))) + { + PROPERTY_LIST_LOOP_3 (key, value, plist) + { + if (EQ (key, Q_data)) + { + dataval = value; + } + else if (EQ (key, Q_type)) + { + type = value; + } + else if (EQ (key, Q_default_)) + { + default_ = value; + } + else if (!KEYWORDP (key)) + { + signal_error + (Qinvalid_read_syntax, + "can't mix keyword and non-keyword structure syntax", + key); + } + else + ABORT (); + } + } +#ifdef NEED_TO_HANDLE_21_4_CODE + else + { + PROPERTY_LIST_LOOP_3 (key, value, plist) + { + if (EQ (key, Qdata)) + { + dataval = value; + } + else if (EQ (key, Qtype)) + { + type = value; + } + else if (KEYWORDP (key)) + signal_error + (Qinvalid_read_syntax, + "can't mix keyword and non-keyword structure syntax", + key); + else + ABORT (); + } + } +#endif /* NEED_TO_HANDLE_21_4_CODE */ + + chartab = Fmake_char_table (type); + if (!UNBOUNDP (default_)) + { + check_valid_char_table_value (default_, XCHAR_TABLE_TYPE (chartab), + ERROR_ME); + set_char_table_default (chartab, default_); + if (!NILP (XCHAR_TABLE (chartab)->mirror_table)) + { + set_char_table_default (XCHAR_TABLE (chartab)->mirror_table, + default_); + } } - chartab = Fmake_char_table (type); - - data = dataval; - while (!NILP (data)) + while (!NILP (dataval)) { - Lisp_Object range = Fcar (data); - Lisp_Object val = Fcar (Fcdr (data)); + Lisp_Object range = Fcar (dataval); + Lisp_Object val = Fcar (Fcdr (dataval)); - data = Fcdr (Fcdr (data)); + dataval = Fcdr (Fcdr (dataval)); if (CONSP (range)) { if (CHAR_OR_CHAR_INTP (XCAR (range))) @@ -1832,10 +1892,10 @@ void syms_of_chartab (void) { - INIT_LRECORD_IMPLEMENTATION (char_table); + INIT_LISP_OBJECT (char_table); #ifdef MULE - INIT_LRECORD_IMPLEMENTATION (char_table_entry); + INIT_LISP_OBJECT (char_table_entry); DEFSYMBOL (Qcategory_table_p); DEFSYMBOL (Qcategory_designator_p); @@ -1891,8 +1951,14 @@ st = define_structure_type (Qchar_table, 0, chartab_instantiate); +#ifdef NEED_TO_HANDLE_21_4_CODE define_structure_type_keyword (st, Qtype, chartab_type_validate); define_structure_type_keyword (st, Qdata, chartab_data_validate); +#endif /* NEED_TO_HANDLE_21_4_CODE */ + + define_structure_type_keyword (st, Q_type, chartab_type_validate); + define_structure_type_keyword (st, Q_data, chartab_data_validate); + define_structure_type_keyword (st, Q_default_, chartab_default_validate); } void diff -r 861f2601a38b -r 1f0b15040456 src/chartab.h --- a/src/chartab.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/chartab.h Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.3. Not synched with FSF. @@ -42,7 +40,7 @@ struct Lisp_Char_Table_Entry { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; /* In the interests of simplicity, we just use a fixed 96-entry table. If we felt like being smarter, we could make this @@ -51,7 +49,7 @@ }; typedef struct Lisp_Char_Table_Entry Lisp_Char_Table_Entry; -DECLARE_LRECORD (char_table_entry, Lisp_Char_Table_Entry); +DECLARE_LISP_OBJECT (char_table_entry, Lisp_Char_Table_Entry); #define XCHAR_TABLE_ENTRY(x) \ XRECORD (x, char_table_entry, Lisp_Char_Table_Entry) #define wrap_char_table_entry(p) wrap_record (p, char_table_entry) @@ -80,7 +78,7 @@ struct Lisp_Char_Table { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; Lisp_Object ascii[NUM_ASCII_CHARS]; Lisp_Object default_; @@ -128,7 +126,7 @@ }; typedef struct Lisp_Char_Table Lisp_Char_Table; -DECLARE_LRECORD (char_table, Lisp_Char_Table); +DECLARE_LISP_OBJECT (char_table, Lisp_Char_Table); #define XCHAR_TABLE(x) XRECORD (x, char_table, Lisp_Char_Table) #define wrap_char_table(p) wrap_record (p, char_table) #define CHAR_TABLEP(x) RECORDP (x, char_table) diff -r 861f2601a38b -r 1f0b15040456 src/cm.c --- a/src/cm.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/cm.c Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,14 @@ /* Cursor motion subroutines for XEmacs. Copyright (C) 1985, 1994, 1995 Free Software Foundation, Inc. + Copyright (C) 2010 Ben Wing. loosely based primarily on public domain code written by Chris Torek This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. Substantially different from FSF. */ @@ -100,8 +99,7 @@ { if (curX == FrameCols) { - if (!MagicWrap || curY >= FrameRows - 1) - ABORT (); + assert (MagicWrap && curY < FrameRows - 1); if (termscript) putc ('\r', termscript); putchar ('\r'); diff -r 861f2601a38b -r 1f0b15040456 src/cm.h --- a/src/cm.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/cm.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ diff -r 861f2601a38b -r 1f0b15040456 src/cmdloop.c --- a/src/cmdloop.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/cmdloop.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.0. Not synched with FSF. This was renamed from keyboard.c. However, it only contains the diff -r 861f2601a38b -r 1f0b15040456 src/cmds.c --- a/src/cmds.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/cmds.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.0, FSF 19.30. */ @@ -334,7 +332,9 @@ Lisp_Object c; EMACS_INT n; - CHECK_NATNUM (count); + /* Can't insert more than most-positive-fixnum characters, the buffer + won't hold that many. */ + check_integer_range (count, Qzero, make_int (EMACS_INT_MAX)); n = XINT (count); if (CHAR_OR_CHAR_INTP (Vlast_command_char)) diff -r 861f2601a38b -r 1f0b15040456 src/coding-system-slots.h --- a/src/coding-system-slots.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/coding-system-slots.h Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: ????. Split out of file-coding.h. */ diff -r 861f2601a38b -r 1f0b15040456 src/commands.h --- a/src/commands.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/commands.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ diff -r 861f2601a38b -r 1f0b15040456 src/compiler.h --- a/src/compiler.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/compiler.h Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* Compiler-specific definitions for XEmacs. Copyright (C) 1998-1999, 2003 Free Software Foundation, Inc. Copyright (C) 1994 Richard Mlynarik. - Copyright (C) 1995, 1996, 2000-2004 Ben Wing. + Copyright (C) 1995, 1996, 2000-2004, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: not in FSF. */ @@ -233,23 +231,44 @@ # define ATTRIBUTE_UNUSED # endif # define UNUSED(decl) UNUSED_ARG (decl) ATTRIBUTE_UNUSED -# ifdef MULE -# define USED_IF_MULE(decl) decl -# else -# define USED_IF_MULE(decl) UNUSED (decl) -# endif -# ifdef HAVE_XFT -# define USED_IF_XFT(decl) decl -# else -# define USED_IF_XFT(decl) UNUSED (decl) -# endif -# ifdef HAVE_SCROLLBARS -# define USED_IF_SCROLLBARS(decl) decl -# else -# define USED_IF_SCROLLBARS(decl) UNUSED (decl) -# endif #endif /* UNUSED */ +/* Various macros for params/variables used or unused depending on + config flags. */ + +#ifdef MULE +# define USED_IF_MULE(decl) decl +#else +# define USED_IF_MULE(decl) UNUSED (decl) +#endif +#ifdef HAVE_XFT +# define USED_IF_XFT(decl) decl +#else +# define USED_IF_XFT(decl) UNUSED (decl) +#endif +#ifdef HAVE_SCROLLBARS +# define USED_IF_SCROLLBARS(decl) decl +#else +# define USED_IF_SCROLLBARS(decl) UNUSED (decl) +#endif +#ifdef NEW_GC +# define USED_IF_NEW_GC(decl) decl +# define UNUSED_IF_NEW_GC(decl) UNUSED (decl) +#else +# define USED_IF_NEW_GC(decl) UNUSED (decl) +# define UNUSED_IF_NEW_GC(decl) decl +#endif +#ifdef HAVE_TTY +#define USED_IF_TTY(decl) decl +#else +#define USED_IF_TTY(decl) UNUSED (decl) +#endif +#ifdef HAVE_TOOLBARS +#define USED_IF_TOOLBARS(decl) decl +#else +#define USED_IF_TOOLBARS(decl) UNUSED (decl) +#endif + /* Declaration that variable or expression X is "used" to defeat "unused variable" warnings. DON'T DO THIS FOR PARAMETERS IF IT ALL POSSIBLE. Use an UNUSED() or USED_IF_*() declaration on the parameter diff -r 861f2601a38b -r 1f0b15040456 src/config.h.in --- a/src/config.h.in Sat Feb 20 06:03:00 2010 -0600 +++ b/src/config.h.in Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Significantly divergent from FSF. */ @@ -114,10 +112,6 @@ #undef XEMACS_CODENAME #undef XEMACS_EXTRA_NAME #undef XEMACS_RELEASE_DATE -/* InfoDock versions, not used with XEmacs */ -#undef INFODOCK_MAJOR_VERSION -#undef INFODOCK_MINOR_VERSION -#undef INFODOCK_BUILD_VERSION /* Make functions from IEEE Stds 1003.[123] available. */ #undef _POSIX_C_SOURCE @@ -339,6 +333,7 @@ /* Darwin; realpath corrects for case: */ #ifdef HAVE_DYLD #define REALPATH_CORRECTS_CASE 1 +#define DEFAULT_FILE_SYSTEM_IGNORE_CASE 1 #endif #undef HAVE_LIBINTL @@ -1183,4 +1178,9 @@ #define XEMACS_DEFS_NEEDS_INLINE_DECLS #endif +/* Do we need to be able to run code compiled by and written for 21.4? */ +#define NEED_TO_HANDLE_21_4_CODE 1 + +#define SUPPORT_CONFOUNDING_FUNCTIONS NEED_TO_HANDLE_21_4_CODE + #endif /* _SRC_CONFIG_H_ */ diff -r 861f2601a38b -r 1f0b15040456 src/conslots.h --- a/src/conslots.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/conslots.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.0, FSF 19.30. (see FSF keyboard.h.) */ diff -r 861f2601a38b -r 1f0b15040456 src/console-gtk-impl.h --- a/src/console-gtk-impl.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/console-gtk-impl.h Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -50,7 +48,7 @@ struct gtk_device { #ifdef NEW_GC - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; #endif /* NEW_GC */ /* Gtk application info. */ GtkWidget *gtk_app_shell; @@ -115,7 +113,7 @@ #ifdef NEW_GC typedef struct gtk_device Lisp_Gtk_Device; -DECLARE_LRECORD (gtk_device, Lisp_Gtk_Device); +DECLARE_LISP_OBJECT (gtk_device, Lisp_Gtk_Device); #define XGTK_DEVICE(x) \ XRECORD (x, gtk_device, Lisp_Gtk_Device) @@ -144,7 +142,7 @@ struct gtk_frame { #ifdef NEW_GC - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; #endif /* NEW_GC */ /* The widget of this frame. */ @@ -159,6 +157,11 @@ /* The widget of the edit portion of this frame; this is a GtkDrawingArea, and the window of this widget is what the redisplay code draws on. */ GtkWidget *edit_widget; + /* #### WARNING: this does not currently work. -- dvl + Position of the edit widget above, for absolute background placement. + + int x, y; + */ /* Lists the widgets above the text area, in the proper order. */ GtkWidget *top_widgets[MAX_CONCURRENT_TOP_WIDGETS]; @@ -203,7 +206,7 @@ #ifdef NEW_GC typedef struct gtk_frame Lisp_Gtk_Frame; -DECLARE_LRECORD (gtk_frame, Lisp_Gtk_Frame); +DECLARE_LISP_OBJECT (gtk_frame, Lisp_Gtk_Frame); #define XGTK_FRAME(x) \ XRECORD (x, gtk_frame, Lisp_Gtk_Frame) @@ -213,6 +216,10 @@ #define FRAME_GTK_DATA(f) FRAME_TYPE_DATA (f, gtk) +/* #### WARNING: this does not currently work. -- dvl + #define FRAME_GTK_X(f) (FRAME_GTK_DATA (f)->x) + #define FRAME_GTK_Y(f) (FRAME_GTK_DATA (f)->y) +*/ #define FRAME_GTK_SHELL_WIDGET(f) (FRAME_GTK_DATA (f)->widget) #define FRAME_GTK_CONTAINER_WIDGET(f) (FRAME_GTK_DATA (f)->container) #define FRAME_GTK_MENUBAR_WIDGET(f) (FRAME_GTK_DATA (f)->menubar_widget) diff -r 861f2601a38b -r 1f0b15040456 src/console-gtk.c --- a/src/console-gtk.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/console-gtk.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -160,7 +158,7 @@ if (!(HASH_TABLEP(Vgtk_seen_characters))) { Vgtk_seen_characters = make_lisp_hash_table (128, HASH_TABLE_NON_WEAK, - HASH_TABLE_EQUAL); + Qequal); } /* Might give the user an opaque error if make_lisp_hash_table fails, diff -r 861f2601a38b -r 1f0b15040456 src/console-gtk.h --- a/src/console-gtk.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/console-gtk.h Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -64,7 +62,8 @@ int start_pixpos, int width, face_index findex, int cursor, int cursor_start, int cursor_width, int cursor_height); -GdkGC *gtk_get_gc (struct device *d, Lisp_Object font, Lisp_Object fg, Lisp_Object bg, +GdkGC *gtk_get_gc (struct frame *f, + Lisp_Object font, Lisp_Object fg, Lisp_Object bg, Lisp_Object bg_pmap, Lisp_Object lwidth); int gtk_initialize_frame_menubar (struct frame *f); diff -r 861f2601a38b -r 1f0b15040456 src/console-impl.h --- a/src/console-impl.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/console-impl.h Sun May 01 18:44:03 2011 +0100 @@ -1,12 +1,12 @@ /* Define console object for XEmacs. - Copyright (C) 1996, 2002, 2003, 2005 Ben Wing + Copyright (C) 1996, 2002, 2003, 2005, 2010 Ben Wing This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -153,9 +151,10 @@ int (*eol_cursor_width_method) (void); void (*output_vertical_divider_method) (struct window *, int); void (*clear_to_window_end_method) (struct window *, int, int); - void (*clear_region_method) (Lisp_Object, struct device*, struct frame*, face_index, - int, int, int, int, - Lisp_Object, Lisp_Object, Lisp_Object); + void (*clear_region_method) (Lisp_Object, struct device*, struct frame*, + face_index, int, int, int, int, + Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object); void (*clear_frame_method) (struct frame *); void (*window_output_begin_method) (struct window *); void (*frame_output_begin_method) (struct frame *); @@ -192,7 +191,7 @@ Lisp_Color_Instance *, int depth); Hashcode (*color_instance_hash_method) (Lisp_Color_Instance *, - int depth); + int depth); Lisp_Object (*color_instance_rgb_components_method) (Lisp_Color_Instance *); int (*valid_color_name_p_method) (struct device *, Lisp_Object color); Lisp_Object (*color_list_method) (void); @@ -289,9 +288,10 @@ scrollbar_instance *); void (*scrollbar_pointer_changed_in_window_method) (struct window *w); #ifdef MEMORY_USAGE_STATS - int (*compute_scrollbar_instance_usage_method) (struct device *, - struct scrollbar_instance *, - struct overhead_stats *); + Bytecount (*compute_scrollbar_instance_usage_method) + (struct device *, + struct scrollbar_instance *, + struct usage_stats *); #endif /* Paint the window's deadbox, a rectangle between window borders and two short edges of both scrollbars. */ @@ -409,7 +409,7 @@ struct console { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; /* Description of this console's methods. */ struct console_methods *conmeths; @@ -453,7 +453,11 @@ /* Redefine basic properties more efficiently */ #undef CONSOLE_LIVE_P -#define CONSOLE_LIVE_P(con) (!EQ (CONSOLE_TYPE (con), Qdead)) +/* The following is the old way, but it can lead to crashes in certain + weird circumstances, where you might want to be printing a console via + debug_print() */ +/* #define CONSOLE_LIVE_P(con) (!EQ (CONSOLE_TYPE (con), Qdead)) */ +#define CONSOLE_LIVE_P(con) ((con)->contype != dead_console) #undef CONSOLE_DEVICE_LIST #define CONSOLE_DEVICE_LIST(con) ((con)->device_list) diff -r 861f2601a38b -r 1f0b15040456 src/console-msw-impl.h --- a/src/console-msw-impl.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/console-msw-impl.h Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* Define mswindows-specific console, device, and frame object for XEmacs. Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 2001, 2002 Ben Wing. + Copyright (C) 2001, 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -57,7 +55,7 @@ struct Lisp_Devmode { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; /* Pointer to the DEVMODE structure */ DEVMODEW *devmode; @@ -82,7 +80,7 @@ struct mswindows_device { #ifdef NEW_GC - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; #endif /* NEW_GC */ Lisp_Object fontlist; /* List of (STRING . FIXED-P), device fonts */ HDC hcdc; /* Compatible DC */ @@ -94,7 +92,7 @@ #ifdef NEW_GC typedef struct mswindows_device Lisp_Mswindows_Device; -DECLARE_LRECORD (mswindows_device, Lisp_Mswindows_Device); +DECLARE_LISP_OBJECT (mswindows_device, Lisp_Mswindows_Device); #define XMSWINDOWS_DEVICE(x) \ XRECORD (x, mswindows_device, Lisp_Mswindows_Device) @@ -110,7 +108,7 @@ struct msprinter_device { #ifdef NEW_GC - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; #endif /* NEW_GC */ HDC hdc, hcdc; /* Printer and the comp. DCs */ HANDLE hprinter; @@ -122,7 +120,7 @@ #ifdef NEW_GC typedef struct msprinter_device Lisp_Msprinter_Device; -DECLARE_LRECORD (msprinter_device, Lisp_Msprinter_Device); +DECLARE_LISP_OBJECT (msprinter_device, Lisp_Msprinter_Device); #define XMSPRINTER_DEVICE(x) \ XRECORD (x, msprinter_device, Lisp_Msprinter_Device) @@ -168,7 +166,7 @@ struct mswindows_frame { #ifdef NEW_GC - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; #endif /* NEW_GC */ /* win32 window handle */ @@ -206,10 +204,6 @@ /* Frame title hash value. See frame-msw.c */ unsigned int title_checksum; - /* Real character width and height of the frame. - FRAME_{HEIGHT,WIDTH} do not work for pixel geometry! */ - int charheight, charwidth; - #ifdef MULE int cursor_x; int cursor_y; @@ -234,7 +228,7 @@ #ifdef NEW_GC typedef struct mswindows_frame Lisp_Mswindows_Frame; -DECLARE_LRECORD (mswindows_frame, Lisp_Mswindows_Frame); +DECLARE_LISP_OBJECT (mswindows_frame, Lisp_Mswindows_Frame); #define XMSWINDOWS_FRAME(x) \ XRECORD (x, mswindows_frame, Lisp_Mswindows_Frame) @@ -259,8 +253,6 @@ (FRAME_MSWINDOWS_DATA (f)->toolbar_checksum[pos]) #define FRAME_MSWINDOWS_MENU_CHECKSUM(f) (FRAME_MSWINDOWS_DATA (f)->menu_checksum) #define FRAME_MSWINDOWS_TITLE_CHECKSUM(f) (FRAME_MSWINDOWS_DATA (f)->title_checksum) -#define FRAME_MSWINDOWS_CHARWIDTH(f) (FRAME_MSWINDOWS_DATA (f)->charwidth) -#define FRAME_MSWINDOWS_CHARHEIGHT(f) (FRAME_MSWINDOWS_DATA (f)->charheight) #define FRAME_MSWINDOWS_TARGET_RECT(f) (FRAME_MSWINDOWS_DATA (f)->target_rect) #define FRAME_MSWINDOWS_POPUP(f) (FRAME_MSWINDOWS_DATA (f)->popup) @@ -318,7 +310,7 @@ struct mswindows_dialog_id { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; Lisp_Object frame; Lisp_Object callbacks; diff -r 861f2601a38b -r 1f0b15040456 src/console-msw.c --- a/src/console-msw.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/console-msw.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -212,7 +210,7 @@ can use eq as the test without worrying. */ Vmswindows_seen_characters = make_lisp_hash_table (128, HASH_TABLE_NON_WEAK, - HASH_TABLE_EQ); + Qeq); } /* Might give the user an opaque error if make_lisp_hash_table fails, but it shouldn't crash. */ diff -r 861f2601a38b -r 1f0b15040456 src/console-msw.h --- a/src/console-msw.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/console-msw.h Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -57,7 +55,7 @@ typedef struct Lisp_Devmode Lisp_Devmode; -DECLARE_LRECORD (devmode, Lisp_Devmode); +DECLARE_LISP_OBJECT (devmode, Lisp_Devmode); #define XDEVMODE(x) XRECORD (x, devmode, Lisp_Devmode) #define wrap_devmode(p) wrap_record (p, devmode) #define DEVMODEP(x) RECORDP (x, devmode) @@ -210,7 +208,7 @@ struct mswindows_dialog_id; -DECLARE_LRECORD (mswindows_dialog_id, struct mswindows_dialog_id); +DECLARE_LISP_OBJECT (mswindows_dialog_id, struct mswindows_dialog_id); #define XMSWINDOWS_DIALOG_ID(x) XRECORD (x, mswindows_dialog_id, struct mswindows_dialog_id) #define wrap_mswindows_dialog_id(p) wrap_record (p, mswindows_dialog_id) #define MSWINDOWS_DIALOG_IDP(x) RECORDP (x, mswindows_dialog_id) diff -r 861f2601a38b -r 1f0b15040456 src/console-stream-impl.h --- a/src/console-stream-impl.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/console-stream-impl.h Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -35,7 +33,7 @@ struct stream_console { #ifdef NEW_GC - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; #endif /* NEW_GC */ FILE *in; FILE *out; @@ -47,7 +45,7 @@ #ifdef NEW_GC typedef struct stream_console Lisp_Stream_Console; -DECLARE_LRECORD (stream_console, Lisp_Stream_Console); +DECLARE_LISP_OBJECT (stream_console, Lisp_Stream_Console); #define XSTREAM_CONSOLE(x) \ XRECORD (x, stream_console, Lisp_Stream_Console) diff -r 861f2601a38b -r 1f0b15040456 src/console-stream.c --- a/src/console-stream.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/console-stream.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -54,11 +52,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("stream-console", stream_console, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - stream_console_data_description_1, - Lisp_Stream_Console); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("stream-console", stream_console, + 0, stream_console_data_description_1, + Lisp_Stream_Console); #else /* not NEW_GC */ const struct sized_memory_description stream_console_data_description = { sizeof (struct stream_console), stream_console_data_description_1 @@ -73,8 +69,8 @@ #ifdef NEW_GC if (CONSOLE_STREAM_DATA (con) == NULL) - CONSOLE_STREAM_DATA (con) = alloc_lrecord_type (struct stream_console, - &lrecord_stream_console); + CONSOLE_STREAM_DATA (con) = + XSTREAM_CONSOLE (ALLOC_NORMAL_LISP_OBJECT (stream_console)); #else /* not NEW_GC */ if (CONSOLE_STREAM_DATA (con) == NULL) CONSOLE_STREAM_DATA (con) = xnew_and_zero (struct stream_console); @@ -282,7 +278,8 @@ int UNUSED (x), int UNUSED (y), int UNUSED (width), int UNUSED (height), Lisp_Object UNUSED (fcolor), Lisp_Object UNUSED (bcolor), - Lisp_Object UNUSED (background_pixmap)) + Lisp_Object UNUSED (background_pixmap), + Lisp_Object UNUSED (background_placement)) { ABORT (); } diff -r 861f2601a38b -r 1f0b15040456 src/console-stream.h --- a/src/console-stream.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/console-stream.h Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/console-tty-impl.h --- a/src/console-tty-impl.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/console-tty-impl.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -40,7 +38,7 @@ struct tty_console { #ifdef NEW_GC - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; #endif /* NEW_GC */ int infd, outfd; Lisp_Object instream, outstream; @@ -63,6 +61,8 @@ int height; int width; + int colors; + /* The count of frame number. */ int frame_count; @@ -207,7 +207,7 @@ #ifdef NEW_GC typedef struct tty_console Lisp_Tty_Console; -DECLARE_LRECORD (tty_console, Lisp_Tty_Console); +DECLARE_LISP_OBJECT (tty_console, Lisp_Tty_Console); #define XTTY_CONSOLE(x) \ XRECORD (x, tty_console, Lisp_Tty_Console) @@ -256,7 +256,7 @@ struct tty_device { #ifdef NEW_GC - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; #endif /* NEW_GC */ #ifdef HAVE_TERMIOS speed_t ospeed; /* Output speed (from sg_ospeed) */ @@ -268,7 +268,7 @@ #ifdef NEW_GC typedef struct tty_device Lisp_Tty_Device; -DECLARE_LRECORD (tty_device, Lisp_Tty_Device); +DECLARE_LISP_OBJECT (tty_device, Lisp_Tty_Device); #define XTTY_DEVICE(x) \ XRECORD (x, tty_device, Lisp_Tty_Device) diff -r 861f2601a38b -r 1f0b15040456 src/console-tty.c --- a/src/console-tty.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/console-tty.c Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -60,11 +58,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("tty-console", tty_console, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - tty_console_data_description_1, - Lisp_Tty_Console); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("tty-console", tty_console, + 0, tty_console_data_description_1, + Lisp_Tty_Console); #else /* not NEW_GC */ const struct sized_memory_description tty_console_data_description = { sizeof (struct tty_console), tty_console_data_description_1 @@ -77,8 +73,7 @@ { /* zero out all slots except the lisp ones ... */ #ifdef NEW_GC - CONSOLE_TTY_DATA (con) = alloc_lrecord_type (struct tty_console, - &lrecord_tty_console); + CONSOLE_TTY_DATA (con) = XTTY_CONSOLE (ALLOC_NORMAL_LISP_OBJECT (tty_console)); #else /* not NEW_GC */ CONSOLE_TTY_DATA (con) = xnew_and_zero (struct tty_console); #endif /* not NEW_GC */ @@ -431,7 +426,7 @@ /* All the keysyms we deal with are character objects; therefore, we can use eq as the test without worrying. */ Vtty_seen_characters = make_lisp_hash_table (128, HASH_TABLE_NON_WEAK, - HASH_TABLE_EQ); + Qeq); } /* Might give the user an opaque error if make_lisp_hash_table fails, diff -r 861f2601a38b -r 1f0b15040456 src/console-tty.h --- a/src/console-tty.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/console-tty.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -55,7 +53,7 @@ extern const struct sized_memory_description tty_console_data_description; -/*************** Prototypes from objects-tty.c ****************/ +/*************** Prototypes from fontcolor-tty.c ****************/ extern const struct sized_memory_description tty_color_instance_data_description; extern const struct sized_memory_description tty_font_instance_data_description; diff -r 861f2601a38b -r 1f0b15040456 src/console-x-impl.h --- a/src/console-x-impl.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/console-x-impl.h Sun May 01 18:44:03 2011 +0100 @@ -2,13 +2,14 @@ Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. Copyright (C) 1996, 2002, 2003 Ben Wing. + Copyright (C) 2010 Didier Verna This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -45,7 +44,7 @@ struct x_device { #ifdef NEW_GC - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; #endif /* NEW_GC */ /* The X connection of this device. */ Display *display; @@ -88,7 +87,7 @@ Atom Xatom_ATOM_PAIR; Atom Xatom_COMPOUND_TEXT; - /* allocated in Xatoms_of_objects_x */ + /* allocated in Xatoms_of_fontcolor_x */ Atom Xatom_FOUNDRY; Atom Xatom_FAMILY_NAME; Atom Xatom_WEIGHT_NAME; @@ -167,7 +166,7 @@ #ifdef NEW_GC typedef struct x_device Lisp_X_Device; -DECLARE_LRECORD (x_device, Lisp_X_Device); +DECLARE_LISP_OBJECT (x_device, Lisp_X_Device); #define XX_DEVICE(x) \ XRECORD (x, x_device, Lisp_X_Device) @@ -218,7 +217,7 @@ #define DEVICE_XATOM_ATOM_PAIR(d) (DEVICE_X_DATA (d)->Xatom_ATOM_PAIR) #define DEVICE_XATOM_COMPOUND_TEXT(d) (DEVICE_X_DATA (d)->Xatom_COMPOUND_TEXT) -/* allocated in Xatoms_of_objects_x */ +/* allocated in Xatoms_of_fontcolor_x */ #define DEVICE_XATOM_FOUNDRY(d) (DEVICE_X_DATA (d)->Xatom_FOUNDRY) #define DEVICE_XATOM_FAMILY_NAME(d) (DEVICE_X_DATA (d)->Xatom_FAMILY_NAME) #define DEVICE_XATOM_WEIGHT_NAME(d) (DEVICE_X_DATA (d)->Xatom_WEIGHT_NAME) @@ -243,7 +242,7 @@ struct x_frame { #ifdef NEW_GC - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; #endif /* NEW_GC */ /* The widget of this frame. @@ -265,6 +264,8 @@ /* The widget of the edit portion of this frame; this is an EmacsFrame, and the window of this widget is what the redisplay code draws on. */ Widget edit_widget; + /* Position of the edit widget above, for absolute background placement. */ + int x, y; /* Lists the widgets above the text area, in the proper order. Used by the EmacsManager. */ @@ -351,7 +352,7 @@ #ifdef NEW_GC typedef struct x_frame Lisp_X_Frame; -DECLARE_LRECORD (x_frame, Lisp_X_Frame); +DECLARE_LISP_OBJECT (x_frame, Lisp_X_Frame); #define XX_FRAME(x) \ XRECORD (x, x_frame, Lisp_X_Frame) @@ -360,6 +361,8 @@ #endif /* NEW_GC */ #define FRAME_X_DATA(f) FRAME_TYPE_DATA (f, x) +#define FRAME_X_X(f) (FRAME_X_DATA (f)->x) +#define FRAME_X_Y(f) (FRAME_X_DATA (f)->y) #define FRAME_X_SHELL_WIDGET(f) (FRAME_X_DATA (f)->widget) #define FRAME_X_CONTAINER_WIDGET(f) (FRAME_X_DATA (f)->container) #define FRAME_X_MENUBAR_WIDGET(f) (FRAME_X_DATA (f)->menubar_widget) @@ -407,6 +410,8 @@ extern struct console_type *x_console_type; +void x_get_frame_text_position (struct frame *); + #endif /* HAVE_X_WINDOWS */ #endif /* INCLUDED_console_x_impl_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/console-x.c --- a/src/console-x.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/console-x.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -240,7 +238,7 @@ split_up_display_spec (connection, &hostname_length, &display_length, &screen_length); - hostname = Fsubstring (connection, Qzero, make_int (hostname_length)); + hostname = Fsubseq (connection, Qzero, make_int (hostname_length)); hostname = canonicalize_host_name (hostname); connection = concat2 (hostname, make_string (XSTRING_DATA (connection) diff -r 861f2601a38b -r 1f0b15040456 src/console-x.h --- a/src/console-x.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/console-x.h Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -98,7 +96,7 @@ void x_handle_property_notify (XPropertyEvent *event); void Xatoms_of_select_x (struct device *d); -void Xatoms_of_objects_x (struct device *d); +void Xatoms_of_fontcolor_x (struct device *d); void x_wm_set_shell_iconic_p (Widget shell, int iconic_p); void x_wm_set_cell_size (Widget wmshell, int cw, int ch); diff -r 861f2601a38b -r 1f0b15040456 src/console-xlike-inc.h --- a/src/console-xlike-inc.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/console-xlike-inc.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -90,7 +88,7 @@ # include "glyphs-x.h" # endif # ifdef NEED_OBJECTS_IMPL_H -# include "objects-x-impl.h" +# include "fontcolor-x-impl.h" # endif #else /* THIS_IS_GTK */ # include "console-gtk-impl.h" @@ -101,7 +99,7 @@ # include "glyphs-gtk.h" # endif # ifdef NEED_OBJECTS_IMPL_H -# include "objects-gtk-impl.h" +# include "fontcolor-gtk-impl.h" # endif #endif /* THIS_IS_GTK */ @@ -169,6 +167,8 @@ #define XLIKE_GC_LINE_WIDTH GCLineWidth #define XLIKE_GC_STIPPLE GCStipple #define XLIKE_GC_TILE GCTile +#define XLIKE_GC_TS_X_ORIGIN GCTileStipXOrigin +#define XLIKE_GC_TS_Y_ORIGIN GCTileStipYOrigin #define XLIKE_GX_COPY GXcopy #define XLIKE_GX_XOR GXxor @@ -258,6 +258,8 @@ #define XLIKE_GC_LINE_WIDTH GDK_GC_LINE_WIDTH #define XLIKE_GC_STIPPLE GDK_GC_STIPPLE #define XLIKE_GC_TILE GDK_GC_TILE +#define XLIKE_GC_TS_X_ORIGIN GDK_GC_TS_X_ORIGIN +#define XLIKE_GC_TS_Y_ORIGIN GDK_GC_TS_Y_ORIGIN #define XLIKE_GX_COPY GDK_COPY #define XLIKE_GX_XOR GDK_XOR diff -r 861f2601a38b -r 1f0b15040456 src/console.c --- a/src/console.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/console.c Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,13 @@ /* The console object. Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1996, 2002 Ben Wing. + Copyright (C) 1996, 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -43,12 +41,6 @@ #include "console-tty-impl.h" #endif -#ifdef HAVE_TTY -#define USED_IF_TTY(decl) decl -#else -#define USED_IF_TTY(decl) UNUSED (decl) -#endif - Lisp_Object Vconsole_list, Vselected_console; Lisp_Object Vcreate_console_hook, Vdelete_console_hook; @@ -169,21 +161,20 @@ struct console *con = XCONSOLE (obj); if (print_readably) - printing_unreadable_lcrecord (obj, XSTRING_DATA (con->name)); + printing_unreadable_lisp_object (obj, XSTRING_DATA (con->name)); write_fmt_string (printcharfun, "#<%s-console", !CONSOLE_LIVE_P (con) ? "dead" : CONSOLE_TYPE_NAME (con)); if (CONSOLE_LIVE_P (con) && !NILP (CONSOLE_CONNECTION (con))) write_fmt_string_lisp (printcharfun, " on %S", 1, CONSOLE_CONNECTION (con)); - write_fmt_string (printcharfun, " 0x%x>", con->header.uid); + write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); } -DEFINE_LRECORD_IMPLEMENTATION ("console", console, - 0, /*dumpable-flag*/ - mark_console, print_console, 0, 0, 0, - console_description, - struct console); +DEFINE_NODUMP_LISP_OBJECT ("console", console, mark_console, + print_console, 0, 0, 0, + console_description, + struct console); static void @@ -200,13 +191,12 @@ static struct console * allocate_console (Lisp_Object type) { - Lisp_Object console; - struct console *con = ALLOC_LCRECORD_TYPE (struct console, &lrecord_console); + Lisp_Object console = ALLOC_NORMAL_LISP_OBJECT (console); + struct console *con = XCONSOLE (console); struct gcpro gcpro1; - COPY_LCRECORD (con, XCONSOLE (Vconsole_defaults)); + copy_lisp_object (console, Vconsole_defaults); - console = wrap_console (con); GCPRO1 (console); con->conmeths = decode_console_type (type, ERROR_ME); @@ -669,7 +659,7 @@ static void nuke_all_console_slots (struct console *con, Lisp_Object zap) { - ZERO_LCRECORD (con); + zero_nonsized_lisp_object (wrap_console (con)); #define MARKED_SLOT(x) con->x = zap; #include "conslots.h" @@ -1193,12 +1183,12 @@ void syms_of_console (void) { - INIT_LRECORD_IMPLEMENTATION (console); + INIT_LISP_OBJECT (console); #ifdef NEW_GC #ifdef HAVE_TTY - INIT_LRECORD_IMPLEMENTATION (tty_console); + INIT_LISP_OBJECT (tty_console); #endif - INIT_LRECORD_IMPLEMENTATION (stream_console); + INIT_LISP_OBJECT (stream_console); #endif /* NEW_GC */ DEFSUBR (Fvalid_console_type_p); @@ -1326,9 +1316,8 @@ #define DEFVAR_CONSOLE_LOCAL_1(lname, field_name, forward_type, magic_fun) \ do { \ struct symbol_value_forward *I_hate_C = \ - alloc_lrecord_type (struct symbol_value_forward, \ - &lrecord_symbol_value_forward); \ - /*mcpro ((Lisp_Object) I_hate_C);*/ \ + XSYMBOL_VALUE_FORWARD (ALLOC_NORMAL_LISP_OBJECT (symbol_value_forward)); \ + /*mcpro ((Lisp_Object) I_hate_C);*/ \ \ I_hate_C->magic.value = &(console_local_flags.field_name); \ I_hate_C->magic.type = forward_type; \ @@ -1360,8 +1349,6 @@ 1 /* lisp_readonly bit */ \ }, \ 0, /* next */ \ - 0, /* uid */ \ - 0 /* free */ \ }, \ &(console_local_flags.field_name), \ forward_type \ @@ -1404,13 +1391,15 @@ /* Make sure all markable slots in console_defaults are initialized reasonably, so mark_console won't choke. */ - struct console *defs = ALLOC_LCRECORD_TYPE (struct console, &lrecord_console); - struct console *syms = ALLOC_LCRECORD_TYPE (struct console, &lrecord_console); + Lisp_Object defobj = ALLOC_NORMAL_LISP_OBJECT (console); + struct console *defs = XCONSOLE (defobj); + Lisp_Object symobj = ALLOC_NORMAL_LISP_OBJECT (console); + struct console *syms = XCONSOLE (symobj); staticpro_nodump (&Vconsole_defaults); staticpro_nodump (&Vconsole_local_symbols); - Vconsole_defaults = wrap_console (defs); - Vconsole_local_symbols = wrap_console (syms); + Vconsole_defaults = defobj; + Vconsole_local_symbols = symobj; nuke_all_console_slots (syms, Qnil); nuke_all_console_slots (defs, Qnil); @@ -1448,6 +1437,8 @@ The local flag bits are in the local_var_flags slot of the console. */ + set_lheader_implementation ((struct lrecord_header *) + &console_local_flags, &lrecord_console); nuke_all_console_slots (&console_local_flags, make_int (-2)); console_local_flags.defining_kbd_macro = always_local_resettable; console_local_flags.last_kbd_macro = always_local_resettable; @@ -1598,10 +1589,9 @@ /* Check for DEFVAR_CONSOLE_LOCAL without initializing the corresponding slot of console_local_flags and vice-versa. Must be done after all DEFVAR_CONSOLE_LOCAL() calls. */ -#define MARKED_SLOT(slot) \ - if ((XINT (console_local_flags.slot) != -2 && \ - XINT (console_local_flags.slot) != -3) \ - != !(NILP (XCONSOLE (Vconsole_local_symbols)->slot))) \ - ABORT (); +#define MARKED_SLOT(slot) \ + assert ((XINT (console_local_flags.slot) != -2 && \ + XINT (console_local_flags.slot) != -3) \ + == !(NILP (XCONSOLE (Vconsole_local_symbols)->slot))); #include "conslots.h" } diff -r 861f2601a38b -r 1f0b15040456 src/console.h --- a/src/console.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/console.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -79,7 +77,7 @@ struct console; -DECLARE_LRECORD (console, struct console); +DECLARE_LISP_OBJECT (console, struct console); #define XCONSOLE(x) XRECORD (x, console, struct console) #define wrap_console(p) wrap_record (p, console) #define CONSOLEP(x) RECORDP (x, console) diff -r 861f2601a38b -r 1f0b15040456 src/data.c --- a/src/data.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/data.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* Primitive operations on Lisp data types for XEmacs Lisp interpreter. Copyright (C) 1985, 1986, 1988, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 2000, 2001, 2002, 2003 Ben Wing. + Copyright (C) 2000, 2001, 2002, 2003, 2005, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.0, FSF 19.30. Some of FSF's data.c is in XEmacs' symbols.c. */ @@ -30,10 +28,11 @@ #include "buffer.h" #include "bytecode.h" +#include "gc.h" #include "syssignal.h" #include "sysfloat.h" -Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound; +Lisp_Object Qnil, Qt, Qlambda, Qunbound; Lisp_Object Qerror_conditions, Qerror_message; Lisp_Object Qerror, Qquit, Qsyntax_error, Qinvalid_read_syntax; Lisp_Object Qlist_formation_error, Qstructure_formation_error; @@ -41,14 +40,16 @@ Lisp_Object Qcircular_list, Qcircular_property_list; Lisp_Object Qinvalid_argument, Qinvalid_constant, Qwrong_type_argument; Lisp_Object Qargs_out_of_range; -Lisp_Object Qwrong_number_of_arguments, Qinvalid_function, Qno_catch; +Lisp_Object Qwrong_number_of_arguments, Qinvalid_function; +Lisp_Object Qinvalid_keyword_argument, Qno_catch; Lisp_Object Qinternal_error, Qinvalid_state, Qstack_overflow, Qout_of_memory; Lisp_Object Qvoid_variable, Qcyclic_variable_indirection; Lisp_Object Qvoid_function, Qcyclic_function_indirection; Lisp_Object Qinvalid_operation, Qinvalid_change, Qprinting_unreadable_object; Lisp_Object Qsetting_constant; Lisp_Object Qediting_error; -Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only; +Lisp_Object Qbeginning_of_buffer, Qend_of_buffer; +Lisp_Object Qbuffer_read_only, Qextent_read_only; Lisp_Object Qio_error, Qfile_error, Qconversion_error, Qend_of_file; Lisp_Object Qtext_conversion_error; Lisp_Object Qarith_error, Qrange_error, Qdomain_error; @@ -156,10 +157,18 @@ } void -check_int_range (EMACS_INT val, EMACS_INT min, EMACS_INT max) +check_integer_range (Lisp_Object val, Lisp_Object min, Lisp_Object max) { - if (val < min || val > max) - args_out_of_range_3 (make_int (val), make_int (min), make_int (max)); + Lisp_Object args[] = { min, val, max }; + int ii; + + for (ii = 0; ii < countof (args); ii++) + { + CHECK_INTEGER (args[ii]); + } + + if (NILP (Fleq (countof (args), args))) + args_out_of_range_3 (val, min, max); } @@ -173,24 +182,6 @@ return EQ_WITH_EBOLA_NOTICE (object1, object2) ? Qt : Qnil; } -DEFUN ("old-eq", Fold_eq, 2, 2, 0, /* -Return t if the two args are (in most cases) the same Lisp object. - -Special kludge: A character is considered `old-eq' to its equivalent integer -even though they are not the same object and are in fact of different -types. This is ABSOLUTELY AND UTTERLY HORRENDOUS but is necessary to -preserve byte-code compatibility with v19. This kludge is known as the -\"char-int confoundance disease\" and appears in a number of other -functions with `old-foo' equivalents. - -Do not use this function! -*/ - (object1, object2)) -{ - /* #### blasphemy */ - return HACKEQ_UNSAFE (object1, object2) ? Qt : Qnil; -} - DEFUN ("null", Fnull, 1, 1, 0, /* Return t if OBJECT is nil. */ @@ -502,11 +493,7 @@ */ (object)) { - return NATNUMP (object) -#ifdef HAVE_BIGNUM - || (BIGNUMP (object) && bignum_sign (XBIGNUM_DATA (object)) >= 0) -#endif - ? Qt : Qnil; + return NATNUMP (object) ? Qt : Qnil; } DEFUN ("nonnegativep", Fnonnegativep, 1, 1, 0, /* @@ -515,9 +502,6 @@ (object)) { return NATNUMP (object) -#ifdef HAVE_BIGNUM - || (BIGNUMP (object) && bignum_sign (XBIGNUM_DATA (object)) >= 0) -#endif #ifdef HAVE_RATIO || (RATIOP (object) && ratio_sign (XRATIO_DATA (object)) >= 0) #endif @@ -1293,9 +1277,8 @@ b = 10; else { - CHECK_INT (base); + check_integer_range (base, make_int (2), make_int (16)); b = XINT (base); - check_int_range (b, 2, 16); } p = XSTRING_DATA (string); @@ -2610,14 +2593,19 @@ static void print_weak_list (Lisp_Object obj, Lisp_Object printcharfun, - int UNUSED (escapeflag)) + int escapeflag) { if (print_readably) - printing_unreadable_lcrecord (obj, 0); - - write_fmt_string_lisp (printcharfun, "#", 2, - encode_weak_list_type (XWEAK_LIST (obj)->type), - XWEAK_LIST (obj)->list); + { + printing_unreadable_lisp_object (obj, 0); + } + + write_ascstring (printcharfun, "#type), + printcharfun, escapeflag); + write_ascstring (printcharfun, " :list "); + print_internal (XWEAK_LIST (obj)->list, printcharfun, escapeflag); + write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); } static int @@ -2631,24 +2619,22 @@ } static Hashcode -weak_list_hash (Lisp_Object obj, int depth) +weak_list_hash (Lisp_Object obj, int depth, Boolint equalp) { struct weak_list *w = XWEAK_LIST (obj); return HASH2 ((Hashcode) w->type, - internal_hash (w->list, depth + 1)); + internal_hash (w->list, depth + 1, equalp)); } Lisp_Object make_weak_list (enum weak_list_type type) { - Lisp_Object result; - struct weak_list *wl = - ALLOC_LCRECORD_TYPE (struct weak_list, &lrecord_weak_list); + Lisp_Object result = ALLOC_NORMAL_LISP_OBJECT (weak_list); + struct weak_list *wl = XWEAK_LIST (result); wl->list = Qnil; wl->type = type; - result = wrap_weak_list (wl); wl->next_weak = Vall_weak_lists; Vall_weak_lists = result; return result; @@ -2662,12 +2648,11 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("weak-list", weak_list, - 1, /*dumpable-flag*/ - mark_weak_list, print_weak_list, - 0, weak_list_equal, weak_list_hash, - weak_list_description, - struct weak_list); +DEFINE_DUMPABLE_LISP_OBJECT ("weak-list", weak_list, + mark_weak_list, print_weak_list, + 0, weak_list_equal, weak_list_hash, + weak_list_description, + struct weak_list); /* -- we do not mark the list elements (either the elements themselves or the cons cells that hold them) in the normal marking phase. @@ -2806,7 +2791,7 @@ if (need_to_mark_elem && ! marked_p (elem)) { #ifdef USE_KKCC - kkcc_gc_stack_push_lisp_object (elem, 0, -1); + kkcc_gc_stack_push_lisp_object_0 (elem); #else /* NOT USE_KKCC */ mark_object (elem); #endif /* NOT USE_KKCC */ @@ -2834,7 +2819,7 @@ if (!NILP (rest2) && ! marked_p (rest2)) { #ifdef USE_KKCC - kkcc_gc_stack_push_lisp_object (rest2, 0, -1); + kkcc_gc_stack_push_lisp_object_0 (rest2); #else /* NOT USE_KKCC */ mark_object (rest2); #endif /* NOT USE_KKCC */ @@ -3088,12 +3073,16 @@ } static void -print_weak_box (Lisp_Object obj, Lisp_Object printcharfun, - int UNUSED (escapeflag)) +print_weak_box (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { if (print_readably) - printing_unreadable_lcrecord (obj, 0); - write_fmt_string (printcharfun, "#"); /* #### fix */ + { + printing_unreadable_lisp_object (obj, 0); + } + + write_ascstring (printcharfun, "#value, printcharfun, escapeflag); + write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); } static int @@ -3106,20 +3095,18 @@ } static Hashcode -weak_box_hash (Lisp_Object obj, int depth) +weak_box_hash (Lisp_Object obj, int depth, Boolint equalp) { struct weak_box *wb = XWEAK_BOX (obj); - return internal_hash (wb->value, depth + 1); + return internal_hash (wb->value, depth + 1, equalp); } Lisp_Object make_weak_box (Lisp_Object value) { - Lisp_Object result; - - struct weak_box *wb = - ALLOC_LCRECORD_TYPE (struct weak_box, &lrecord_weak_box); + Lisp_Object result = ALLOC_NORMAL_LISP_OBJECT (weak_box); + struct weak_box *wb = XWEAK_BOX (result); wb->value = value; result = wrap_weak_box (wb); @@ -3133,12 +3120,10 @@ { XD_END} }; -DEFINE_LRECORD_IMPLEMENTATION ("weak_box", weak_box, - 0, /*dumpable-flag*/ - mark_weak_box, print_weak_box, - 0, weak_box_equal, weak_box_hash, - weak_box_description, - struct weak_box); +DEFINE_NODUMP_LISP_OBJECT ("weak-box", weak_box, mark_weak_box, + print_weak_box, 0, weak_box_equal, + weak_box_hash, weak_box_description, + struct weak_box); DEFUN ("make-weak-box", Fmake_weak_box, 1, 1, 0, /* Return a new weak box from value CONTENTS. @@ -3214,8 +3199,8 @@ if (marked_p (XEPHEMERON (rest)->key)) { #ifdef USE_KKCC - kkcc_gc_stack_push_lisp_object - (XCAR (XEPHEMERON (rest)->cons_chain), 0, -1); + kkcc_gc_stack_push_lisp_object_0 + (XCAR (XEPHEMERON (rest)->cons_chain)); #else /* NOT USE_KKCC */ mark_object (XCAR (XEPHEMERON (rest)->cons_chain)); #endif /* NOT USE_KKCC */ @@ -3264,8 +3249,8 @@ { MARK_CONS (XCONS (XEPHEMERON (rest)->cons_chain)); #ifdef USE_KKCC - kkcc_gc_stack_push_lisp_object - (XCAR (XEPHEMERON (rest)->cons_chain), 0, -1); + kkcc_gc_stack_push_lisp_object_0 + (XCAR (XEPHEMERON (rest)->cons_chain)); #else /* NOT USE_KKCC */ mark_object (XCAR (XEPHEMERON (rest)->cons_chain)); #endif /* NOT USE_KKCC */ @@ -3314,12 +3299,20 @@ } static void -print_ephemeron (Lisp_Object obj, Lisp_Object printcharfun, - int UNUSED (escapeflag)) +print_ephemeron (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { if (print_readably) - printing_unreadable_lcrecord (obj, 0); - write_fmt_string (printcharfun, "#"); /* #### fix */ + { + printing_unreadable_lisp_object (obj, 0); + } + + write_ascstring (printcharfun, "#key, printcharfun, escapeflag); + write_ascstring (printcharfun, " :value "); + print_internal (XEPHEMERON (obj)->value, printcharfun, escapeflag); + write_ascstring (printcharfun, " :finalizer "); + print_internal (XEPHEMERON_FINALIZER (obj), printcharfun, escapeflag); + write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); } static int @@ -3331,30 +3324,29 @@ } static Hashcode -ephemeron_hash(Lisp_Object obj, int depth) +ephemeron_hash(Lisp_Object obj, int depth, Boolint equalp) { - return internal_hash (XEPHEMERON_REF (obj), depth + 1); + return internal_hash (XEPHEMERON_REF (obj), depth + 1, equalp); } Lisp_Object -make_ephemeron(Lisp_Object key, Lisp_Object value, Lisp_Object finalizer) +make_ephemeron (Lisp_Object key, Lisp_Object value, Lisp_Object finalizer) { - Lisp_Object result, temp = Qnil; + Lisp_Object temp = Qnil; struct gcpro gcpro1, gcpro2; - - struct ephemeron *eph = - ALLOC_LCRECORD_TYPE (struct ephemeron, &lrecord_ephemeron); + Lisp_Object result = ALLOC_NORMAL_LISP_OBJECT (ephemeron); + struct ephemeron *eph = XEPHEMERON (result); eph->key = Qnil; eph->cons_chain = Qnil; eph->value = Qnil; - result = wrap_ephemeron(eph); + result = wrap_ephemeron (eph); GCPRO2 (result, temp); eph->key = key; - temp = Fcons(value, finalizer); - eph->cons_chain = Fcons(temp, Vall_ephemerons); + temp = Fcons (value, finalizer); + eph->cons_chain = Fcons (temp, Vall_ephemerons); eph->value = value; Vall_ephemerons = result; @@ -3375,12 +3367,11 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("ephemeron", ephemeron, - 0, /*dumpable-flag*/ - mark_ephemeron, print_ephemeron, - 0, ephemeron_equal, ephemeron_hash, - ephemeron_description, - struct ephemeron); +DEFINE_NODUMP_LISP_OBJECT ("ephemeron", ephemeron, + mark_ephemeron, print_ephemeron, + 0, ephemeron_equal, ephemeron_hash, + ephemeron_description, + struct ephemeron); DEFUN ("make-ephemeron", Fmake_ephemeron, 2, 3, 0, /* Return a new ephemeron with key KEY, value VALUE, and finalizer FINALIZER. @@ -3472,6 +3463,7 @@ DEFERROR_STANDARD (Qwrong_number_of_arguments, Qinvalid_argument); DEFERROR_STANDARD (Qinvalid_function, Qinvalid_argument); DEFERROR_STANDARD (Qinvalid_constant, Qinvalid_argument); + DEFERROR_STANDARD (Qinvalid_keyword_argument, Qinvalid_argument); DEFERROR (Qno_catch, "No catch for tag", Qinvalid_argument); DEFERROR_STANDARD (Qinvalid_state, Qerror); @@ -3500,6 +3492,7 @@ DEFERROR_STANDARD (Qbeginning_of_buffer, Qediting_error); DEFERROR_STANDARD (Qend_of_buffer, Qediting_error); DEFERROR (Qbuffer_read_only, "Buffer is read-only", Qediting_error); + DEFERROR (Qextent_read_only, "Extent is read-only", Qediting_error); DEFERROR (Qio_error, "IO Error", Qinvalid_operation); DEFERROR_STANDARD (Qfile_error, Qio_error); @@ -3518,11 +3511,10 @@ void syms_of_data (void) { - INIT_LRECORD_IMPLEMENTATION (weak_list); - INIT_LRECORD_IMPLEMENTATION (ephemeron); - INIT_LRECORD_IMPLEMENTATION (weak_box); - - DEFSYMBOL (Qquote); + INIT_LISP_OBJECT (weak_list); + INIT_LISP_OBJECT (ephemeron); + INIT_LISP_OBJECT (weak_box); + DEFSYMBOL (Qlambda); DEFSYMBOL (Qlistp); DEFSYMBOL (Qtrue_list_p); @@ -3558,7 +3550,6 @@ DEFSUBR (Fdiv); #endif DEFSUBR (Feq); - DEFSUBR (Fold_eq); DEFSUBR (Fnull); Ffset (intern ("not"), intern ("null")); DEFSUBR (Flistp); diff -r 861f2601a38b -r 1f0b15040456 src/database.c --- a/src/database.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/database.c Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,13 @@ /* Database access routines Copyright (C) 1996, William M. Perry - Copyright (C) 2001, 2002, 2005 Ben Wing. + Copyright (C) 2001, 2002, 2005, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -147,7 +145,7 @@ struct Lisp_Database { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; Lisp_Object fname; int mode; int access_; @@ -180,7 +178,8 @@ static Lisp_Database * allocate_database (void) { - Lisp_Database *db = ALLOC_LCRECORD_TYPE (Lisp_Database, &lrecord_database); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (database); + Lisp_Database *db = XDATABASE (obj); db->fname = Qnil; db->live_p = 0; @@ -216,7 +215,7 @@ Lisp_Database *db = XDATABASE (obj); if (print_readably) - printing_unreadable_lcrecord (obj, 0); + printing_unreadable_lisp_object (obj, 0); write_fmt_string_lisp (printcharfun, "#fname, db->funcs->get_type (db), @@ -231,29 +230,22 @@ XSYMBOL_NAME (XCODING_SYSTEM_NAME (db->coding_system))); - write_fmt_string (printcharfun, "0x%x>", db->header.uid); + write_fmt_string (printcharfun, "0x%x>", LISP_OBJECT_UID (obj)); } static void -finalize_database (void *header, int for_disksave) +finalize_database (Lisp_Object obj) { - Lisp_Database *db = (Lisp_Database *) header; + Lisp_Database *db = XDATABASE (obj); - if (for_disksave) - { - invalid_operation - ("Can't dump an emacs containing database objects", - wrap_database (db)); - } db->funcs->close (db); } -DEFINE_LRECORD_IMPLEMENTATION ("database", database, - 0, /*dumpable-flag*/ - mark_database, print_database, - finalize_database, 0, 0, - database_description, - Lisp_Database); +DEFINE_NODUMP_LISP_OBJECT ("database", database, + mark_database, print_database, + finalize_database, 0, 0, + database_description, + Lisp_Database); DEFUN ("close-database", Fclose_database, 1, 1, 0, /* Close database DATABASE. @@ -860,7 +852,7 @@ void syms_of_database (void) { - INIT_LRECORD_IMPLEMENTATION (database); + INIT_LISP_OBJECT (database); DEFSYMBOL (Qdatabasep); #ifdef HAVE_DBM diff -r 861f2601a38b -r 1f0b15040456 src/database.h --- a/src/database.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/database.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* This file is only necessary to get inline handling correct. See inline.c */ @@ -25,6 +23,6 @@ #define INCLUDED_database_h_ typedef struct Lisp_Database Lisp_Database; -DECLARE_LRECORD (database, Lisp_Database); +DECLARE_LISP_OBJECT (database, Lisp_Database); #endif /* INCLUDED_database_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/debug.c --- a/src/debug.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/debug.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/debug.h --- a/src/debug.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/debug.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/depend --- a/src/depend Sat Feb 20 06:03:00 2010 -0600 +++ b/src/depend Sun May 01 18:44:03 2011 +0100 @@ -11,94 +11,94 @@ LISP_H= #else CONFIG_H=config.h -LISP_H=lisp.h compiler.h config.h dumper.h gc.h general-slots.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h $(LISP_UNION_H) +LISP_H=lisp.h array.h compiler.h config.h dumper.h gc.h general-slots.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h $(LISP_UNION_H) #endif #if defined(HAVE_MS_WINDOWS) -console-msw.o: $(CONFIG_H) $(LISP_H) compiler.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h dumper.h elhash.h events.h gc.h general-slots.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h specifier.h symeval.h symsinit.h systime.h syswindows.h text.h vdb.h -device-msw.o: $(CONFIG_H) $(LISP_H) charset.h compiler.h conslots.h console-impl.h console-msw-impl.h console-msw.h console-stream.h console.h device-impl.h device.h devslots.h dumper.h events.h faces.h frame.h gc.h general-slots.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects-msw.h objects.h redisplay.h specifier.h symeval.h symsinit.h sysdep.h systime.h syswindows.h text.h vdb.h -dialog-msw.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h dumper.h frame-impl.h frame.h frameslots.h gc.h general-slots.h gui.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h redisplay.h specifier.h symeval.h symsinit.h sysfile.h syswindows.h text.h vdb.h -dired-msw.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h console-msw.h console.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h ndir.h number-gmp.h number-mp.h number.h regex.h symeval.h symsinit.h syntax.h sysdir.h sysfile.h sysfloat.h sysproc.h syspwd.h syssignal.h systime.h syswindows.h text.h vdb.h -event-msw.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console-msw-impl.h console-msw.h console-stream-impl.h console-stream.h console.h device-impl.h device.h devslots.h dragdrop.h dumper.h events.h faces.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs.h gui.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h menubar.h number-gmp.h number-mp.h number.h objects-impl.h objects-msw-impl.h objects-msw.h objects.h process.h redisplay.h scrollbar-msw.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h sysproc.h syssignal.h systime.h syswait.h syswindows.h text.h vdb.h window-impl.h window.h winslots.h -frame-msw.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h device-impl.h device.h devslots.h dumper.h elhash.h events.h faces.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs-msw.h glyphs.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h syswindows.h text.h vdb.h window-impl.h window.h winslots.h -glyphs-msw.o: $(CONFIG_H) $(LISP_H) charset.h coding-system-slots.h compiler.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h device-impl.h device.h devslots.h dumper.h elhash.h faces.h file-coding.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs-msw.h glyphs.h gui.h imgproc.h insdel.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h objects-impl.h objects-msw-impl.h objects-msw.h objects.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h syswindows.h text.h vdb.h window-impl.h window.h winslots.h -gui-msw.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h dumper.h elhash.h events.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs.h gui.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h syswindows.h text.h vdb.h window-impl.h window.h winslots.h -menubar-msw.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h compiler.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h dumper.h elhash.h events.h frame-impl.h frame.h frameslots.h gc.h general-slots.h gui.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h menubar.h number-gmp.h number-mp.h number.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h syswindows.h text.h vdb.h window-impl.h window.h winslots.h -objects-msw.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h device-impl.h device.h devslots.h dumper.h elhash.h gc.h general-slots.h insdel.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects-impl.h objects-msw-impl.h objects-msw.h objects.h opaque.h specifier.h symeval.h symsinit.h syswindows.h text.h vdb.h -redisplay-msw.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h debug.h device-impl.h device.h devslots.h dumper.h events.h faces.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs-msw.h glyphs.h gutter.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects-impl.h objects-msw-impl.h objects-msw.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h systime.h syswindows.h text.h vdb.h window-impl.h window.h winslots.h -scrollbar-msw.o: $(CONFIG_H) $(LISP_H) compiler.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h device.h dumper.h elhash.h events.h frame-impl.h frame.h frameslots.h gc.h general-slots.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h redisplay.h scrollbar-msw.h scrollbar.h specifier.h symeval.h symsinit.h systime.h syswindows.h text.h vdb.h window-impl.h window.h winslots.h -select-msw.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h dumper.h file-coding.h frame-impl.h frame.h frameslots.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h redisplay.h select.h specifier.h symeval.h symsinit.h syswindows.h text.h vdb.h -toolbar-msw.o: $(CONFIG_H) $(LISP_H) charset.h compiler.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h device.h dumper.h elhash.h faces.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs-msw.h glyphs.h gui.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h syswindows.h text.h toolbar.h vdb.h window-impl.h window.h winslots.h +console-msw.o: $(CONFIG_H) $(LISP_H) conslots.h console-impl.h console-msw-impl.h console-msw.h console.h elhash.h events.h intl-auto-encap-win32.h keymap-buttons.h opaque.h specifier.h systime.h syswindows.h +device-msw.o: $(CONFIG_H) $(LISP_H) charset.h conslots.h console-impl.h console-msw-impl.h console-msw.h console-stream.h console.h device-impl.h device.h devslots.h events.h faces.h fontcolor-msw.h fontcolor.h frame.h intl-auto-encap-win32.h keymap-buttons.h redisplay.h specifier.h sysdep.h systime.h syswindows.h +dialog-msw.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h frame-impl.h frame.h frameslots.h gui.h intl-auto-encap-win32.h opaque.h redisplay.h specifier.h sysfile.h syswindows.h +dired-msw.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h console-msw.h console.h intl-auto-encap-win32.h ndir.h regex.h syntax.h sysdir.h sysfile.h sysfloat.h sysproc.h syspwd.h syssignal.h systime.h syswindows.h +event-msw.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console-msw-impl.h console-msw.h console-stream-impl.h console-stream.h console.h device-impl.h device.h devslots.h dragdrop.h events.h faces.h fontcolor-impl.h fontcolor-msw-impl.h fontcolor-msw.h fontcolor.h frame-impl.h frame.h frameslots.h glyphs.h gui.h intl-auto-encap-win32.h keymap-buttons.h lstream.h menubar.h process.h redisplay.h scrollbar-msw.h scrollbar.h specifier.h sysdep.h sysfile.h sysproc.h syssignal.h systime.h syswait.h syswindows.h window-impl.h window.h winslots.h +fontcolor-msw.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h device-impl.h device.h devslots.h elhash.h fontcolor-impl.h fontcolor-msw-impl.h fontcolor-msw.h fontcolor.h insdel.h intl-auto-encap-win32.h opaque.h specifier.h syswindows.h +frame-msw.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h device-impl.h device.h devslots.h elhash.h events.h faces.h frame-impl.h frame.h frameslots.h glyphs-msw.h glyphs.h intl-auto-encap-win32.h keymap-buttons.h redisplay.h scrollbar.h specifier.h systime.h syswindows.h window-impl.h window.h winslots.h +glyphs-msw.o: $(CONFIG_H) $(LISP_H) charset.h coding-system-slots.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h device-impl.h device.h devslots.h elhash.h faces.h file-coding.h fontcolor-impl.h fontcolor-msw-impl.h fontcolor-msw.h fontcolor.h frame-impl.h frame.h frameslots.h glyphs-msw.h glyphs.h gui.h imgproc.h insdel.h intl-auto-encap-win32.h lstream.h opaque.h redisplay.h scrollbar.h specifier.h sysdep.h sysfile.h syswindows.h window-impl.h window.h winslots.h +gui-msw.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h elhash.h events.h frame-impl.h frame.h frameslots.h glyphs.h gui.h intl-auto-encap-win32.h keymap-buttons.h redisplay.h scrollbar.h specifier.h systime.h syswindows.h window-impl.h window.h winslots.h +menubar-msw.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h elhash.h events.h frame-impl.h frame.h frameslots.h gui.h intl-auto-encap-win32.h keymap-buttons.h menubar.h opaque.h redisplay.h scrollbar.h specifier.h systime.h syswindows.h window-impl.h window.h winslots.h +redisplay-msw.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h debug.h device-impl.h device.h devslots.h events.h faces.h fontcolor-impl.h fontcolor-msw-impl.h fontcolor-msw.h fontcolor.h frame-impl.h frame.h frameslots.h glyphs-msw.h glyphs.h gutter.h intl-auto-encap-win32.h keymap-buttons.h redisplay.h scrollbar.h specifier.h sysdep.h systime.h syswindows.h window-impl.h window.h winslots.h +scrollbar-msw.o: $(CONFIG_H) $(LISP_H) conslots.h console-impl.h console-msw-impl.h console-msw.h console.h device.h elhash.h events.h frame-impl.h frame.h frameslots.h intl-auto-encap-win32.h keymap-buttons.h opaque.h redisplay.h scrollbar-msw.h scrollbar.h specifier.h systime.h syswindows.h window-impl.h window.h winslots.h +select-msw.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h file-coding.h frame-impl.h frame.h frameslots.h intl-auto-encap-win32.h opaque.h redisplay.h select.h specifier.h syswindows.h +toolbar-msw.o: $(CONFIG_H) $(LISP_H) charset.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h device.h elhash.h faces.h frame-impl.h frame.h frameslots.h glyphs-msw.h glyphs.h gui.h intl-auto-encap-win32.h redisplay.h scrollbar.h specifier.h syswindows.h toolbar.h window-impl.h window.h winslots.h #endif #if defined(HAVE_XLIKE) event-xlike-inc.o: -objects-xlike-inc.o: $(LWLIB_SRCDIR)/lwlib.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console-x-impl.h console-x.h console-xlike-inc.h console.h gccache-gtk.h gccache-x.h glyphs-gtk.h glyphs-x.h glyphs.h objects-gtk-impl.h objects-gtk.h objects-impl.h objects-x-impl.h objects-x.h objects.h redisplay.h scrollbar.h specifier.h sysgtk.h window-impl.h window.h winslots.h xintrinsic.h -redisplay-xlike-inc.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console-x-impl.h console-x.h console-xlike-inc.h console.h debug.h device-impl.h device.h devslots.h dumper.h faces.h file-coding.h frame-impl.h frame.h frameslots.h gc.h gccache-gtk.h gccache-x.h general-slots.h glyphs-gtk.h glyphs-x.h glyphs.h gutter.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h mule-ccl.h number-gmp.h number-mp.h number.h objects-gtk-impl.h objects-gtk.h objects-impl.h objects-x-impl.h objects-x.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysgtk.h sysproc.h syssignal.h systime.h text.h vdb.h window-impl.h window.h winslots.h xintrinsic.h xintrinsicp.h xmotif.h xmprimitivep.h +fontcolor-xlike-inc.o: $(LWLIB_SRCDIR)/lwlib.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console-x-impl.h console-x.h console-xlike-inc.h console.h fontcolor-gtk-impl.h fontcolor-gtk.h fontcolor-impl.h fontcolor-x-impl.h fontcolor-x.h fontcolor.h gccache-gtk.h gccache-x.h glyphs-gtk.h glyphs-x.h glyphs.h redisplay.h scrollbar.h specifier.h sysgtk.h window-impl.h window.h winslots.h xintrinsic.h +redisplay-xlike-inc.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console-x-impl.h console-x.h console-xlike-inc.h console.h debug.h device-impl.h device.h devslots.h faces.h file-coding.h fontcolor-gtk-impl.h fontcolor-gtk.h fontcolor-impl.h fontcolor-x-impl.h fontcolor-x.h fontcolor.h frame-impl.h frame.h frameslots.h gccache-gtk.h gccache-x.h glyphs-gtk.h glyphs-x.h glyphs.h gutter.h mule-ccl.h redisplay.h scrollbar.h specifier.h sysdep.h sysgtk.h sysproc.h syssignal.h systime.h window-impl.h window.h winslots.h xintrinsic.h xintrinsicp.h xmotif.h xmprimitivep.h select-xlike-inc.o: -toolbar-xlike.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h charset.h compiler.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h dumper.h faces.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysgtk.h text.h toolbar-xlike.h toolbar.h vdb.h window-impl.h window.h winslots.h xintrinsic.h +toolbar-xlike.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h charset.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h faces.h frame-impl.h frame.h frameslots.h glyphs.h redisplay.h scrollbar.h specifier.h sysgtk.h toolbar-xlike.h toolbar.h window-impl.h window.h winslots.h xintrinsic.h #endif #if defined(HAVE_X_WINDOWS) -EmacsFrame.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h EmacsManager.h charset.h compiler.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h dumper.h faces.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs-x.h glyphs.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects-x.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h text.h toolbar.h vdb.h window-impl.h window.h winslots.h xintrinsic.h xintrinsicp.h xmotif.h xmprimitivep.h +EmacsFrame.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h EmacsManager.h charset.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h faces.h fontcolor-x.h fontcolor.h frame-impl.h frame.h frameslots.h glyphs-x.h glyphs.h redisplay.h scrollbar.h specifier.h toolbar.h window-impl.h window.h winslots.h xintrinsic.h xintrinsicp.h xmotif.h xmprimitivep.h EmacsManager.o: $(CONFIG_H) $(LWLIB_SRCDIR)/lwlib.h EmacsManager.h EmacsManagerP.h compiler.h xintrinsicp.h xmmanagerp.h xmotif.h xmprimitivep.h EmacsShell-sub.o: $(CONFIG_H) $(LWLIB_SRCDIR)/lwlib.h EmacsShell.h EmacsShellP.h xintrinsic.h xintrinsicp.h EmacsShell.o: $(CONFIG_H) EmacsShell.h ExternalShell.h xintrinsicp.h -balloon-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h balloon_help.h compiler.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h specifier.h symeval.h symsinit.h text.h vdb.h xintrinsic.h +balloon-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h balloon_help.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h specifier.h xintrinsic.h balloon_help.o: $(CONFIG_H) balloon_help.h compiler.h xintrinsic.h -console-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h dumper.h elhash.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h process.h redisplay.h specifier.h symeval.h symsinit.h text.h vdb.h xintrinsic.h -device-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h dumper.h elhash.h events.h faces.h file-coding.h frame-impl.h frame.h frameslots.h gc.h gccache-x.h general-slots.h glyphs-x.h glyphs.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects-x.h objects.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysdll.h sysfile.h systime.h syswindows.h text.h vdb.h window-impl.h window.h winslots.h xintrinsic.h xintrinsicp.h -dialog-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h buffer.h bufslots.h casetab.h charset.h chartab.h commands.h compiler.h conslots.h console-impl.h console-x-impl.h console-x.h console.h dumper.h events.h frame-impl.h frame.h frameslots.h gc.h general-slots.h gui.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h text.h vdb.h window.h xintrinsic.h -frame-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h EmacsManager.h EmacsShell.h ExternalShell.h buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h dragdrop.h dumper.h events.h extents.h faces.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs-x.h glyphs.h gutter.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects-impl.h objects-x-impl.h objects-x.h objects.h redisplay.h scrollbar-x.h scrollbar.h specifier.h symeval.h symsinit.h systime.h text.h vdb.h window-impl.h window.h winslots.h xintrinsic.h xintrinsicp.h xmotif.h xmprimitivep.h -gccache-x.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h gccache-x.h general-slots.h hash.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -glyphs-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h bitmaps.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h dumper.h faces.h file-coding.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs-x.h glyphs.h gui.h imgproc.h insdel.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h objects-impl.h objects-x-impl.h objects-x.h objects.h opaque.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysfile.h sysproc.h syssignal.h systime.h syswindows.h text.h vdb.h window-impl.h window.h winslots.h xintrinsic.h xmotif.h -gui-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h dumper.h events.h frame.h gc.h general-slots.h glyphs.h gui.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h menubar.h number-gmp.h number-mp.h number.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h text.h vdb.h window-impl.h window.h winslots.h xintrinsic.h xmotif.h -intl-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h compiler.h console-x.h console.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h xintrinsic.h -menubar-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h buffer.h bufslots.h casetab.h charset.h chartab.h commands.h compiler.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h dumper.h events.h frame-impl.h frame.h frameslots.h gc.h general-slots.h gui.h keymap-buttons.h keymap.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h menubar.h number-gmp.h number-mp.h number.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h text.h vdb.h window-impl.h window.h winslots.h xintrinsic.h -objects-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h charset.h compiler.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console-x-impl.h console-x.h console-xlike-inc.h console.h device-impl.h device.h devslots.h dumper.h elhash.h font-mgr.h gc.h gccache-gtk.h gccache-x.h general-slots.h glyphs-gtk.h glyphs-x.h glyphs.h insdel.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects-gtk-impl.h objects-gtk.h objects-impl.h objects-x-impl.h objects-x.h objects-xlike-inc.c objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysgtk.h text.h vdb.h window-impl.h window.h winslots.h xintrinsic.h -redisplay-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console-x-impl.h console-x.h console-xlike-inc.h console.h debug.h device-impl.h device.h devslots.h dumper.h faces.h file-coding.h frame-impl.h frame.h frameslots.h gc.h gccache-gtk.h gccache-x.h general-slots.h glyphs-gtk.h glyphs-x.h glyphs.h gutter.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h mule-ccl.h number-gmp.h number-mp.h number.h objects-gtk-impl.h objects-gtk.h objects-impl.h objects-x-impl.h objects-x.h objects.h redisplay-xlike-inc.c redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysgtk.h sysproc.h syssignal.h systime.h text.h vdb.h window-impl.h window.h winslots.h xintrinsic.h xintrinsicp.h xmotif.h xmprimitivep.h -scrollbar-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h compiler.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h dumper.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs-x.h glyphs.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar-x.h scrollbar.h specifier.h symeval.h symsinit.h text.h vdb.h window-impl.h window.h winslots.h xintrinsic.h -select-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h charset.h compiler.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h dumper.h frame-impl.h frame.h frameslots.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects-x.h objects.h opaque.h redisplay.h select-xlike-inc.c select.h specifier.h symeval.h symsinit.h systime.h text.h vdb.h xintrinsic.h xmotif.h -toolbar-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h charset.h compiler.h conslots.h console-impl.h console-x-impl.h console-x.h console.h dumper.h faces.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs-x.h glyphs.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects-x.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h text.h toolbar-xlike.h toolbar.h vdb.h window-impl.h window.h winslots.h xintrinsic.h xintrinsicp.h xmotif.h xmprimitivep.h +console-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h elhash.h process.h redisplay.h specifier.h xintrinsic.h +device-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h elhash.h events.h faces.h file-coding.h fontcolor-x.h fontcolor.h frame-impl.h frame.h frameslots.h gccache-x.h glyphs-x.h glyphs.h intl-auto-encap-win32.h keymap-buttons.h process.h redisplay.h scrollbar.h specifier.h sysdep.h sysdll.h sysfile.h systime.h syswindows.h window-impl.h window.h winslots.h xintrinsic.h xintrinsicp.h +dialog-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h buffer.h bufslots.h casetab.h charset.h chartab.h commands.h conslots.h console-impl.h console-x-impl.h console-x.h console.h events.h frame-impl.h frame.h frameslots.h gui.h keymap-buttons.h opaque.h redisplay.h scrollbar.h specifier.h systime.h window.h xintrinsic.h +fontcolor-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h charset.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console-x-impl.h console-x.h console-xlike-inc.h console.h device-impl.h device.h devslots.h elhash.h font-mgr.h fontcolor-gtk-impl.h fontcolor-gtk.h fontcolor-impl.h fontcolor-x-impl.h fontcolor-x.h fontcolor-xlike-inc.c fontcolor.h gccache-gtk.h gccache-x.h glyphs-gtk.h glyphs-x.h glyphs.h insdel.h redisplay.h scrollbar.h specifier.h sysgtk.h window-impl.h window.h winslots.h xintrinsic.h +frame-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h EmacsManager.h EmacsShell.h ExternalShell.h buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h dragdrop.h events.h extents.h faces.h fontcolor-impl.h fontcolor-x-impl.h fontcolor-x.h fontcolor.h frame-impl.h frame.h frameslots.h glyphs-x.h glyphs.h gutter.h keymap-buttons.h redisplay.h scrollbar-x.h scrollbar.h specifier.h systime.h window-impl.h window.h winslots.h xintrinsic.h xintrinsicp.h xmotif.h xmprimitivep.h +gccache-x.o: $(CONFIG_H) $(LISP_H) gccache-x.h hash.h +glyphs-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h bitmaps.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h faces.h file-coding.h fontcolor-impl.h fontcolor-x-impl.h fontcolor-x.h fontcolor.h frame-impl.h frame.h frameslots.h glyphs-x.h glyphs.h gui.h imgproc.h insdel.h intl-auto-encap-win32.h lstream.h opaque.h process.h redisplay.h scrollbar.h specifier.h sysfile.h sysproc.h syssignal.h systime.h syswindows.h window-impl.h window.h winslots.h xintrinsic.h xmotif.h +gui-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h events.h frame.h glyphs.h gui.h keymap-buttons.h menubar.h opaque.h redisplay.h scrollbar.h specifier.h systime.h window-impl.h window.h winslots.h xintrinsic.h xmotif.h +intl-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h console-x.h console.h xintrinsic.h +menubar-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h buffer.h bufslots.h casetab.h charset.h chartab.h commands.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h events.h frame-impl.h frame.h frameslots.h gui.h keymap-buttons.h keymap.h menubar.h opaque.h redisplay.h scrollbar.h specifier.h systime.h window-impl.h window.h winslots.h xintrinsic.h +redisplay-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console-x-impl.h console-x.h console-xlike-inc.h console.h debug.h device-impl.h device.h devslots.h faces.h file-coding.h fontcolor-gtk-impl.h fontcolor-gtk.h fontcolor-impl.h fontcolor-x-impl.h fontcolor-x.h fontcolor.h frame-impl.h frame.h frameslots.h gccache-gtk.h gccache-x.h glyphs-gtk.h glyphs-x.h glyphs.h gutter.h mule-ccl.h redisplay-xlike-inc.c redisplay.h scrollbar.h specifier.h sysdep.h sysgtk.h sysproc.h syssignal.h systime.h window-impl.h window.h winslots.h xintrinsic.h xintrinsicp.h xmotif.h xmprimitivep.h +scrollbar-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h frame-impl.h frame.h frameslots.h glyphs-x.h glyphs.h redisplay.h scrollbar-x.h scrollbar.h specifier.h window-impl.h window.h winslots.h xintrinsic.h +select-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h charset.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h fontcolor-x.h fontcolor.h frame-impl.h frame.h frameslots.h opaque.h redisplay.h select-xlike-inc.c select.h specifier.h systime.h xintrinsic.h xmotif.h +toolbar-x.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h charset.h conslots.h console-impl.h console-x-impl.h console-x.h console.h faces.h fontcolor-x.h fontcolor.h frame-impl.h frame.h frameslots.h glyphs-x.h glyphs.h redisplay.h scrollbar.h specifier.h toolbar-xlike.h toolbar.h window-impl.h window.h winslots.h xintrinsic.h xintrinsicp.h xmotif.h xmprimitivep.h #endif #if defined(HAVE_TTY) -console-tty.o: $(CONFIG_H) $(LISP_H) charset.h coding-system-slots.h compiler.h conslots.h console-impl.h console-stream.h console-tty-impl.h console-tty.h console.h dumper.h elhash.h faces.h file-coding.h frame.h gc.h general-slots.h glyphs.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h systty.h syswindows.h text.h vdb.h window-impl.h window.h winslots.h -device-tty.o: $(CONFIG_H) $(LISP_H) charset.h compiler.h conslots.h console-impl.h console-stream.h console-tty-impl.h console-tty.h console.h device-impl.h device.h devslots.h dumper.h events.h faces.h frame.h gc.h general-slots.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h syssignal.h systime.h systty.h syswindows.h text.h vdb.h -event-tty.o: $(CONFIG_H) $(LISP_H) compiler.h conslots.h console-impl.h console-tty-impl.h console-tty.h console.h device.h dumper.h events.h frame.h gc.h general-slots.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h process.h redisplay.h specifier.h symeval.h symsinit.h sysproc.h syssignal.h systime.h systty.h syswait.h text.h vdb.h -frame-tty.o: $(CONFIG_H) $(LISP_H) compiler.h conslots.h console-impl.h console-tty-impl.h console-tty.h console.h device-impl.h device.h devslots.h dumper.h events.h frame-impl.h frame.h frameslots.h gc.h general-slots.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h specifier.h symeval.h symsinit.h systime.h systty.h text.h vdb.h -objects-tty.o: $(CONFIG_H) $(LISP_H) charset.h compiler.h conslots.h console-impl.h console-tty-impl.h console-tty.h console.h device.h dumper.h gc.h general-slots.h insdel.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects-impl.h objects-tty-impl.h objects-tty.h objects.h specifier.h symeval.h symsinit.h systty.h text.h vdb.h -redisplay-tty.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console-tty-impl.h console-tty.h console.h device-impl.h device.h devslots.h dumper.h events.h faces.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h objects-impl.h objects-tty-impl.h objects-tty.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h syssignal.h systime.h systty.h text.h vdb.h window-impl.h window.h winslots.h +console-tty.o: $(CONFIG_H) $(LISP_H) charset.h coding-system-slots.h conslots.h console-impl.h console-stream.h console-tty-impl.h console-tty.h console.h elhash.h faces.h file-coding.h frame.h glyphs.h intl-auto-encap-win32.h lstream.h process.h redisplay.h scrollbar.h specifier.h sysdep.h sysfile.h systty.h syswindows.h window-impl.h window.h winslots.h +device-tty.o: $(CONFIG_H) $(LISP_H) charset.h conslots.h console-impl.h console-stream.h console-tty-impl.h console-tty.h console.h device-impl.h device.h devslots.h events.h faces.h frame.h intl-auto-encap-win32.h keymap-buttons.h lstream.h redisplay.h specifier.h sysdep.h sysfile.h syssignal.h systime.h systty.h syswindows.h +event-tty.o: $(CONFIG_H) $(LISP_H) conslots.h console-impl.h console-tty-impl.h console-tty.h console.h device.h events.h frame.h keymap-buttons.h process.h redisplay.h specifier.h sysproc.h syssignal.h systime.h systty.h syswait.h +fontcolor-tty.o: $(CONFIG_H) $(LISP_H) charset.h conslots.h console-impl.h console-tty-impl.h console-tty.h console.h device.h fontcolor-impl.h fontcolor-tty-impl.h fontcolor-tty.h fontcolor.h insdel.h specifier.h systty.h +frame-tty.o: $(CONFIG_H) $(LISP_H) conslots.h console-impl.h console-tty-impl.h console-tty.h console.h device-impl.h device.h devslots.h events.h frame-impl.h frame.h frameslots.h keymap-buttons.h redisplay.h specifier.h systime.h systty.h +redisplay-tty.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console-tty-impl.h console-tty.h console.h device-impl.h device.h devslots.h events.h faces.h fontcolor-impl.h fontcolor-tty-impl.h fontcolor-tty.h fontcolor.h frame-impl.h frame.h frameslots.h glyphs.h keymap-buttons.h lstream.h redisplay.h scrollbar.h specifier.h sysdep.h syssignal.h systime.h systty.h window-impl.h window.h winslots.h #endif #if defined(HAVE_GTK) -console-gtk.o: $(CONFIG_H) $(LISP_H) charset.h compiler.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h dumper.h elhash.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h process.h redisplay.h specifier.h symeval.h symsinit.h sysgtk.h text.h vdb.h -device-gtk.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h elhash.h events.h faces.h frame-impl.h frame.h frameslots.h gc.h gccache-gtk.h general-slots.h glyphs-gtk.h glyphs.h gtk-xemacs.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects-gtk.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h sysgdkx.h sysgtk.h systime.h syswindows.h text.h vdb.h window-impl.h window.h winslots.h -dialog-gtk.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h compiler.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h dumper.h events.h frame.h gc.h general-slots.h gui.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysgtk.h systime.h text.h vdb.h window.h +console-gtk.o: $(CONFIG_H) $(LISP_H) charset.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h elhash.h process.h redisplay.h specifier.h sysgtk.h +device-gtk.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h device-impl.h device.h devslots.h elhash.h events.h faces.h fontcolor-gtk.h fontcolor.h frame-impl.h frame.h frameslots.h gccache-gtk.h glyphs-gtk.h glyphs.h gtk-xemacs.h intl-auto-encap-win32.h keymap-buttons.h redisplay.h scrollbar.h specifier.h sysdep.h sysfile.h sysgdkx.h sysgtk.h systime.h syswindows.h window-impl.h window.h winslots.h +dialog-gtk.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h events.h frame.h gui.h keymap-buttons.h opaque.h redisplay.h scrollbar.h specifier.h sysgtk.h systime.h window.h emacs-marshals.o: hash.h emacs-widget-accessors.o: -event-gtk.o: $(CONFIG_H) $(LISP_H) blocktype.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h commands.h compiler.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console-tty.h console.h device-impl.h device.h devslots.h dragdrop.h dumper.h elhash.h event-xlike-inc.c events.h file-coding.h frame-impl.h frame.h frameslots.h gc.h general-slots.h gtk-xemacs.h gui.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h menubar.h number-gmp.h number-mp.h number.h objects-gtk.h objects.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysgdkx.h sysgtk.h sysproc.h syssignal.h systime.h systty.h text.h vdb.h window.h -frame-gtk.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h device-impl.h device.h devslots.h dragdrop.h dumper.h elhash.h events.h extents.h faces.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs-gtk.h glyphs.h gtk-xemacs.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects-gtk-impl.h objects-gtk.h objects-impl.h objects.h redisplay.h scrollbar-gtk.h scrollbar.h specifier.h symeval.h symsinit.h sysdll.h sysgdkx.h sysgtk.h systime.h text.h ui-gtk.h vdb.h window-impl.h window.h winslots.h -gccache-gtk.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h gccache-gtk.h general-slots.h hash.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h sysgtk.h text.h vdb.h +event-gtk.o: $(CONFIG_H) $(LISP_H) blocktype.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h commands.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console-tty.h console.h device-impl.h device.h devslots.h dragdrop.h elhash.h event-xlike-inc.c events.h file-coding.h fontcolor-gtk.h fontcolor.h frame-impl.h frame.h frameslots.h gtk-xemacs.h gui.h keymap-buttons.h lstream.h menubar.h process.h redisplay.h scrollbar.h specifier.h sysgdkx.h sysgtk.h sysproc.h syssignal.h systime.h systty.h window.h +fontcolor-gtk.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console-x-impl.h console-x.h console-xlike-inc.h console.h device-impl.h device.h devslots.h fontcolor-gtk-impl.h fontcolor-gtk.h fontcolor-impl.h fontcolor-x-impl.h fontcolor-x.h fontcolor-xlike-inc.c fontcolor.h gccache-gtk.h gccache-x.h glyphs-gtk.h glyphs-x.h glyphs.h insdel.h redisplay.h scrollbar.h specifier.h sysgdkx.h sysgtk.h window-impl.h window.h winslots.h xintrinsic.h +frame-gtk.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h device-impl.h device.h devslots.h dragdrop.h elhash.h events.h extents.h faces.h fontcolor-gtk-impl.h fontcolor-gtk.h fontcolor-impl.h fontcolor.h frame-impl.h frame.h frameslots.h glyphs-gtk.h glyphs.h gtk-xemacs.h keymap-buttons.h redisplay.h scrollbar-gtk.h scrollbar.h specifier.h sysdll.h sysgdkx.h sysgtk.h systime.h ui-gtk.h window-impl.h window.h winslots.h +gccache-gtk.o: $(CONFIG_H) $(LISP_H) gccache-gtk.h hash.h sysgtk.h glade.o: bytecode.h -glyphs-gtk.o: $(CONFIG_H) $(LISP_H) bitmaps.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h elhash.h events.h faces.h file-coding.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs-gtk.h glyphs.h gui.h imgproc.h insdel.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h objects-gtk-impl.h objects-gtk.h objects-impl.h objects.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdll.h sysfile.h sysgdkx.h sysgtk.h systime.h syswindows.h text.h ui-gtk.h vdb.h window-impl.h window.h winslots.h -gtk-glue.o: console-gtk.h console.h objects-gtk-impl.h objects-gtk.h objects-impl.h objects.h specifier.h sysgtk.h -gtk-xemacs.o: $(CONFIG_H) $(LISP_H) charset.h compiler.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h faces.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs.h gtk-xemacs.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects-gtk.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysgtk.h text.h vdb.h window-impl.h window.h winslots.h -gui-gtk.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h frame.h gc.h general-slots.h gui.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h redisplay.h specifier.h symeval.h symsinit.h sysgtk.h text.h vdb.h -menubar-gtk.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h compiler.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h events.h frame-impl.h frame.h frameslots.h gc.h general-slots.h gui.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h menubar.h number-gmp.h number-mp.h number.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdll.h sysgtk.h systime.h text.h ui-gtk.h vdb.h window-impl.h window.h winslots.h -native-gtk-toolbar.o: $(CONFIG_H) $(LISP_H) charset.h compiler.h console-gtk.h console.h dumper.h faces.h frame.h gc.h general-slots.h glyphs-gtk.h glyphs.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects-gtk.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysgtk.h text.h toolbar.h vdb.h window-impl.h window.h winslots.h -objects-gtk.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console-x-impl.h console-x.h console-xlike-inc.h console.h device-impl.h device.h devslots.h dumper.h gc.h gccache-gtk.h gccache-x.h general-slots.h glyphs-gtk.h glyphs-x.h glyphs.h insdel.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects-gtk-impl.h objects-gtk.h objects-impl.h objects-x-impl.h objects-x.h objects-xlike-inc.c objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysgdkx.h sysgtk.h text.h vdb.h window-impl.h window.h winslots.h xintrinsic.h -redisplay-gtk.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console-x-impl.h console-x.h console-xlike-inc.h console.h debug.h device-impl.h device.h devslots.h dumper.h faces.h file-coding.h frame-impl.h frame.h frameslots.h gc.h gccache-gtk.h gccache-x.h general-slots.h glyphs-gtk.h glyphs-x.h glyphs.h gutter.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h mule-ccl.h number-gmp.h number-mp.h number.h objects-gtk-impl.h objects-gtk.h objects-impl.h objects-x-impl.h objects-x.h objects.h redisplay-xlike-inc.c redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysgdkx.h sysgtk.h sysproc.h syssignal.h systime.h text.h vdb.h window-impl.h window.h winslots.h xintrinsic.h xintrinsicp.h xmotif.h xmprimitivep.h -scrollbar-gtk.o: $(CONFIG_H) $(LISP_H) compiler.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h dumper.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs-gtk.h glyphs.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar-gtk.h scrollbar.h specifier.h symeval.h symsinit.h sysgtk.h text.h vdb.h window-impl.h window.h winslots.h -select-gtk.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h events.h frame.h gc.h general-slots.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h redisplay.h select-xlike-inc.c select.h specifier.h symeval.h symsinit.h sysgtk.h systime.h text.h vdb.h -toolbar-gtk.o: $(CONFIG_H) $(LISP_H) compiler.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h dumper.h frame.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h specifier.h symeval.h symsinit.h sysgtk.h text.h toolbar-xlike.h vdb.h +glyphs-gtk.o: $(CONFIG_H) $(LISP_H) bitmaps.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h device-impl.h device.h devslots.h elhash.h events.h faces.h file-coding.h fontcolor-gtk-impl.h fontcolor-gtk.h fontcolor-impl.h fontcolor.h frame-impl.h frame.h frameslots.h glyphs-gtk.h glyphs.h gui.h imgproc.h insdel.h intl-auto-encap-win32.h keymap-buttons.h lstream.h opaque.h redisplay.h scrollbar.h specifier.h sysdll.h sysfile.h sysgdkx.h sysgtk.h systime.h syswindows.h ui-gtk.h window-impl.h window.h winslots.h +gtk-glue.o: console-gtk.h console.h fontcolor-gtk-impl.h fontcolor-gtk.h fontcolor-impl.h fontcolor.h specifier.h sysgtk.h +gtk-xemacs.o: $(CONFIG_H) $(LISP_H) charset.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h device-impl.h device.h devslots.h faces.h fontcolor-gtk.h fontcolor.h frame-impl.h frame.h frameslots.h glyphs.h gtk-xemacs.h redisplay.h scrollbar.h specifier.h sysgtk.h window-impl.h window.h winslots.h +gui-gtk.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h device-impl.h device.h devslots.h frame.h gui.h opaque.h redisplay.h specifier.h sysgtk.h +menubar-gtk.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h device-impl.h device.h devslots.h events.h frame-impl.h frame.h frameslots.h gui.h keymap-buttons.h menubar.h opaque.h redisplay.h scrollbar.h specifier.h sysdll.h sysgtk.h systime.h ui-gtk.h window-impl.h window.h winslots.h +native-gtk-toolbar.o: $(CONFIG_H) $(LISP_H) charset.h console-gtk.h console.h faces.h fontcolor-gtk.h fontcolor.h frame.h glyphs-gtk.h glyphs.h redisplay.h scrollbar.h specifier.h sysgtk.h toolbar.h window-impl.h window.h winslots.h +redisplay-gtk.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console-x-impl.h console-x.h console-xlike-inc.h console.h debug.h device-impl.h device.h devslots.h faces.h file-coding.h fontcolor-gtk-impl.h fontcolor-gtk.h fontcolor-impl.h fontcolor-x-impl.h fontcolor-x.h fontcolor.h frame-impl.h frame.h frameslots.h gccache-gtk.h gccache-x.h glyphs-gtk.h glyphs-x.h glyphs.h gutter.h mule-ccl.h redisplay-xlike-inc.c redisplay.h scrollbar.h specifier.h sysdep.h sysgdkx.h sysgtk.h sysproc.h syssignal.h systime.h window-impl.h window.h winslots.h xintrinsic.h xintrinsicp.h xmotif.h xmprimitivep.h +scrollbar-gtk.o: $(CONFIG_H) $(LISP_H) conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h frame-impl.h frame.h frameslots.h glyphs-gtk.h glyphs.h redisplay.h scrollbar-gtk.h scrollbar.h specifier.h sysgtk.h window-impl.h window.h winslots.h +select-gtk.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h device-impl.h device.h devslots.h events.h frame.h keymap-buttons.h opaque.h redisplay.h select-xlike-inc.c select.h specifier.h sysgtk.h systime.h +toolbar-gtk.o: $(CONFIG_H) $(LISP_H) conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h frame.h redisplay.h specifier.h sysgtk.h toolbar-xlike.h ui-byhand.o: gui.h -ui-gtk.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h compiler.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h device.h dumper.h elhash.h emacs-marshals.c emacs-widget-accessors.c events.h faces.h gc.h general-slots.h glade.c glyphs-gtk.h glyphs.h gtk-glue.c gui.h hash.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects-gtk-impl.h objects-gtk.h objects-impl.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdll.h sysgtk.h systime.h text.h ui-byhand.c ui-gtk.h vdb.h window-impl.h window.h winslots.h +ui-gtk.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h device.h elhash.h emacs-marshals.c emacs-widget-accessors.c events.h faces.h fontcolor-gtk-impl.h fontcolor-gtk.h fontcolor-impl.h fontcolor.h glade.c glyphs-gtk.h glyphs.h gtk-glue.c gui.h hash.h keymap-buttons.h redisplay.h scrollbar.h specifier.h sysdll.h sysgtk.h systime.h ui-byhand.c ui-gtk.h window-impl.h window.h winslots.h #endif #if defined(HAVE_DATABASE) -database.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h database.h dumper.h file-coding.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h sysfile.h syswindows.h text.h vdb.h +database.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h database.h file-coding.h intl-auto-encap-win32.h sysfile.h syswindows.h #endif #if defined(MULE) -mule-ccl.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h dumper.h elhash.h file-coding.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h mule-ccl.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -mule-charset.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h console.h device.h dumper.h elhash.h faces.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h mule-ccl.h number-gmp.h number-mp.h number.h objects.h specifier.h symeval.h symsinit.h text.h vdb.h -mule-coding.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h dumper.h elhash.h extents.h file-coding.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h mule-ccl.h number-gmp.h number-mp.h number.h rangetab.h symeval.h symsinit.h text.h vdb.h -mule-wnnfns.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h symeval.h symsinit.h sysdep.h text.h vdb.h window.h +mule-ccl.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h elhash.h file-coding.h mule-ccl.h +mule-charset.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h console.h device.h elhash.h faces.h fontcolor.h lstream.h mule-ccl.h specifier.h +mule-coding.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h elhash.h extents.h file-coding.h mule-ccl.h rangetab.h +mule-wnnfns.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h redisplay.h scrollbar.h sysdep.h window.h #endif #if defined(EXTERNAL_WIDGET) ExternalClient-Xlib.o: extw-Xlib.h @@ -107,153 +107,153 @@ extw-Xlib.o: $(CONFIG_H) extw-Xlib.h extw-Xt.o: $(CONFIG_H) compiler.h extw-Xlib.h extw-Xt.h #endif -abbrev.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h compiler.h dumper.h gc.h general-slots.h insdel.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h symeval.h symsinit.h syntax.h text.h vdb.h window.h -alloc.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h conslots.h console-impl.h console-stream.h console.h device.h dumper.h elhash.h events.h extents-impl.h extents.h file-coding.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h process.h profile.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h systime.h syswindows.h text.h vdb.h window-impl.h window.h winslots.h -alloca.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -alsaplay.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h sound.h symeval.h symsinit.h sysfile.h syswindows.h text.h vdb.h -blocktype.o: $(CONFIG_H) $(LISP_H) blocktype.h compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -buffer.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h commands.h compiler.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h elhash.h extents.h faces.h file-coding.h frame-impl.h frame.h frameslots.h gc.h general-slots.h insdel.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h ndir.h number-gmp.h number-mp.h number.h process.h redisplay.h scrollbar.h select.h specifier.h symeval.h symsinit.h syntax.h sysdir.h sysfile.h syswindows.h text.h vdb.h window.h -bytecode.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h bytecode-ops.h bytecode.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h redisplay.h scrollbar.h symeval.h symsinit.h syntax.h text.h vdb.h window.h -callint.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h commands.h compiler.h dumper.h events.h gc.h general-slots.h insdel.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h symeval.h symsinit.h systime.h text.h vdb.h window-impl.h window.h winslots.h -casefiddle.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h insdel.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h syntax.h text.h vdb.h -casetab.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h symeval.h symsinit.h text.h vdb.h -chartab.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h syntax.h text.h vdb.h -cm.o: $(CONFIG_H) $(LISP_H) compiler.h conslots.h console-impl.h console-tty-impl.h console-tty.h console.h device.h dumper.h frame.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h specifier.h symeval.h symsinit.h systty.h text.h vdb.h -cmdloop.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h compiler.h conslots.h console-impl.h console-msw.h console.h device.h dumper.h events.h frame.h gc.h general-slots.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h syswindows.h text.h vdb.h window.h -cmds.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h compiler.h dumper.h extents.h gc.h general-slots.h insdel.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h syntax.h text.h vdb.h -console-stream.o: $(CONFIG_H) $(LISP_H) compiler.h conslots.h console-impl.h console-stream-impl.h console-stream.h console-tty.h console.h device-impl.h device.h devslots.h dumper.h events.h frame-impl.h frame.h frameslots.h gc.h general-slots.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h systime.h systty.h syswindows.h text.h vdb.h window.h -console.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console-stream-impl.h console-stream.h console-tty-impl.h console-tty.h console.h device-impl.h device.h devslots.h dumper.h events.h frame-impl.h frame.h frameslots.h gc.h general-slots.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h systime.h systty.h text.h vdb.h window.h -data.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h sysfloat.h syssignal.h text.h vdb.h -debug.o: $(CONFIG_H) $(LISP_H) bytecode.h compiler.h debug.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -device.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h elhash.h events.h faces.h frame-impl.h frame.h frameslots.h gc.h general-slots.h keymap-buttons.h keymap.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h syssignal.h systime.h text.h toolbar.h vdb.h window.h -dialog.o: $(CONFIG_H) $(LISP_H) compiler.h conslots.h console-impl.h console.h dumper.h frame-impl.h frame.h frameslots.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h specifier.h symeval.h symsinit.h text.h vdb.h -dired.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h compiler.h dumper.h elhash.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h ndir.h number-gmp.h number-mp.h number.h opaque.h regex.h symeval.h symsinit.h syntax.h sysdep.h sysdir.h sysfile.h syspwd.h systime.h syswindows.h text.h vdb.h -doc.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h dumper.h file-coding.h gc.h general-slots.h insdel.h intl-auto-encap-win32.h keymap-buttons.h keymap.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h sysfile.h syswindows.h text.h vdb.h -doprnt.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -dragdrop.o: $(CONFIG_H) $(LISP_H) compiler.h dragdrop.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -dump-data.o: $(CONFIG_H) $(LISP_H) compiler.h dump-data.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -dumper.o: $(CONFIG_H) $(LISP_H) coding-system-slots.h compiler.h console-stream.h console.h dump-data.h dumper.h elhash.h file-coding.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h specifier.h symeval.h symsinit.h sysfile.h syswindows.h text.h vdb.h -dynarr.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h +abbrev.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h insdel.h redisplay.h scrollbar.h syntax.h window.h +alloc.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h coding-system-slots.h conslots.h console-impl.h console-stream.h console.h device.h elhash.h events.h extents-impl.h extents.h file-coding.h frame-impl.h frame.h frameslots.h glyphs.h intl-auto-encap-win32.h keymap-buttons.h lstream.h opaque.h process.h profile.h redisplay.h scrollbar.h specifier.h sysdep.h sysfile.h systime.h syswindows.h window-impl.h window.h winslots.h +alloca.o: $(CONFIG_H) $(LISP_H) +alsaplay.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h intl-auto-encap-win32.h sound.h sysfile.h syswindows.h +array.o: $(CONFIG_H) $(LISP_H) insdel.h +blocktype.o: $(CONFIG_H) $(LISP_H) blocktype.h +buffer.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h commands.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h elhash.h extents.h faces.h file-coding.h frame-impl.h frame.h frameslots.h insdel.h intl-auto-encap-win32.h lstream.h ndir.h process.h redisplay.h scrollbar.h select.h specifier.h syntax.h sysdir.h sysfile.h syswindows.h window.h +bytecode.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h bytecode-ops.h bytecode.h casetab.h charset.h chartab.h opaque.h redisplay.h scrollbar.h syntax.h window.h +callint.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h commands.h events.h insdel.h keymap-buttons.h redisplay.h scrollbar.h systime.h window-impl.h window.h winslots.h +casefiddle.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h insdel.h syntax.h +casetab.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h opaque.h +chartab.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h syntax.h +cm.o: $(CONFIG_H) $(LISP_H) conslots.h console-impl.h console-tty-impl.h console-tty.h console.h device.h frame.h lstream.h redisplay.h specifier.h systty.h +cmdloop.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h conslots.h console-impl.h console-msw.h console.h device.h events.h frame.h intl-auto-encap-win32.h keymap-buttons.h redisplay.h scrollbar.h specifier.h systime.h syswindows.h window.h +cmds.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h extents.h insdel.h syntax.h +console-stream.o: $(CONFIG_H) $(LISP_H) conslots.h console-impl.h console-stream-impl.h console-stream.h console-tty.h console.h device-impl.h device.h devslots.h events.h frame-impl.h frame.h frameslots.h intl-auto-encap-win32.h keymap-buttons.h redisplay.h scrollbar.h specifier.h sysdep.h sysfile.h systime.h systty.h syswindows.h window.h +console.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console-stream-impl.h console-stream.h console-tty-impl.h console-tty.h console.h device-impl.h device.h devslots.h events.h frame-impl.h frame.h frameslots.h keymap-buttons.h redisplay.h scrollbar.h specifier.h sysdep.h systime.h systty.h window.h +data.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h sysfloat.h syssignal.h +debug.o: $(CONFIG_H) $(LISP_H) bytecode.h debug.h +device.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h elhash.h events.h faces.h fontcolor.h frame-impl.h frame.h frameslots.h keymap-buttons.h keymap.h redisplay.h scrollbar.h specifier.h sysdep.h syssignal.h systime.h toolbar.h window.h +dialog.o: $(CONFIG_H) $(LISP_H) conslots.h console-impl.h console.h frame-impl.h frame.h frameslots.h redisplay.h specifier.h +dired.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h elhash.h intl-auto-encap-win32.h ndir.h opaque.h regex.h syntax.h sysdep.h sysdir.h sysfile.h syspwd.h systime.h syswindows.h +doc.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h coding-system-slots.h file-coding.h insdel.h intl-auto-encap-win32.h keymap-buttons.h keymap.h lstream.h sysfile.h syswindows.h +doprnt.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h lstream.h +dragdrop.o: $(CONFIG_H) $(LISP_H) dragdrop.h +dump-data.o: $(CONFIG_H) $(LISP_H) dump-data.h +dumper.o: $(CONFIG_H) $(LISP_H) coding-system-slots.h console-stream.h console.h dump-data.h elhash.h file-coding.h intl-auto-encap-win32.h lstream.h specifier.h sysfile.h syswindows.h ecrt0.o: $(CONFIG_H) -editfns.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h compiler.h console.h device.h dumper.h events.h frame.h gc.h general-slots.h insdel.h intl-auto-encap-win32.h keymap-buttons.h line-number.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h ndir.h number-gmp.h number-mp.h number.h process.h redisplay.h scrollbar.h symeval.h symsinit.h sysdep.h sysdir.h sysfile.h sysproc.h syspwd.h syssignal.h systime.h syswindows.h text.h vdb.h window.h -elhash.o: $(CONFIG_H) $(LISP_H) bytecode.h compiler.h dumper.h elhash.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h symeval.h symsinit.h text.h vdb.h -emacs.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h casetab.h charset.h chartab.h commands.h compiler.h console-msw.h console.h dump-data.h dumper.h frame.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h paths.h process.h redisplay.h symeval.h symsinit.h sysdep.h sysdll.h sysfile.h sysproc.h syssignal.h systime.h systty.h syswindows.h text.h vdb.h -emodules.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h console.h dumper.h emodules.h file-coding.h frame.h gc.h general-slots.h insdel.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h symeval.h symsinit.h sysdep.h sysdll.h text.h vdb.h window.h -esd.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h miscplay.h number-gmp.h number-mp.h number.h sound.h symeval.h symsinit.h sysfile.h syswindows.h text.h vdb.h -eval.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h commands.h compiler.h conslots.h console-impl.h console.h device.h dumper.h frame.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h profile.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h text.h vdb.h window.h -event-Xt.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h Emacs.ad.h EmacsFrame.h blocktype.h charset.h coding-system-slots.h compiler.h conslots.h console-impl.h console-tty.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h dragdrop.h dumper.h elhash.h event-xlike-inc.c events.h file-coding.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h objects-x.h objects.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysproc.h syssignal.h systime.h systty.h text.h vdb.h window-impl.h window.h winslots.h xintrinsic.h xintrinsicp.h xmotif.h -event-stream.o: $(CONFIG_H) $(LISP_H) backtrace.h blocktype.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h commands.h compiler.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h elhash.h events.h file-coding.h frame-impl.h frame.h frameslots.h gc.h general-slots.h gui.h insdel.h intl-auto-encap-win32.h keymap-buttons.h keymap.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h macros.h mc-alloc.h menubar.h number-gmp.h number-mp.h number.h process.h profile.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h syssignal.h systime.h syswindows.h text.h vdb.h window-impl.h window.h winslots.h -event-unixoid.o: $(CONFIG_H) $(LISP_H) compiler.h conslots.h console-impl.h console-stream-impl.h console-stream.h console-tty-impl.h console-tty.h console.h device-impl.h device.h devslots.h dumper.h events.h gc.h general-slots.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h process.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h sysproc.h syssignal.h systime.h systty.h syswindows.h text.h vdb.h -events.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console-tty-impl.h console-tty.h console.h device.h dumper.h events.h extents.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs.h keymap-buttons.h keymap.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h systty.h text.h toolbar.h vdb.h window-impl.h window.h winslots.h -extents.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h console.h debug.h device.h dumper.h elhash.h extents-impl.h extents.h faces.h frame.h gc.h general-slots.h glyphs.h gutter.h insdel.h keymap-buttons.h keymap.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h process.h profile.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h text.h vdb.h window-impl.h window.h winslots.h -faces.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h elhash.h extents-impl.h extents.h faces.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects-impl.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h text.h vdb.h window-impl.h window.h winslots.h -file-coding.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h dumper.h elhash.h extents.h file-coding.h gc.h general-slots.h insdel.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h rangetab.h symeval.h symsinit.h text.h vdb.h -fileio.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h console.h device.h dumper.h events.h file-coding.h frame.h gc.h general-slots.h insdel.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h ndir.h number-gmp.h number-mp.h number.h process.h profile.h redisplay.h scrollbar.h symeval.h symsinit.h sysdep.h sysdir.h sysfile.h sysproc.h syspwd.h syssignal.h systime.h syswindows.h text.h vdb.h window-impl.h window.h winslots.h -filelock.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h ndir.h number-gmp.h number-mp.h number.h paths.h symeval.h symsinit.h sysdir.h sysfile.h sysproc.h syspwd.h syssignal.h systime.h syswindows.h text.h vdb.h -filemode.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h sysfile.h syswindows.h text.h vdb.h -floatfns.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h sysfloat.h syssignal.h text.h vdb.h -fns.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h compiler.h console.h device.h dumper.h events.h extents.h frame.h gc.h general-slots.h insdel.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h process.h redisplay.h symeval.h symsinit.h sysfile.h sysproc.h syssignal.h systime.h syswindows.h text.h vdb.h -font-lock.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h insdel.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h syntax.h text.h vdb.h -font-mgr.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h compiler.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h dumper.h font-mgr.h gc.h general-slots.h hash.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects-impl.h objects-x-impl.h objects-x.h objects.h specifier.h symeval.h symsinit.h sysfile.h syswindows.h text.h vdb.h xintrinsic.h -frame.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h events.h extents.h faces.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs.h gui.h gutter.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h menubar.h number-gmp.h number-mp.h number.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h text.h toolbar.h vdb.h window-impl.h window.h winslots.h -free-hook.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h hash.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -gc.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h conslots.h console-impl.h console-stream.h console.h device.h dumper.h elhash.h events.h extents-impl.h extents.h file-coding.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h process.h profile.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h systime.h syswindows.h text.h vdb.h window-impl.h window.h winslots.h -general.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -getloadavg.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h sysfile.h syswindows.h text.h vdb.h -glyphs-eimage.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h faces.h file-coding.h frame.h gc.h general-slots.h glyphs.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h objects-impl.h objects.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysfile.h syswindows.h text.h vdb.h window-impl.h window.h winslots.h -glyphs-shared.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h console.h dumper.h elhash.h faces.h frame.h gc.h general-slots.h glyphs.h imgproc.h insdel.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h syswindows.h text.h vdb.h window-impl.h window.h winslots.h -glyphs-widget.o: $(CONFIG_H) $(LISP_H) bytecode.h charset.h compiler.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h faces.h frame.h gc.h general-slots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h objects.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h text.h vdb.h window-impl.h window.h winslots.h -glyphs.o: $(CONFIG_H) $(LISP_H) blocktype.h buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h elhash.h faces.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs.h gui.h insdel.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects-impl.h objects.h opaque.h rangetab.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysfile.h syswindows.h text.h vdb.h window-impl.h window.h winslots.h -gmalloc.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h getpagesize.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h sysdep.h text.h vdb.h -gpmevent.o: $(CONFIG_H) $(LISP_H) commands.h compiler.h conslots.h console-impl.h console-tty-impl.h console-tty.h console.h device-impl.h device.h devslots.h dumper.h events.h frame.h gc.h general-slots.h gpmevent.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h process.h redisplay.h specifier.h symeval.h symsinit.h sysdep.h sysproc.h syssignal.h systime.h systty.h text.h vdb.h -gui.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h compiler.h dumper.h elhash.h gc.h general-slots.h gui.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h menubar.h number-gmp.h number-mp.h number.h redisplay.h symeval.h symsinit.h text.h vdb.h -gutter.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h faces.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs.h gutter.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h text.h vdb.h window-impl.h window.h winslots.h -hash.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h hash.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -hpplay.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h sound.h symeval.h symsinit.h text.h vdb.h -imgproc.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h imgproc.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -indent.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h console.h device.h dumper.h extents.h faces.h frame.h gc.h general-slots.h glyphs.h insdel.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h text.h vdb.h window-impl.h window.h winslots.h -inline.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h conslots.h console-gtk.h console-impl.h console-msw.h console.h database.h device-impl.h device.h devslots.h dumper.h elhash.h events.h extents-impl.h extents.h faces.h file-coding.h font-mgr.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs-x.h glyphs.h gui.h intl-auto-encap-win32.h keymap-buttons.h keymap.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h objects-impl.h objects.h opaque.h process.h rangetab.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h syntax.h sysdll.h sysfile.h sysgtk.h systime.h syswindows.h text.h toolbar.h tooltalk.h ui-gtk.h vdb.h window-impl.h window.h winslots.h xintrinsic.h -input-method-motif.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h compiler.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device.h dumper.h frame-impl.h frame.h frameslots.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h specifier.h symeval.h symsinit.h text.h vdb.h xintrinsic.h xmotif.h -input-method-xlib.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h dumper.h events.h frame-impl.h frame.h frameslots.h gc.h general-slots.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h text.h vdb.h window-impl.h window.h winslots.h xintrinsic.h -insdel.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h console.h device.h dumper.h extents.h frame.h gc.h general-slots.h insdel.h line-number.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h symeval.h symsinit.h text.h vdb.h -intl-auto-encap-win32.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h syswindows.h text.h vdb.h -intl-encap-win32.o: $(CONFIG_H) $(LISP_H) compiler.h console-msw.h console.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h syswindows.h text.h vdb.h -intl-win32.o: $(CONFIG_H) $(LISP_H) charset.h coding-system-slots.h compiler.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h dumper.h elhash.h faces.h file-coding.h frame-impl.h frame.h frameslots.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects-impl.h objects-msw-impl.h objects-msw.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h syswindows.h text.h vdb.h window-impl.h window.h winslots.h -intl.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -keymap.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console.h dumper.h elhash.h events.h extents.h frame.h gc.h general-slots.h insdel.h keymap-buttons.h keymap-slots.h keymap.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h text.h vdb.h window.h +editfns.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h console.h device.h events.h frame.h insdel.h intl-auto-encap-win32.h keymap-buttons.h line-number.h ndir.h process.h redisplay.h scrollbar.h sysdep.h sysdir.h sysfile.h sysproc.h syspwd.h syssignal.h systime.h syswindows.h window.h +elhash.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h elhash.h opaque.h +emacs.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h casetab.h charset.h chartab.h commands.h console-msw.h console.h dump-data.h frame.h intl-auto-encap-win32.h paths.h process.h redisplay.h sysdep.h sysdll.h sysfile.h sysproc.h syssignal.h systime.h systty.h syswindows.h +emodules.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h console.h emodules.h file-coding.h frame.h insdel.h lstream.h redisplay.h scrollbar.h sysdep.h sysdll.h window.h +esd.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h intl-auto-encap-win32.h miscplay.h sound.h sysfile.h syswindows.h +eval.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h commands.h conslots.h console-impl.h console.h device.h frame.h lstream.h opaque.h profile.h redisplay.h scrollbar.h specifier.h window.h +event-Xt.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h Emacs.ad.h EmacsFrame.h blocktype.h charset.h coding-system-slots.h conslots.h console-impl.h console-tty.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h dragdrop.h elhash.h event-xlike-inc.c events.h file-coding.h fontcolor-x.h fontcolor.h frame-impl.h frame.h frameslots.h glyphs.h keymap-buttons.h lstream.h process.h redisplay.h scrollbar.h specifier.h sysproc.h syssignal.h systime.h systty.h window-impl.h window.h winslots.h xintrinsic.h xintrinsicp.h xmotif.h +event-stream.o: $(CONFIG_H) $(LISP_H) backtrace.h blocktype.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h commands.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h elhash.h events.h file-coding.h frame-impl.h frame.h frameslots.h gui.h insdel.h intl-auto-encap-win32.h keymap-buttons.h keymap.h lstream.h macros.h menubar.h process.h profile.h redisplay.h scrollbar.h specifier.h sysdep.h sysfile.h syssignal.h systime.h syswindows.h window-impl.h window.h winslots.h +event-unixoid.o: $(CONFIG_H) $(LISP_H) conslots.h console-impl.h console-stream-impl.h console-stream.h console-tty-impl.h console-tty.h console.h device-impl.h device.h devslots.h events.h intl-auto-encap-win32.h keymap-buttons.h lstream.h process.h specifier.h sysdep.h sysfile.h sysproc.h syssignal.h systime.h systty.h syswindows.h +events.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console-tty-impl.h console-tty.h console.h device.h events.h extents.h frame-impl.h frame.h frameslots.h glyphs.h keymap-buttons.h keymap.h lstream.h redisplay.h scrollbar.h specifier.h systime.h systty.h toolbar.h window-impl.h window.h winslots.h +extents.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h casetab.h charset.h chartab.h console.h debug.h device.h elhash.h extents-impl.h extents.h faces.h frame.h glyphs.h gutter.h insdel.h keymap-buttons.h keymap.h opaque.h process.h profile.h redisplay.h scrollbar.h specifier.h window-impl.h window.h winslots.h +faces.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h elhash.h extents-impl.h extents.h faces.h fontcolor-impl.h fontcolor.h frame-impl.h frame.h frameslots.h glyphs.h redisplay.h scrollbar.h specifier.h window-impl.h window.h winslots.h +file-coding.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h elhash.h extents.h file-coding.h insdel.h lstream.h opaque.h rangetab.h +fileio.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h console.h device.h events.h file-coding.h frame.h insdel.h intl-auto-encap-win32.h keymap-buttons.h lstream.h ndir.h process.h profile.h redisplay.h scrollbar.h sysdep.h sysdir.h sysfile.h sysproc.h syspwd.h syssignal.h systime.h syswindows.h window-impl.h window.h winslots.h +filelock.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h intl-auto-encap-win32.h ndir.h paths.h sysdir.h sysfile.h sysproc.h syspwd.h syssignal.h systime.h syswindows.h +filemode.o: $(CONFIG_H) $(LISP_H) intl-auto-encap-win32.h sysfile.h syswindows.h +floatfns.o: $(CONFIG_H) $(LISP_H) sysfloat.h syssignal.h +fns.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h console.h device.h events.h extents.h frame.h insdel.h intl-auto-encap-win32.h keymap-buttons.h lstream.h opaque.h process.h redisplay.h sysfile.h sysproc.h syssignal.h systime.h syswindows.h +font-lock.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h insdel.h syntax.h +font-mgr.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h font-mgr.h fontcolor-impl.h fontcolor-x-impl.h fontcolor-x.h fontcolor.h hash.h intl-auto-encap-win32.h specifier.h sysfile.h syswindows.h xintrinsic.h +fontcolor.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console-tty.h console.h device-impl.h device.h devslots.h elhash.h faces.h fontcolor-impl.h fontcolor.h frame.h glyphs.h redisplay.h scrollbar.h specifier.h systty.h window-impl.h window.h winslots.h +frame.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h events.h extents.h faces.h frame-impl.h frame.h frameslots.h glyphs.h gui.h gutter.h keymap-buttons.h menubar.h process.h redisplay.h scrollbar.h specifier.h systime.h toolbar.h window-impl.h window.h winslots.h +free-hook.o: $(CONFIG_H) $(LISP_H) hash.h +gc.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h coding-system-slots.h conslots.h console-impl.h console-stream.h console.h device.h elhash.h events.h extents-impl.h extents.h file-coding.h frame-impl.h frame.h frameslots.h glyphs.h intl-auto-encap-win32.h keymap-buttons.h lstream.h opaque.h process.h profile.h redisplay.h scrollbar.h specifier.h sysdep.h sysfile.h systime.h syswindows.h window-impl.h window.h winslots.h +general.o: $(CONFIG_H) $(LISP_H) general-slots.h +getloadavg.o: $(CONFIG_H) $(LISP_H) intl-auto-encap-win32.h sysfile.h syswindows.h +glyphs-eimage.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h faces.h file-coding.h fontcolor-impl.h fontcolor.h frame.h glyphs.h intl-auto-encap-win32.h lstream.h opaque.h redisplay.h scrollbar.h specifier.h sysfile.h syswindows.h window-impl.h window.h winslots.h +glyphs-shared.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h console.h elhash.h faces.h frame.h glyphs.h imgproc.h insdel.h intl-auto-encap-win32.h lstream.h opaque.h redisplay.h scrollbar.h specifier.h sysdep.h sysfile.h syswindows.h window-impl.h window.h winslots.h +glyphs-widget.o: $(CONFIG_H) $(LISP_H) bytecode.h charset.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h faces.h fontcolor.h frame.h glyphs.h gui.h insdel.h lstream.h opaque.h redisplay.h scrollbar.h specifier.h window-impl.h window.h winslots.h +glyphs.o: $(CONFIG_H) $(LISP_H) blocktype.h buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h elhash.h faces.h fontcolor-impl.h fontcolor.h frame-impl.h frame.h frameslots.h glyphs.h gui.h insdel.h intl-auto-encap-win32.h opaque.h rangetab.h redisplay.h scrollbar.h specifier.h sysfile.h syswindows.h window-impl.h window.h winslots.h +gmalloc.o: $(CONFIG_H) $(LISP_H) getpagesize.h sysdep.h +gpmevent.o: $(CONFIG_H) $(LISP_H) commands.h conslots.h console-impl.h console-tty-impl.h console-tty.h console.h device-impl.h device.h devslots.h events.h frame.h gpmevent.h keymap-buttons.h lstream.h process.h redisplay.h specifier.h sysdep.h sysproc.h syssignal.h systime.h systty.h +gui.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h elhash.h gui.h menubar.h redisplay.h +gutter.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h faces.h frame-impl.h frame.h frameslots.h glyphs.h gutter.h redisplay.h scrollbar.h specifier.h window-impl.h window.h winslots.h +hash.o: $(CONFIG_H) $(LISP_H) hash.h +hpplay.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h sound.h +imgproc.o: $(CONFIG_H) $(LISP_H) imgproc.h +indent.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h console.h device.h extents.h faces.h frame.h glyphs.h insdel.h redisplay.h scrollbar.h specifier.h window-impl.h window.h winslots.h +inline.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h coding-system-slots.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console-msw-impl.h console-msw.h console-stream-impl.h console-stream.h console-tty-impl.h console-tty.h console-x-impl.h console-x.h console.h database.h device-impl.h device.h devslots.h elhash.h events.h extents-impl.h extents.h faces.h file-coding.h font-mgr.h fontcolor-impl.h fontcolor-tty-impl.h fontcolor-tty.h fontcolor.h frame-impl.h frame.h frameslots.h glyphs.h gui.h intl-auto-encap-win32.h keymap-buttons.h keymap.h lstream.h opaque.h process.h rangetab.h redisplay.h scrollbar.h specifier.h syntax.h sysdll.h sysfile.h sysgtk.h systime.h systty.h syswindows.h toolbar.h tooltalk.h ui-gtk.h window-impl.h window.h winslots.h xintrinsic.h +input-method-motif.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device.h frame-impl.h frame.h frameslots.h redisplay.h specifier.h xintrinsic.h xmotif.h +input-method-xlib.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h events.h frame-impl.h frame.h frameslots.h keymap-buttons.h redisplay.h scrollbar.h specifier.h systime.h window-impl.h window.h winslots.h xintrinsic.h +insdel.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h console.h device.h extents.h frame.h insdel.h line-number.h lstream.h redisplay.h +intl-auto-encap-win32.o: $(CONFIG_H) $(LISP_H) intl-auto-encap-win32.h syswindows.h +intl-encap-win32.o: $(CONFIG_H) $(LISP_H) console-msw.h console.h intl-auto-encap-win32.h syswindows.h +intl-win32.o: $(CONFIG_H) $(LISP_H) charset.h coding-system-slots.h conslots.h console-impl.h console-msw-impl.h console-msw.h console.h elhash.h faces.h file-coding.h fontcolor-impl.h fontcolor-msw-impl.h fontcolor-msw.h fontcolor.h frame-impl.h frame.h frameslots.h intl-auto-encap-win32.h redisplay.h scrollbar.h specifier.h syswindows.h window-impl.h window.h winslots.h +intl.o: $(CONFIG_H) $(LISP_H) +keymap.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h conslots.h console-impl.h console.h elhash.h events.h extents.h frame.h insdel.h keymap-buttons.h keymap-slots.h keymap.h redisplay.h scrollbar.h specifier.h systime.h window.h lastfile.o: $(CONFIG_H) -libinterface.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h libinterface.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -libsst.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h libsst.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h sound.h symeval.h symsinit.h sysfile.h syswindows.h text.h vdb.h -line-number.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h line-number.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -linuxplay.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h miscplay.h number-gmp.h number-mp.h number.h sound.h symeval.h symsinit.h sysfile.h syssignal.h systty.h syswindows.h text.h vdb.h -lread.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h dumper.h elhash.h file-coding.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h profile.h symeval.h symsinit.h sysfile.h sysfloat.h syswindows.h text.h vdb.h -lstream.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h insdel.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h sysfile.h syswindows.h text.h vdb.h -macros.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h compiler.h conslots.h console-impl.h console.h device.h dumper.h events.h frame.h gc.h general-slots.h keymap-buttons.h keymap.h lisp-disunion.h lisp-union.h lisp.h lrecord.h macros.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h text.h vdb.h window.h -marker.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -mc-alloc.o: $(CONFIG_H) $(LISP_H) blocktype.h compiler.h dumper.h gc.h general-slots.h getpagesize.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -md5.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h dumper.h file-coding.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -menubar.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h frame-impl.h frame.h frameslots.h gc.h general-slots.h gui.h keymap-buttons.h keymap.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h menubar.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h text.h vdb.h window-impl.h window.h winslots.h -minibuf.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h compiler.h conslots.h console-impl.h console-stream.h console.h dumper.h events.h frame-impl.h frame.h frameslots.h gc.h general-slots.h insdel.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h text.h vdb.h window-impl.h window.h winslots.h -miscplay.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h miscplay.h number-gmp.h number-mp.h number.h sound.h symeval.h symsinit.h sysfile.h syssignal.h syswindows.h text.h vdb.h -nas.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h sound.h symeval.h symsinit.h sysdep.h syssignal.h text.h vdb.h -nt.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h ndir.h number-gmp.h number-mp.h number.h process.h symeval.h symsinit.h sysdir.h sysfile.h sysproc.h syspwd.h syssignal.h systime.h syswindows.h text.h vdb.h -ntheap.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h sysdep.h syswindows.h text.h vdb.h -ntplay.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h sound.h symeval.h symsinit.h sysfile.h syswindows.h text.h vdb.h -number-gmp.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h sysproc.h syssignal.h systime.h text.h vdb.h -number-mp.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -number.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -objects.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console-tty.h console.h device-impl.h device.h devslots.h dumper.h elhash.h faces.h frame.h gc.h general-slots.h glyphs.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects-impl.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systty.h text.h vdb.h window-impl.h window.h winslots.h -opaque.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h symeval.h symsinit.h text.h vdb.h -print.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console-msw.h console-stream-impl.h console-stream.h console-tty-impl.h console-tty.h console.h device-impl.h device.h devslots.h dumper.h extents.h frame.h gc.h general-slots.h insdel.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h redisplay.h specifier.h symeval.h symsinit.h sysfile.h systty.h syswindows.h text.h vdb.h -process-nt.o: $(CONFIG_H) $(LISP_H) compiler.h console-msw.h console.h dumper.h events.h gc.h general-slots.h hash.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h process-slots.h process.h procimpl.h symeval.h symsinit.h sysfile.h sysproc.h syssignal.h systime.h syswindows.h text.h vdb.h -process-unix.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h console.h dumper.h events.h file-coding.h frame.h gc.h general-slots.h hash.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h ndir.h number-gmp.h number-mp.h number.h opaque.h process-slots.h process.h procimpl.h redisplay.h scrollbar.h symeval.h symsinit.h sysdep.h sysdir.h sysfile.h sysproc.h syssignal.h systime.h systty.h syswait.h syswindows.h text.h vdb.h window.h -process.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h commands.h compiler.h console.h device.h dumper.h events.h file-coding.h frame.h gc.h general-slots.h hash.h insdel.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h process-slots.h process.h procimpl.h redisplay.h scrollbar.h symeval.h symsinit.h sysdep.h sysfile.h sysproc.h syssignal.h systime.h systty.h syswait.h syswindows.h text.h vdb.h window.h -profile.o: $(CONFIG_H) $(LISP_H) backtrace.h bytecode.h compiler.h dumper.h elhash.h gc.h general-slots.h hash.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h profile.h symeval.h symsinit.h syssignal.h systime.h text.h vdb.h -ralloc.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h getpagesize.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -rangetab.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h rangetab.h symeval.h symsinit.h text.h vdb.h -realpath.o: $(CONFIG_H) $(LISP_H) backtrace.h compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h ndir.h number-gmp.h number-mp.h number.h profile.h symeval.h symsinit.h sysdir.h sysfile.h syswindows.h text.h vdb.h -redisplay-output.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h faces.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs.h gutter.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h text.h vdb.h window-impl.h window.h winslots.h -redisplay.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h commands.h compiler.h conslots.h console-impl.h console-tty.h console.h debug.h device-impl.h device.h devslots.h dumper.h elhash.h events.h extents-impl.h extents.h faces.h file-coding.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs.h gui.h gutter.h insdel.h intl-auto-encap-win32.h keymap-buttons.h line-number.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h menubar.h number-gmp.h number-mp.h number.h objects-impl.h objects.h opaque.h process.h profile.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysfile.h systime.h systty.h syswindows.h text.h toolbar.h vdb.h window-impl.h window.h winslots.h -regex.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h regex.h symeval.h symsinit.h syntax.h text.h vdb.h -scrollbar.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h compiler.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs.h gutter.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h text.h vdb.h window-impl.h window.h winslots.h -search.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h insdel.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h regex.h symeval.h symsinit.h syntax.h text.h vdb.h -select.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h extents.h frame.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects.h opaque.h redisplay.h select.h specifier.h symeval.h symsinit.h text.h vdb.h -sgiplay.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h libst.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h sound.h symeval.h symsinit.h sysfile.h sysproc.h syssignal.h systime.h syswindows.h text.h vdb.h -sheap.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h sheap-adjust.h symeval.h symsinit.h sysfile.h syswindows.h text.h vdb.h -signal.o: $(CONFIG_H) $(LISP_H) compiler.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h events.h frame-impl.h frame.h frameslots.h gc.h general-slots.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h process.h redisplay.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h syssignal.h systime.h syswindows.h text.h vdb.h -sound.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h sound.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h sysproc.h syssignal.h systime.h syswindows.h text.h vdb.h xintrinsic.h -specifier.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h elhash.h frame.h gc.h general-slots.h glyphs.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h rangetab.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h text.h vdb.h window-impl.h window.h winslots.h +libinterface.o: $(CONFIG_H) $(LISP_H) libinterface.h +libsst.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h intl-auto-encap-win32.h libsst.h sound.h sysfile.h syswindows.h +line-number.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h line-number.h +linuxplay.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h intl-auto-encap-win32.h miscplay.h sound.h sysfile.h syssignal.h systty.h syswindows.h +lread.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h coding-system-slots.h elhash.h file-coding.h intl-auto-encap-win32.h lstream.h opaque.h profile.h sysfile.h sysfloat.h syswindows.h +lstream.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h insdel.h intl-auto-encap-win32.h lstream.h sysfile.h syswindows.h +macros.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h conslots.h console-impl.h console.h device.h events.h frame.h keymap-buttons.h keymap.h macros.h redisplay.h scrollbar.h specifier.h systime.h window.h +marker.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h +mc-alloc.o: $(CONFIG_H) $(LISP_H) blocktype.h getpagesize.h +md5.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h file-coding.h lstream.h +menubar.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h frame-impl.h frame.h frameslots.h gui.h keymap-buttons.h keymap.h menubar.h redisplay.h scrollbar.h specifier.h window-impl.h window.h winslots.h +minibuf.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h conslots.h console-impl.h console-stream.h console.h events.h frame-impl.h frame.h frameslots.h insdel.h keymap-buttons.h redisplay.h scrollbar.h specifier.h systime.h window-impl.h window.h winslots.h +miscplay.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h intl-auto-encap-win32.h miscplay.h sound.h sysfile.h syssignal.h syswindows.h +nas.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h sound.h sysdep.h syssignal.h +nt.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h intl-auto-encap-win32.h ndir.h process.h sysdir.h sysfile.h sysproc.h syspwd.h syssignal.h systime.h syswindows.h +ntheap.o: $(CONFIG_H) $(LISP_H) intl-auto-encap-win32.h sysdep.h syswindows.h +ntplay.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h intl-auto-encap-win32.h sound.h sysfile.h syswindows.h +number-gmp.o: $(CONFIG_H) $(LISP_H) sysproc.h syssignal.h systime.h +number-mp.o: $(CONFIG_H) $(LISP_H) +number.o: $(CONFIG_H) $(LISP_H) +opaque.o: $(CONFIG_H) $(LISP_H) opaque.h +print.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h conslots.h console-impl.h console-msw.h console-stream-impl.h console-stream.h console-tty-impl.h console-tty.h console.h device-impl.h device.h devslots.h extents.h frame.h insdel.h intl-auto-encap-win32.h lstream.h opaque.h redisplay.h specifier.h sysfile.h systty.h syswindows.h +process-nt.o: $(CONFIG_H) $(LISP_H) console-msw.h console.h events.h hash.h intl-auto-encap-win32.h keymap-buttons.h lstream.h process-slots.h process.h procimpl.h sysfile.h sysproc.h syssignal.h systime.h syswindows.h +process-unix.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h console.h events.h file-coding.h frame.h hash.h intl-auto-encap-win32.h keymap-buttons.h lstream.h ndir.h opaque.h process-slots.h process.h procimpl.h redisplay.h scrollbar.h sysdep.h sysdir.h sysfile.h sysproc.h syssignal.h systime.h systty.h syswait.h syswindows.h window.h +process.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h commands.h console.h device.h events.h file-coding.h frame.h hash.h insdel.h intl-auto-encap-win32.h keymap-buttons.h lstream.h opaque.h process-slots.h process.h procimpl.h redisplay.h scrollbar.h sysdep.h sysfile.h sysproc.h syssignal.h systime.h systty.h syswait.h syswindows.h window.h +profile.o: $(CONFIG_H) $(LISP_H) backtrace.h bytecode.h elhash.h hash.h profile.h syssignal.h systime.h +ralloc.o: $(CONFIG_H) $(LISP_H) getpagesize.h +rangetab.o: $(CONFIG_H) $(LISP_H) rangetab.h +realpath.o: $(CONFIG_H) $(LISP_H) backtrace.h intl-auto-encap-win32.h ndir.h profile.h sysdir.h sysfile.h syswindows.h +redisplay-output.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h faces.h frame-impl.h frame.h frameslots.h glyphs.h gutter.h redisplay.h scrollbar.h specifier.h window-impl.h window.h winslots.h +redisplay.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h commands.h conslots.h console-impl.h console-tty.h console.h debug.h device-impl.h device.h devslots.h elhash.h events.h extents-impl.h extents.h faces.h file-coding.h fontcolor-impl.h fontcolor.h frame-impl.h frame.h frameslots.h glyphs.h gui.h gutter.h insdel.h intl-auto-encap-win32.h keymap-buttons.h line-number.h menubar.h opaque.h process.h profile.h redisplay.h scrollbar.h specifier.h sysfile.h systime.h systty.h syswindows.h toolbar.h window-impl.h window.h winslots.h +regex.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h regex.h syntax.h +scrollbar.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h frame-impl.h frame.h frameslots.h glyphs.h gutter.h redisplay.h scrollbar.h specifier.h window-impl.h window.h winslots.h +search.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h insdel.h opaque.h regex.h syntax.h +select.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h extents.h fontcolor.h frame.h opaque.h redisplay.h select.h specifier.h +sgiplay.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h intl-auto-encap-win32.h libst.h sound.h sysfile.h sysproc.h syssignal.h systime.h syswindows.h +sheap.o: $(CONFIG_H) $(LISP_H) intl-auto-encap-win32.h sheap-adjust.h sysfile.h syswindows.h +signal.o: $(CONFIG_H) $(LISP_H) conslots.h console-impl.h console.h device-impl.h device.h devslots.h events.h frame-impl.h frame.h frameslots.h intl-auto-encap-win32.h keymap-buttons.h process.h redisplay.h specifier.h sysdep.h sysfile.h syssignal.h systime.h syswindows.h +sound.o: $(CONFIG_H) $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h intl-auto-encap-win32.h redisplay.h sound.h specifier.h sysdep.h sysfile.h sysproc.h syssignal.h systime.h syswindows.h xintrinsic.h +specifier.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h elhash.h frame.h glyphs.h opaque.h rangetab.h redisplay.h scrollbar.h specifier.h window-impl.h window.h winslots.h strcat.o: $(CONFIG_H) -strftime.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -sunplay.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h sound.h symeval.h symsinit.h sysdep.h sysfile.h syssignal.h syswindows.h text.h vdb.h -sunpro.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -symbols.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console.h dumper.h elhash.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h specifier.h symeval.h symsinit.h text.h vdb.h -syntax.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h extents.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h syntax.h text.h vdb.h -sysdep.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console-stream-impl.h console-stream.h console-tty-impl.h console-tty.h console.h device-impl.h device.h devslots.h dumper.h events.h frame.h gc.h general-slots.h intl-auto-encap-win32.h keymap-buttons.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h ndir.h number-gmp.h number-mp.h number.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysdir.h sysfile.h sysproc.h syspwd.h syssignal.h systime.h systty.h syswait.h syswindows.h text.h vdb.h window.h -sysdll.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h sysdll.h sysfile.h syswindows.h text.h vdb.h -termcap.o: $(CONFIG_H) $(LISP_H) compiler.h console.h device.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h +strftime.o: $(CONFIG_H) $(LISP_H) +sunplay.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h intl-auto-encap-win32.h sound.h sysdep.h sysfile.h syssignal.h syswindows.h +sunpro.o: $(CONFIG_H) $(LISP_H) +symbols.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h conslots.h console-impl.h console.h elhash.h specifier.h +syntax.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h extents.h syntax.h +sysdep.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console-stream-impl.h console-stream.h console-tty-impl.h console-tty.h console.h device-impl.h device.h devslots.h events.h frame.h intl-auto-encap-win32.h keymap-buttons.h ndir.h process.h redisplay.h scrollbar.h specifier.h sysdep.h sysdir.h sysfile.h sysproc.h syspwd.h syssignal.h systime.h systty.h syswait.h syswindows.h window.h +sysdll.o: $(CONFIG_H) $(LISP_H) intl-auto-encap-win32.h sysdll.h sysfile.h syswindows.h +termcap.o: $(CONFIG_H) $(LISP_H) conslots.h console-impl.h console.h device-impl.h device.h devslots.h intl-auto-encap-win32.h process.h specifier.h sysfile.h syswindows.h terminfo.o: $(CONFIG_H) -tests.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h dumper.h elhash.h file-coding.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h symeval.h symsinit.h text.h vdb.h -text.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h dumper.h file-coding.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h lstream.h mc-alloc.h number-gmp.h number-mp.h number.h profile.h symeval.h symsinit.h text.h vdb.h -toolbar.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h text.h toolbar.h vdb.h window-impl.h window.h winslots.h -tooltalk.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h elhash.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h process.h symeval.h symsinit.h syssignal.h text.h tooltalk.h vdb.h -tparam.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -undo.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h extents.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -unexaix.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h getpagesize.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h +tests.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h elhash.h file-coding.h lstream.h opaque.h +text.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h file-coding.h lstream.h profile.h +toolbar.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h frame-impl.h frame.h frameslots.h glyphs.h redisplay.h scrollbar.h specifier.h toolbar.h window-impl.h window.h winslots.h +tooltalk.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h elhash.h process.h syssignal.h tooltalk.h +tparam.o: $(CONFIG_H) $(LISP_H) +undo.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h extents.h +unexaix.o: $(CONFIG_H) $(LISP_H) getpagesize.h unexalpha.o: $(CONFIG_H) compiler.h -unexcw.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h sysfile.h syswindows.h text.h vdb.h -unexec.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h getpagesize.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -unexelf.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -unexhp9k800.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -unexnt.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h sysfile.h syswindows.h text.h vdb.h +unexcw.o: $(CONFIG_H) $(LISP_H) intl-auto-encap-win32.h sysfile.h syswindows.h +unexec.o: $(CONFIG_H) $(LISP_H) getpagesize.h +unexelf.o: $(CONFIG_H) $(LISP_H) +unexhp9k800.o: $(CONFIG_H) $(LISP_H) +unexnt.o: $(CONFIG_H) $(LISP_H) intl-auto-encap-win32.h sysfile.h syswindows.h unexsol2-6.o: compiler.h -unicode.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h compiler.h dumper.h extents.h file-coding.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h opaque.h rangetab.h symeval.h symsinit.h sysfile.h syswindows.h text.h vdb.h -vdb-fake.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -vdb-mach.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -vdb-posix.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -vdb-win32.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h syswindows.h text.h vdb.h -vdb.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -vm-limit.o: $(CONFIG_H) $(LISP_H) compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h mem-limits.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -widget.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h dumper.h gc.h general-slots.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h -win32.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h casetab.h charset.h chartab.h compiler.h console-msw.h console.h dumper.h gc.h general-slots.h hash.h intl-auto-encap-win32.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h profile.h symeval.h symsinit.h sysfile.h sysproc.h syssignal.h systime.h syswindows.h text.h vdb.h -window.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h compiler.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h dumper.h elhash.h faces.h frame-impl.h frame.h frameslots.h gc.h general-slots.h glyphs.h gutter.h lisp-disunion.h lisp-union.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h text.h vdb.h window-impl.h window.h winslots.h +unicode.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h extents.h file-coding.h intl-auto-encap-win32.h opaque.h rangetab.h sysfile.h syswindows.h +vdb-fake.o: $(CONFIG_H) $(LISP_H) +vdb-mach.o: $(CONFIG_H) $(LISP_H) +vdb-posix.o: $(CONFIG_H) $(LISP_H) +vdb-win32.o: $(CONFIG_H) $(LISP_H) intl-auto-encap-win32.h syswindows.h +vdb.o: $(CONFIG_H) $(LISP_H) +vm-limit.o: $(CONFIG_H) $(LISP_H) mem-limits.h +widget.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h +win32.o: $(CONFIG_H) $(LISP_H) backtrace.h buffer.h bufslots.h casetab.h charset.h chartab.h console-msw.h console.h hash.h intl-auto-encap-win32.h profile.h sysfile.h sysproc.h syssignal.h systime.h syswindows.h +window.o: $(CONFIG_H) $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h elhash.h faces.h fontcolor.h frame-impl.h frame.h frameslots.h glyphs.h gutter.h redisplay.h scrollbar.h specifier.h window-impl.h window.h winslots.h diff -r 861f2601a38b -r 1f0b15040456 src/device-gtk.c --- a/src/device-gtk.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/device-gtk.c Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -42,7 +40,7 @@ #include "console-gtk-impl.h" #include "gccache-gtk.h" #include "glyphs-gtk.h" -#include "objects-gtk.h" +#include "fontcolor-gtk.h" #include "gtk-xemacs.h" #include "sysfile.h" @@ -76,11 +74,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("gtk-device", gtk_device, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - gtk_device_data_description_1, - Lisp_Gtk_Device); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("gtk-device", gtk_device, + 0, gtk_device_data_description_1, + Lisp_Gtk_Device); #else /* not NEW_GC */ extern const struct sized_memory_description gtk_device_data_description; @@ -117,7 +113,7 @@ allocate_gtk_device_struct (struct device *d) { #ifdef NEW_GC - d->device_data = alloc_lrecord_type (struct gtk_device, &lrecord_gtk_device); + d->device_data = XGTK_DEVICE (ALLOC_NORMAL_LISP_OBJECT (gtk_device)); #else /* not NEW_GC */ d->device_data = xnew_and_zero (struct gtk_device); #endif /* not NEW_GC */ @@ -186,11 +182,7 @@ slow_down_interrupts (); #ifdef HAVE_GNOME -#ifdef INFODOCK - gnome_init ("InfoDock", EMACS_VERSION, argc, argv); -#else gnome_init ("XEmacs", EMACS_VERSION, argc, argv); -#endif /* INFODOCK */ #else gtk_init (&argc, &argv); #endif @@ -689,7 +681,7 @@ syms_of_device_gtk (void) { #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (gtk_device); + INIT_LISP_OBJECT (gtk_device); #endif /* NEW_GC */ DEFSUBR (Fgtk_keysym_on_keyboard_p); diff -r 861f2601a38b -r 1f0b15040456 src/device-impl.h --- a/src/device-impl.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/device-impl.h Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -71,7 +69,7 @@ struct device { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; /* Methods for this device's console. This can also be retrieved through device->console, but it's faster this way. */ diff -r 861f2601a38b -r 1f0b15040456 src/device-msw.c --- a/src/device-msw.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/device-msw.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* device functions for mswindows. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. Copyright (C) 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 2000, 2001, 2002 Ben Wing. + Copyright (C) 2000, 2001, 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -45,7 +43,7 @@ #include "console-msw-impl.h" #include "console-stream.h" -#include "objects-msw.h" +#include "fontcolor-msw.h" #include "sysdep.h" @@ -75,11 +73,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("mswindows-device", mswindows_device, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - mswindows_device_data_description_1, - Lisp_Mswindows_Device); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("mswindows-device", mswindows_device, + 0, mswindows_device_data_description_1, + Lisp_Mswindows_Device); #else /* not NEW_GC */ extern const struct sized_memory_description mswindows_device_data_description; @@ -96,11 +92,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("msprinter-device", msprinter_device, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - msprinter_device_data_description_1, - Lisp_Msprinter_Device); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("msprinter-device", msprinter_device, + 0, msprinter_device_data_description_1, + Lisp_Msprinter_Device); #else /* not NEW_GC */ extern const struct sized_memory_description msprinter_device_data_description; @@ -166,8 +160,7 @@ init_one_device (d); #ifdef NEW_GC - d->device_data = alloc_lrecord_type (struct mswindows_device, - &lrecord_mswindows_device); + d->device_data = XMSWINDOWS_DEVICE (ALLOC_NORMAL_LISP_OBJECT (mswindows_device)); #else /* not NEW_GC */ d->device_data = xnew_and_zero (struct mswindows_device); #endif /* not NEW_GC */ @@ -523,8 +516,7 @@ Extbyte *printer_name; #ifdef NEW_GC - d->device_data = alloc_lrecord_type (struct msprinter_device, - &lrecord_msprinter_device); + d->device_data = XMSPRINTER_DEVICE (ALLOC_NORMAL_LISP_OBJECT (msprinter_device)); #else /* not NEW_GC */ d->device_data = xnew_and_zero (struct msprinter_device); #endif /* not NEW_GC */ @@ -580,6 +572,7 @@ #ifndef NEW_GC xfree (d->device_data); + d->device_data = 0; #endif /* not NEW_GC */ } } @@ -671,7 +664,7 @@ suffix. */ Ibyte new_connext[20]; - qxesprintf (new_connext, ":%X", d->header.uid); + qxesprintf (new_connext, ":%X", LISP_OBJECT_UID (wrap_device (d))); new_connection = concat2 (devname, build_istring (new_connext)); } DEVICE_CONNECTION (d) = new_connection; @@ -1154,28 +1147,19 @@ { Lisp_Devmode *dm = XDEVMODE (obj); if (print_readably) - printing_unreadable_lcrecord (obj, 0); + printing_unreadable_lisp_object (obj, 0); write_ascstring (printcharfun, "#printer_name)) write_fmt_string_lisp (printcharfun, " for %S", 1, dm->printer_name); if (!NILP (dm->device)) write_fmt_string_lisp (printcharfun, " (currently on %s)", 1, dm->device); - write_fmt_string (printcharfun, " 0x%x>", dm->header.uid); + write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); } static void -finalize_devmode (void *header, int for_disksave) +finalize_devmode (Lisp_Object obj) { - Lisp_Devmode *dm = (Lisp_Devmode *) header; - - if (for_disksave) - { - Lisp_Object devmode = wrap_devmode (dm); - - invalid_operation - ("Cannot dump XEmacs containing an msprinter-settings object", - devmode); - } + Lisp_Devmode *dm = XDEVMODE (obj); assert (NILP (dm->device)); } @@ -1199,30 +1183,29 @@ } static Hashcode -hash_devmode (Lisp_Object obj, int depth) +hash_devmode (Lisp_Object obj, int depth, Boolint UNUSED (equalp)) { Lisp_Devmode *dm = XDEVMODE (obj); return HASH3 (XDEVMODE_SIZE (dm), dm->devmode ? memory_hash (dm->devmode, XDEVMODE_SIZE (dm)) : 0, - internal_hash (dm->printer_name, depth + 1)); + internal_hash (dm->printer_name, depth + 1, 0)); } -DEFINE_LRECORD_IMPLEMENTATION ("msprinter-settings", devmode, - 0, /*dumpable-flag*/ - mark_devmode, print_devmode, finalize_devmode, - equal_devmode, hash_devmode, - devmode_description, - Lisp_Devmode); +DEFINE_NODUMP_LISP_OBJECT ("msprinter-settings", devmode, + mark_devmode, print_devmode, + finalize_devmode, + equal_devmode, hash_devmode, + devmode_description, + Lisp_Devmode); static Lisp_Object allocate_devmode (DEVMODEW* src_devmode, int do_copy, Lisp_Object src_name, struct device *d) { - Lisp_Devmode *dm; - - dm = ALLOC_LCRECORD_TYPE (Lisp_Devmode, &lrecord_devmode); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (devmode); + Lisp_Devmode *dm = XDEVMODE (obj); if (d) dm->device = wrap_device (d); @@ -1241,7 +1224,7 @@ dm->devmode = src_devmode; } - return wrap_devmode (dm); + return obj; } DEFUN ("msprinter-settings-copy", Fmsprinter_settings_copy, 1, 1, 0, /* @@ -1344,9 +1327,12 @@ GCPRO2 (result, def_printer); + def_printer = msprinter_default_printer (); + while (num_printers--) { Extbyte *printer_name; + Lisp_Object printer_name_lisp; if (have_nt) { PRINTER_INFO_4 *info = (PRINTER_INFO_4 *) data_buf; @@ -1358,12 +1344,15 @@ printer_name = (Extbyte *) info->pPrinterName; } data_buf += enum_entry_size; - - result = Fcons (build_tstr_string (printer_name), result); + + printer_name_lisp = build_tstr_string (printer_name); + if (0 != qxestrcasecmp (XSTRING_DATA (def_printer), + XSTRING_DATA (printer_name_lisp))) + { + result = Fcons (printer_name_lisp, result); + } } - def_printer = msprinter_default_printer (); - result = Fdelete (def_printer, result); result = Fcons (def_printer, result); RETURN_UNGCPRO (result); @@ -1377,11 +1366,11 @@ void syms_of_device_mswindows (void) { - INIT_LRECORD_IMPLEMENTATION (devmode); + INIT_LISP_OBJECT (devmode); #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (mswindows_device); - INIT_LRECORD_IMPLEMENTATION (msprinter_device); + INIT_LISP_OBJECT (mswindows_device); + INIT_LISP_OBJECT (msprinter_device); #endif /* NEW_GC */ DEFSUBR (Fmsprinter_get_settings); diff -r 861f2601a38b -r 1f0b15040456 src/device-tty.c --- a/src/device-tty.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/device-tty.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* TTY device functions. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. Copyright (C) 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1996 Ben Wing. + Copyright (C) 1996, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -49,18 +47,16 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("tty-device", tty_device, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - tty_device_data_description_1, - Lisp_Tty_Device); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("tty-device", tty_device, + 0, tty_device_data_description_1, + Lisp_Tty_Device); #endif /* NEW_GC */ static void allocate_tty_device_struct (struct device *d) { #ifdef NEW_GC - d->device_data = alloc_lrecord_type (struct tty_device, &lrecord_tty_device); + d->device_data = XTTY_DEVICE (ALLOC_NORMAL_LISP_OBJECT (tty_device)); #else /* not NEW_GC */ d->device_data = xnew_and_zero (struct tty_device); #endif /* not NEW_GC */ @@ -118,7 +114,10 @@ free_tty_device_struct (struct device *d) { if (d->device_data) - xfree (d->device_data); + { + xfree (d->device_data); + d->device_data = 0; + } } static void @@ -177,7 +176,7 @@ /* We know the frame is tty because we made sure that the device is tty. */ - change_frame_size (f, height, width, 1); + change_frame_size (f, width, height, 1); } } } @@ -195,6 +194,14 @@ case DM_size_device: return Fcons (make_int (CONSOLE_TTY_DATA (con)->width), make_int (CONSOLE_TTY_DATA (con)->height)); + case DM_num_bit_planes: + { + EMACS_INT l2 = (EMACS_INT) (log (CONSOLE_TTY_DATA (con)->colors) + / log (2)); + return make_int (l2); + } + case DM_num_color_cells: + return make_int (CONSOLE_TTY_DATA (con)->colors); default: /* No such device metric property for TTY devices */ return Qunbound; } @@ -208,7 +215,7 @@ syms_of_device_tty (void) { #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (tty_device); + INIT_LISP_OBJECT (tty_device); #endif /* NEW_GC */ DEFSYMBOL (Qmake_device_early_tty_entry_point); diff -r 861f2601a38b -r 1f0b15040456 src/device-x.c --- a/src/device-x.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/device-x.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* Device functions for X windows. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. Copyright (C) 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 2001, 2002, 2004 Ben Wing. + Copyright (C) 2001, 2002, 2004, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -44,7 +42,7 @@ #include "console-x-impl.h" #include "glyphs-x.h" -#include "objects-x.h" +#include "fontcolor-x.h" #include "sysfile.h" #include "systime.h" @@ -111,11 +109,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("x-device", x_device, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - x_device_data_description_1, - Lisp_X_Device); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("x-device", x_device, + 0, x_device_data_description_1, + Lisp_X_Device); #else /* not NEW_GC */ extern const struct sized_memory_description x_device_data_description; @@ -151,14 +147,9 @@ struct device * get_device_from_display (Display *dpy) { +#define FALLBACK_RESOURCE_NAME "xemacs" struct device *d = get_device_from_display_1 (dpy); -#if !defined(INFODOCK) -# define FALLBACK_RESOURCE_NAME "xemacs" -# else -# define FALLBACK_RESOURCE_NAME "infodock" -#endif - if (!d) { /* This isn't one of our displays. Let's crash? */ @@ -230,7 +221,7 @@ allocate_x_device_struct (struct device *d) { #ifdef NEW_GC - d->device_data = alloc_lrecord_type (struct x_device, &lrecord_x_device); + d->device_data = XX_DEVICE (ALLOC_NORMAL_LISP_OBJECT (x_device)); #else /* not NEW_GC */ d->device_data = xnew_and_zero (struct x_device); #endif /* not NEW_GC */ @@ -346,11 +337,7 @@ const char *xdefs, *key; int len; -#ifdef INFODOCK - key = "InfoDock"; -#else key = "XEmacs"; -#endif len = strlen (key); if (!dpy) @@ -488,7 +475,7 @@ vi_in.visualid = XVisualIDFromVisual (visual); vi_out = XGetVisualInfo (dpy, /*VisualScreenMask|*/VisualIDMask, &vi_in, &out_count); - if (! vi_out) ABORT (); + assert (vi_out); d = vi_out [0].depth; XFree ((char *) vi_out); return d; @@ -655,11 +642,7 @@ { app_class = (NILP (Vx_emacs_application_class) && have_xemacs_resources_in_xrdb (dpy)) -#ifdef INFODOCK - ? "InfoDock" -#else ? "XEmacs" -#endif : "Emacs"; } else @@ -691,7 +674,7 @@ Extbyte *path; const Extbyte *format; XrmDatabase db = XtDatabase (dpy); /* #### XtScreenDatabase(dpy) ? */ - const Extbyte *locale = xstrdup (XrmLocaleOfDatabase (db)); + Extbyte *locale = xstrdup (XrmLocaleOfDatabase (db)); Extbyte *locale_end; if (STRINGP (Vx_app_defaults_directory) && @@ -722,28 +705,26 @@ if (!access (path, R_OK)) XrmCombineFileDatabase (path, &db, False); - if ((locale_end = strchr(locale, '.'))) { - *locale_end = '\0'; - sprintf (path, format, data_dir, locale); + if ((locale_end = strchr (locale, '.'))) + { + *locale_end = '\0'; + sprintf (path, format, data_dir, locale); - if (!access (path, R_OK)) - XrmCombineFileDatabase (path, &db, False); - } + if (!access (path, R_OK)) + XrmCombineFileDatabase (path, &db, False); + } - if ((locale_end = strchr(locale, '_'))) { - *locale_end = '\0'; - sprintf (path, format, data_dir, locale); + if ((locale_end = strchr (locale, '_'))) + { + *locale_end = '\0'; + sprintf (path, format, data_dir, locale); - if (!access (path, R_OK)) - XrmCombineFileDatabase (path, &db, False); - } + if (!access (path, R_OK)) + XrmCombineFileDatabase (path, &db, False); + } no_data_directory: - { - /* Cast off const for G++ 4.3. */ - Extbyte *temp = (Extbyte *) locale; - xfree (temp); - } + xfree (locale); } #endif /* MULE */ @@ -924,7 +905,7 @@ DEVICE_X_GRAY_PIXMAP (d) = None; Xatoms_of_device_x (d); Xatoms_of_select_x (d); - Xatoms_of_objects_x (d); + Xatoms_of_fontcolor_x (d); x_init_device_class (d); } @@ -1272,7 +1253,8 @@ DEVICE_X_BEING_DELETED (d) = 1; } - throw_or_bomb_out (Qtop_level, Qnil, 0, Qnil, Qnil); + redisplay_cancel_ritual_suicide(); + throw_or_bomb_out_unsafe (Qtop_level, Qnil, 0, Qnil, Qnil); RETURN_NOT_REACHED (0); } @@ -1564,9 +1546,9 @@ db = XtDatabase (display); codesys = coding_system_of_xrm_database (db); Dynarr_add (name_Extbyte_dynarr, '.'); - Dynarr_add_lisp_string (name_Extbyte_dynarr, name, Qbinary); + Dynarr_add_ext_lisp_string (name_Extbyte_dynarr, name, Qbinary); Dynarr_add (class_Extbyte_dynarr, '.'); - Dynarr_add_lisp_string (class_Extbyte_dynarr, class_, Qbinary); + Dynarr_add_ext_lisp_string (class_Extbyte_dynarr, class_, Qbinary); Dynarr_add (name_Extbyte_dynarr, '\0'); Dynarr_add (class_Extbyte_dynarr, '\0'); @@ -2108,7 +2090,7 @@ syms_of_device_x (void) { #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (x_device); + INIT_LISP_OBJECT (x_device); #endif /* NEW_GC */ DEFSUBR (Fx_debug_mode); diff -r 861f2601a38b -r 1f0b15040456 src/device.c --- a/src/device.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/device.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* Generic device functions. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. Copyright (C) 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1995, 1996, 2002 Ben Wing. + Copyright (C) 1995, 1996, 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -38,7 +36,7 @@ #include "faces.h" #include "frame-impl.h" #include "keymap.h" -#include "objects.h" +#include "fontcolor.h" #include "redisplay.h" #include "specifier.h" #include "sysdep.h" @@ -160,20 +158,19 @@ struct device *d = XDEVICE (obj); if (print_readably) - printing_unreadable_lcrecord (obj, XSTRING_DATA (d->name)); + printing_unreadable_lisp_object (obj, XSTRING_DATA (d->name)); write_fmt_string (printcharfun, "#<%s-device", !DEVICE_LIVE_P (d) ? "dead" : DEVICE_TYPE_NAME (d)); if (DEVICE_LIVE_P (d) && !NILP (DEVICE_CONNECTION (d))) write_fmt_string_lisp (printcharfun, " on %S", 1, DEVICE_CONNECTION (d)); - write_fmt_string (printcharfun, " 0x%x>", d->header.uid); + write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); } -DEFINE_LRECORD_IMPLEMENTATION ("device", device, - 0, /*dumpable-flag*/ - mark_device, print_device, 0, 0, 0, - device_description, - struct device); +DEFINE_NODUMP_LISP_OBJECT ("device", device, + mark_device, print_device, 0, 0, 0, + device_description, + struct device); int valid_device_class_p (Lisp_Object class_) @@ -201,7 +198,7 @@ static void nuke_all_device_slots (struct device *d, Lisp_Object zap) { - ZERO_LCRECORD (d); + zero_nonsized_lisp_object (wrap_device (d)); #define MARKED_SLOT(x) d->x = zap; #include "devslots.h" @@ -210,12 +207,11 @@ static struct device * allocate_device (Lisp_Object console) { - Lisp_Object device; - struct device *d = ALLOC_LCRECORD_TYPE (struct device, &lrecord_device); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (device); + struct device *d = XDEVICE (obj); struct gcpro gcpro1; - device = wrap_device (d); - GCPRO1 (device); + GCPRO1 (obj); nuke_all_device_slots (d, Qnil); @@ -224,9 +220,9 @@ /* #### is 20 reasonable? */ d->color_instance_cache = - make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, Qequal); d->font_instance_cache = - make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, Qequal); #ifdef MULE initialize_charset_font_caches (d); #endif @@ -236,7 +232,7 @@ time there aren't very many different masks that will be used. */ d->image_instance_cache = - make_lisp_hash_table (5, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (5, HASH_TABLE_NON_WEAK, Qeq); UNGCPRO; return d; @@ -1059,8 +1055,8 @@ return DEVICE_PRINTER_P (decode_device (device)) ? Qt : Qnil; } -DEFUN ("device-system-metric", Fdevice_system_metric, 1, 3, 0, /* -Get a metric for DEVICE as provided by the system. +DEFUN ("device-system-metric", Fdevice_system_metric, 2, 3, 0, /* +Get DEVICE METRIC as provided by the system. METRIC must be a symbol specifying requested metric. Note that the metrics returned are these provided by the system internally, not read from resources, @@ -1398,7 +1394,7 @@ void syms_of_device (void) { - INIT_LRECORD_IMPLEMENTATION (device); + INIT_LISP_OBJECT (device); DEFSUBR (Fvalid_device_class_p); DEFSUBR (Fdevice_class_list); diff -r 861f2601a38b -r 1f0b15040456 src/device.h --- a/src/device.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/device.h Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -31,7 +29,7 @@ struct device; -DECLARE_LRECORD (device, struct device); +DECLARE_LISP_OBJECT (device, struct device); #define XDEVICE(x) XRECORD (x, device, struct device) #define wrap_device(p) wrap_record (p, device) #define DEVICEP(x) RECORDP (x, device) diff -r 861f2601a38b -r 1f0b15040456 src/devslots.h --- a/src/devslots.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/devslots.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -106,7 +104,7 @@ to determine an appropriate font. */ MARKED_SLOT (charset_font_cache_stage_1) - /* Similar cache for stage 2, if it exists. See objects.c. */ + /* Similar cache for stage 2, if it exists. See fontcolor.c. */ MARKED_SLOT (charset_font_cache_stage_2) #endif diff -r 861f2601a38b -r 1f0b15040456 src/dialog-gtk.c --- a/src/dialog-gtk.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/dialog-gtk.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/dialog-msw.c --- a/src/dialog-msw.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/dialog-msw.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -183,12 +181,11 @@ return data->callbacks; } -DEFINE_LRECORD_IMPLEMENTATION ("mswindows-dialog-id", mswindows_dialog_id, - 0, /* dump-able flag */ - mark_mswindows_dialog_id, - internal_object_printer, 0, 0, 0, - mswindows_dialog_id_description, - struct mswindows_dialog_id); +DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("mswindows-dialog-id", + mswindows_dialog_id, + mark_mswindows_dialog_id, + mswindows_dialog_id_description, + struct mswindows_dialog_id); /* Dialog procedure */ static BOOL CALLBACK @@ -442,6 +439,7 @@ { ret = tstr_to_local_file_format (pd.unknown_fname); xfree (pd.unknown_fname); + pd.unknown_fname = 0; } else while (1) signal_quit (); @@ -748,13 +746,9 @@ GC-protected and thus it is put into a statically protected list. */ { - Lisp_Object dialog_data; int i; - struct mswindows_dialog_id *did = - ALLOC_LCRECORD_TYPE (struct mswindows_dialog_id, - &lrecord_mswindows_dialog_id); - - dialog_data = wrap_mswindows_dialog_id (did); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (mswindows_dialog_id); + struct mswindows_dialog_id *did = XMSWINDOWS_DIALOG_ID (obj); did->frame = wrap_frame (f); did->callbacks = make_vector (Dynarr_length (dialog_items), Qunbound); @@ -767,16 +761,16 @@ qxeCreateDialogIndirectParam (NULL, (LPDLGTEMPLATE) Dynarr_begin (template_), FRAME_MSWINDOWS_HANDLE (f), dialog_proc, - (LPARAM) STORE_LISP_IN_VOID (dialog_data)); + (LPARAM) STORE_LISP_IN_VOID (obj)); if (!did->hwnd) /* Something went wrong creating the dialog */ signal_error (Qdialog_box_error, "Creating dialog", keys); - Vdialog_data_list = Fcons (dialog_data, Vdialog_data_list); + Vdialog_data_list = Fcons (obj, Vdialog_data_list); /* Cease protection and free dynarrays */ unbind_to (unbind_count); - return dialog_data; + return obj; } } @@ -814,7 +808,7 @@ void syms_of_dialog_mswindows (void) { - INIT_LRECORD_IMPLEMENTATION (mswindows_dialog_id); + INIT_LISP_OBJECT (mswindows_dialog_id); DEFKEYWORD (Q_initial_directory); DEFKEYWORD (Q_initial_filename); diff -r 861f2601a38b -r 1f0b15040456 src/dialog-x.c --- a/src/dialog-x.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/dialog-x.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* Implements elisp-programmable dialog boxes -- X interface. Copyright (C) 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Tinker Systems and INS Engineering Corp. - Copyright (C) 2000, 2002, 2003 Ben Wing. + Copyright (C) 2000, 2002, 2003, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/dialog.c --- a/src/dialog.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/dialog.c Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/dired-msw.c --- a/src/dired-msw.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/dired-msw.c Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/dired.c --- a/src/dired.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/dired.c Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,13 @@ /* Lisp functions for making directory listings. Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 2001, 2002, 2010 Ben Wing. + Copyright (C) 2001, 2002 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ @@ -46,6 +44,7 @@ Lisp_Object Qfile_name_completion; Lisp_Object Qfile_name_all_completions; Lisp_Object Qfile_attributes; +Lisp_Object Qfile_system_ignore_case_p; static Lisp_Object close_directory_unwind (Lisp_Object unwind_obj) @@ -180,7 +179,7 @@ unbind_to (speccount); /* This will close the dir */ if (NILP (nosort)) - list = Fsort (Fnreverse (list), Qstring_lessp); + list = list_sort (Fnreverse (list), check_string_lessp_nokey, Qnil, Qnil); RETURN_UNGCPRO (list); } @@ -508,7 +507,7 @@ return bestmatch; if (matchcount == 1 && bestmatchsize == file_name_length) return Qt; - return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize)); + return Fsubseq (bestmatch, Qzero, make_int (bestmatchsize)); } @@ -772,19 +771,26 @@ return bestmatch; if (matchcount == 1 && bestmatchsize == user_name_length) return Qt; - return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize)); + return Fsubseq (bestmatch, Qzero, make_int (bestmatchsize)); } Lisp_Object -make_directory_hash_table (const Ibyte *path) +make_directory_hash_table (Lisp_Object path) { DIR *d; - if ((d = qxe_opendir (path))) + if ((d = qxe_opendir (XSTRING_DATA (path)))) { + Lisp_Object hash_table_test = Qequal, hash = Qnil; DIRENTRY *dp; - Lisp_Object hash = - make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); + + if (!UNBOUNDP (XSYMBOL_FUNCTION (Qfile_system_ignore_case_p)) + && !NILP (call1 (Qfile_system_ignore_case_p, path))) + { + hash_table_test = Qequalp; + } + + hash = make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, hash_table_test); while ((dp = qxe_readdir (d))) { @@ -837,14 +843,13 @@ (filename)) { /* This function can GC. GC checked 1997.06.04. */ - Lisp_Object values[12]; Lisp_Object directory = Qnil; struct stat s; char modes[10]; - Lisp_Object handler; - struct gcpro gcpro1, gcpro2; + Lisp_Object handler, mode, modestring = Qnil, size, gid; + struct gcpro gcpro1, gcpro2, gcpro3; - GCPRO2 (filename, directory); + GCPRO3 (filename, directory, modestring); filename = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, @@ -862,7 +867,7 @@ return Qnil; } -#ifdef BSD4_3 +#ifdef BSD4_2 directory = Ffile_name_directory (filename); #endif @@ -885,49 +890,54 @@ switch (s.st_mode & S_IFMT) { default: - values[0] = Qnil; + mode = Qnil; break; case S_IFDIR: - values[0] = Qt; + mode = Qt; break; #ifdef S_IFLNK case S_IFLNK: - values[0] = Ffile_symlink_p (filename); + mode = Ffile_symlink_p (filename); break; #endif } - values[1] = make_int (s.st_nlink); - values[2] = make_int (s.st_uid); - values[3] = make_int (s.st_gid); - values[4] = make_time (s.st_atime); - values[5] = make_time (s.st_mtime); - values[6] = make_time (s.st_ctime); #ifndef HAVE_BIGNUM - values[7] = make_integer (NUMBER_FITS_IN_AN_EMACS_INT (s.st_size) ? - (EMACS_INT)s.st_size : -1); + size = make_integer (NUMBER_FITS_IN_AN_EMACS_INT (s.st_size) ? + (EMACS_INT)s.st_size : -1); #else - values[7] = make_integer (s.st_size); -#endif + size = make_integer (s.st_size); +#endif filemodestring (&s, modes); - values[8] = make_string ((Ibyte *) modes, 10); -#ifdef BSD4_3 /* file gid will be dir gid */ + modestring = make_string ((Ibyte *) modes, 10); + +#if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */ { struct stat sdir; if (!NILP (directory) && qxe_stat (XSTRING_DATA (directory), &sdir) == 0) - values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil; + gid = (sdir.st_gid != s.st_gid) ? Qt : Qnil; else /* if we can't tell, assume worst */ - values[9] = Qt; + gid = Qt; } #else /* file gid will be egid */ - values[9] = (s.st_gid != getegid ()) ? Qt : Qnil; -#endif /* BSD4_3 */ - values[10] = make_int (s.st_ino); - values[11] = make_int (s.st_dev); - UNGCPRO; - return Flist (countof (values), values); + gid = (s.st_gid != getegid ()) ? Qt : Qnil; +#endif /* BSD4_2 or BSD4_3 */ + + RETURN_UNGCPRO (listn (12, + mode, + make_int (s.st_nlink), + make_int (s.st_uid), + make_int (s.st_gid), + make_time (s.st_atime), + make_time (s.st_mtime), + make_time (s.st_ctime), + size, + modestring, + gid, + make_int (s.st_ino), + make_int (s.st_dev))); } @@ -942,6 +952,7 @@ DEFSYMBOL (Qfile_name_completion); DEFSYMBOL (Qfile_name_all_completions); DEFSYMBOL (Qfile_attributes); + DEFSYMBOL (Qfile_system_ignore_case_p); DEFSUBR (Fdirectory_files); DEFSUBR (Ffile_name_completion); diff -r 861f2601a38b -r 1f0b15040456 src/doc.c --- a/src/doc.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/doc.c Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ @@ -613,7 +611,15 @@ if (STRINGP (tem)) doc = tem; else if (NATNUMP (tem) || CONSP (tem)) - doc = get_doc_string (tem); + { + doc = get_doc_string (tem); + /* We may have zero length strings in the docfile for file + information. */ + if (STRINGP (doc) && 0 == XSTRING_LENGTH (doc)) + { + return Qnil; + } + } else return Qnil; } @@ -903,33 +909,24 @@ slots for it. */ Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); - /* This compiled-function object must have a - slot for the docstring, since we've found a - docstring for it. Unless there were multiple - definitions of it, and the latter one didn't - have any doc, which is a legal if slightly - bogus situation, so don't blow up. */ + /* If there were multiple definitions for this function, + and the latter one didn't + have any doc, warn and don't blow up. */ + Lisp_Object old = + compiled_function_documentation (f); + if (!ZEROP (old) && !NILP (old)) + { + weird_doc (sym, "duplicate", "bytecode", pos); + /* In the case of duplicate doc file entries, + always take the later one. But if the doc is + not an int (a string, say) leave it alone. */ + if (!INTP (old)) + goto weird; + } - if (! (f->flags.documentationp)) - { - weird_doc (sym, "no doc slot", "bytecode", pos); - goto weird; - } - else - { - Lisp_Object old = - compiled_function_documentation (f); - if (!ZEROP (old)) - { - weird_doc (sym, "duplicate", "bytecode", pos); - /* In the case of duplicate doc file entries, - always take the later one. But if the doc is - not an int (a string, say) leave it alone. */ - if (!INTP (old)) - goto weird; - } - set_compiled_function_documentation (f, offset); - } + /* This may be a function or variable where we want + to make the file name available. */ + set_compiled_function_documentation (f, offset); } else { diff -r 861f2601a38b -r 1f0b15040456 src/doprnt.c --- a/src/doprnt.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/doprnt.c Sun May 01 18:44:03 2011 +0100 @@ -10,10 +10,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -21,9 +21,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Rewritten by Ben Wing. Not in FSF. */ @@ -591,11 +589,7 @@ Lisp_Object obj = largs[spec->argnum - 1]; if (CHARP (obj)) obj = make_int (XCHAR (obj)); -#ifdef WITH_NUMBER_TYPES if (!NUMBERP (obj)) -#else - if (!INT_OR_FLOATP (obj)) -#endif { /* WARNING! This MUST be big enough for the sprintf below */ CIbyte msg[48]; @@ -606,9 +600,10 @@ } else if (strchr (double_converters, ch)) { -#ifdef WITH_NUMBER_TYPES - if (INTP (obj) || FLOATP (obj)) - arg.d = XFLOATINT (obj); + if (INTP (obj)) + arg.d = XINT (obj); + else if (FLOATP (obj)) + arg.d = XFLOAT_DATA (obj); #ifdef HAVE_BIGNUM else if (BIGNUMP (obj)) arg.d = bignum_to_double (XBIGNUM_DATA (obj)); @@ -631,9 +626,6 @@ } } #endif -#else /* !WITH_NUMBER_TYPES */ - arg.d = XFLOATINT (obj); -#endif /* WITH_NUMBER_TYPES */ } else { diff -r 861f2601a38b -r 1f0b15040456 src/dragdrop.c --- a/src/dragdrop.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/dragdrop.c Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/dragdrop.h --- a/src/dragdrop.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/dragdrop.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/dump-data.c --- a/src/dump-data.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/dump-data.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/dump-data.h --- a/src/dump-data.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/dump-data.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/dumper.c --- a/src/dumper.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/dumper.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* Portable data dumper for XEmacs. Copyright (C) 1999-2000,2004 Olivier Galibert Copyright (C) 2001 Martin Buchholz - Copyright (C) 2001, 2002, 2003, 2004, 2005 Ben Wing. + Copyright (C) 2001, 2002, 2003, 2004, 2005, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -253,8 +251,20 @@ for (i=0; icount; i++) { struct lrecord_header *lh = * (struct lrecord_header **) p; +#ifdef ALLOC_TYPE_STATS + if (C_READONLY_RECORD_HEADER_P (lh)) + tick_lrecord_stats (lh, ALLOC_IN_USE); + + else + { + tick_lrecord_stats (lh, MARKED_RECORD_HEADER_P (lh) ? + ALLOC_IN_USE : ALLOC_ON_FREE_LIST); + UNMARK_RECORD_HEADER (lh); + } +#else /* not ALLOC_TYPE_STATS */ if (! C_READONLY_RECORD_HEADER_P (lh)) UNMARK_RECORD_HEADER (lh); +#endif /* (not) ALLOC_TYPE_STATS */ p += sizeof (EMACS_INT); } } else @@ -788,7 +798,7 @@ break; } #ifdef NEW_GC - case XD_LISP_OBJECT_BLOCK_PTR: + case XD_INLINE_LISP_OBJECT_BLOCK_PTR: { EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, data); @@ -1061,7 +1071,7 @@ break; } #ifdef NEW_GC - case XD_LISP_OBJECT_BLOCK_PTR: + case XD_INLINE_LISP_OBJECT_BLOCK_PTR: #endif /* NEW_GC */ case XD_OPAQUE_DATA_PTR: case XD_ASCII_STRING: @@ -1302,7 +1312,7 @@ case XD_LONG: case XD_INT_RESET: break; - case XD_LISP_OBJECT_BLOCK_PTR: + case XD_INLINE_LISP_OBJECT_BLOCK_PTR: case XD_OPAQUE_DATA_PTR: case XD_ASCII_STRING: case XD_BLOCK_PTR: diff -r 861f2601a38b -r 1f0b15040456 src/dumper.h --- a/src/dumper.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/dumper.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/dynarr.c --- a/src/dynarr.c Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,416 +0,0 @@ -/* Support for dynamic arrays. - Copyright (C) 1993 Sun Microsystems, Inc. - Copyright (C) 2002, 2003, 2004, 2005, 2010 Ben Wing. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* Written by Ben Wing, December 1993. */ - -/* - -A "dynamic array" is a contiguous array of fixed-size elements where there -is no upper limit (except available memory) on the number of elements in the -array. Because the elements are maintained contiguously, space is used -efficiently (no per-element pointers necessary) and random access to a -particular element is in constant time. At any one point, the block of memory -that holds the array has an upper limit; if this limit is exceeded, the -memory is realloc()ed into a new array that is twice as big. Assuming that -the time to grow the array is on the order of the new size of the array -block, this scheme has a provably constant amortized time (i.e. average -time over all additions). - -When you add elements or retrieve elements, pointers are used. Note that -the element itself (of whatever size it is), and not the pointer to it, -is stored in the array; thus you do not have to allocate any heap memory -on your own. Also, returned pointers are only guaranteed to be valid -until the next operation that changes the length of the array. - -This is a container object. Declare a dynamic array of a specific type -as follows: - - typedef struct - { - Dynarr_declare (mytype); - } mytype_dynarr; - -Use the following functions/macros: - - void *Dynarr_new(type) - [MACRO] Create a new dynamic-array object, with each element of the - specified type. The return value is cast to (type##_dynarr). - This requires following the convention that types are declared in - such a way that this type concatenation works. In particular, TYPE - must be a symbol, not an arbitrary C type. - - Dynarr_add(d, el) - [MACRO] Add an element to the end of a dynamic array. EL is a pointer - to the element; the element itself is stored in the array, however. - No function call is performed unless the array needs to be resized. - - Dynarr_add_many(d, base, len) - [MACRO] Add LEN elements to the end of the dynamic array. The elements - should be contiguous in memory, starting at BASE. If BASE if NULL, - just make space for the elements; don't actually add them. - - Dynarr_insert_many_at_start(d, base, len) - [MACRO] Append LEN elements to the beginning of the dynamic array. - The elements should be contiguous in memory, starting at BASE. - If BASE if NULL, just make space for the elements; don't actually - add them. - - Dynarr_insert_many(d, base, len, start) - Insert LEN elements to the dynamic array starting at position - START. The elements should be contiguous in memory, starting at BASE. - If BASE if NULL, just make space for the elements; don't actually - add them. - - Dynarr_delete(d, i) - [MACRO] Delete an element from the dynamic array at position I. - - Dynarr_delete_many(d, start, len) - Delete LEN elements from the dynamic array starting at position - START. - - Dynarr_delete_by_pointer(d, p) - [MACRO] Delete an element from the dynamic array at pointer P, - which must point within the block of memory that stores the data. - P should be obtained using Dynarr_atp(). - - int Dynarr_length(d) - [MACRO] Return the number of elements currently in a dynamic array. - - int Dynarr_largest(d) - [MACRO] Return the maximum value that Dynarr_length(d) would - ever have returned. This is used esp. in the redisplay code, - which reuses dynarrs for performance reasons. - - type Dynarr_at(d, i) - [MACRO] Return the element at the specified index (no bounds checking - done on the index). The element itself is returned, not a pointer - to it. - - type *Dynarr_atp(d, i) - [MACRO] Return a pointer to the element at the specified index (no - bounds checking done on the index). The pointer may not be valid - after an element is added to or removed from the array. - - Dynarr_reset(d) - [MACRO] Reset the length of a dynamic array to 0. - - Dynarr_free(d) - Destroy a dynamic array and the memory allocated to it. - -Use the following global variable: - - Dynarr_min_size - Minimum allowable size for a dynamic array when it is resized. - -*/ - -#include -#include "lisp.h" - -static const struct memory_description const_Ascbyte_ptr_description_1[] = { - { XD_ASCII_STRING, 0 }, - { XD_END } -}; - -const struct sized_memory_description const_Ascbyte_ptr_description = { - sizeof (const Ascbyte *), - const_Ascbyte_ptr_description_1 -}; - -static const struct memory_description const_Ascbyte_ptr_dynarr_description_1[] = { - XD_DYNARR_DESC (const_Ascbyte_ptr_dynarr, &const_Ascbyte_ptr_description), - { XD_END } -}; - -const struct sized_memory_description const_Ascbyte_ptr_dynarr_description = { - sizeof (const_Ascbyte_ptr_dynarr), - const_Ascbyte_ptr_dynarr_description_1 -}; - - -static int Dynarr_min_size = 8; - -static void -Dynarr_realloc (Dynarr *dy, int new_size) -{ - if (DUMPEDP (dy->base)) - { - void *new_base = malloc (new_size * dy->elsize); - memcpy (new_base, dy->base, - (Dynarr_max (dy) < new_size ? Dynarr_max (dy) : new_size) * - dy->elsize); - dy->base = new_base; - } - else - dy->base = xrealloc (dy->base, new_size * dy->elsize); -} - -void * -Dynarr_newf (int elsize) -{ - Dynarr *d = xnew_and_zero (Dynarr); - d->elsize = elsize; - - return d; -} - -#ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("dynarr", dynarr, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - 0, - Dynarr); - -static void -Dynarr_lisp_realloc (Dynarr *dy, int new_size) -{ - void *new_base = alloc_lrecord_array (dy->elsize, new_size, dy->lisp_imp); - if (dy->base) - memcpy (new_base, dy->base, - (Dynarr_max (dy) < new_size ? Dynarr_max (dy) : new_size) * - dy->elsize); - dy->base = new_base; -} - -void * -Dynarr_lisp_newf (int elsize, - const struct lrecord_implementation *dynarr_imp, - const struct lrecord_implementation *imp) -{ - Dynarr *d = (Dynarr *) alloc_lrecord (sizeof (Dynarr), dynarr_imp); - d->elsize = elsize; - d->lisp_imp = imp; - - return d; -} -#endif /* not NEW_GC */ - -void -Dynarr_resize (void *d, Elemcount size) -{ - int newsize; - double multiplier; - Dynarr *dy = (Dynarr *) Dynarr_verify (d); - - if (Dynarr_max (dy) <= 8) - multiplier = 2; - else - multiplier = 1.5; - - for (newsize = Dynarr_max (dy); newsize < size;) - newsize = max (Dynarr_min_size, (int) (multiplier * newsize)); - - /* Don't do anything if the array is already big enough. */ - if (newsize > Dynarr_max (dy)) - { -#ifdef NEW_GC - if (dy->lisp_imp) - Dynarr_lisp_realloc (dy, newsize); - else - Dynarr_realloc (dy, newsize); -#else /* not NEW_GC */ - Dynarr_realloc (dy, newsize); -#endif /* not NEW_GC */ - dy->max_ = newsize; - } -} - -/* Add a number of contiguous elements to the array starting at START. */ -void -Dynarr_insert_many (void *d, const void *el, int len, int start) -{ - Dynarr *dy = Dynarr_verify_mod (d); - - Dynarr_resize_if (dy, len); - - /* #### This could conceivably be wrong, if code wants to access stuff - between len and largest. */ - dynarr_checking_assert (start >= 0 && start <= Dynarr_length (dy)); - - if (start != Dynarr_length (dy)) - { - memmove ((char *) dy->base + (start + len)*dy->elsize, - (char *) dy->base + start*dy->elsize, - (Dynarr_length (dy) - start)*dy->elsize); - } - /* Some functions call us with a value of 0 to mean "reserve space but - don't write into it" */ - if (el) - memcpy ((char *) dy->base + start*dy->elsize, el, len*dy->elsize); - - Dynarr_set_length_1 (dy, Dynarr_length (dy) + len); - (void) Dynarr_verify_mod (dy); -} - -void -Dynarr_delete_many (void *d, int start, int len) -{ - Dynarr *dy = Dynarr_verify_mod (d); - - dynarr_checking_assert (start >= 0 && len >= 0 && - start + len <= Dynarr_length (dy)); - - memmove ((char *) dy->base + start*dy->elsize, - (char *) dy->base + (start + len)*dy->elsize, - (Dynarr_length (dy) - start - len)*dy->elsize); - - Dynarr_set_length_1 (dy, Dynarr_length (dy) - len); - (void) Dynarr_verify_mod (dy); -} - -void -Dynarr_free (void *d) -{ - Dynarr *dy = (Dynarr *) d; - -#ifdef NEW_GC - if (dy->base && !DUMPEDP (dy->base)) - { - if (!dy->lisp_imp) - xfree (dy->base); - } - if(!DUMPEDP (dy)) - { - if (!dy->lisp_imp) - xfree (dy); - } -#else /* not NEW_GC */ - if (dy->base && !DUMPEDP (dy->base)) - xfree (dy->base); - if(!DUMPEDP (dy)) - xfree (dy); -#endif /* not NEW_GC */ -} - -#ifdef MEMORY_USAGE_STATS - -/* Return memory usage for Dynarr D. The returned value is the total - amount of bytes actually being used for the Dynarr, including all - overhead. The extra amount of space in the Dynarr that is - allocated beyond what was requested is returned in DYNARR_OVERHEAD - in STATS. The extra amount of space that malloc() allocates beyond - what was requested of it is returned in MALLOC_OVERHEAD in STATS. - See the comment above the definition of this structure. */ - -Bytecount -Dynarr_memory_usage (void *d, struct overhead_stats *stats) -{ - Bytecount total = 0; - Dynarr *dy = (Dynarr *) d; - - /* We have to be a bit tricky here because not all of the - memory that malloc() will claim as "requested" was actually - requested. */ - - if (dy->base) - { - Bytecount malloc_used = - malloced_storage_size (dy->base, dy->elsize * Dynarr_max (dy), 0); - /* #### This may or may not be correct. Some Dynarrs would - prefer that we use dy->len instead of dy->largest here. */ - Bytecount was_requested = dy->elsize * Dynarr_largest (dy); - Bytecount dynarr_overhead = - dy->elsize * (Dynarr_max (dy) - Dynarr_largest (dy)); - - total += malloc_used; - stats->was_requested += was_requested; - stats->dynarr_overhead += dynarr_overhead; - /* And the remainder must be malloc overhead. */ - stats->malloc_overhead += - malloc_used - was_requested - dynarr_overhead; - } - - total += malloced_storage_size (d, sizeof (*dy), stats); - - return total; -} - -#endif /* MEMORY_USAGE_STATS */ - -/* Version of malloc() that will be extremely efficient when allocation - nearly always occurs in LIFO (stack) order. - - #### Perhaps shouldn't be in this file, but where else? */ - -typedef struct -{ - Dynarr_declare (char_dynarr *); -} char_dynarr_dynarr; - -char_dynarr_dynarr *stack_like_free_list; -char_dynarr_dynarr *stack_like_in_use_list; - -void * -stack_like_malloc (Bytecount size) -{ - char_dynarr *this_one; - if (!stack_like_free_list) - { - stack_like_free_list = Dynarr_new2 (char_dynarr_dynarr, - char_dynarr *); - stack_like_in_use_list = Dynarr_new2 (char_dynarr_dynarr, - char_dynarr *); - } - - if (Dynarr_length (stack_like_free_list) > 0) - this_one = Dynarr_pop (stack_like_free_list); - else - this_one = Dynarr_new (char); - Dynarr_add (stack_like_in_use_list, this_one); - Dynarr_reset (this_one); - Dynarr_add_many (this_one, 0, size); - return Dynarr_begin (this_one); -} - -void -stack_like_free (void *val) -{ - int len = Dynarr_length (stack_like_in_use_list); - assert (len > 0); - /* The vast majority of times, we will be called in a last-in first-out - order, and the item at the end of the list will be the one we're - looking for, so just check for this first and avoid any function - calls. */ - if (Dynarr_begin (Dynarr_at (stack_like_in_use_list, len - 1)) == val) - { - char_dynarr *this_one = Dynarr_pop (stack_like_in_use_list); - Dynarr_add (stack_like_free_list, this_one); - } - else - { - /* Find the item and delete it. */ - int i; - assert (len >= 2); - for (i = len - 2; i >= 0; i--) - if (Dynarr_begin (Dynarr_at (stack_like_in_use_list, i)) == - val) - { - char_dynarr *this_one = Dynarr_at (stack_like_in_use_list, i); - Dynarr_add (stack_like_free_list, this_one); - Dynarr_delete (stack_like_in_use_list, i); - return; - } - - ABORT (); - } -} diff -r 861f2601a38b -r 1f0b15040456 src/ecrt0.c --- a/src/ecrt0.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/ecrt0.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ diff -r 861f2601a38b -r 1f0b15040456 src/editfns.c --- a/src/editfns.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/editfns.c Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.0, FSF 19.30. */ @@ -1044,11 +1042,10 @@ %Y is replaced by the year with century. %z is replaced by the time zone as a numeric offset (e.g +0530, -0800 etc.) %Z is replaced by the time zone abbreviation. +%\\xe6 is replaced by the month as a lowercase Roman number (i-xii) +%\\xc6 is replaced by the month as an uppercase Roman number (I-XII) The number of options reflects the `strftime' function. - -BUG: If the charset used by the current locale is not ISO 8859-1, the -characters appearing in the day and month names may be incorrect. */ (format_string, time_)) { @@ -1103,29 +1100,28 @@ time_t time_spec; struct tm save_tm; struct tm *decoded_time; - Lisp_Object list_args[9]; if (! lisp_to_time (specified_time, &time_spec)) invalid_argument ("Invalid time specification", Qunbound); decoded_time = localtime (&time_spec); - list_args[0] = make_int (decoded_time->tm_sec); - list_args[1] = make_int (decoded_time->tm_min); - list_args[2] = make_int (decoded_time->tm_hour); - list_args[3] = make_int (decoded_time->tm_mday); - list_args[4] = make_int (decoded_time->tm_mon + 1); - list_args[5] = make_int (decoded_time->tm_year + 1900); - list_args[6] = make_int (decoded_time->tm_wday); - list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil; /* Make a copy, in case gmtime modifies the struct. */ save_tm = *decoded_time; decoded_time = gmtime (&time_spec); - if (decoded_time == 0) - list_args[8] = Qnil; - else - list_args[8] = make_int (difftm (&save_tm, decoded_time)); - return Flist (9, list_args); + + return listn(9, + make_int (save_tm.tm_sec), + make_int (save_tm.tm_min), + make_int (save_tm.tm_hour), + make_int (save_tm.tm_mday), + make_int (save_tm.tm_mon + 1), + make_int (save_tm.tm_year + 1900), + make_int (save_tm.tm_wday), + save_tm.tm_isdst ? Qt : Qnil, + (decoded_time == NULL) + ? Qnil + : make_int (difftm (&save_tm, decoded_time))); } static void set_time_zone_rule (Extbyte *tzstring); @@ -2262,18 +2258,6 @@ : x1 == x2) ? Qt : Qnil; } - -DEFUN ("char=", Fchar_Equal, 2, 2, 0, /* -Return t if two characters match, case is significant. -Both arguments must be characters (i.e. NOT integers). -*/ - (character1, character2)) -{ - CHECK_CHAR_COERCE_INT (character1); - CHECK_CHAR_COERCE_INT (character2); - - return EQ (character1, character2) ? Qt : Qnil; -} #if 0 /* Undebugged FSFmacs code */ /* Transpose the markers in two regions of the current buffer, and @@ -2399,7 +2383,6 @@ DEFSYMBOL (Quser_files_and_directories); DEFSUBR (Fchar_equal); - DEFSUBR (Fchar_Equal); DEFSUBR (Fgoto_char); DEFSUBR (Fstring_to_char); DEFSUBR (Fchar_to_string); diff -r 861f2601a38b -r 1f0b15040456 src/elhash.c --- a/src/elhash.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/elhash.c Sun May 01 18:44:03 2011 +0100 @@ -1,24 +1,22 @@ /* Implementation of the hash table lisp object type. Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995, 1996, 2002, 2004 Ben Wing. + Copyright (C) 1995, 1996, 2002, 2004, 2010 Ben Wing. Copyright (C) 1997 Free Software Foundation, Inc. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 MERCNTABILITY or +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -81,31 +79,82 @@ #include "lisp.h" #include "bytecode.h" #include "elhash.h" +#include "gc.h" #include "opaque.h" +#include "buffer.h" Lisp_Object Qhash_tablep; -static Lisp_Object Qhashtable, Qhash_table; +Lisp_Object Qeq, Qeql, Qequal, Qequalp; +Lisp_Object Qeq_hash, Qeql_hash, Qequal_hash, Qequalp_hash; + +static Lisp_Object Qhashtable, Qhash_table, Qmake_hash_table; static Lisp_Object Qweakness, Qvalue, Qkey_or_value, Qkey_and_value; static Lisp_Object Vall_weak_hash_tables; static Lisp_Object Qrehash_size, Qrehash_threshold; -static Lisp_Object Q_size, Q_test, Q_weakness, Q_rehash_size, Q_rehash_threshold; +static Lisp_Object Q_size, Q_weakness, Q_rehash_size, Q_rehash_threshold; +static Lisp_Object Vhash_table_test_eq, Vhash_table_test_eql; +static Lisp_Object Vhash_table_test_weak_list; /* obsolete as of 19990901 in xemacs-21.2 */ static Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qkey_or_value_weak; -static Lisp_Object Qnon_weak, Q_type, Q_data; +static Lisp_Object Qnon_weak; + +/* A hash table test, with its associated hash function. equal_function may + call lisp_equal_function, and hash_function similarly may call + lisp_hash_function. */ +struct Hash_Table_Test +{ + NORMAL_LISP_OBJECT_HEADER header; + Lisp_Object name; + hash_table_equal_function_t equal_function; + hash_table_hash_function_t hash_function; + Lisp_Object lisp_equal_function; + Lisp_Object lisp_hash_function; +}; + +static Lisp_Object +mark_hash_table_test (Lisp_Object obj) +{ + Hash_Table_Test *http = XHASH_TABLE_TEST (obj); + + mark_object (http->name); + mark_object (http->lisp_equal_function); + mark_object (http->lisp_hash_function); + + return Qnil; +} + +static const struct memory_description hash_table_test_description_1[] = + { + { XD_LISP_OBJECT, offsetof (struct Hash_Table_Test, name) }, + { XD_LISP_OBJECT, offsetof (struct Hash_Table_Test, lisp_equal_function) }, + { XD_LISP_OBJECT, offsetof (struct Hash_Table_Test, lisp_hash_function) }, + { XD_END } + }; + +static const struct sized_memory_description hash_table_test_description = + { + sizeof (struct Hash_Table_Test), + hash_table_test_description_1 + }; + +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("hash-table-test", hash_table_test, + mark_hash_table_test, + hash_table_test_description_1, + Hash_Table_Test); +/* A hash table. */ struct Lisp_Hash_Table { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; Elemcount size; Elemcount count; Elemcount rehash_count; double rehash_size; double rehash_threshold; Elemcount golden_ratio; - hash_table_hash_function_t hash_function; - hash_table_test_function_t test_function; htentry *hentries; + Lisp_Object test; enum hash_table_weakness weakness; Lisp_Object next_weak; /* Used to chain together all of the weak hash tables. Don't mark through this. */ @@ -118,16 +167,17 @@ #define HASH_TABLE_DEFAULT_SIZE 16 #define HASH_TABLE_DEFAULT_REHASH_SIZE 1.3 #define HASH_TABLE_MIN_SIZE 10 -#define HASH_TABLE_DEFAULT_REHASH_THRESHOLD(size, test_function) \ - (((size) > 4096 && NULL == (test_function)) ? 0.7 : 0.6) +#define HASH_TABLE_DEFAULT_REHASH_THRESHOLD(size, test) \ + (((size) > 4096 && EQ (Vhash_table_test_eq, test)) ? 0.7 : 0.6) -#define HASHCODE(key, ht) \ - ((((ht)->hash_function ? (ht)->hash_function (key) : LISP_HASH (key)) \ - * (ht)->golden_ratio) \ - % (ht)->size) +#define HASHCODE(key, ht, http) \ + ((((!EQ (Vhash_table_test_eq, ht->test)) ? \ + (http)->hash_function (http, key) : \ + LISP_HASH (key)) * (ht)->golden_ratio) % (ht)->size) -#define KEYS_EQUAL_P(key1, key2, testfun) \ - (EQ (key1, key2) || ((testfun) && (testfun) (key1, key2))) +#define KEYS_EQUAL_P(key1, key2, test, http) \ + (EQ (key1, key2) || ((!EQ (Vhash_table_test_eq, test) && \ + (http->equal_function) (http, key1, key2)))) #define LINEAR_PROBING_LOOP(probe, entries, size) \ for (; \ @@ -186,28 +236,92 @@ static int -lisp_object_eql_equal (Lisp_Object obj1, Lisp_Object obj2) +lisp_object_eql_equal (const Hash_Table_Test *UNUSED (http), Lisp_Object obj1, + Lisp_Object obj2) { return EQ (obj1, obj2) || (NON_FIXNUM_NUMBER_P (obj1) && internal_equal (obj1, obj2, 0)); } static Hashcode -lisp_object_eql_hash (Lisp_Object obj) +lisp_object_eql_hash (const Hash_Table_Test *UNUSED (http), Lisp_Object obj) { - return NON_FIXNUM_NUMBER_P (obj) ? internal_hash (obj, 0) : LISP_HASH (obj); + return NON_FIXNUM_NUMBER_P (obj) ? + internal_hash (obj, 0, 0) : LISP_HASH (obj); } static int -lisp_object_equal_equal (Lisp_Object obj1, Lisp_Object obj2) +lisp_object_equal_equal (const Hash_Table_Test *UNUSED (http), + Lisp_Object obj1, Lisp_Object obj2) { return internal_equal (obj1, obj2, 0); } static Hashcode -lisp_object_equal_hash (Lisp_Object obj) +lisp_object_equal_hash (const Hash_Table_Test *UNUSED (http), Lisp_Object obj) +{ + return internal_hash (obj, 0, 0); +} + +static Hashcode +lisp_object_equalp_hash (const Hash_Table_Test *UNUSED (http), Lisp_Object obj) +{ + return internal_hash (obj, 0, 1); +} + +static int +lisp_object_equalp_equal (const Hash_Table_Test *UNUSED (http), + Lisp_Object obj1, Lisp_Object obj2) +{ + return internal_equalp (obj1, obj2, 0); +} + +static Hashcode +lisp_object_general_hash (const Hash_Table_Test *http, Lisp_Object obj) { - return internal_hash (obj, 0); + struct gcpro gcpro1; + Lisp_Object args[2] = { http->lisp_hash_function, obj }, res; + + /* Make sure any weakly referenced objects don't get collected before the + funcall: */ + GCPRO1 (args[0]); + gcpro1.nvars = countof (args); + res = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args)); + UNGCPRO; + + if (INTP (res)) + { + return (Hashcode) (XINT (res)); + } + +#ifdef HAVE_BIGNUM + if (BIGNUMP (res)) + { + if (bignum_fits_emacs_int_p (XBIGNUM_DATA (res))) + { + return (Hashcode) bignum_to_emacs_int (XBIGNUM_DATA (res)); + } + + signal_error (Qrange_error, "Not a valid hash code", res); + } +#endif + + dead_wrong_type_argument (Qintegerp, res); +} + +static int +lisp_object_general_equal (const Hash_Table_Test *http, Lisp_Object obj1, + Lisp_Object obj2) +{ + struct gcpro gcpro1; + Lisp_Object args[] = { http->lisp_equal_function, obj1, obj2 }, res; + + GCPRO1 (args[0]); + gcpro1.nvars = countof (args); + res = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args)); + UNGCPRO; + + return !(NILP (res)); } @@ -230,6 +344,9 @@ mark_object (e->value); } } + + mark_object (ht->test); + return Qnil; } @@ -251,8 +368,8 @@ Lisp_Hash_Table *ht2 = XHASH_TABLE (hash_table2); htentry *e, *sentinel; - if ((ht1->test_function != ht2->test_function) || - (ht1->weakness != ht2->weakness) || + if (!(EQ (ht1->test, ht2->test)) || + (ht1->weakness != ht2->weakness) || (ht1->count != ht2->count)) return 0; @@ -275,11 +392,34 @@ Examining all entries is too expensive, and examining a random subset does not yield a correct hash function. */ static Hashcode -hash_table_hash (Lisp_Object hash_table, int UNUSED (depth)) +hash_table_hash (Lisp_Object hash_table, int UNUSED (depth), + int UNUSED (equalp)) { return XHASH_TABLE (hash_table)->count; } +#ifdef MEMORY_USAGE_STATS + +struct hash_table_stats +{ + struct usage_stats u; + Bytecount hentries; +}; + +static void +hash_table_memory_usage (Lisp_Object hashtab, + struct generic_usage_stats *gustats) +{ + Lisp_Hash_Table *ht = XHASH_TABLE (hashtab); + struct hash_table_stats *stats = (struct hash_table_stats *) gustats; + stats->hentries += + malloced_storage_size (ht->hentries, + sizeof (htentry) * (ht->size + 1), + &stats->u); +} + +#endif /* MEMORY_USAGE_STATS */ + /* Printing hash tables. @@ -343,17 +483,11 @@ write_ascstring (printcharfun, print_readably ? "#s(hash-table" : "#test_function) - write_ascstring (printcharfun, " :test eq"); - else if (ht->test_function == lisp_object_equal_equal) - write_ascstring (printcharfun, " :test equal"); - else if (ht->test_function == lisp_object_eql_equal) - DO_NOTHING; - else - ABORT (); + if (!(EQ (ht->test, Vhash_table_test_eql))) + { + write_fmt_string_lisp (printcharfun, " :test %S", + 1, XHASH_TABLE_TEST (ht->test)->name); + } if (ht->count || !print_readably) { @@ -382,8 +516,7 @@ } if (ht->rehash_threshold - != HASH_TABLE_DEFAULT_REHASH_THRESHOLD (ht->size, - ht->test_function)) + != HASH_TABLE_DEFAULT_REHASH_THRESHOLD (ht->size, ht->test)) { float_to_string (pigbuf, ht->rehash_threshold); write_fmt_string (printcharfun, " :rehash-threshold %s", pigbuf); @@ -395,25 +528,24 @@ if (print_readably) write_ascstring (printcharfun, ")"); else - write_fmt_string (printcharfun, " 0x%x>", ht->header.uid); + write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); } +#ifdef ERROR_CHECK_STRUCTURES +#define USED_IF_ERROR_CHECK_STRUCTURES(x) x +#else +#define USED_IF_ERROR_CHECK_STRUCTURES(x) UNUSED (x) +#endif + #ifndef NEW_GC static void free_hentries (htentry *hentries, -#ifdef ERROR_CHECK_STRUCTURES - size_t size -#else /* not ERROR_CHECK_STRUCTURES) */ - size_t UNUSED (size) -#endif /* not ERROR_CHECK_STRUCTURES) */ - ) + Elemcount USED_IF_ERROR_CHECK_STRUCTURES (size)) { #ifdef ERROR_CHECK_STRUCTURES /* Ensure a crash if other code uses the discarded entries afterwards. */ - htentry *e, *sentinel; - - for (e = hentries, sentinel = e + size; e < sentinel; e++) - * (unsigned long *) e = 0xdeadbeef; /* -559038737 base 10 */ + deadbeef_memory (hentries, + (Rawbyte *) (hentries + size) - (Rawbyte *) hentries); #endif if (!DUMPEDP (hentries)) @@ -421,14 +553,11 @@ } static void -finalize_hash_table (void *header, int for_disksave) +finalize_hash_table (Lisp_Object obj) { - if (!for_disksave) - { - Lisp_Hash_Table *ht = (Lisp_Hash_Table *) header; - free_hentries (ht->hentries, ht->size); - ht->hentries = 0; - } + Lisp_Hash_Table *ht = XHASH_TABLE (obj); + free_hentries (ht->hentries, ht->size); + ht->hentries = 0; } #endif /* not NEW_GC */ @@ -455,20 +584,18 @@ htentry_weak_description_1 }; -DEFINE_LRECORD_IMPLEMENTATION ("hash-table-entry", hash_table_entry, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - htentry_description_1, - Lisp_Hash_Table_Entry); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("hash-table-entry", hash_table_entry, + 0, htentry_description_1, + Lisp_Hash_Table_Entry); #endif /* NEW_GC */ static const struct memory_description htentry_union_description_1[] = { /* Note: XD_INDIRECT in this table refers to the surrounding table, and so this will work. */ #ifdef NEW_GC - { XD_LISP_OBJECT_BLOCK_PTR, HASH_TABLE_NON_WEAK, + { XD_INLINE_LISP_OBJECT_BLOCK_PTR, HASH_TABLE_NON_WEAK, XD_INDIRECT (0, 1), { &htentry_description } }, - { XD_LISP_OBJECT_BLOCK_PTR, 0, XD_INDIRECT (0, 1), + { XD_INLINE_LISP_OBJECT_BLOCK_PTR, 0, XD_INDIRECT (0, 1), { &htentry_weak_description }, XD_FLAG_UNION_DEFAULT_ENTRY }, #else /* not NEW_GC */ { XD_BLOCK_PTR, HASH_TABLE_NON_WEAK, XD_INDIRECT (0, 1), @@ -490,25 +617,16 @@ { XD_UNION, offsetof (Lisp_Hash_Table, hentries), XD_INDIRECT (1, 0), { &htentry_union_description } }, { XD_LO_LINK, offsetof (Lisp_Hash_Table, next_weak) }, + { XD_LISP_OBJECT,offsetof (Lisp_Hash_Table, test) }, { XD_END } }; -#ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("hash-table", hash_table, - 1, /*dumpable-flag*/ - mark_hash_table, print_hash_table, - 0, hash_table_equal, hash_table_hash, - hash_table_description, - Lisp_Hash_Table); -#else /* not NEW_GC */ -DEFINE_LRECORD_IMPLEMENTATION ("hash-table", hash_table, - 1, /*dumpable-flag*/ - mark_hash_table, print_hash_table, - finalize_hash_table, - hash_table_equal, hash_table_hash, - hash_table_description, - Lisp_Hash_Table); -#endif /* not NEW_GC */ +DEFINE_DUMPABLE_LISP_OBJECT ("hash-table", hash_table, + mark_hash_table, print_hash_table, + IF_OLD_GC (finalize_hash_table), + hash_table_equal, hash_table_hash, + hash_table_description, + Lisp_Hash_Table); static Lisp_Hash_Table * xhash_table (Lisp_Object hash_table) @@ -535,55 +653,32 @@ ((double) ht->size * (.6180339887 / (double) sizeof (Lisp_Object))); } -Lisp_Object -make_standard_lisp_hash_table (enum hash_table_test test, - Elemcount size, - double rehash_size, - double rehash_threshold, - enum hash_table_weakness weakness) +static htentry * +allocate_hash_table_entries (Elemcount size) { - hash_table_hash_function_t hash_function = 0; - hash_table_test_function_t test_function = 0; - - switch (test) - { - case HASH_TABLE_EQ: - test_function = 0; - hash_function = 0; - break; - - case HASH_TABLE_EQL: - test_function = lisp_object_eql_equal; - hash_function = lisp_object_eql_hash; - break; - - case HASH_TABLE_EQUAL: - test_function = lisp_object_equal_equal; - hash_function = lisp_object_equal_hash; - break; - - default: - ABORT (); - } - - return make_general_lisp_hash_table (hash_function, test_function, - size, rehash_size, rehash_threshold, - weakness); +#ifdef NEW_GC + return XHASH_TABLE_ENTRY (alloc_lrecord_array + (size, &lrecord_hash_table_entry)); +#else /* not NEW_GC */ + return xnew_array_and_zero (htentry, size); +#endif /* not NEW_GC */ } +static Lisp_Object decode_hash_table_test (Lisp_Object obj); + Lisp_Object -make_general_lisp_hash_table (hash_table_hash_function_t hash_function, - hash_table_test_function_t test_function, +make_general_lisp_hash_table (Lisp_Object test, Elemcount size, double rehash_size, double rehash_threshold, enum hash_table_weakness weakness) { - Lisp_Object hash_table; - Lisp_Hash_Table *ht = ALLOC_LCRECORD_TYPE (Lisp_Hash_Table, &lrecord_hash_table); + Lisp_Object hash_table = ALLOC_NORMAL_LISP_OBJECT (hash_table); + Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); - ht->test_function = test_function; - ht->hash_function = hash_function; + assert (HASH_TABLE_TESTP (test)); + + ht->test = test; ht->weakness = weakness; ht->rehash_size = @@ -591,7 +686,7 @@ ht->rehash_threshold = rehash_threshold > 0.0 ? rehash_threshold : - HASH_TABLE_DEFAULT_REHASH_THRESHOLD (size, ht->test_function); + HASH_TABLE_DEFAULT_REHASH_THRESHOLD (size, ht->test); if (size < HASH_TABLE_MIN_SIZE) size = HASH_TABLE_MIN_SIZE; @@ -602,15 +697,7 @@ compute_hash_table_derived_values (ht); /* We leave room for one never-occupied sentinel htentry at the end. */ -#ifdef NEW_GC - ht->hentries = (htentry *) alloc_lrecord_array (sizeof (htentry), - ht->size + 1, - &lrecord_hash_table_entry); -#else /* not NEW_GC */ - ht->hentries = xnew_array_and_zero (htentry, ht->size + 1); -#endif /* not NEW_GC */ - - hash_table = wrap_hash_table (ht); + ht->hentries = allocate_hash_table_entries (ht->size + 1); if (weakness == HASH_TABLE_NON_WEAK) ht->next_weak = Qunbound; @@ -621,11 +708,11 @@ } Lisp_Object -make_lisp_hash_table (Elemcount size, - enum hash_table_weakness weakness, - enum hash_table_test test) +make_lisp_hash_table (Elemcount size, enum hash_table_weakness weakness, + Lisp_Object test) { - return make_standard_lisp_hash_table (test, size, -1.0, -1.0, weakness); + test = decode_hash_table_test (test); + return make_general_lisp_hash_table (test, size, -1.0, -1.0, weakness); } /* Pretty reading of hash tables. @@ -644,10 +731,27 @@ Error_Behavior errb) { if (NATNUMP (value)) - return 1; + { + if (BIGNUMP (value)) + { + /* hash_table_size() can't handle excessively large sizes. */ + maybe_signal_error_1 (Qargs_out_of_range, + list3 (value, Qzero, + make_integer (EMACS_INT_MAX)), + Qhash_table, errb); + return 0; + } + else + { + return 1; + } + } + else + { + maybe_signal_error_1 (Qwrong_type_argument, list2 (Qnatnump, value), + Qhash_table, errb); + } - maybe_signal_error_1 (Qwrong_type_argument, list2 (Qnatnump, value), - Qhash_table, errb); return 0; } @@ -668,12 +772,14 @@ if (EQ (value, Qkey_or_value)) return 1; if (EQ (value, Qvalue)) return 1; +#ifdef NEED_TO_HANDLE_21_4_CODE /* Following values are obsolete as of 19990901 in xemacs-21.2 */ if (EQ (value, Qnon_weak)) return 1; if (EQ (value, Qweak)) return 1; if (EQ (value, Qkey_weak)) return 1; if (EQ (value, Qkey_or_value_weak)) return 1; if (EQ (value, Qvalue_weak)) return 1; +#endif maybe_invalid_constant ("Invalid hash table weakness", value, Qhash_table, errb); @@ -690,12 +796,14 @@ if (EQ (obj, Qkey_or_value)) return HASH_TABLE_KEY_VALUE_WEAK; if (EQ (obj, Qvalue)) return HASH_TABLE_VALUE_WEAK; +#ifdef NEED_TO_HANDLE_21_4_CODE /* Following values are obsolete as of 19990901 in xemacs-21.2 */ if (EQ (obj, Qnon_weak)) return HASH_TABLE_NON_WEAK; if (EQ (obj, Qweak)) return HASH_TABLE_WEAK; if (EQ (obj, Qkey_weak)) return HASH_TABLE_KEY_WEAK; if (EQ (obj, Qkey_or_value_weak)) return HASH_TABLE_KEY_VALUE_WEAK; if (EQ (obj, Qvalue_weak)) return HASH_TABLE_VALUE_WEAK; +#endif invalid_constant ("Invalid hash table weakness", obj); RETURN_NOT_REACHED (HASH_TABLE_NON_WEAK); @@ -705,26 +813,40 @@ hash_table_test_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, Error_Behavior errb) { - if (EQ (value, Qnil)) return 1; - if (EQ (value, Qeq)) return 1; - if (EQ (value, Qequal)) return 1; - if (EQ (value, Qeql)) return 1; + Lisp_Object lookup; + + if (NILP (value)) + { + return 1; + } - maybe_invalid_constant ("Invalid hash table test", - value, Qhash_table, errb); - return 0; + lookup = Fassq (value, XWEAK_LIST_LIST (Vhash_table_test_weak_list)); + if (NILP (lookup)) + { + maybe_invalid_constant ("Invalid hash table test", + value, Qhash_table, errb); + } + + return 1; } -static enum hash_table_test +static Lisp_Object decode_hash_table_test (Lisp_Object obj) { - if (EQ (obj, Qnil)) return HASH_TABLE_EQL; - if (EQ (obj, Qeq)) return HASH_TABLE_EQ; - if (EQ (obj, Qequal)) return HASH_TABLE_EQUAL; - if (EQ (obj, Qeql)) return HASH_TABLE_EQL; + Lisp_Object result; + + if (NILP (obj)) + { + obj = Qeql; + } - invalid_constant ("Invalid hash table test", obj); - RETURN_NOT_REACHED (HASH_TABLE_EQ); + result = Fassq (obj, XWEAK_LIST_LIST (Vhash_table_test_weak_list)); + if (NILP (result)) + { + invalid_constant ("Invalid hash table test", obj); + } + + return XCDR (result); } static int @@ -855,7 +977,9 @@ else if (EQ (key, Qrehash_threshold)) rehash_threshold = value; else if (EQ (key, Qweakness)) weakness = value; else if (EQ (key, Qdata)) data = value; +#ifdef NEED_TO_HANDLE_21_4_CODE else if (EQ (key, Qtype))/*obsolete*/ weakness = value; +#endif else if (KEYWORDP (key)) signal_error (Qinvalid_read_syntax, "can't mix keyword and non-keyword hash table syntax", @@ -865,14 +989,14 @@ } /* Create the hash table. */ - hash_table = make_standard_lisp_hash_table + hash_table = make_general_lisp_hash_table (decode_hash_table_test (test), decode_hash_table_size (size), decode_hash_table_rehash_size (rehash_size), decode_hash_table_rehash_threshold (rehash_threshold), decode_hash_table_weakness (weakness)); - /* I'm not sure whether this can GC, but better safe than sorry. */ + /* This can GC with a user-specified test. */ { struct gcpro gcpro1; GCPRO1 (hash_table); @@ -906,6 +1030,7 @@ define_structure_type_keyword (st, Q_weakness, hash_table_weakness_validate); define_structure_type_keyword (st, Q_data, hash_table_data_validate); +#ifdef NEED_TO_HANDLE_21_4_CODE /* Next the mutually exclusive, older, non-keyword syntax: */ define_structure_type_keyword (st, Qtest, hash_table_test_validate); define_structure_type_keyword (st, Qsize, hash_table_size_validate); @@ -916,6 +1041,7 @@ /* obsolete as of 19990901 in xemacs-21.2 */ define_structure_type_keyword (st, Qtype, hash_table_weakness_validate); +#endif } /* Create a built-in Lisp structure type named `hash-table'. @@ -926,7 +1052,9 @@ structure_type_create_hash_table (void) { structure_type_create_hash_table_structure_name (Qhash_table); +#ifdef NEED_TO_HANDLE_21_4_CODE structure_type_create_hash_table_structure_name (Qhashtable); /* compat */ +#endif } @@ -946,10 +1074,13 @@ Return a new empty hash table object. Use Common Lisp style keywords to specify hash table properties. -Keyword :test can be `eq', `eql' (default) or `equal'. -Comparison between keys is done using this function. -If speed is important, consider using `eq'. -When storing strings in the hash table, you will likely need to use `equal'. +Keyword :test can be `eq', `eql' (default), `equal' or `equalp'. +Comparison between keys is done using this function. If speed is important, +consider using `eq'. When storing strings in the hash table, you will +likely need to use `equal' or `equalp' (for case-insensitivity). With other +objects, consider using a test function defined with +`define-hash-table-test', an emacs extension to this Common Lisp hash table +API. Keyword :size specifies the number of keys likely to be inserted. This number of entries can be inserted without enlarging the hash table. @@ -993,29 +1124,27 @@ */ (int nargs, Lisp_Object *args)) { - int i = 0; - Lisp_Object test = Qnil; - Lisp_Object size = Qnil; - Lisp_Object rehash_size = Qnil; - Lisp_Object rehash_threshold = Qnil; - Lisp_Object weakness = Qnil; - - while (i + 1 < nargs) - { - Lisp_Object keyword = args[i++]; - Lisp_Object value = args[i++]; +#ifndef NEED_TO_HANDLE_21_4_CODE + PARSE_KEYWORDS (Fmake_hash_table, nargs, args, 5, + (test, size, rehash_size, rehash_threshold, weakness), + NULL); +#else + PARSE_KEYWORDS (Fmake_hash_table, nargs, args, 6, + (test, size, rehash_size, rehash_threshold, weakness, + type), (type = Qunbound, weakness = Qunbound)); - if (EQ (keyword, Q_test)) test = value; - else if (EQ (keyword, Q_size)) size = value; - else if (EQ (keyword, Q_rehash_size)) rehash_size = value; - else if (EQ (keyword, Q_rehash_threshold)) rehash_threshold = value; - else if (EQ (keyword, Q_weakness)) weakness = value; - else if (EQ (keyword, Q_type))/*obsolete*/ weakness = value; - else invalid_constant ("Invalid hash table property keyword", keyword); + if (EQ (weakness, Qunbound)) + { + if (EQ (weakness, Qunbound) && !EQ (type, Qunbound)) + { + weakness = type; + } + else + { + weakness = Qnil; + } } - - if (i < nargs) - sferror ("Hash table property requires a value", args[i]); +#endif #define VALIDATE_VAR(var) \ if (!NILP (var)) hash_table_##var##_validate (Q##var, var, ERROR_ME); @@ -1026,7 +1155,7 @@ VALIDATE_VAR (rehash_threshold); VALIDATE_VAR (weakness); - return make_standard_lisp_hash_table + return make_general_lisp_hash_table (decode_hash_table_test (test), decode_hash_table_size (size), decode_hash_table_rehash_size (rehash_size), @@ -1041,27 +1170,21 @@ (hash_table)) { const Lisp_Hash_Table *ht_old = xhash_table (hash_table); - Lisp_Hash_Table *ht = ALLOC_LCRECORD_TYPE (Lisp_Hash_Table, &lrecord_hash_table); - COPY_LCRECORD (ht, ht_old); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (hash_table); + Lisp_Hash_Table *ht = XHASH_TABLE (obj); + copy_lisp_object (obj, hash_table); -#ifdef NEW_GC - ht->hentries = (htentry *) alloc_lrecord_array (sizeof (htentry), - ht_old->size + 1, - &lrecord_hash_table_entry); -#else /* not NEW_GC */ - ht->hentries = xnew_array (htentry, ht_old->size + 1); -#endif /* not NEW_GC */ + /* We leave room for one never-occupied sentinel htentry at the end. */ + ht->hentries = allocate_hash_table_entries (ht_old->size + 1); memcpy (ht->hentries, ht_old->hentries, (ht_old->size + 1) * sizeof (htentry)); - hash_table = wrap_hash_table (ht); - if (! EQ (ht->next_weak, Qunbound)) { ht->next_weak = Vall_weak_hash_tables; - Vall_weak_hash_tables = hash_table; + Vall_weak_hash_tables = obj; } - return hash_table; + return obj; } static void @@ -1069,19 +1192,15 @@ { htentry *old_entries, *new_entries, *sentinel, *e; Elemcount old_size; + Hash_Table_Test *http = XHASH_TABLE_TEST (ht->test); old_size = ht->size; ht->size = new_size; old_entries = ht->hentries; -#ifdef NEW_GC - ht->hentries = (htentry *) alloc_lrecord_array (sizeof (htentry), - new_size + 1, - &lrecord_hash_table_entry); -#else /* not NEW_GC */ - ht->hentries = xnew_array_and_zero (htentry, new_size + 1); -#endif /* not NEW_GC */ + /* We leave room for one never-occupied sentinel htentry at the end. */ + ht->hentries = allocate_hash_table_entries (new_size + 1); new_entries = ht->hentries; compute_hash_table_derived_values (ht); @@ -1089,7 +1208,7 @@ for (e = old_entries, sentinel = e + old_size; e < sentinel; e++) if (!HTENTRY_CLEAR_P (e)) { - htentry *probe = new_entries + HASHCODE (e->key, ht); + htentry *probe = new_entries + HASHCODE (e->key, ht, http); LINEAR_PROBING_LOOP (probe, new_entries, new_size) ; *probe = *e; @@ -1107,19 +1226,15 @@ pdump_reorganize_hash_table (Lisp_Object hash_table) { const Lisp_Hash_Table *ht = xhash_table (hash_table); -#ifdef NEW_GC - htentry *new_entries = - (htentry *) alloc_lrecord_array (sizeof (htentry), ht->size + 1, - &lrecord_hash_table_entry); -#else /* not NEW_GC */ - htentry *new_entries = xnew_array_and_zero (htentry, ht->size + 1); -#endif /* not NEW_GC */ + /* We leave room for one never-occupied sentinel htentry at the end. */ + htentry *new_entries = allocate_hash_table_entries (ht->size + 1); htentry *e, *sentinel; + Hash_Table_Test *http = XHASH_TABLE_TEST (ht->test); for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) if (!HTENTRY_CLEAR_P (e)) { - htentry *probe = new_entries + HASHCODE (e->key, ht); + htentry *probe = new_entries + HASHCODE (e->key, ht, http); LINEAR_PROBING_LOOP (probe, new_entries, ht->size) ; *probe = *e; @@ -1143,19 +1258,21 @@ htentry * find_htentry (Lisp_Object key, const Lisp_Hash_Table *ht) { - hash_table_test_function_t test_function = ht->test_function; + Lisp_Object test = ht->test; + Hash_Table_Test *http = XHASH_TABLE_TEST (test); + htentry *entries = ht->hentries; - htentry *probe = entries + HASHCODE (key, ht); + htentry *probe = entries + HASHCODE (key, ht, http); LINEAR_PROBING_LOOP (probe, entries, ht->size) - if (KEYS_EQUAL_P (probe->key, key, test_function)) + if (KEYS_EQUAL_P (probe->key, key, test, http)) break; return probe; } /* A version of Fputhash() that increments the value by the specified - amount and dispenses will all error checks. Assumes that tables does + amount and dispenses with all error checks. Assumes that tables does comparison using EQ. Used by the profiling routines to avoid overhead -- profiling overhead was being recorded at up to 15% of the total time. */ @@ -1164,8 +1281,9 @@ inchash_eq (Lisp_Object key, Lisp_Object table, EMACS_INT offset) { Lisp_Hash_Table *ht = XHASH_TABLE (table); + Hash_Table_Test *http = XHASH_TABLE_TEST (ht->test); htentry *entries = ht->hentries; - htentry *probe = entries + HASHCODE (key, ht); + htentry *probe = entries + HASHCODE (key, ht, http); LINEAR_PROBING_LOOP (probe, entries, ht->size) if (EQ (probe->key, key)) @@ -1221,6 +1339,7 @@ static void remhash_1 (Lisp_Hash_Table *ht, htentry *entries, htentry *probe) { + Hash_Table_Test *http = XHASH_TABLE_TEST (ht->test); Elemcount size = ht->size; CLEAR_HTENTRY (probe); probe++; @@ -1229,7 +1348,7 @@ LINEAR_PROBING_LOOP (probe, entries, size) { Lisp_Object key = probe->key; - htentry *probe2 = entries + HASHCODE (key, ht); + htentry *probe2 = entries + HASHCODE (key, ht, http); LINEAR_PROBING_LOOP (probe2, entries, size) if (EQ (probe2->key, key)) /* htentry at probe doesn't need to move. */ @@ -1287,16 +1406,15 @@ } DEFUN ("hash-table-test", Fhash_table_test, 1, 1, 0, /* -Return the test function of HASH-TABLE. -This can be one of `eq', `eql' or `equal'. +Return HASH-TABLE's test. + +This can be one of `eq', `eql', `equal', `equalp', or some symbol supplied +as the NAME argument to `define-hash-table-test', which see. */ (hash_table)) { - hash_table_test_function_t fun = xhash_table (hash_table)->test_function; - - return (fun == lisp_object_eql_equal ? Qeql : - fun == lisp_object_equal_equal ? Qequal : - Qeq); + CHECK_HASH_TABLE (hash_table); + return XHASH_TABLE_TEST (XHASH_TABLE (hash_table)->test)->name; } DEFUN ("hash-table-size", Fhash_table_size, 1, 1, 0, /* @@ -1560,7 +1678,7 @@ Lisp_Object mo_obj = (obj); \ if (!marked_p (mo_obj)) \ { \ - kkcc_gc_stack_push_lisp_object (mo_obj, 0, -1); \ + kkcc_gc_stack_push_lisp_object_0 (mo_obj); \ did_mark = 1; \ } \ } while (0) @@ -1719,7 +1837,7 @@ /* Return a hash value for an array of Lisp_Objects of size SIZE. */ Hashcode -internal_array_hash (Lisp_Object *arr, int size, int depth) +internal_array_hash (Lisp_Object *arr, int size, int depth, Boolint equalp) { int i; Hashcode hash = 0; @@ -1728,7 +1846,7 @@ if (size <= 5) { for (i = 0; i < size; i++) - hash = HASH2 (hash, internal_hash (arr[i], depth)); + hash = HASH2 (hash, internal_hash (arr[i], depth, equalp)); return hash; } @@ -1736,11 +1854,78 @@ A slightly better approach would be to offset by some noise factor from the points chosen below. */ for (i = 0; i < 5; i++) - hash = HASH2 (hash, internal_hash (arr[i*size/5], depth)); + hash = HASH2 (hash, internal_hash (arr[i*size/5], depth, equalp)); return hash; } +/* This needs to be algorithmically the same as + internal_array_hash(). Unfortunately, for strings with non-ASCII content, + it has to be O(2N), I don't see a reasonable alternative to hashing + sequence relying on their length. It is O(1) for pure ASCII strings, + though. */ + +static Hashcode +string_equalp_hash (Lisp_Object string) +{ + Bytecount len = XSTRING_LENGTH (string), + ascii_begin = (Bytecount) XSTRING_ASCII_BEGIN (string); + const Ibyte *ptr = XSTRING_DATA (string), *pend = ptr + len; + Charcount clen; + Hashcode hash = 0; + + if (len == ascii_begin) + { + clen = len; + } + else + { + clen = string_char_length (string); + } + + if (clen <= 5) + { + while (ptr < pend) + { + hash = HASH2 (hash, + LISP_HASH (make_char (CANONCASE (NULL, + itext_ichar (ptr))))); + INC_IBYTEPTR (ptr); + } + } + else + { + int ii; + + if (clen == len) + { + for (ii = 0; ii < 5; ii++) + { + hash = HASH2 (hash, + LISP_HASH (make_char + (CANONCASE (NULL, + ptr[ii * clen / 5])))); + } + } + else + { + Charcount this_char = 0, last_char = 0; + for (ii = 0; ii < 5; ii++) + { + this_char = ii * clen / 5; + ptr = itext_n_addr (ptr, this_char - last_char); + last_char = this_char; + + hash = HASH2 (hash, + LISP_HASH (make_char + (CANONCASE (NULL, itext_ichar (ptr))))); + } + } + } + + return HASH2 (clen, hash); +} + /* Return a hash value for a Lisp_Object. This is for use when hashing objects with the comparison being `equal' (for `eq', you can just use the Lisp_Object itself as the hash value). You need to make a @@ -1754,40 +1939,45 @@ hash, but practically this won't ever happen. */ Hashcode -internal_hash (Lisp_Object obj, int depth) +internal_hash (Lisp_Object obj, int depth, Boolint equalp) { if (depth > 5) return 0; - if (CONSP(obj)) + if (CONSP (obj)) { Hashcode hash, h; int s; depth += 1; - if (!CONSP(XCDR(obj))) + if (!CONSP (XCDR (obj))) { /* special case for '(a . b) conses */ - return HASH2(internal_hash(XCAR(obj), depth), - internal_hash(XCDR(obj), depth)); + return HASH2 (internal_hash (XCAR(obj), depth, equalp), + internal_hash (XCDR (obj), depth, equalp)); } /* Don't simply tail recurse; we want to hash lists with the same contents in distinct orders differently. */ - hash = internal_hash(XCAR(obj), depth); + hash = internal_hash (XCAR (obj), depth, equalp); - obj = XCDR(obj); - for (s = 1; s < 6 && CONSP(obj); obj = XCDR(obj), s++) + obj = XCDR (obj); + for (s = 1; s < 6 && CONSP (obj); obj = XCDR (obj), s++) { - h = internal_hash(XCAR(obj), depth); - hash = HASH3(hash, h, s); + h = internal_hash (XCAR (obj), depth, equalp); + hash = HASH3 (hash, h, s); } return hash; } if (STRINGP (obj)) { + if (equalp) + { + return string_equalp_hash (obj); + } + return hash_string (XSTRING_DATA (obj), XSTRING_LENGTH (obj)); } if (LRECORDP (obj)) @@ -1795,40 +1985,261 @@ const struct lrecord_implementation *imp = XRECORD_LHEADER_IMPLEMENTATION (obj); if (imp->hash) - return imp->hash (obj, depth); + return imp->hash (obj, depth, equalp); + } + + if (equalp) + { + if (CHARP (obj)) + { + /* Characters and numbers of the same numeric value hash + differently, which is fine, they're not equalp. */ + return LISP_HASH (make_char (CANONCASE (NULL, XCHAR (obj)))); + } + + if (INTP (obj)) + { + return FLOAT_HASHCODE_FROM_DOUBLE ((double) (XINT (obj))); + } } return LISP_HASH (obj); } -DEFUN ("sxhash", Fsxhash, 1, 1, 0, /* -Return a hash value for OBJECT. -\(equal obj1 obj2) implies (= (sxhash obj1) (sxhash obj2)). +DEFUN ("eq-hash", Feq_hash, 1, 1, 0, /* +Return a hash value for OBJECT appropriate for use with `eq.' +*/ + (object)) +{ + return make_integer ((EMACS_INT) XPNTRVAL (object)); +} + +DEFUN ("eql-hash", Feql_hash, 1, 1, 0, /* +Return a hash value for OBJECT appropriate for use with `eql.' +*/ + (object)) +{ + EMACS_INT hashed = lisp_object_eql_hash (NULL, object); + return make_integer (hashed); +} + +DEFUN ("equal-hash", Fequal_hash, 1, 1, 0, /* +Return a hash value for OBJECT appropriate for use with `equal.' +\(equal obj1 obj2) implies (= (equal-hash obj1) (equal-hash obj2)). +*/ + (object)) +{ + EMACS_INT hashed = internal_hash (object, 0, 0); + return make_integer (hashed); +} + +DEFUN ("equalp-hash", Fequalp_hash, 1, 1, 0, /* +Return a hash value for OBJECT appropriate for use with `equalp.' */ (object)) { - return make_int (internal_hash (object, 0)); + EMACS_INT hashed = internal_hash (object, 0, 1); + return make_integer (hashed); +} + +static Lisp_Object +make_hash_table_test (Lisp_Object name, + hash_table_equal_function_t equal_function, + hash_table_hash_function_t hash_function, + Lisp_Object lisp_equal_function, + Lisp_Object lisp_hash_function) +{ + Lisp_Object result = ALLOC_NORMAL_LISP_OBJECT (hash_table_test); + Hash_Table_Test *http = XHASH_TABLE_TEST (result); + + http->name = name; + http->equal_function = equal_function; + http->hash_function = hash_function; + http->lisp_equal_function = lisp_equal_function; + http->lisp_hash_function = lisp_hash_function; + + return result; +} + +Lisp_Object +define_hash_table_test (Lisp_Object name, + hash_table_equal_function_t equal_function, + hash_table_hash_function_t hash_function, + Lisp_Object lisp_equal_function, + Lisp_Object lisp_hash_function) +{ + Lisp_Object result = make_hash_table_test (name, equal_function, + hash_function, + lisp_equal_function, + lisp_hash_function); + XWEAK_LIST_LIST (Vhash_table_test_weak_list) + = Fcons (Fcons (name, result), + XWEAK_LIST_LIST (Vhash_table_test_weak_list)); + + return result; } -#if 0 -DEFUN ("internal-hash-value", Finternal_hash_value, 1, 1, 0, /* -Hash value of OBJECT. For debugging. -The value is returned as (HIGH . LOW). +DEFUN ("define-hash-table-test", Fdefine_hash_table_test, 3, 3, 0, /* +Define a new hash table test with name NAME, a symbol. + +In a hash table created with NAME as its test, use EQUAL-FUNCTION to compare +keys, and HASH-FUNCTION for computing hash codes of keys. + +EQUAL-FUNCTION must be a function taking two arguments and returning non-nil +if both arguments are the same. HASH-FUNCTION must be a function taking one +argument and returning an integer that is the hash code of the argument. + +Computation should use the whole value range of the underlying machine long +type. In XEmacs this will necessitate bignums for values above +`most-positive-fixnum' but below (1+ (* most-positive-fixnum 2)) and +analogous values below `most-negative-fixnum'. Relatively poor hashing +performance is guaranteed in a build without bignums. + +This function returns t if successful, and errors if NAME +cannot be defined as a hash table test. +*/ + (name, equal_function, hash_function)) +{ + Lisp_Object min, max, lookup; + + CHECK_SYMBOL (name); + + lookup = Fassq (name, XWEAK_LIST_LIST (Vhash_table_test_weak_list)); + + if (!NILP (lookup)) + { + invalid_change ("Cannot redefine existing hash table test", name); + } + + min = Ffunction_min_args (equal_function); + max = Ffunction_max_args (equal_function); + + if (!((XINT (min) <= 2) && (NILP (max) || 2 <= XINT (max)))) + { + signal_wrong_number_of_arguments_error (equal_function, 2); + } + + min = Ffunction_min_args (hash_function); + max = Ffunction_max_args (hash_function); + + if (!((XINT (min) <= 1) && (NILP (max) || 1 <= XINT (max)))) + { + signal_wrong_number_of_arguments_error (hash_function, 1); + } + + define_hash_table_test (name, lisp_object_general_equal, + lisp_object_general_hash, equal_function, + hash_function); + return Qt; +} + +DEFUN ("valid-hash-table-test-p", Fvalid_hash_table_test_p, 1, 1, 0, /* +Return t if OBJECT names a hash table test, nil otherwise. + +A valid hash table test is one of the symbols `eq', `eql', `equal', +`equalp', or some symbol passed as the NAME argument to +`define-hash-table-test'. As a special case, `nil' is regarded as +equivalent to `eql'. */ (object)) { - /* This function is pretty 32bit-centric. */ - Hashcode hash = internal_hash (object, 0); - return Fcons (hash >> 16, hash & 0xffff); + Lisp_Object lookup; + + if (NILP (object)) + { + return Qt; + } + + lookup = Fassq (object, XWEAK_LIST_LIST (Vhash_table_test_weak_list)); + + if (!NILP (lookup)) + { + return Qt; + } + + return Qnil; +} + +DEFUN ("hash-table-test-list", Fhash_table_test_list, 0, 0, 0, /* +Return a list of symbols naming valid hash table tests. +These can be passed as the value of the TEST keyword to `make-hash-table'. +This list does not include nil, regarded as equivalent to `eql' by +`make-hash-table'. +*/ + ()) +{ + Lisp_Object result = Qnil; + + LIST_LOOP_2 (test, XWEAK_LIST_LIST (Vhash_table_test_weak_list)) + { + if (!UNBOUNDP (XCAR (test))) + { + result = Fcons (XCAR (test), result); + } + } + + return result; } -#endif + +DEFUN ("hash-table-test-equal-function", + Fhash_table_test_equal_function, 1, 1, 0, /* +Return the comparison function used for hash table test TEST. +See `define-hash-table-test' and `make-hash-table'. +*/ + (test)) +{ + Lisp_Object lookup; + + if (NILP (test)) + { + test = Qeql; + } + + lookup = Fassq (test, XWEAK_LIST_LIST (Vhash_table_test_weak_list)); + if (NILP (lookup)) + { + invalid_argument ("Not a defined hash table test", test); + } + return XHASH_TABLE_TEST (XCDR (lookup))->lisp_equal_function; +} + +DEFUN ("hash-table-test-hash-function", + Fhash_table_test_hash_function, 1, 1, 0, /* +Return the hash function used for hash table test TEST. +See `define-hash-table-test' and `make-hash-table'. +*/ + (test)) +{ + Lisp_Object lookup; + + if (NILP (test)) + { + test = Qeql; + } + + lookup = Fassq (test, XWEAK_LIST_LIST (Vhash_table_test_weak_list)); + if (NILP (lookup)) + { + invalid_argument ("Not a defined hash table test", test); + } + + return XHASH_TABLE_TEST (XCDR (lookup))->lisp_hash_function; +} /************************************************************************/ /* initialization */ /************************************************************************/ void +hash_table_objects_create (void) +{ +#ifdef MEMORY_USAGE_STATS + OBJECT_HAS_METHOD (hash_table, memory_usage); +#endif +} + +void syms_of_elhash (void) { DEFSUBR (Fhash_table_p); @@ -1846,14 +2257,24 @@ DEFSUBR (Fhash_table_rehash_threshold); DEFSUBR (Fhash_table_weakness); DEFSUBR (Fhash_table_type); /* obsolete */ - DEFSUBR (Fsxhash); -#if 0 - DEFSUBR (Finternal_hash_value); -#endif + + DEFSUBR (Feq_hash); + DEFSUBR (Feql_hash); + DEFSUBR (Fequal_hash); + Ffset (intern ("sxhash"), intern ("equal-hash")); + DEFSUBR (Fequalp_hash); + + DEFSUBR (Fdefine_hash_table_test); + DEFSUBR (Fvalid_hash_table_test_p); + DEFSUBR (Fhash_table_test_list); + DEFSUBR (Fhash_table_test_equal_function); + DEFSUBR (Fhash_table_test_hash_function); DEFSYMBOL_MULTIWORD_PREDICATE (Qhash_tablep); + DEFSYMBOL (Qhash_table); DEFSYMBOL (Qhashtable); + DEFSYMBOL (Qmake_hash_table); DEFSYMBOL (Qweakness); DEFSYMBOL (Qvalue); DEFSYMBOL (Qkey_or_value); @@ -1868,23 +2289,75 @@ DEFSYMBOL (Qnon_weak); /* obsolete */ DEFKEYWORD (Q_data); - DEFKEYWORD (Q_test); DEFKEYWORD (Q_size); DEFKEYWORD (Q_rehash_size); DEFKEYWORD (Q_rehash_threshold); DEFKEYWORD (Q_weakness); - DEFKEYWORD (Q_type); /* obsolete */ +} + +void +vars_of_elhash (void) +{ + Lisp_Object weak_list_list = XWEAK_LIST_LIST (Vhash_table_test_weak_list); + + /* This var was staticpro'd and initialised in + init_elhash_once_early, but its Vall_weak_lists isn't sane, since + that was done before vars_of_data() was called. Create a sane + weak list object now, set its list appropriately, assert that our + data haven't been garbage collected. */ + assert (!NILP (Fassq (Qeq, weak_list_list))); + assert (!NILP (Fassq (Qeql, weak_list_list))); + assert (!NILP (Fassq (Qequal, weak_list_list))); + assert (!NILP (Fassq (Qequalp, weak_list_list))); + assert (4 == XINT (Flength (weak_list_list))); + + Vhash_table_test_weak_list = make_weak_list (WEAK_LIST_KEY_ASSOC); + XWEAK_LIST_LIST (Vhash_table_test_weak_list) = weak_list_list; + +#ifdef MEMORY_USAGE_STATS + OBJECT_HAS_PROPERTY + (hash_table, memusage_stats_list, list1 (intern ("hash-entries"))); +#endif /* MEMORY_USAGE_STATS */ } void init_elhash_once_early (void) { - INIT_LRECORD_IMPLEMENTATION (hash_table); + INIT_LISP_OBJECT (hash_table); + INIT_LISP_OBJECT (hash_table_test); + #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (hash_table_entry); + INIT_LISP_OBJECT (hash_table_entry); #endif /* NEW_GC */ + /* init_elhash_once_early() is called very early, we can't have these + DEFSYMBOLs in syms_of_elhash(), unfortunately. */ + + DEFSYMBOL (Qeq); + DEFSYMBOL (Qeql); + DEFSYMBOL (Qequal); + DEFSYMBOL (Qequalp); + + DEFSYMBOL (Qeq_hash); + DEFSYMBOL (Qeql_hash); + DEFSYMBOL (Qequal_hash); + DEFSYMBOL (Qequalp_hash); + /* This must NOT be staticpro'd */ Vall_weak_hash_tables = Qnil; dump_add_weak_object_chain (&Vall_weak_hash_tables); + + staticpro (&Vhash_table_test_weak_list); + Vhash_table_test_weak_list = make_weak_list (WEAK_LIST_KEY_ASSOC); + + staticpro (&Vhash_table_test_eq); + Vhash_table_test_eq = define_hash_table_test (Qeq, NULL, NULL, Qeq, Qeq_hash); + staticpro (&Vhash_table_test_eql); + Vhash_table_test_eql + = define_hash_table_test (Qeql, lisp_object_eql_equal, + lisp_object_eql_hash, Qeql, Qeql_hash); + (void) define_hash_table_test (Qequal, lisp_object_equal_equal, + lisp_object_equal_hash, Qequal, Qequal_hash); + (void) define_hash_table_test (Qequalp, lisp_object_equalp_equal, + lisp_object_equalp_hash, Qequalp, Qequalp_hash); } diff -r 861f2601a38b -r 1f0b15040456 src/elhash.h --- a/src/elhash.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/elhash.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -25,7 +23,7 @@ typedef struct Lisp_Hash_Table Lisp_Hash_Table; -DECLARE_LRECORD (hash_table, Lisp_Hash_Table); +DECLARE_LISP_OBJECT (hash_table, Lisp_Hash_Table); #define XHASH_TABLE(x) XRECORD (x, hash_table, Lisp_Hash_Table) #define wrap_hash_table(p) wrap_record (p, hash_table) @@ -36,7 +34,7 @@ typedef struct htentry { #ifdef NEW_GC - struct lrecord_header lheader; + NORMAL_LISP_OBJECT_HEADER lheader; #endif /* NEW_GC */ Lisp_Object key; Lisp_Object value; @@ -48,7 +46,7 @@ typedef struct htentry Lisp_Hash_Table_Entry; -DECLARE_LRECORD (hash_table_entry, Lisp_Hash_Table_Entry); +DECLARE_LISP_OBJECT (hash_table_entry, Lisp_Hash_Table_Entry); #define XHASH_TABLE_ENTRY(x) \ XRECORD (x, hash_table_entry, Lisp_Hash_Table_Entry) @@ -74,7 +72,8 @@ { HASH_TABLE_EQ, HASH_TABLE_EQL, - HASH_TABLE_EQUAL + HASH_TABLE_EQUAL, + HASH_TABLE_EQUALP }; extern const struct memory_description hash_table_description[]; @@ -86,27 +85,34 @@ EXFUN (Fremhash, 2); EXFUN (Fclrhash, 1); -typedef int (*hash_table_test_function_t) (Lisp_Object obj1, Lisp_Object obj2); -typedef Hashcode (*hash_table_hash_function_t) (Lisp_Object obj); +typedef struct Hash_Table_Test Hash_Table_Test; + +DECLARE_LISP_OBJECT (hash_table_test, struct Hash_Table_Test); +#define XHASH_TABLE_TEST(x) XRECORD (x, hash_table_test, struct Hash_Table_Test) +#define wrap_hash_table_test(p) wrap_record (p, hash_table_test) +#define HASH_TABLE_TESTP(x) RECORDP (x, hash_table_test) +#define CHECK_HASH_TABLE_TEST(x) CHECK_RECORD (x, hash_table_test) +#define CONCHECK_HASH_TABLE_TEST(x) CONCHECK_RECORD (x, hash_table_test) + +typedef int (*hash_table_equal_function_t) (const Hash_Table_Test *http, + Lisp_Object obj1, Lisp_Object obj2); +typedef Hashcode (*hash_table_hash_function_t) (const Hash_Table_Test *http, + Lisp_Object obj); typedef int (*maphash_function_t) (Lisp_Object key, Lisp_Object value, void* extra_arg); -Lisp_Object make_standard_lisp_hash_table (enum hash_table_test test, - Elemcount size, - double rehash_size, - double rehash_threshold, - enum hash_table_weakness weakness); - -Lisp_Object make_general_lisp_hash_table (hash_table_hash_function_t hash_function, - hash_table_test_function_t test_function, +/* test here is a Lisp_Object of type hash-table-test. You probably don't + want to call this, unless you have registered your own test. */ +Lisp_Object make_general_lisp_hash_table (Lisp_Object test, Elemcount size, double rehash_size, double rehash_threshold, enum hash_table_weakness weakness); +/* test here is a symbol, e.g. Qeq, Qequal. */ Lisp_Object make_lisp_hash_table (Elemcount size, enum hash_table_weakness weakness, - enum hash_table_test test); + Lisp_Object test); void elisp_maphash (maphash_function_t function, Lisp_Object hash_table, void *extra_arg); @@ -126,4 +132,12 @@ htentry *find_htentry (Lisp_Object key, const Lisp_Hash_Table *ht); +Lisp_Object define_hash_table_test (Lisp_Object name, + hash_table_equal_function_t equal_function, + hash_table_hash_function_t hash_function, + Lisp_Object lisp_equal_function, + Lisp_Object lisp_hash_function); + +void mark_hash_table_tests (void); + #endif /* INCLUDED_elhash_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/emacs.c --- a/src/emacs.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/emacs.c Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin St - Fifth Floor, -Boston, MA 02111-1301, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.0, FSF 19.28. */ @@ -512,11 +510,6 @@ Lisp_Object Vxemacs_codename; Lisp_Object Vxemacs_extra_name; Lisp_Object Vxemacs_release_date; -#ifdef INFODOCK -Lisp_Object Vinfodock_major_version; -Lisp_Object Vinfodock_minor_version; -Lisp_Object Vinfodock_build_version; -#endif /* The path under which XEmacs was invoked. */ Lisp_Object Vinvocation_path; @@ -766,6 +759,7 @@ while (argv[elt]) { xfree (argv[elt]); + argv[elt] = 0; elt++; } xfree (argv); @@ -1464,13 +1458,33 @@ /* Make sure that eistrings can be created. */ init_eistring_once_early (); - + } +#ifdef PDUMP + else if (!restart) /* after successful pdump_load() + (note, we are inside ifdef PDUMP) */ + { + reinit_alloc_early (); + reinit_gc_early (); + reinit_symbols_early (); + reinit_process_early (); +#ifndef NEW_GC + reinit_opaque_early (); +#endif /* not NEW_GC */ + reinit_eistring_early (); +#ifdef WITH_NUMBER_TYPES + reinit_vars_of_number (); +#endif + } +#endif /* PDUMP */ + + if (!initialized) + { /* Now declare all the symbols and define all the Lisp primitives. The *only* thing that the syms_of_*() functions are allowed to do is call one of the following: - INIT_LRECORD_IMPLEMENTATION() + INIT_LISP_OBJECT() defsymbol(), DEFSYMBOL(), or DEFSYMBOL_MULTIWORD_PREDICATE() defsubr() (i.e. DEFSUBR) deferror(), DEFERROR(), or DEFERROR_STANDARD() @@ -1489,6 +1503,7 @@ #ifdef NEW_GC syms_of_vdb (); #endif /* NEW_GC */ + syms_of_array (); syms_of_buffer (); syms_of_bytecode (); syms_of_callint (); @@ -1538,8 +1553,10 @@ syms_of_frame (); syms_of_general (); syms_of_glyphs (); +#ifdef HAVE_WINDOW_SYSTEM syms_of_glyphs_eimage (); syms_of_glyphs_shared (); +#endif syms_of_glyphs_widget (); syms_of_gui (); syms_of_gutter (); @@ -1547,6 +1564,7 @@ syms_of_intl (); syms_of_keymap (); syms_of_lread (); + syms_of_lstream (); syms_of_macros (); syms_of_marker (); syms_of_md5 (); @@ -1563,7 +1581,7 @@ #ifdef WITH_NUMBER_TYPES syms_of_number (); #endif - syms_of_objects (); + syms_of_fontcolor (); syms_of_print (); syms_of_process (); #ifdef HAVE_WIN32_PROCESSES @@ -1597,14 +1615,14 @@ syms_of_console_tty (); syms_of_device_tty (); syms_of_frame_tty (); - syms_of_objects_tty (); + syms_of_fontcolor_tty (); #endif #ifdef HAVE_GTK syms_of_device_gtk (); syms_of_frame_gtk (); syms_of_glyphs_gtk (); - syms_of_objects_gtk (); + syms_of_fontcolor_gtk (); syms_of_ui_gtk (); syms_of_select_gtk (); #ifdef HAVE_DIALOGS @@ -1630,7 +1648,7 @@ #endif syms_of_frame_x (); syms_of_glyphs_x (); - syms_of_objects_x (); + syms_of_fontcolor_x (); #ifdef HAVE_MENUBARS syms_of_menubar_x (); #endif @@ -1659,7 +1677,7 @@ syms_of_dialog_mswindows (); #endif syms_of_frame_mswindows (); - syms_of_objects_mswindows (); + syms_of_fontcolor_mswindows (); syms_of_select_mswindows (); syms_of_glyphs_mswindows (); #ifdef HAVE_GUI_OBJECTS @@ -1730,7 +1748,37 @@ #if defined (HAVE_POSTGRESQL) && !defined (HAVE_SHLIB) syms_of_postgresql (); #endif - + } + + if (!initialized +#ifdef PDUMP + || !restart +#endif + ) + { + buffer_objects_create (); + casetab_objects_create (); + extent_objects_create (); + face_objects_create (); + frame_objects_create (); + glyph_objects_create (); + hash_table_objects_create (); + lstream_objects_create (); +#ifdef MULE + mule_charset_objects_create (); +#endif +#ifdef HAVE_SCROLLBARS + scrollbar_objects_create (); +#endif + specifier_objects_create (); +#ifdef HAVE_GTK + ui_gtk_objects_create (); +#endif + window_objects_create (); + } + + if (!initialized) + { /* Now create the subtypes for the types that have them. We do this before the vars_*() because more symbols may get initialized here. */ @@ -1753,7 +1801,7 @@ console_type_create_tty (); console_type_create_device_tty (); console_type_create_frame_tty (); - console_type_create_objects_tty (); + console_type_create_fontcolor_tty (); console_type_create_redisplay_tty (); #endif @@ -1762,7 +1810,7 @@ console_type_create_select_gtk (); console_type_create_device_gtk (); console_type_create_frame_gtk (); - console_type_create_objects_gtk (); + console_type_create_fontcolor_gtk (); console_type_create_glyphs_gtk (); console_type_create_redisplay_gtk (); #ifdef HAVE_MENUBARS @@ -1788,7 +1836,7 @@ #ifdef HAVE_MENUBARS console_type_create_menubar_x (); #endif - console_type_create_objects_x (); + console_type_create_fontcolor_x (); console_type_create_redisplay_x (); #ifdef HAVE_SCROLLBARS console_type_create_scrollbar_x (); @@ -1805,7 +1853,7 @@ console_type_create_mswindows (); console_type_create_device_mswindows (); console_type_create_frame_mswindows (); - console_type_create_objects_mswindows (); + console_type_create_fontcolor_mswindows (); console_type_create_redisplay_mswindows (); console_type_create_glyphs_mswindows (); console_type_create_select_mswindows (); @@ -1837,7 +1885,7 @@ specifier_type_create_image (); specifier_type_create_gutter (); - specifier_type_create_objects (); + specifier_type_create_fontcolor (); #ifdef HAVE_TOOLBARS specifier_type_create_toolbar (); #endif @@ -1873,7 +1921,9 @@ called before the any calls to the other macros. */ image_instantiator_format_create (); +#ifdef HAVE_WINDOW_SYSTEM image_instantiator_format_create_glyphs_eimage (); +#endif image_instantiator_format_create_glyphs_widget (); #ifdef HAVE_TTY image_instantiator_format_create_glyphs_tty (); @@ -1892,17 +1942,6 @@ else if (!restart) /* after successful pdump_load() (note, we are inside ifdef PDUMP) */ { - reinit_alloc_early (); - reinit_gc_early (); - reinit_symbols_early (); -#ifndef NEW_GC - reinit_opaque_early (); -#endif /* not NEW_GC */ - reinit_eistring_early (); -#ifdef WITH_NUMBER_TYPES - reinit_vars_of_number (); -#endif - reinit_console_type_create_stream (); #ifdef HAVE_TTY reinit_console_type_create_tty (); @@ -1921,7 +1960,7 @@ reinit_specifier_type_create (); reinit_specifier_type_create_image (); reinit_specifier_type_create_gutter (); - reinit_specifier_type_create_objects (); + reinit_specifier_type_create_fontcolor (); #ifdef HAVE_TOOLBARS reinit_specifier_type_create_toolbar (); #endif @@ -2021,8 +2060,8 @@ - make_int() - make_char() - make_extent() - - BASIC_ALLOC_LCRECORD() - - ALLOC_LCRECORD_TYPE() + - ALLOC_NORMAL_LISP_OBJECT() + - ALLOC_SIZED_LISP_OBJECT() - Fcons() - listN() - make_lcrecord_list() @@ -2054,6 +2093,7 @@ vars_of_buffer (); vars_of_bytecode (); vars_of_callint (); + vars_of_casetab (); vars_of_chartab (); vars_of_cmdloop (); vars_of_cmds (); @@ -2074,6 +2114,7 @@ vars_of_dragdrop (); #endif vars_of_editfns (); + vars_of_elhash (); vars_of_emacs (); vars_of_eval (); @@ -2104,7 +2145,9 @@ vars_of_frame (); vars_of_gc (); vars_of_glyphs (); +#ifdef HAVE_WINDOW_SYSTEM vars_of_glyphs_eimage (); +#endif vars_of_glyphs_widget (); vars_of_gui (); vars_of_gutter (); @@ -2141,7 +2184,7 @@ #ifdef WITH_NUMBER_TYPES vars_of_number (); #endif - vars_of_objects (); + vars_of_fontcolor (); vars_of_print (); vars_of_process (); @@ -2180,7 +2223,7 @@ #ifdef HAVE_TTY vars_of_console_tty (); vars_of_frame_tty (); - vars_of_objects_tty (); + vars_of_fontcolor_tty (); #endif #ifdef HAVE_GTK @@ -2196,7 +2239,7 @@ #ifdef HAVE_MENUBARS vars_of_menubar_gtk (); #endif - vars_of_objects_gtk (); + vars_of_fontcolor_gtk (); vars_of_select_gtk (); #ifdef HAVE_SCROLLBARS vars_of_scrollbar_gtk (); @@ -2220,7 +2263,7 @@ #ifdef HAVE_MENUBARS vars_of_menubar_x (); #endif - vars_of_objects_x (); + vars_of_fontcolor_x (); vars_of_select_x (); #ifdef HAVE_SCROLLBARS vars_of_scrollbar_x (); @@ -2240,7 +2283,7 @@ vars_of_device_mswindows (); vars_of_console_mswindows (); vars_of_frame_mswindows (); - vars_of_objects_mswindows (); + vars_of_fontcolor_mswindows (); vars_of_select_mswindows (); vars_of_glyphs_mswindows (); #ifdef HAVE_SCROLLBARS @@ -2299,6 +2342,7 @@ { /* Now do additional vars_of_*() initialization that happens both at dump time and after pdump load. */ + reinit_vars_of_alloc (); reinit_vars_of_buffer (); reinit_vars_of_bytecode (); reinit_vars_of_console (); @@ -2312,7 +2356,6 @@ #endif reinit_vars_of_event_stream (); reinit_vars_of_events (); - reinit_vars_of_extents (); reinit_vars_of_file_coding (); reinit_vars_of_fileio (); #ifdef USE_C_FONT_LOCK @@ -2329,7 +2372,7 @@ #ifdef HAVE_SHLIB reinit_vars_of_module (); #endif - reinit_vars_of_objects (); + reinit_vars_of_fontcolor (); reinit_vars_of_print (); reinit_vars_of_search (); reinit_vars_of_text (); @@ -2339,7 +2382,7 @@ #ifdef HAVE_MS_WINDOWS reinit_vars_of_event_mswindows (); reinit_vars_of_frame_mswindows (); - reinit_vars_of_object_mswindows (); + reinit_vars_of_fontcolor_mswindows (); #endif #ifdef HAVE_GTK @@ -2908,8 +2951,7 @@ from += options[from]; } - if (best < 0) - ABORT (); + assert (best >= 0); /* Copy the highest priority remaining option, with its args, to NEW_ARGV. */ @@ -3343,7 +3385,7 @@ go. The two conditions sound somewhat redundant (maybe we could just use the second?) but they aren't completely: Theoretically (maybe with MinGW?) we could imagine compiling under native Windows as the OS - but e.g. targetting only X Windows as the window system. --ben */ + but e.g. targeting only X Windows as the window system. --ben */ #if defined (HAVE_MS_WINDOWS) && defined (WIN32_NATIVE) # define NEED_WINDOWS_MESSAGE_PAUSE @@ -3588,15 +3630,9 @@ "Your version of XEmacs was distributed with a PROBLEMS file that may describe\n" "your crash, and with luck a workaround. Please check it first, but do report\n" "the crash anyway.\n\n" -#ifdef INFODOCK -"Please report this bug by selecting `Report-Bug' in the InfoDock menu, or\n" -"(last resort) by emailing `xemacs-beta@xemacs.org' -- note that this is for\n" -"XEmacs in general, not just Infodock." -#else "Please report this bug by invoking M-x report-emacs-bug, or by selecting\n" "`Send Bug Report' from the Help menu. If that won't work, send ordinary\n" "email to `xemacs-beta@xemacs.org'." -#endif " *MAKE SURE* to include this entire\n" "output from this crash, especially including the Lisp backtrace, as well as\n" "the XEmacs configuration from M-x describe-installation (or equivalently,\n" @@ -3644,7 +3680,7 @@ "then type `where' at the debugger prompt. No GDB on your system? You may\n" "have DBX, or XDB, or SDB. (Ask your system administrator if you need help.)\n" "If no core file was produced, enable them (often with `ulimit -c unlimited')\n" -"in case of future recurrance of the crash.\n"); +"in case of future reoccurrence of the crash.\n"); #endif /* _MSC_VER */ } @@ -4057,6 +4093,20 @@ in_assert_failed--; } +/* This is called when an assert() fails or when ABORT() is called -- both + of those are defined in the preprocessor to an expansion involving + assert_failed(). */ +void +assert_equal_failed (const Ascbyte *file, int line, EMACS_INT x, EMACS_INT y, + const Ascbyte *exprx, const Ascbyte *expry) +{ + Ascbyte bigstr[1000]; /* #### Could overflow, but avoids any need to do any + allocation, even alloca(), hence safer */ + sprintf (bigstr, "%s (%ld) should == %s (%ld) but doesn't", + exprx, x, expry, y); + assert_failed (file, line, bigstr); +} + /* -------------------------------------- */ /* low-memory notification */ /* -------------------------------------- */ @@ -4281,22 +4331,6 @@ Vemacs_beta_version = Qnil; #endif -#ifdef INFODOCK - DEFVAR_LISP ("infodock-major-version", &Vinfodock_major_version /* -Major version number of this InfoDock release. -*/ ); - Vinfodock_major_version = make_int (INFODOCK_MAJOR_VERSION); - - DEFVAR_LISP ("infodock-minor-version", &Vinfodock_minor_version /* -Minor version number of this InfoDock release. -*/ ); - Vinfodock_minor_version = make_int (INFODOCK_MINOR_VERSION); - - DEFVAR_LISP ("infodock-build-version", &Vinfodock_build_version /* -Build version of this InfoDock release. -*/ ); - Vinfodock_build_version = make_int (INFODOCK_BUILD_VERSION); -#endif DEFVAR_LISP ("xemacs-codename", &Vxemacs_codename /* Codename of this version of Emacs (a string). @@ -4495,7 +4529,6 @@ DEFVAR_LISP ("emacs-program-name", &Vemacs_program_name /* *Name of the Emacs variant. -For example, this may be \"xemacs\" or \"infodock\". This is mainly meant for use in path searching. */ ); Vemacs_program_name = build_extstring (PATH_PROGNAME, Qfile_name); diff -r 861f2601a38b -r 1f0b15040456 src/emodules.c --- a/src/emodules.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/emodules.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* This file has been Mule-ized, Ben Wing, 1-26-10. */ @@ -257,9 +255,13 @@ if (dll_close (modules[mod].dlhandle) == 0) { xfree (modules[mod].soname); + modules[mod].soname = 0; xfree (modules[mod].modname); + modules[mod].modname = 0; xfree (modules[mod].modver); + modules[mod].modver = 0; xfree (modules[mod].modtitle); + modules[mod].modtitle = 0; modules[mod].dlhandle = 0; modules[mod].used = 0; } @@ -386,11 +388,7 @@ (const Ibyte *) "emodule_name"); if (f == NULL || *f == NULL) signal_error (Qdll_error, "Invalid dynamic module: Missing symbol `emodule_name'", Qunbound); - - mname = EXTERNAL_TO_ITEXT (f, Qemodule_string_encoding); - /* #### Not obvious we have to force an alloca copy here, but the old - code did so */ - IBYTE_STRING_TO_ALLOCA (mname, mname); + mname = EXTERNAL_TO_ITEXT (*f, Qemodule_string_encoding); if (mname[0] == '\0') signal_error (Qdll_error, "Invalid dynamic module: Empty value for `emodule_name'", Qunbound); @@ -399,21 +397,13 @@ (const Ibyte *) "emodule_version"); if (f == NULL || *f == NULL) signal_error (Qdll_error, "Missing symbol `emodule_version': Invalid dynamic module", Qunbound); - - mver = EXTERNAL_TO_ITEXT (f, Qemodule_string_encoding); - /* #### Not obvious we have to force an alloca copy here, but the old - code did so */ - IBYTE_STRING_TO_ALLOCA (mver, mver); + mver = EXTERNAL_TO_ITEXT (*f, Qemodule_string_encoding); f = (const Extbyte **) dll_variable (dlhandle, (const Ibyte *) "emodule_title"); if (f == NULL || *f == NULL) signal_error (Qdll_error, "Invalid dynamic module: Missing symbol `emodule_title'", Qunbound); - - mtitle = EXTERNAL_TO_ITEXT (f, Qemodule_string_encoding); - /* #### Not obvious we have to force an alloca copy here, but the old - code did so */ - IBYTE_STRING_TO_ALLOCA (mtitle, mtitle); + mtitle = EXTERNAL_TO_ITEXT (*f, Qemodule_string_encoding); symname = alloca_ibytes (qxestrlen (mname) + 15); diff -r 861f2601a38b -r 1f0b15040456 src/emodules.h --- a/src/emodules.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/emodules.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ #ifndef EMODULES_HDR diff -r 861f2601a38b -r 1f0b15040456 src/esd.c --- a/src/esd.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/esd.c Sun May 01 18:44:03 2011 +0100 @@ -1,11 +1,13 @@ /* esd.c - play a sound over ESD +Copyright 1999 Robert Bihlmeyer + This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -13,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/eval.c --- a/src/eval.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/eval.c Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30 (except for Fsignal), Mule 2.0. */ @@ -418,6 +416,29 @@ static Lisp_Object maybe_get_trapping_problems_backtrace (void); + +/* When parsing keyword arguments; is some element of NARGS + :allow-other-keys, and is that element followed by a non-nil Lisp + object? */ + +Boolint +non_nil_allow_other_keys_p (Elemcount offset, int nargs, Lisp_Object *args) +{ + Lisp_Object key, value; + while (offset + 1 < nargs) + { + key = args[offset++]; + value = args[offset++]; + if (EQ (key, Q_allow_other_keys)) + { + /* The ANSI Common Lisp standard says the first value for a given + keyword overrides. */ + return !NILP (value); + } + } + return 0; +} + /************************************************************************/ /* The subr object type */ /************************************************************************/ @@ -432,7 +453,7 @@ const Ascbyte *trailer = subr->prompt ? " (interactive)>" : ">"; if (print_readably) - printing_unreadable_object ("%s%s%s", header, name, trailer); + printing_unreadable_object_fmt ("%s%s%s", header, name, trailer); write_ascstring (printcharfun, header); write_ascstring (printcharfun, name); @@ -444,11 +465,10 @@ { XD_END } }; -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("subr", subr, - 1, /*dumpable-flag*/ - 0, print_subr, 0, 0, 0, - subr_description, - Lisp_Subr); +DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("subr", subr, + 0, print_subr, 0, 0, 0, + subr_description, + Lisp_Subr); /************************************************************************/ /* Entering the debugger */ @@ -1248,9 +1268,20 @@ object preceded by `''. Thus, `'x' is equivalent to `(quote x)', in all contexts. A print function may use either. Internally the expression is represented as `(quote x)'). + +arguments: (OBJECT) */ (args)) { + int nargs; + + GET_LIST_LENGTH (args, nargs); + if (nargs != 1) + { + Fsignal (Qwrong_number_of_arguments, + list2 (Qquote, make_int (nargs))); + } + return XCAR (args); } @@ -1319,9 +1350,20 @@ object preceded by `#''. Thus, #'x is equivalent to (function x), in all contexts. A print function may use either. Internally the expression is represented as `(function x)'). + +arguments: (SYMBOL-OR-LAMBDA) */ (args)) { + int nargs; + + GET_LIST_LENGTH (args, nargs); + if (nargs != 1) + { + Fsignal (Qwrong_number_of_arguments, + list2 (Qfunction, make_int (nargs))); + } + return XCAR (args); } @@ -1758,23 +1800,13 @@ LONGJMP (c->jmp, 1); } -DECLARE_DOESNT_RETURN (throw_or_bomb_out (Lisp_Object, Lisp_Object, int, +DECLARE_DOESNT_RETURN (throw_or_bomb_out_unsafe (Lisp_Object, Lisp_Object, int, Lisp_Object, Lisp_Object)); DOESNT_RETURN -throw_or_bomb_out (Lisp_Object tag, Lisp_Object val, int bomb_out_p, - Lisp_Object sig, Lisp_Object data) -{ -#ifdef DEFEND_AGAINST_THROW_RECURSION - /* die if we recurse more than is reasonable */ - if (++throw_level > 20) - ABORT (); -#endif - -#ifdef ERROR_CHECK_TRAPPING_PROBLEMS - check_proper_critical_section_nonlocal_exit_protection (); -#endif - +throw_or_bomb_out_unsafe (Lisp_Object tag, Lisp_Object val, int bomb_out_p, + Lisp_Object sig, Lisp_Object data) +{ /* If bomb_out_p is t, this is being called from Fsignal as a "last resort" when there is no handler for this error and the debugger couldn't be invoked, so we are throwing to @@ -1814,6 +1846,24 @@ call1 (Qreally_early_error_handler, Fcons (sig, data)); } } + +DECLARE_DOESNT_RETURN (throw_or_bomb_out (Lisp_Object, Lisp_Object, int, + Lisp_Object, Lisp_Object)); + +DOESNT_RETURN +throw_or_bomb_out (Lisp_Object tag, Lisp_Object val, int bomb_out_p, + Lisp_Object sig, Lisp_Object data) +{ +#ifdef DEFEND_AGAINST_THROW_RECURSION + /* die if we recurse more than is reasonable */ + assert (++throw_level <= 20); +#endif + +#ifdef ERROR_CHECK_TRAPPING_PROBLEMS + check_proper_critical_section_nonlocal_exit_protection (); +#endif + throw_or_bomb_out_unsafe (tag, val, bomb_out_p, sig, data); +} /* See above, where CATCHLIST is defined, for a description of how Fthrow() works. @@ -3051,6 +3101,12 @@ } DOESNT_RETURN +invalid_keyword_argument (Lisp_Object function, Lisp_Object keyword) +{ + signal_error_1 (Qinvalid_keyword_argument, list2 (function, keyword)); +} + +DOESNT_RETURN invalid_constant (const Ascbyte *reason, Lisp_Object frob) { signal_error (Qinvalid_constant, reason, frob); @@ -4072,12 +4128,16 @@ } else if (max_args == UNEVALLED) /* Can't funcall a special operator */ { + +#ifdef NEED_TO_HANDLE_21_4_CODE /* Ugh, ugh, ugh. */ if (EQ (fun, XSYMBOL_FUNCTION (Qthrow))) { args[0] = Qobsolete_throw; goto retry; } +#endif /* NEED_TO_HANDLE_21_4_CODE */ + goto invalid_function; } else @@ -4492,6 +4552,7 @@ Bytecount sizem; struct multiple_value *mv; Elemcount i, allocated_count; + Lisp_Object mvobj; assert (count != 1); @@ -4517,8 +4578,8 @@ sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (multiple_value, Lisp_Object, contents, allocated_count); - mv = (multiple_value *) BASIC_ALLOC_LCRECORD (sizem, - &lrecord_multiple_value); + mvobj = ALLOC_SIZED_LISP_OBJECT (sizem, multiple_value); + mv = XMULTIPLE_VALUE (mvobj); mv->count = count; mv->first_desired = first_desired; @@ -4530,7 +4591,7 @@ mv->contents[1 + (i - first_desired)] = Qunbound; } - return wrap_multiple_value (mv); + return mvobj; } void @@ -4577,13 +4638,13 @@ if (print_readably) { - printing_unreadable_object ("multiple values"); + printing_unreadable_object_fmt ("#", + LISP_OBJECT_UID (obj)); } - if (0 == count) - { - write_msg_string (printcharfun, "#"); - } + write_fmt_string (printcharfun, + "# 1 && index < count) { - write_ascstring (printcharfun, " ;\n"); + write_ascstring (printcharfun, " "); } } + + write_fmt_string (printcharfun, ") 0x%x>", LISP_OBJECT_UID (obj)); } static Lisp_Object @@ -4624,12 +4687,11 @@ } static Bytecount -size_multiple_value (const void *lheader) +size_multiple_value (Lisp_Object obj) { return FLEXIBLE_ARRAY_STRUCT_SIZEOF (struct multiple_value, Lisp_Object, contents, - ((struct multiple_value *) lheader)-> - allocated_count); + XMULTIPLE_VALUE (obj)->allocated_count); } static const struct memory_description multiple_value_description[] = { @@ -4641,15 +4703,14 @@ { XD_END } }; -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("multiple-value", multiple_value, - 1, /*dumpable-flag*/ - mark_multiple_value, - print_multiple_value, 0, - 0, /* No equal method. */ - 0, /* No hash method. */ - multiple_value_description, - size_multiple_value, - struct multiple_value); +DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("multiple-value", multiple_value, + mark_multiple_value, + print_multiple_value, 0, + 0, /* No equal method. */ + 0, /* No hash method. */ + multiple_value_description, + size_multiple_value, + struct multiple_value); /* Given that FIRST and UPPER are the inclusive lower and exclusive upper bounds for the multiple values we're interested in, modify (or don't) the @@ -4869,17 +4930,19 @@ } argv[0] = IGNORE_MULTIPLE_VALUES (Feval (XCAR (args))); - CHECK_NATNUM (argv[0]); - first = XINT (argv[0]); GCPRO1 (argv[0]); gcpro1.nvars = 1; args = XCDR (args); - argv[1] = IGNORE_MULTIPLE_VALUES (Feval (XCAR (args))); - CHECK_NATNUM (argv[1]); + + check_integer_range (argv[1], Qzero, make_int (EMACS_INT_MAX)); + check_integer_range (argv[0], Qzero, argv[1]); + upper = XINT (argv[1]); + first = XINT (argv[0]); + gcpro1.nvars = 2; /* The unintuitive order of things here is for the sake of the bytecode; @@ -7151,7 +7214,7 @@ REGISTER int i; Lisp_Object tem; - CHECK_NATNUM (nframes); + check_integer_range (nframes, Qzero, make_integer (EMACS_INT_MAX)); /* Find the frame requested. */ for (i = XINT (nframes); backlist && (i-- > 0);) @@ -7237,8 +7300,8 @@ void syms_of_eval (void) { - INIT_LRECORD_IMPLEMENTATION (subr); - INIT_LRECORD_IMPLEMENTATION (multiple_value); + INIT_LISP_OBJECT (subr); + INIT_LISP_OBJECT (multiple_value); DEFSYMBOL (Qinhibit_quit); DEFSYMBOL (Qautoload); diff -r 861f2601a38b -r 1f0b15040456 src/event-Xt.c --- a/src/event-Xt.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/event-Xt.c Sun May 01 18:44:03 2011 +0100 @@ -2,13 +2,14 @@ Copyright (C) 1991-5, 1997 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. Copyright (C) 1996, 2001, 2002, 2003, 2010 Ben Wing. + Copyright (C) 2010 Didier Verna This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -50,7 +49,7 @@ #include "console-tty.h" #include "console-x-impl.h" -#include "objects-x.h" +#include "fontcolor-x.h" #include "../lwlib/lwlib.h" #include "EmacsFrame.h" @@ -133,8 +132,6 @@ static int last_quit_check_signal_tick_count; -Lisp_Object Qsans_modifiers; - #define THIS_IS_X #include "event-xlike-inc.c" @@ -232,7 +229,7 @@ Fclrhash (hash_table); else xd->x_keysym_map_hash_table = hash_table = - make_lisp_hash_table (128, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (128, HASH_TABLE_NON_WEAK, Qequal); for (keysym = xd->x_keysym_map, keysyms_per_code = xd->x_keysym_map_keysyms_per_code, @@ -1898,6 +1895,25 @@ break; case ConfigureNotify: + { + XEvent xev; + + /* Let's eat all events of that type to avoid useless + reconfigurations. */ + while (XCheckTypedWindowEvent + (DEVICE_X_DISPLAY (XDEVICE (FRAME_DEVICE (f))), + XtWindow (FRAME_X_TEXT_WIDGET (f)), + ConfigureNotify, + &xev) + == True); + } + /* #### NOTE: in fact, the frame faces didn't really change, but if some + #### of them have their background-placement property set to + #### absolute, we need a redraw. This is semantically equivalent to + #### changing the background pixmap. -- dvl */ + x_get_frame_text_position (f); + MARK_FRAME_FACES_CHANGED (f); + #ifdef HAVE_XIM XIM_SetGeometry (f); #endif @@ -3024,8 +3040,6 @@ void syms_of_event_Xt (void) { - DEFSYMBOL (Qsans_modifiers); - DEFSYMBOL (Qself_insert_command); } void diff -r 861f2601a38b -r 1f0b15040456 src/event-gtk.c --- a/src/event-gtk.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/event-gtk.c Sun May 01 18:44:03 2011 +0100 @@ -1,15 +1,15 @@ /* The event_stream interface for X11 with gtk, and/or tty frames. Copyright (C) 1991-5, 1997 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1996, 2001, 2002, 2003 Ben Wing. + Copyright (C) 1996, 2001, 2002, 2003, 2010 Ben Wing. Copyright (C) 2000 William Perry. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* This file is heavily based upon event-Xt.c */ @@ -45,7 +43,7 @@ #include "console-tty.h" #include "console-gtk-impl.h" -#include "objects-gtk.h" +#include "fontcolor-gtk.h" #include "gtk-xemacs.h" @@ -86,8 +84,6 @@ static int last_quit_check_signal_tick_count; -Lisp_Object Qsans_modifiers; - /* * Identify if the keysym is a modifier. This implementation mirrors x.org's * IsModifierKey(), but for GDK keysyms. @@ -1616,7 +1612,6 @@ void syms_of_event_gtk (void) { - DEFSYMBOL (Qsans_modifiers); } void @@ -1762,7 +1757,7 @@ else { xd->x_keysym_map_hashtable = hashtable = - make_lisp_hash_table (128, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (128, HASH_TABLE_NON_WEAK, Qequal); } for (keysym = xd->x_keysym_map, diff -r 861f2601a38b -r 1f0b15040456 src/event-msw.c --- a/src/event-msw.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/event-msw.c Sun May 01 18:44:03 2011 +0100 @@ -1,15 +1,15 @@ /* The mswindows event_stream interface. Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1996, 2000, 2001, 2002, 2003, 2005 Ben Wing. + Copyright (C) 1996, 2000, 2001, 2002, 2003, 2005, 2010 Ben Wing. Copyright (C) 1997 Jonathan Harris. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -83,7 +81,7 @@ #include "console-stream-impl.h" #include "console-msw-impl.h" -#include "objects-msw-impl.h" +#include "fontcolor-msw-impl.h" #ifdef HAVE_SCROLLBARS # include "scrollbar-msw.h" @@ -3386,13 +3384,9 @@ FRAME_PIXWIDTH (frame) = rect.right; FRAME_PIXHEIGHT (frame) = rect.bottom; - pixel_to_real_char_size (frame, rect.right, rect.bottom, - &FRAME_MSWINDOWS_CHARWIDTH (frame), - &FRAME_MSWINDOWS_CHARHEIGHT (frame)); - - pixel_to_char_size (frame, rect.right, rect.bottom, &columns, + pixel_to_frame_unit_size (frame, rect.right, rect.bottom, &columns, &rows); - change_frame_size (frame, rows, columns, 1); + change_frame_size (frame, columns, rows, 1); /* If we are inside frame creation, we have to apply geometric properties now. */ @@ -3477,7 +3471,7 @@ GetMenu(hwnd) != NULL, qxeGetWindowLong (hwnd, GWL_EXSTYLE)); - round_size_to_real_char (XFRAME (mswindows_find_frame (hwnd)), + round_size_to_char (XFRAME (mswindows_find_frame (hwnd)), wp->cx - (ncsize.right - ncsize.left), wp->cy - (ncsize.bottom - ncsize.top), &pixwidth, &pixheight); diff -r 861f2601a38b -r 1f0b15040456 src/event-stream.c --- a/src/event-stream.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/event-stream.c Sun May 01 18:44:03 2011 +0100 @@ -2,14 +2,14 @@ Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1995 Board of Trustees, University of Illinois. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 1996, 2001, 2002, 2003 Ben Wing. + Copyright (C) 1995, 1996, 2001, 2002, 2003, 2005, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -243,6 +241,8 @@ Lisp_Object Qself_insert_defer_undo; +Lisp_Object Qsans_modifiers; + int in_modal_loop; /* the number of keyboard characters read. callint.c wants this. */ @@ -330,10 +330,6 @@ #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder) #define CONCHECK_COMMAND_BUILDER(x) CONCHECK_RECORD (x, command_builder) -#ifndef NEW_GC -static Lisp_Object Vcommand_builder_free_list; -#endif /* not NEW_GC */ - static const struct memory_description command_builder_description [] = { { XD_LISP_OBJECT, offsetof (struct command_builder, current_events) }, { XD_LISP_OBJECT, offsetof (struct command_builder, most_current_event) }, @@ -356,25 +352,22 @@ } static void -finalize_command_builder (void *header, int for_disksave) +finalize_command_builder (Lisp_Object obj) { - if (!for_disksave) + struct command_builder *b = XCOMMAND_BUILDER (obj); + if (b->echo_buf) { - struct command_builder *b = (struct command_builder *) header; - if (b->echo_buf) - { - xfree (b->echo_buf); - b->echo_buf = 0; - } + xfree (b->echo_buf); + b->echo_buf = 0; } } -DEFINE_LRECORD_IMPLEMENTATION ("command-builder", command_builder, - 0, /*dumpable-flag*/ - mark_command_builder, internal_object_printer, - finalize_command_builder, 0, 0, - command_builder_description, - struct command_builder); +DEFINE_NODUMP_LISP_OBJECT ("command-builder", command_builder, + mark_command_builder, + internal_object_printer, + finalize_command_builder, 0, 0, + command_builder_description, + struct command_builder); static void reset_command_builder_event_chain (struct command_builder *builder) @@ -389,13 +382,7 @@ Lisp_Object allocate_command_builder (Lisp_Object console, int with_echo_buf) { - Lisp_Object builder_obj = -#ifdef NEW_GC - wrap_pointer_1 (alloc_lrecord_type (struct command_builder, - &lrecord_command_builder)); -#else /* not NEW_GC */ - alloc_managed_lcrecord (Vcommand_builder_free_list); -#endif /* not NEW_GC */ + Lisp_Object builder_obj = ALLOC_NORMAL_LISP_OBJECT (command_builder); struct command_builder *builder = XCOMMAND_BUILDER (builder_obj); builder->console = console; @@ -466,12 +453,7 @@ xfree (builder->echo_buf); builder->echo_buf = NULL; } -#ifdef NEW_GC - free_lrecord (wrap_command_builder (builder)); -#else /* not NEW_GC */ - free_managed_lcrecord (Vcommand_builder_free_list, - wrap_command_builder (builder)); -#endif /* not NEW_GC */ + free_normal_lisp_object (wrap_command_builder (builder)); } static void @@ -1035,10 +1017,6 @@ static Lisp_Object pending_timeout_list, pending_async_timeout_list; -#ifndef NEW_GC -static Lisp_Object Vtimeout_free_list; -#endif /* not NEW_GC */ - static Lisp_Object mark_timeout (Lisp_Object obj) { @@ -1053,10 +1031,9 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("timeout", timeout, - 1, /*dumpable-flag*/ - mark_timeout, internal_object_printer, - 0, 0, 0, timeout_description, Lisp_Timeout); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("timeout", timeout, + mark_timeout, timeout_description, + Lisp_Timeout); /* Generate a timeout and return its ID. */ @@ -1066,12 +1043,7 @@ Lisp_Object function, Lisp_Object object, int async_p) { -#ifdef NEW_GC - Lisp_Object op = - wrap_pointer_1 (alloc_lrecord_type (Lisp_Timeout, &lrecord_timeout)); -#else /* not NEW_GC */ - Lisp_Object op = alloc_managed_lcrecord (Vtimeout_free_list); -#endif /* not NEW_GC */ + Lisp_Object op = ALLOC_NORMAL_LISP_OBJECT (timeout); Lisp_Timeout *timeout = XTIMEOUT (op); EMACS_TIME current_time; EMACS_TIME interval; @@ -1147,7 +1119,7 @@ op = XCAR (rest); timeout = XTIMEOUT (op); /* We make sure to snarf the data out of the timeout object before - we free it with free_managed_lcrecord(). */ + we free it with free_normal_lisp_object(). */ id = timeout->id; *function = timeout->function; *object = timeout->object; @@ -1189,11 +1161,7 @@ *timeout_list = noseeum_cons (op, *timeout_list); } else -#ifdef NEW_GC - free_lrecord (op); -#else /* not NEW_GC */ - free_managed_lcrecord (Vtimeout_free_list, op); -#endif /* not NEW_GC */ + free_normal_lisp_object (op); UNGCPRO; return id; @@ -1230,11 +1198,7 @@ signal_remove_async_interval_timeout (timeout->interval_id); else event_stream_remove_timeout (timeout->interval_id); -#ifdef NEW_GC - free_lrecord (op); -#else /* not NEW_GC */ - free_managed_lcrecord (Vtimeout_free_list, op); -#endif /* not NEW_GC */ + free_normal_lisp_object (op); } } @@ -1272,18 +1236,30 @@ static unsigned long lisp_number_to_milliseconds (Lisp_Object secs, int allow_0) { - double fsecs; - CHECK_INT_OR_FLOAT (secs); - fsecs = XFLOATINT (secs); - if (fsecs < 0) - invalid_argument ("timeout is negative", secs); - if (!allow_0 && fsecs == 0) - invalid_argument ("timeout is non-positive", secs); - if (fsecs >= (((unsigned int) 0xFFFFFFFF) / 1000)) - invalid_argument - ("timeout would exceed 32 bits when represented in milliseconds", secs); - - return (unsigned long) (1000 * fsecs); + Lisp_Object args[] = { allow_0 ? Qzero : make_int (1), + secs, + /* (((unsigned int) 0xFFFFFFFF) / 1000) - 1 */ + make_int (4294967 - 1) }; + + if (!allow_0 && FLOATP (secs) && XFLOAT_DATA (secs) > 0) + { + args[0] = secs; + } + + if (NILP (Fleq (countof (args), args))) + { + args_out_of_range_3 (secs, args[0], args[2]); + } + + args[0] = make_int (1000); + args[0] = Ftimes (2, args); + + if (INTP (args[0])) + { + return XINT (args[0]); + } + + return (unsigned long) extract_float (args[0]); } DEFUN ("add-timeout", Fadd_timeout, 3, 4, 0, /* @@ -1329,7 +1305,7 @@ Lisp_Object lid; id = event_stream_generate_wakeup (msecs, msecs2, function, object, 0); lid = make_int (id); - if (id != XINT (lid)) ABORT (); + assert (id == XINT (lid)); return lid; } @@ -1408,7 +1384,7 @@ Lisp_Object lid; id = event_stream_generate_wakeup (msecs, msecs2, function, object, 1); lid = make_int (id); - if (id != XINT (lid)) ABORT (); + assert (id == XINT (lid)); return lid; } @@ -2649,7 +2625,8 @@ msecs = lisp_number_to_milliseconds (timeout_secs, 1); if (!NILP (timeout_msecs)) { - CHECK_NATNUM (timeout_msecs); + check_integer_range (timeout_msecs, Qzero, + make_integer (EMACS_INT_MAX)); msecs += XINT (timeout_msecs); } if (msecs) @@ -3738,7 +3715,8 @@ nwanted = recent_keys_ring_size; else { - CHECK_NATNUM (number); + check_integer_range (number, Qzero, + make_integer (ARRAY_DIMENSION_LIMIT)); nwanted = XINT (number); } @@ -3778,8 +3756,7 @@ { Lisp_Object e = XVECTOR_DATA (Vrecent_keys_ring)[j]; - if (NILP (e)) - ABORT (); + assert (!NILP (e)); XVECTOR_DATA (val)[i] = Fcopy_event (e, Qnil); if (++j >= recent_keys_ring_size) j = 0; @@ -4466,6 +4443,7 @@ { Lisp_Object leaf = lookup_command_event (command_builder, event, 1); + lookedup: if (KEYMAPP (leaf)) /* Incomplete key sequence */ break; @@ -4545,6 +4523,22 @@ GCPRO1 (keys); pre_command_hook (); UNGCPRO; + + if (!NILP (Vthis_command)) + { + /* Allow pre-command-hook to change the command to + something more useful, and avoid barfing. */ + leaf = Vthis_command; + if (!EQ (command_builder->most_current_event, + Vlast_command_event)) + { + reset_current_events (command_builder); + command_builder_append_event (command_builder, + Vlast_command_event); + } + goto lookedup; + } + /* The post-command-hook doesn't run. */ Fsignal (Qundefined_keystroke_sequence, list1 (keys)); } @@ -4554,7 +4548,7 @@ else /* key sequence is bound to a command */ { int magic_undo = 0; - int magic_undo_count = 20; + Elemcount magic_undo_count = 20; Vthis_command = leaf; @@ -4574,7 +4568,21 @@ { Lisp_Object prop = Fget (leaf, Qself_insert_defer_undo, Qnil); if (NATNUMP (prop)) - magic_undo = 1, magic_undo_count = XINT (prop); + { + magic_undo = 1; + if (INTP (prop)) + { + magic_undo_count = XINT (prop); + } +#ifdef HAVE_BIGNUM + else if (BIGNUMP (prop) + && bignum_fits_emacs_int_p (XBIGNUM_DATA (prop))) + { + magic_undo_count + = bignum_to_emacs_int (XBIGNUM_DATA (prop)); + } +#endif + } else if (!NILP (prop)) magic_undo = 1; else if (EQ (leaf, Qself_insert_command)) @@ -4876,8 +4884,8 @@ void syms_of_event_stream (void) { - INIT_LRECORD_IMPLEMENTATION (command_builder); - INIT_LRECORD_IMPLEMENTATION (timeout); + INIT_LISP_OBJECT (command_builder); + INIT_LISP_OBJECT (timeout); DEFSYMBOL (Qdisabled); DEFSYMBOL (Qcommand_event_p); @@ -4923,6 +4931,8 @@ DEFSYMBOL (Qnext_event); DEFSYMBOL (Qdispatch_event); + + DEFSYMBOL (Qsans_modifiers); } void @@ -4931,15 +4941,6 @@ recent_keys_ring_index = 0; recent_keys_ring_size = 100; num_input_chars = 0; -#ifndef NEW_GC - Vtimeout_free_list = make_lcrecord_list (sizeof (Lisp_Timeout), - &lrecord_timeout); - staticpro_nodump (&Vtimeout_free_list); - Vcommand_builder_free_list = - make_lcrecord_list (sizeof (struct command_builder), - &lrecord_command_builder); - staticpro_nodump (&Vcommand_builder_free_list); -#endif /* not NEW_GC */ the_low_level_timeout_blocktype = Blocktype_new (struct low_level_timeout_blocktype); something_happened = 0; @@ -5276,7 +5277,7 @@ inhibit_input_event_recording = 0; Vkeyboard_translate_table = - make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, Qequal); DEFVAR_BOOL ("try-alternate-layouts-for-commands", &try_alternate_layouts_for_commands /* @@ -5374,8 +5375,8 @@ ;(let ((inhibit-quit t)) (setq x (list (read-char) quit-flag)))^J^G ;for BOTH, x should get set to (7 t), but no result should be printed. ;; #### According to the doc of quit-flag, second test should return -;; (?\^G nil). Accidentaly XEmacs returns correct value. However, -;; XEmacs 21.1.12 and 21.2.36 both fails on first test. +;; (?\^G nil). XEmacs accidentally returns the correct value. However, +;; XEmacs 21.1.12 and 21.2.36 both fail on the first test. ;also do this: make two frames, one viewing "*scratch*", the other "foo". ;in *scratch*, type (sit-for 20)^J diff -r 861f2601a38b -r 1f0b15040456 src/event-tty.c --- a/src/event-tty.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/event-tty.c Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/event-unixoid.c --- a/src/event-unixoid.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/event-unixoid.c Sun May 01 18:44:03 2011 +0100 @@ -7,10 +7,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -18,9 +18,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/event-xlike-inc.c --- a/src/event-xlike-inc.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/event-xlike-inc.c Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/events.c --- a/src/events.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/events.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* Events: printing them, converting them to and from characters. Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 2001, 2002, 2005 Ben Wing. + Copyright (C) 2001, 2002, 2005, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -41,18 +39,6 @@ #include "console-tty-impl.h" /* for stuff in character_to_event */ -#ifdef HAVE_TTY -#define USED_IF_TTY(decl) decl -#else -#define USED_IF_TTY(decl) UNUSED (decl) -#endif - -#ifdef HAVE_TOOLBARS -#define USED_IF_TOOLBARS(decl) decl -#else -#define USED_IF_TOOLBARS(decl) UNUSED (decl) -#endif - /* Where old events go when they are explicitly deallocated. The event chain here is cut loose before GC, so these will be freed eventually. @@ -74,7 +60,7 @@ /* definition of event object */ /************************************************************************/ -/* #### Ad-hoc hack. Should be part of define_lrecord_implementation */ +/* #### Ad-hoc hack. Should be an object method. */ void clear_event_resource (void) { @@ -86,14 +72,10 @@ deinitialize_event (Lisp_Object ev) { Lisp_Event *event = XEVENT (ev); - int i; - /* Preserve the old UID for this event, for tracking it */ - unsigned int old_uid = event->lheader.uid; - for (i = 0; i < (int) (sizeof (Lisp_Event) / sizeof (int)); i++) - ((int *) event) [i] = 0xdeadbeef; /* -559038737 base 10 */ - set_lheader_implementation (&event->lheader, &lrecord_event); - event->lheader.uid = old_uid; + deadbeef_memory ((Rawbyte *) event + sizeof (event->lheader), + sizeof (*event) - sizeof (event->lheader)); + set_event_type (event, dead_event); SET_EVENT_CHANNEL (event, Qnil); XSET_EVENT_NEXT (ev, Qnil); @@ -103,12 +85,7 @@ void zero_event (Lisp_Event *e) { - /* Preserve the old UID for this event, for tracking it */ - unsigned int old_uid = e->lheader.uid; - - xzero (*e); - set_lheader_implementation (&e->lheader, &lrecord_event); - e->lheader.uid = old_uid; + zero_nonsized_lisp_object (wrap_event (e)); set_event_type (e, empty_event); SET_EVENT_CHANNEL (e, Qnil); SET_EVENT_NEXT (e, Qnil); @@ -224,59 +201,50 @@ #ifdef EVENT_DATA_AS_OBJECTS -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("key-data", key_data, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - key_data_description, - Lisp_Key_Data); +DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("key-data", key_data, + 0, internal_object_printer, 0, 0, 0, + key_data_description, + Lisp_Key_Data); -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("button-data", button_data, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - button_data_description, - Lisp_Button_Data); +DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("button-data", button_data, + 0, internal_object_printer, 0, 0, 0, + button_data_description, + Lisp_Button_Data); -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("motion-data", motion_data, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - motion_data_description, - Lisp_Motion_Data); +DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("motion-data", motion_data, + 0, internal_object_printer, 0, 0, 0, + motion_data_description, + Lisp_Motion_Data); -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("process-data", process_data, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - process_data_description, - Lisp_Process_Data); +DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("process-data", process_data, + 0, internal_object_printer, 0, 0, 0, + process_data_description, + Lisp_Process_Data); -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("timeout-data", timeout_data, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - timeout_data_description, - Lisp_Timeout_Data); +DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("timeout-data", timeout_data, + 0, internal_object_printer, 0, 0, 0, + timeout_data_description, + Lisp_Timeout_Data); -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("eval-data", eval_data, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - eval_data_description, - Lisp_Eval_Data); +DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("eval-data", eval_data, + 0, internal_object_printer, 0, 0, 0, + eval_data_description, + Lisp_Eval_Data); -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("misc-user-data", misc_user_data, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - misc_user_data_description, - Lisp_Misc_User_Data); +DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("misc-user-data", misc_user_data, + 0, internal_object_printer, 0, 0, 0, + misc_user_data_description, + Lisp_Misc_User_Data); -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("magic-eval-data", magic_eval_data, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - magic_eval_data_description, - Lisp_Magic_Eval_Data); +DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("magic-eval-data", magic_eval_data, + 0, internal_object_printer, 0, 0, 0, + magic_eval_data_description, + Lisp_Magic_Eval_Data); -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("magic-data", magic_data, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - magic_data_description, - Lisp_Magic_Data); +DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("magic-data", magic_data, + 0, internal_object_printer, 0, 0, 0, + magic_data_description, + Lisp_Magic_Data); #endif /* EVENT_DATA_AS_OBJECTS */ @@ -334,7 +302,7 @@ int UNUSED (escapeflag)) { if (print_readably) - printing_unreadable_object ("#"); + printing_unreadable_object_fmt ("#", LISP_OBJECT_UID (obj)); switch (XEVENT (obj)->event_type) { @@ -392,7 +360,7 @@ write_ascstring (printcharfun, "#"); + write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); } static int @@ -463,7 +431,7 @@ } static Hashcode -event_hash (Lisp_Object obj, int depth) +event_hash (Lisp_Object obj, int depth, Boolint UNUSED (equalp)) { Lisp_Event *e = XEVENT (obj); Hashcode hash; @@ -476,8 +444,8 @@ case timeout_event: return HASH3 (hash, - internal_hash (EVENT_TIMEOUT_FUNCTION (e), depth + 1), - internal_hash (EVENT_TIMEOUT_OBJECT (e), depth + 1)); + internal_hash (EVENT_TIMEOUT_FUNCTION (e), depth + 1, 0), + internal_hash (EVENT_TIMEOUT_OBJECT (e), depth + 1, 0)); case key_press_event: return HASH3 (hash, LISP_HASH (EVENT_KEY_KEYSYM (e)), @@ -492,18 +460,18 @@ case misc_user_event: return HASH5 (hash, - internal_hash (EVENT_MISC_USER_FUNCTION (e), depth + 1), - internal_hash (EVENT_MISC_USER_OBJECT (e), depth + 1), + internal_hash (EVENT_MISC_USER_FUNCTION (e), depth + 1, 0), + internal_hash (EVENT_MISC_USER_OBJECT (e), depth + 1, 0), EVENT_MISC_USER_BUTTON (e), EVENT_MISC_USER_MODIFIERS (e)); case eval_event: - return HASH3 (hash, internal_hash (EVENT_EVAL_FUNCTION (e), depth + 1), - internal_hash (EVENT_EVAL_OBJECT (e), depth + 1)); + return HASH3 (hash, internal_hash (EVENT_EVAL_FUNCTION (e), depth + 1, 0), + internal_hash (EVENT_EVAL_OBJECT (e), depth + 1, 0)); case magic_eval_event: return HASH3 (hash, (Hashcode) EVENT_MAGIC_EVAL_INTERNAL_FUNCTION (e), - internal_hash (EVENT_MAGIC_EVAL_OBJECT (e), depth + 1)); + internal_hash (EVENT_MAGIC_EVAL_OBJECT (e), depth + 1, 0)); case magic_event: return HASH2 (hash, event_stream_hash_magic_event (e)); @@ -519,11 +487,11 @@ return 0; /* unreached */ } -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("event", event, - 0, /*dumpable-flag*/ - mark_event, print_event, 0, event_equal, - event_hash, event_description, - Lisp_Event); +DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("event", event, + mark_event, print_event, 0, + event_equal, event_hash, + event_description, + Lisp_Event); DEFUN ("make-event", Fmake_event, 0, 2, 0, /* Return a new event of type TYPE, with properties described by PLIST. @@ -671,8 +639,7 @@ } else if (EQ (keyword, Qbutton)) { - CHECK_NATNUM (value); - check_int_range (XINT (value), 0, 7); + check_integer_range (value, Qzero, make_int (26)); switch (EVENT_TYPE (e)) { @@ -767,8 +734,23 @@ } else if (EQ (keyword, Qtimestamp)) { - CHECK_NATNUM (value); - SET_EVENT_TIMESTAMP (e, XINT (value)); +#ifdef HAVE_BIGNUM + check_integer_range (value, Qzero, make_integer (UINT_MAX)); + if (BIGNUMP (value)) + { + SET_EVENT_TIMESTAMP (e, bignum_to_uint (XBIGNUM_DATA (value))); + } +#else + check_integer_range (value, Qzero, make_integer (EMACS_INT_MAX)); +#endif + if (INTP (value)) + { + SET_EVENT_TIMESTAMP (e, XINT (value)); + } + else + { + ABORT (); + } } else if (EQ (keyword, Qfunction)) { @@ -889,21 +871,18 @@ { int i, len; - if (EQ (event, Vlast_command_event) || - EQ (event, Vlast_input_event) || - EQ (event, Vunread_command_event)) - ABORT (); + assert (!(EQ (event, Vlast_command_event) || + EQ (event, Vlast_input_event) || + EQ (event, Vunread_command_event))); len = XVECTOR_LENGTH (Vthis_command_keys); for (i = 0; i < len; i++) - if (EQ (event, XVECTOR_DATA (Vthis_command_keys) [i])) - ABORT (); + assert (!EQ (event, XVECTOR_DATA (Vthis_command_keys) [i])); if (!NILP (Vrecent_keys_ring)) { int recent_ring_len = XVECTOR_LENGTH (Vrecent_keys_ring); for (i = 0; i < recent_ring_len; i++) - if (EQ (event, XVECTOR_DATA (Vrecent_keys_ring) [i])) - ABORT (); + assert (!EQ (event, XVECTOR_DATA (Vrecent_keys_ring) [i])); } } #endif /* 0 */ @@ -1780,7 +1759,9 @@ { CHECK_LIVE_EVENT (event); /* This junk is so that timestamps don't get to be negative, but contain - as many bits as this particular emacs will allow. + as many bits as this particular emacs will allow. We could return + bignums on builds that support them, but that involves consing and + doesn't work on builds that don't support bignums. */ return make_int (EMACS_INT_MAX & XEVENT_TIMESTAMP (event)); } @@ -1796,8 +1777,9 @@ { EMACS_INT t1, t2; - CHECK_NATNUM (time1); - CHECK_NATNUM (time2); + check_integer_range (time1, Qzero, make_integer (EMACS_INT_MAX)); + check_integer_range (time2, Qzero, make_integer (EMACS_INT_MAX)); + t1 = XINT (time1); t2 = XINT (time2); @@ -2149,14 +2131,13 @@ pointer points to random memory, often filled with 0, sometimes not. */ /* #### Chuck, do we still need this crap? */ - if (!NILP (ret_obj1) && !(GLYPHP (ret_obj1) #ifdef HAVE_TOOLBARS - || TOOLBAR_BUTTONP (ret_obj1) + assert (NILP (ret_obj1) || GLYPHP (ret_obj1) + || TOOLBAR_BUTTONP (ret_obj1)); +#else + assert (NILP (ret_obj1) || GLYPHP (ret_obj1)); #endif - )) - ABORT (); - if (!NILP (ret_obj2) && !(EXTENTP (ret_obj2) || CONSP (ret_obj2))) - ABORT (); + assert (NILP (ret_obj2) || EXTENTP (ret_obj2) || CONSP (ret_obj2)); if (char_x) *char_x = ret_x; @@ -2572,17 +2553,17 @@ void syms_of_events (void) { - INIT_LRECORD_IMPLEMENTATION (event); + INIT_LISP_OBJECT (event); #ifdef EVENT_DATA_AS_OBJECTS - INIT_LRECORD_IMPLEMENTATION (key_data); - INIT_LRECORD_IMPLEMENTATION (button_data); - INIT_LRECORD_IMPLEMENTATION (motion_data); - INIT_LRECORD_IMPLEMENTATION (process_data); - INIT_LRECORD_IMPLEMENTATION (timeout_data); - INIT_LRECORD_IMPLEMENTATION (eval_data); - INIT_LRECORD_IMPLEMENTATION (misc_user_data); - INIT_LRECORD_IMPLEMENTATION (magic_eval_data); - INIT_LRECORD_IMPLEMENTATION (magic_data); + INIT_LISP_OBJECT (key_data); + INIT_LISP_OBJECT (button_data); + INIT_LISP_OBJECT (motion_data); + INIT_LISP_OBJECT (process_data); + INIT_LISP_OBJECT (timeout_data); + INIT_LISP_OBJECT (eval_data); + INIT_LISP_OBJECT (misc_user_data); + INIT_LISP_OBJECT (magic_eval_data); + INIT_LISP_OBJECT (magic_data); #endif /* EVENT_DATA_AS_OBJECTS */ DEFSUBR (Fcharacter_to_event); @@ -2655,7 +2636,7 @@ { Vevent_resource = Qnil; #ifdef NEW_GC - staticpro (&Vevent_resource); + staticpro_nodump (&Vevent_resource); #endif /* NEW_GC */ } diff -r 861f2601a38b -r 1f0b15040456 src/events.h --- a/src/events.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/events.h Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -123,7 +121,7 @@ struct Lisp_Key_Data { #ifdef EVENT_DATA_AS_OBJECTS - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; #endif /* EVENT_DATA_AS_OBJECTS */ /* What keysym this is; a character or a symbol. */ Lisp_Object keysym; @@ -186,7 +184,7 @@ #define SET_KEY_DATA_MODIFIERS(d, m) ((d)->modifiers = m) #ifdef EVENT_DATA_AS_OBJECTS -DECLARE_LRECORD (key_data, Lisp_Key_Data); +DECLARE_LISP_OBJECT (key_data, Lisp_Key_Data); #define XKEY_DATA(x) XRECORD (x, key_data, Lisp_Key_Data) #define wrap_key_data(p) wrap_record (p, key_data) #define KEY_DATAP(x) RECORDP (x, key_data) @@ -219,7 +217,7 @@ struct Lisp_Button_Data { #ifdef EVENT_DATA_AS_OBJECTS - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; #endif /* EVENT_DATA_AS_OBJECTS */ /* What button went down or up. */ int button; @@ -232,7 +230,7 @@ typedef struct Lisp_Button_Data Lisp_Button_Data; #ifdef EVENT_DATA_AS_OBJECTS -DECLARE_LRECORD (button_data, Lisp_Button_Data); +DECLARE_LISP_OBJECT (button_data, Lisp_Button_Data); #define XBUTTON_DATA(x) XRECORD (x, button_data, Lisp_Button_Data) #define wrap_button_data(p) wrap_record (p, button_data) #define BUTTON_DATAP(x) RECORDP (x, button_data) @@ -271,7 +269,7 @@ struct Lisp_Motion_Data { #ifdef EVENT_DATA_AS_OBJECTS - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; #endif /* EVENT_DATA_AS_OBJECTS */ /* Where it was after it moved (in pixels). */ int x, y; @@ -281,7 +279,7 @@ typedef struct Lisp_Motion_Data Lisp_Motion_Data; #ifdef EVENT_DATA_AS_OBJECTS -DECLARE_LRECORD (motion_data, Lisp_Motion_Data); +DECLARE_LISP_OBJECT (motion_data, Lisp_Motion_Data); #define XMOTION_DATA(x) XRECORD (x, motion_data, Lisp_Motion_Data) #define wrap_motion_data(p) wrap_record (p, motion_data) #define MOTION_DATAP(x) RECORDP (x, motion_data) @@ -313,7 +311,7 @@ struct Lisp_Process_Data { #ifdef EVENT_DATA_AS_OBJECTS - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; #endif /* EVENT_DATA_AS_OBJECTS */ /* the XEmacs "process" object in question */ Lisp_Object process; @@ -321,7 +319,7 @@ typedef struct Lisp_Process_Data Lisp_Process_Data; #ifdef EVENT_DATA_AS_OBJECTS -DECLARE_LRECORD (process_data, Lisp_Process_Data); +DECLARE_LISP_OBJECT (process_data, Lisp_Process_Data); #define XPROCESS_DATA(x) XRECORD (x, process_data, Lisp_Process_Data) #define wrap_process_data(p) wrap_record (p, process_data) #define PROCESS_DATAP(x) RECORDP (x, process_data) @@ -352,7 +350,7 @@ object The object passed to that function. */ #ifdef EVENT_DATA_AS_OBJECTS - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; #endif /* EVENT_DATA_AS_OBJECTS */ int interval_id; int id_number; @@ -362,7 +360,7 @@ typedef struct Lisp_Timeout_Data Lisp_Timeout_Data; #ifdef EVENT_DATA_AS_OBJECTS -DECLARE_LRECORD (timeout_data, Lisp_Timeout_Data); +DECLARE_LISP_OBJECT (timeout_data, Lisp_Timeout_Data); #define XTIMEOUT_DATA(x) XRECORD (x, timeout_data, Lisp_Timeout_Data) #define wrap_timeout_data(p) wrap_record(p, timeout_data) #define TIMEOUT_DATAP(x) RECORDP (x, timeout_data) @@ -411,7 +409,7 @@ object Argument of function. */ #ifdef EVENT_DATA_AS_OBJECTS - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; #endif /* EVENT_DATA_AS_OBJECTS */ Lisp_Object function; Lisp_Object object; @@ -419,7 +417,7 @@ typedef struct Lisp_Eval_Data Lisp_Eval_Data; #ifdef EVENT_DATA_AS_OBJECTS -DECLARE_LRECORD (eval_data, Lisp_Eval_Data); +DECLARE_LISP_OBJECT (eval_data, Lisp_Eval_Data); #define XEVAL_DATA(x) XRECORD (x, eval_data, Lisp_Eval_Data) #define wrap_eval_data(p) wrap_record(p, eval_data) #define EVAL_DATAP(x) RECORDP (x, eval_data) @@ -464,7 +462,7 @@ values for other types of misc_user_events. */ #ifdef EVENT_DATA_AS_OBJECTS - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; #endif /* EVENT_DATA_AS_OBJECTS */ Lisp_Object function; Lisp_Object object; @@ -475,7 +473,7 @@ typedef struct Lisp_Misc_User_Data Lisp_Misc_User_Data; #ifdef EVENT_DATA_AS_OBJECTS -DECLARE_LRECORD (misc_user_data, Lisp_Misc_User_Data); +DECLARE_LISP_OBJECT (misc_user_data, Lisp_Misc_User_Data); #define XMISC_USER_DATA(x) XRECORD (x, misc_user_data, Lisp_Misc_User_Data) #define wrap_misc_user_data(p) wrap_record(p, misc_user_data) #define MISC_USER_DATAP(x) RECORDP (x, misc_user_data) @@ -541,7 +539,7 @@ */ #ifdef EVENT_DATA_AS_OBJECTS - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; #endif /* EVENT_DATA_AS_OBJECTS */ void (*internal_function) (Lisp_Object); Lisp_Object object; @@ -549,7 +547,7 @@ typedef struct Lisp_Magic_Eval_Data Lisp_Magic_Eval_Data; #ifdef EVENT_DATA_AS_OBJECTS -DECLARE_LRECORD (magic_eval_data, Lisp_Magic_Eval_Data); +DECLARE_LISP_OBJECT (magic_eval_data, Lisp_Magic_Eval_Data); #define XMAGIC_EVAL_DATA(x) XRECORD (x, magic_eval_data, Lisp_Magic_Eval_Data) #define wrap_magic_eval_data(p) wrap_record(p, magic_eval_data) #define MAGIC_EVAL_DATAP(x) RECORDP (x, magic_eval_data) @@ -597,7 +595,7 @@ */ #ifdef EVENT_DATA_AS_OBJECTS - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; #endif /* EVENT_DATA_AS_OBJECTS */ union { @@ -616,7 +614,7 @@ typedef struct Lisp_Magic_Data Lisp_Magic_Data; #ifdef EVENT_DATA_AS_OBJECTS -DECLARE_LRECORD (magic_data, Lisp_Magic_Data); +DECLARE_LISP_OBJECT (magic_data, Lisp_Magic_Data); #define XMAGIC_DATA(x) XRECORD (x, magic_data, Lisp_Magic_Data) #define wrap_magic_data(p) wrap_record(p, magic_data) #define MAGIC_DATAP(x) RECORDP (x, magic_data) @@ -660,7 +658,7 @@ struct Lisp_Timeout { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; int id; /* Id we use to identify the timeout over its lifetime */ int interval_id; /* Id for this particular interval; this may be different each time the timeout is @@ -675,7 +673,7 @@ }; typedef struct Lisp_Timeout Lisp_Timeout; -DECLARE_LRECORD (timeout, Lisp_Timeout); +DECLARE_LISP_OBJECT (timeout, Lisp_Timeout); #define XTIMEOUT(x) XRECORD (x, timeout, Lisp_Timeout) #define wrap_timeout(p) wrap_record (p, timeout) #define TIMEOUTP(x) RECORDP (x, timeout) @@ -690,7 +688,7 @@ - Likewise for events chained in the command builder. - Otherwise it's Qnil. */ - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; Lisp_Object next; emacs_event_type event_type; @@ -747,14 +745,14 @@ #endif /* not EVENT_DATA_AS_OBJECTS */ }; -DECLARE_LRECORD (event, Lisp_Event); +DECLARE_LISP_OBJECT (event, Lisp_Event); #define XEVENT(x) XRECORD (x, event, Lisp_Event) #define wrap_event(p) wrap_record (p, event) #define EVENTP(x) RECORDP (x, event) #define CHECK_EVENT(x) CHECK_RECORD (x, event) #define CONCHECK_EVENT(x) CONCHECK_RECORD (x, event) -DECLARE_LRECORD (command_builder, struct command_builder); +DECLARE_LISP_OBJECT (command_builder, struct command_builder); #define EVENT_CHANNEL(a) ((a)->channel) #define XEVENT_CHANNEL(ev) (XEVENT (ev)->channel) @@ -1117,7 +1115,7 @@ */ struct command_builder { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; Lisp_Object console; /* back pointer to the console this command builder is for */ #if 0 @@ -1159,7 +1157,7 @@ boundary: up to 20 consecutive self-inserts can happen before an undo- boundary is pushed. This variable is that counter. */ - int self_insert_countdown; + Elemcount self_insert_countdown; }; #endif /* INCLUDED_events_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/extents-impl.h --- a/src/extents-impl.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/extents-impl.h Sun May 01 18:44:03 2011 +0100 @@ -1,12 +1,12 @@ /* Copyright (c) 1994, 1995 Free Software Foundation. - Copyright (c) 1995, 1996, 2002 Ben Wing. + Copyright (c) 1995, 1996, 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -27,7 +25,7 @@ struct extent { - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; Memxpos start; Memxpos end; @@ -101,35 +99,42 @@ have this structure around and thus the size of an extent is smaller. */ typedef struct extent_auxiliary extent_auxiliary; + +#define EXTENT_AUXILIARY_SLOTS \ + SLOT (begin_glyph) \ + SLOT (end_glyph) \ + SLOT (parent) \ + /* We use a weak list here. Originally I didn't do this and \ + depended on having the extent's finalization method remove \ + itself from its parent's children list. This runs into \ + lots and lots of problems though because everything is in \ + a really really bizarre state when an extent's finalization \ + method is called (it happens in sweep_extents() by way of \ + ADDITIONAL_FREE_extent()) and it's extremely difficult to \ + avoid getting hosed by just-freed objects. */ \ + SLOT (children) \ + SLOT (invisible) \ + SLOT (read_only) \ + SLOT (mouse_face) \ + SLOT (initial_redisplay_function) \ + SLOT (before_change_functions) \ + SLOT (after_change_functions) + + struct extent_auxiliary { - struct LCRECORD_HEADER header; - - Lisp_Object begin_glyph; - Lisp_Object end_glyph; - Lisp_Object parent; - /* We use a weak list here. Originally I didn't do this and - depended on having the extent's finalization method remove - itself from its parent's children list. This runs into - lots and lots of problems though because everything is in - a really really bizarre state when an extent's finalization - method is called (it happens in sweep_extents() by way of - ADDITIONAL_FREE_extent()) and it's extremely difficult to - avoid getting hosed by just-freed objects. */ - Lisp_Object children; - Lisp_Object invisible; - Lisp_Object read_only; - Lisp_Object mouse_face; - Lisp_Object initial_redisplay_function; - Lisp_Object before_change_functions, after_change_functions; + NORMAL_LISP_OBJECT_HEADER header; +#define SLOT(x) Lisp_Object x; + EXTENT_AUXILIARY_SLOTS +#undef SLOT int priority; }; -extern struct extent_auxiliary extent_auxiliary_defaults; +extern Lisp_Object Vextent_auxiliary_defaults; struct extent_info { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; struct extent_list *extents; struct stack_of_extents *soe; @@ -153,7 +158,7 @@ { return e->flags.has_aux ? XEXTENT_AUXILIARY (XCAR (e->plist)) : - & extent_auxiliary_defaults; + XEXTENT_AUXILIARY (Vextent_auxiliary_defaults); } #define extent_no_chase_aux_field(e, field) (extent_aux_or_default(e)->field) @@ -167,8 +172,8 @@ #define set_extent_no_chase_aux_field(e, field, value) do { \ EXTENT sencaf_e = (e); \ if (! sencaf_e->flags.has_aux) \ - allocate_extent_auxiliary (sencaf_e); \ - XEXTENT_AUXILIARY (XCAR (sencaf_e->plist))->field = (value);\ + attach_extent_auxiliary (sencaf_e); \ + XEXTENT_AUXILIARY (XCAR (sencaf_e->plist))->field = (value); \ } while (0) #define set_extent_no_chase_normal_field(e, field, value) \ diff -r 861f2601a38b -r 1f0b15040456 src/extents.c --- a/src/extents.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/extents.c Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,13 @@ /* Copyright (c) 1994, 1995 Free Software Foundation, Inc. Copyright (c) 1995 Sun Microsystems, Inc. - Copyright (c) 1995, 1996, 2000, 2002, 2003, 2004, 2005 Ben Wing. + Copyright (c) 1995, 1996, 2000, 2002, 2003, 2004, 2005, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -231,95 +229,13 @@ #include "gutter.h" /* ------------------------------- */ -/* gap array */ -/* ------------------------------- */ - -/* Note that this object is not extent-specific and should perhaps be - moved into another file. */ - -/* Holds a marker that moves as elements in the array are inserted and - deleted, similar to standard markers. */ - -typedef struct gap_array_marker -{ -#ifdef NEW_GC - struct lrecord_header header; -#endif /* NEW_GC */ - int pos; - struct gap_array_marker *next; -} Gap_Array_Marker; - - -/* Holds a "gap array", which is an array of elements with a gap located - in it. Insertions and deletions with a high degree of locality - are very fast, essentially in constant time. Array positions as - used and returned in the gap array functions are independent of - the gap. */ - -/* Layout of gap array: - - <------ gap ------><---- gapsize ----><----- numels - gap ----> - <---------------------- numels + gapsize ---------------------> - - For marking purposes, we use two extra variables computed from - the others -- the offset to the data past the gap, plus the number - of elements in that data: - - offset_past_gap = elsize * (gap + gapsize) - els_past_gap = numels - gap -*/ - - -typedef struct gap_array -{ -#ifdef NEW_GC - struct lrecord_header header; -#endif /* NEW_GC */ - Elemcount gap; - Elemcount gapsize; - Elemcount numels; - Bytecount elsize; - /* Redundant numbers computed from the others, for marking purposes */ - Bytecount offset_past_gap; - Elemcount els_past_gap; - Gap_Array_Marker *markers; - /* this is a stretchy array */ - char array[1]; -} Gap_Array; - -#ifndef NEW_GC -static Gap_Array_Marker *gap_array_marker_freelist; -#endif /* not NEW_GC */ - -/* Convert a "memory position" (i.e. taking the gap into account) into - the address of the element at (i.e. after) that position. "Memory - positions" are only used internally and are of type Memxpos. - "Array positions" are used externally and are of type int. */ -#define GAP_ARRAY_MEMEL_ADDR(ga, memel) ((ga)->array + (ga)->elsize*(memel)) - -/* Number of elements currently in a gap array */ -#define GAP_ARRAY_NUM_ELS(ga) ((ga)->numels) - -#define GAP_ARRAY_ARRAY_TO_MEMORY_POS(ga, pos) \ - ((pos) <= (ga)->gap ? (pos) : (pos) + (ga)->gapsize) - -#define GAP_ARRAY_MEMORY_TO_ARRAY_POS(ga, pos) \ - ((pos) <= (ga)->gap ? (pos) : (pos) - (ga)->gapsize) - -/* Convert an array position into the address of the element at - (i.e. after) that position. */ -#define GAP_ARRAY_EL_ADDR(ga, pos) ((pos) < (ga)->gap ? \ - GAP_ARRAY_MEMEL_ADDR(ga, pos) : \ - GAP_ARRAY_MEMEL_ADDR(ga, (pos) + (ga)->gapsize)) - -/* ------------------------------- */ /* extent list */ /* ------------------------------- */ typedef struct extent_list_marker { #ifdef NEW_GC - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; #endif /* NEW_GC */ Gap_Array_Marker *m; int endp; @@ -329,7 +245,7 @@ typedef struct extent_list { #ifdef NEW_GC - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; #endif /* NEW_GC */ Gap_Array *start; Gap_Array *end; @@ -379,13 +295,7 @@ #define EXTENT_E_LESS_EQUAL(e1,e2) \ EXTENT_E_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2)) -#define EXTENT_GAP_ARRAY_AT(ga, pos) (* (EXTENT *) GAP_ARRAY_EL_ADDR(ga, pos)) - -/* ------------------------------- */ -/* auxiliary extent structure */ -/* ------------------------------- */ - -struct extent_auxiliary extent_auxiliary_defaults; +#define EXTENT_GAP_ARRAY_AT(ga, pos) gap_array_at (ga, pos, EXTENT) /* ------------------------------- */ /* buffer-extent primitives */ @@ -394,7 +304,7 @@ typedef struct stack_of_extents { #ifdef NEW_GC - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; #endif /* NEW_GC */ Extent_List *extents; Memxpos pos; /* Position of stack of extents. EXTENTS is the list of @@ -442,6 +352,8 @@ Lisp_Object Vlast_highlighted_extent; +Lisp_Object Vextent_auxiliary_defaults; + Lisp_Object QSin_map_extents_internal; Fixnum mouse_highlight_priority; @@ -510,269 +422,7 @@ changes */ int in_modeline_generation; - -/************************************************************************/ -/* Generalized gap array */ -/************************************************************************/ - -/* This generalizes the "array with a gap" model used to store buffer - characters. This is based on the stuff in insdel.c and should - probably be merged with it. This is not extent-specific and should - perhaps be moved into a separate file. */ - -/* ------------------------------- */ -/* internal functions */ -/* ------------------------------- */ - -/* Adjust the gap array markers in the range (FROM, TO]. Parallel to - adjust_markers() in insdel.c. */ - -static void -gap_array_adjust_markers (Gap_Array *ga, Memxpos from, - Memxpos to, Elemcount amount) -{ - Gap_Array_Marker *m; - - for (m = ga->markers; m; m = m->next) - m->pos = do_marker_adjustment (m->pos, from, to, amount); -} - -static void -gap_array_recompute_derived_values (Gap_Array *ga) -{ - ga->offset_past_gap = ga->elsize * (ga->gap + ga->gapsize); - ga->els_past_gap = ga->numels - ga->gap; -} - -/* Move the gap to array position POS. Parallel to move_gap() in - insdel.c but somewhat simplified. */ - -static void -gap_array_move_gap (Gap_Array *ga, Elemcount pos) -{ - Elemcount gap = ga->gap; - Elemcount gapsize = ga->gapsize; - - if (pos < gap) - { - memmove (GAP_ARRAY_MEMEL_ADDR (ga, pos + gapsize), - GAP_ARRAY_MEMEL_ADDR (ga, pos), - (gap - pos)*ga->elsize); - gap_array_adjust_markers (ga, (Memxpos) pos, (Memxpos) gap, - gapsize); - } - else if (pos > gap) - { - memmove (GAP_ARRAY_MEMEL_ADDR (ga, gap), - GAP_ARRAY_MEMEL_ADDR (ga, gap + gapsize), - (pos - gap)*ga->elsize); - gap_array_adjust_markers (ga, (Memxpos) (gap + gapsize), - (Memxpos) (pos + gapsize), - gapsize); - } - ga->gap = pos; - - gap_array_recompute_derived_values (ga); -} - -/* Make the gap INCREMENT characters longer. Parallel to make_gap() in - insdel.c. The gap array may be moved, so assign the return value back - to the array pointer. */ - -static Gap_Array * -gap_array_make_gap (Gap_Array *ga, Elemcount increment) -{ - Elemcount real_gap_loc; - Elemcount old_gap_size; - - /* If we have to get more space, get enough to last a while. We use - a geometric progression that saves on realloc space. */ - increment += 100 + ga->numels / 8; - -#ifdef NEW_GC - ga = (Gap_Array *) mc_realloc (ga, - offsetof (Gap_Array, array) + - (ga->numels + ga->gapsize + increment) * - ga->elsize); -#else /* not NEW_GC */ - ga = (Gap_Array *) xrealloc (ga, - offsetof (Gap_Array, array) + - (ga->numels + ga->gapsize + increment) * - ga->elsize); -#endif /* not NEW_GC */ - if (ga == 0) - memory_full (); - - real_gap_loc = ga->gap; - old_gap_size = ga->gapsize; - - /* Call the newly allocated space a gap at the end of the whole space. */ - ga->gap = ga->numels + ga->gapsize; - ga->gapsize = increment; - - /* Move the new gap down to be consecutive with the end of the old one. - This adjusts the markers properly too. */ - gap_array_move_gap (ga, real_gap_loc + old_gap_size); - - /* Now combine the two into one large gap. */ - ga->gapsize += old_gap_size; - ga->gap = real_gap_loc; - - gap_array_recompute_derived_values (ga); - - return ga; -} - -/* ------------------------------- */ -/* external functions */ -/* ------------------------------- */ - -/* Insert NUMELS elements (pointed to by ELPTR) into the specified - gap array at POS. The gap array may be moved, so assign the - return value back to the array pointer. */ - -static Gap_Array * -gap_array_insert_els (Gap_Array *ga, Elemcount pos, void *elptr, - Elemcount numels) -{ - assert (pos >= 0 && pos <= ga->numels); - if (ga->gapsize < numels) - ga = gap_array_make_gap (ga, numels - ga->gapsize); - if (pos != ga->gap) - gap_array_move_gap (ga, pos); - - memcpy (GAP_ARRAY_MEMEL_ADDR (ga, ga->gap), (char *) elptr, - numels*ga->elsize); - ga->gapsize -= numels; - ga->gap += numels; - ga->numels += numels; - gap_array_recompute_derived_values (ga); - /* This is the equivalent of insert-before-markers. - - #### Should only happen if marker is "moves forward at insert" type. - */ - - gap_array_adjust_markers (ga, pos - 1, pos, numels); - return ga; -} - -/* Delete NUMELS elements from the specified gap array, starting at FROM. */ - -static void -gap_array_delete_els (Gap_Array *ga, Elemcount from, Elemcount numdel) -{ - Elemcount to = from + numdel; - Elemcount gapsize = ga->gapsize; - - assert (from >= 0); - assert (numdel >= 0); - assert (to <= ga->numels); - - /* Make sure the gap is somewhere in or next to what we are deleting. */ - if (to < ga->gap) - gap_array_move_gap (ga, to); - if (from > ga->gap) - gap_array_move_gap (ga, from); - - /* Relocate all markers pointing into the new, larger gap - to point at the end of the text before the gap. */ - gap_array_adjust_markers (ga, to + gapsize, to + gapsize, - - numdel - gapsize); - - ga->gapsize += numdel; - ga->numels -= numdel; - ga->gap = from; - gap_array_recompute_derived_values (ga); -} - -static Gap_Array_Marker * -gap_array_make_marker (Gap_Array *ga, Elemcount pos) -{ - Gap_Array_Marker *m; - - assert (pos >= 0 && pos <= ga->numels); -#ifdef NEW_GC - m = alloc_lrecord_type (Gap_Array_Marker, &lrecord_gap_array_marker); -#else /* not NEW_GC */ - if (gap_array_marker_freelist) - { - m = gap_array_marker_freelist; - gap_array_marker_freelist = gap_array_marker_freelist->next; - } - else - m = xnew (Gap_Array_Marker); -#endif /* not NEW_GC */ - - m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos); - m->next = ga->markers; - ga->markers = m; - return m; -} - -static void -gap_array_delete_marker (Gap_Array *ga, Gap_Array_Marker *m) -{ - Gap_Array_Marker *p, *prev; - - for (prev = 0, p = ga->markers; p && p != m; prev = p, p = p->next) - ; - assert (p); - if (prev) - prev->next = p->next; - else - ga->markers = p->next; -#ifndef NEW_GC - m->next = gap_array_marker_freelist; - m->pos = 0xDEADBEEF; /* -559038737 base 10 */ - gap_array_marker_freelist = m; -#endif /* not NEW_GC */ -} - -#ifndef NEW_GC -static void -gap_array_delete_all_markers (Gap_Array *ga) -{ - Gap_Array_Marker *p, *next; - - for (p = ga->markers; p; p = next) - { - next = p->next; - p->next = gap_array_marker_freelist; - p->pos = 0xDEADBEEF; /* -559038737 as an int */ - gap_array_marker_freelist = p; - } -} -#endif /* not NEW_GC */ - -static void -gap_array_move_marker (Gap_Array *ga, Gap_Array_Marker *m, Elemcount pos) -{ - assert (pos >= 0 && pos <= ga->numels); - m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos); -} - -#define gap_array_marker_pos(ga, m) \ - GAP_ARRAY_MEMORY_TO_ARRAY_POS (ga, (m)->pos) - -static Gap_Array * -make_gap_array (Elemcount elsize) -{ -#ifdef NEW_GC - Gap_Array *ga = alloc_lrecord_type (Gap_Array, &lrecord_gap_array); -#else /* not NEW_GC */ - Gap_Array *ga = xnew_and_zero (Gap_Array); -#endif /* not NEW_GC */ - ga->elsize = elsize; - return ga; -} - -#ifndef NEW_GC -static void -free_gap_array (Gap_Array *ga) -{ - gap_array_delete_all_markers (ga); - xfree (ga); -} -#endif /* not NEW_GC */ +int debug_soe; /************************************************************************/ @@ -792,7 +442,7 @@ */ /* Number of elements in an extent list */ -#define extent_list_num_els(el) GAP_ARRAY_NUM_ELS (el->start) +#define extent_list_num_els(el) gap_array_length (el->start) /* Return the position at which EXTENT is located in the specified extent list (in the display order if ENDP is 0, in the e-order otherwise). @@ -806,7 +456,7 @@ extent_list_locate (Extent_List *el, EXTENT extent, int endp, int *foundp) { Gap_Array *ga = endp ? el->end : el->start; - int left = 0, right = GAP_ARRAY_NUM_ELS (ga); + int left = 0, right = gap_array_length (ga); int oldfoundpos, foundpos; int found; @@ -826,7 +476,7 @@ /* Now we're at the beginning of all equal extents. */ found = 0; oldfoundpos = foundpos = left; - while (foundpos < GAP_ARRAY_NUM_ELS (ga)) + while (foundpos < gap_array_length (ga)) { EXTENT e = EXTENT_GAP_ARRAY_AT (ga, foundpos); if (e == extent) @@ -881,7 +531,7 @@ { Gap_Array *ga = endp ? el->end : el->start; - assert (pos >= 0 && pos < GAP_ARRAY_NUM_ELS (ga)); + assert (pos >= 0 && pos < gap_array_length (ga)); return EXTENT_GAP_ARRAY_AT (ga, pos); } @@ -918,8 +568,8 @@ static void extent_list_delete_all (Extent_List *el) { - gap_array_delete_els (el->start, 0, GAP_ARRAY_NUM_ELS (el->start)); - gap_array_delete_els (el->end, 0, GAP_ARRAY_NUM_ELS (el->end)); + gap_array_delete_els (el->start, 0, gap_array_length (el->start)); + gap_array_delete_els (el->end, 0, gap_array_length (el->end)); } static Extent_List_Marker * @@ -928,7 +578,7 @@ Extent_List_Marker *m; #ifdef NEW_GC - m = alloc_lrecord_type (Extent_List_Marker, &lrecord_extent_list_marker); + m = XEXTENT_LIST_MARKER (ALLOC_NORMAL_LISP_OBJECT (extent_list_marker)); #else /* not NEW_GC */ if (extent_list_marker_freelist) { @@ -977,12 +627,12 @@ allocate_extent_list (void) { #ifdef NEW_GC - Extent_List *el = alloc_lrecord_type (Extent_List, &lrecord_extent_list); + Extent_List *el = XEXTENT_LIST (ALLOC_NORMAL_LISP_OBJECT (extent_list)); #else /* not NEW_GC */ Extent_List *el = xnew (Extent_List); #endif /* not NEW_GC */ - el->start = make_gap_array (sizeof (EXTENT)); - el->end = make_gap_array (sizeof (EXTENT)); + el->start = make_gap_array (sizeof (EXTENT), 1); + el->end = make_gap_array (sizeof (EXTENT), 1); el->markers = 0; return el; } @@ -1003,48 +653,49 @@ /************************************************************************/ static const struct memory_description extent_auxiliary_description[] ={ - { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, begin_glyph) }, - { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, end_glyph) }, - { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, parent) }, - { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, children) }, - { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, invisible) }, - { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, read_only) }, - { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, mouse_face) }, - { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, initial_redisplay_function) }, - { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, before_change_functions) }, - { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, after_change_functions) }, +#define SLOT(x) \ + { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, x) }, + EXTENT_AUXILIARY_SLOTS +#undef SLOT { XD_END } }; static Lisp_Object mark_extent_auxiliary (Lisp_Object obj) { struct extent_auxiliary *data = XEXTENT_AUXILIARY (obj); - mark_object (data->begin_glyph); - mark_object (data->end_glyph); - mark_object (data->invisible); - mark_object (data->children); - mark_object (data->read_only); - mark_object (data->mouse_face); - mark_object (data->initial_redisplay_function); - mark_object (data->before_change_functions); - mark_object (data->after_change_functions); - return data->parent; -} - -DEFINE_LRECORD_IMPLEMENTATION ("extent-auxiliary", extent_auxiliary, - 0, /*dumpable-flag*/ - mark_extent_auxiliary, internal_object_printer, - 0, 0, 0, extent_auxiliary_description, - struct extent_auxiliary); +#define SLOT(x) mark_object (data->x); + EXTENT_AUXILIARY_SLOTS +#undef SLOT + + return Qnil; +} + +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("extent-auxiliary", + extent_auxiliary, + mark_extent_auxiliary, + extent_auxiliary_description, + struct extent_auxiliary); + + +static Lisp_Object +allocate_extent_auxiliary (void) +{ + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (extent_auxiliary); + struct extent_auxiliary *data = XEXTENT_AUXILIARY (obj); + +#define SLOT(x) data->x = Qnil; + EXTENT_AUXILIARY_SLOTS +#undef SLOT + + return obj; +} + void -allocate_extent_auxiliary (EXTENT ext) -{ - Lisp_Object extent_aux; - struct extent_auxiliary *data = - ALLOC_LCRECORD_TYPE (struct extent_auxiliary, &lrecord_extent_auxiliary); - COPY_LCRECORD (data, &extent_auxiliary_defaults); - extent_aux = wrap_extent_auxiliary (data); - ext->plist = Fcons (extent_aux, ext->plist); +attach_extent_auxiliary (EXTENT ext) +{ + Lisp_Object obj = allocate_extent_auxiliary (); + + ext->plist = Fcons (obj, ext->plist); ext->flags.has_aux = 1; } @@ -1080,69 +731,7 @@ #endif /* not NEW_GC */ static void soe_invalidate (Lisp_Object obj); -extern const struct sized_memory_description gap_array_marker_description; - -static const struct memory_description gap_array_marker_description_1[] = { -#ifdef NEW_GC - { XD_LISP_OBJECT, offsetof (Gap_Array_Marker, next) }, -#else /* not NEW_GC */ - { XD_BLOCK_PTR, offsetof (Gap_Array_Marker, next), 1, - { &gap_array_marker_description } }, -#endif /* not NEW_GC */ - { XD_END } -}; - -#ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("gap-array-marker", gap_array_marker, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - gap_array_marker_description_1, - struct gap_array_marker); -#else /* not NEW_GC */ -const struct sized_memory_description gap_array_marker_description = { - sizeof (Gap_Array_Marker), - gap_array_marker_description_1 -}; -#endif /* not NEW_GC */ - -static const struct memory_description lispobj_gap_array_description_1[] = { - { XD_ELEMCOUNT, offsetof (Gap_Array, gap) }, - { XD_BYTECOUNT, offsetof (Gap_Array, offset_past_gap) }, - { XD_ELEMCOUNT, offsetof (Gap_Array, els_past_gap) }, -#ifdef NEW_GC - { XD_LISP_OBJECT, offsetof (Gap_Array, markers) }, -#else /* not NEW_GC */ - { XD_BLOCK_PTR, offsetof (Gap_Array, markers), 1, - { &gap_array_marker_description }, XD_FLAG_NO_KKCC }, -#endif /* not NEW_GC */ - { XD_BLOCK_ARRAY, offsetof (Gap_Array, array), XD_INDIRECT (0, 0), - { &lisp_object_description } }, - { XD_BLOCK_ARRAY, XD_INDIRECT (1, offsetof (Gap_Array, array)), - XD_INDIRECT (2, 0), { &lisp_object_description } }, - { XD_END } -}; - -#ifdef NEW_GC - -static Bytecount -size_gap_array (const void *lheader) -{ - Gap_Array *ga = (Gap_Array *) lheader; - return offsetof (Gap_Array, array) + (ga->numels + ga->gapsize) * ga->elsize; -} - -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("gap-array", gap_array, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - lispobj_gap_array_description_1, - size_gap_array, - struct gap_array); -#else /* not NEW_GC */ -static const struct sized_memory_description lispobj_gap_array_description = { - sizeof (Gap_Array), - lispobj_gap_array_description_1 -}; - +#ifndef NEW_GC extern const struct sized_memory_description extent_list_marker_description; #endif /* not NEW_GC */ @@ -1160,11 +749,10 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("extent-list-marker", extent_list_marker, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - extent_list_marker_description_1, - struct extent_list_marker); +DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("extent-list-marker", + extent_list_marker, + 0, extent_list_marker_description_1, + struct extent_list_marker); #else /* not NEW_GC */ const struct sized_memory_description extent_list_marker_description = { sizeof (Extent_List_Marker), @@ -1189,11 +777,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("extent-list", extent_list, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - extent_list_description_1, - struct extent_list); +DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("extent-list", extent_list, + 0, extent_list_description_1, + struct extent_list); #else /* not NEW_GC */ static const struct sized_memory_description extent_list_description = { sizeof (Extent_List), @@ -1212,11 +798,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("stack-of-extents", stack_of_extents, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - stack_of_extents_description_1, - struct stack_of_extents); +DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("stack-of-extents", stack_of_extents, + 0, stack_of_extents_description_1, + struct stack_of_extents); #else /* not NEW_GC */ static const struct sized_memory_description stack_of_extents_description = { sizeof (Stack_Of_Extents), @@ -1267,24 +851,13 @@ return Qnil; } -#ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info, - 0, /*dumpable-flag*/ - mark_extent_info, internal_object_printer, - 0, 0, 0, - extent_info_description, - struct extent_info); -#else /* not NEW_GC */ +#ifndef NEW_GC + static void -finalize_extent_info (void *header, int for_disksave) -{ - struct extent_info *data = (struct extent_info *) header; - - if (for_disksave) - return; - - data->soe = 0; - data->extents = 0; +finalize_extent_info (Lisp_Object obj) +{ + struct extent_info *data = XEXTENT_INFO (obj); + if (data->soe) { free_soe (data->soe); @@ -1297,25 +870,23 @@ } } -DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info, - 0, /*dumpable-flag*/ - mark_extent_info, internal_object_printer, - finalize_extent_info, 0, 0, - extent_info_description, - struct extent_info); #endif /* not NEW_GC */ + +DEFINE_NODUMP_LISP_OBJECT ("extent-info", extent_info, + mark_extent_info, internal_object_printer, + IF_OLD_GC (finalize_extent_info), 0, 0, + extent_info_description, + struct extent_info); static Lisp_Object allocate_extent_info (void) { - Lisp_Object extent_info; - struct extent_info *data = - ALLOC_LCRECORD_TYPE (struct extent_info, &lrecord_extent_info); - - extent_info = wrap_extent_info (data); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (extent_info); + struct extent_info *data = XEXTENT_INFO (obj); + data->extents = allocate_extent_list (); data->soe = 0; - return extent_info; + return obj; } void @@ -1472,15 +1043,11 @@ void uninit_buffer_extents (struct buffer *b) { -#ifndef NEW_GC - struct extent_info *data = XEXTENT_INFO (b->extent_info); -#endif /* not NEW_GC */ - /* Don't destroy the extents here -- there may still be children extents pointing to the extents. */ detach_all_extents (wrap_buffer (b)); #ifndef NEW_GC - finalize_extent_info (data, 0); + finalize_extent_info (b->extent_info); #endif /* not NEW_GC */ } @@ -1551,24 +1118,7 @@ return info->soe; } -/* #### don't even think of #define'ing this, the prototype of - print_extent_1 has changed! */ -/* #define SOE_DEBUG */ - -#ifdef SOE_DEBUG - -static void print_extent_1 (char *buf, Lisp_Object extent); - -static void -print_extent_2 (EXTENT e) -{ - Lisp_Object extent; - char buf[200]; - - extent = wrap_extent (e); - print_extent_1 (buf, extent); - fputs (buf, stdout); -} +#ifdef DEBUG_XEMACS static void soe_dump (Lisp_Object obj) @@ -1580,29 +1130,29 @@ if (!soe) { - printf ("No SOE"); + stderr_out ("No SOE"); return; } sel = soe->extents; - printf ("SOE pos is %d (memxpos %d)\n", - soe->pos < 0 ? soe->pos : - buffer_or_string_memxpos_to_bytexpos (obj, soe->pos), - soe->pos); + stderr_out ("SOE pos is %ld (memxpos %ld)\n", + soe->pos < 0 ? soe->pos : + buffer_or_string_memxpos_to_bytexpos (obj, soe->pos), + soe->pos); for (endp = 0; endp < 2; endp++) { - printf (endp ? "SOE end:" : "SOE start:"); + stderr_out (endp ? "SOE end:" : "SOE start:"); for (i = 0; i < extent_list_num_els (sel); i++) { EXTENT e = extent_list_at (sel, i, endp); - putchar ('\t'); - print_extent_2 (e); + stderr_out ("\t"); + debug_print (wrap_extent (e)); } - putchar ('\n'); + stderr_out ("\n"); } - putchar ('\n'); -} - -#endif + stderr_out ("\n"); +} + +#endif /* DEBUG_XEMACS */ /* Insert EXTENT into OBJ's stack of extents, if necessary. */ @@ -1611,23 +1161,30 @@ { Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj); -#ifdef SOE_DEBUG - printf ("Inserting into SOE: "); - print_extent_2 (extent); - putchar ('\n'); +#ifdef DEBUG_XEMACS + if (debug_soe) + { + stderr_out ("Inserting into SOE: "); + debug_print (wrap_extent (extent)); + stderr_out ("\n"); + } #endif if (!soe || soe->pos < extent_start (extent) || soe->pos > extent_end (extent)) { -#ifdef SOE_DEBUG - printf ("(not needed)\n\n"); +#ifdef DEBUG_XEMACS + if (debug_soe) + stderr_out ("(not needed)\n\n"); #endif return; } extent_list_insert (soe->extents, extent); -#ifdef SOE_DEBUG - puts ("SOE afterwards is:"); - soe_dump (obj); +#ifdef DEBUG_XEMACS + if (debug_soe) + { + stderr_out ("SOE afterwards is:\n"); + soe_dump (obj); + } #endif } @@ -1638,23 +1195,30 @@ { Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj); -#ifdef SOE_DEBUG - printf ("Deleting from SOE: "); - print_extent_2 (extent); - putchar ('\n'); +#ifdef DEBUG_XEMACS + if (debug_soe) + { + stderr_out ("Deleting from SOE: "); + debug_print (wrap_extent (extent)); + stderr_out ("\n"); + } #endif if (!soe || soe->pos < extent_start (extent) || soe->pos > extent_end (extent)) { -#ifdef SOE_DEBUG - puts ("(not needed)\n"); +#ifdef DEBUG_XEMACS + if (debug_soe) + stderr_out ("(not needed)\n\n"); #endif return; } extent_list_delete (soe->extents, extent); -#ifdef SOE_DEBUG - puts ("SOE afterwards is:"); - soe_dump (obj); +#ifdef DEBUG_XEMACS + if (debug_soe) + { + stderr_out ("SOE afterwards is:\n"); + soe_dump (obj); + } #endif } @@ -1674,11 +1238,12 @@ assert (bel); #endif -#ifdef SOE_DEBUG - printf ("Moving SOE from %d (memxpos %d) to %d (memxpos %d)\n", - soe->pos < 0 ? soe->pos : - buffer_or_string_memxpos_to_bytexpos (obj, soe->pos), soe->pos, - buffer_or_string_memxpos_to_bytexpos (obj, pos), pos); +#ifdef DEBUG_XEMACS + if (debug_soe) + stderr_out ("Moving SOE from %ld (memxpos %ld) to %ld (memxpos %ld)\n", + soe->pos < 0 ? soe->pos : + buffer_or_string_memxpos_to_bytexpos (obj, soe->pos), soe->pos, + buffer_or_string_memxpos_to_bytexpos (obj, pos), pos); #endif if (soe->pos < pos) { @@ -1692,8 +1257,9 @@ } else { -#ifdef SOE_DEBUG - puts ("(not needed)\n"); +#ifdef DEBUG_XEMACS + if (debug_soe) + stderr_out ("(not needed)\n\n"); #endif return; } @@ -1778,9 +1344,12 @@ } soe->pos = pos; -#ifdef SOE_DEBUG - puts ("SOE afterwards is:"); - soe_dump (obj); +#ifdef DEBUG_XEMACS + if (debug_soe) + { + stderr_out ("SOE afterwards is:\n"); + soe_dump (obj); + } #endif } @@ -1800,8 +1369,8 @@ allocate_soe (void) { #ifdef NEW_GC - struct stack_of_extents *soe = - alloc_lrecord_type (struct stack_of_extents, &lrecord_stack_of_extents); + struct stack_of_extents *soe = + XSTACK_OF_EXTENTS (ALLOC_NORMAL_LISP_OBJECT (stack_of_extents)); #else /* not NEW_GC */ struct stack_of_extents *soe = xnew_and_zero (struct stack_of_extents); #endif /* not NEW_GC */ @@ -3222,10 +2791,10 @@ Lisp_Object function = extent_initial_redisplay_function (e); Lisp_Object obj; - /* printf ("initial redisplay function called!\n "); */ - - /* print_extent_2 (e); - printf ("\n"); */ + /* stderr_out ("initial redisplay function called!\n "); */ + + /* debug_print (wrap_extent (e)); + stderr_out ("\n"); */ /* FIXME: One should probably inhibit the displaying of this extent to reduce flicker */ @@ -3253,7 +2822,7 @@ /* These are the basic helper functions for handling the allocation of extent objects. They are similar to the functions for other - lrecord objects. allocate_extent() is in alloc.c, not here. */ + frob-block objects. allocate_extent() is in alloc.c, not here. */ static Lisp_Object mark_extent (Lisp_Object obj) @@ -3310,8 +2879,6 @@ if (NILP (v)) continue; write_fmt_string_lisp (printcharfun, "%S ", 1, XCAR (tail)); } - - write_fmt_string (printcharfun, "0x%lx", (long) ext); } static void @@ -3355,10 +2922,11 @@ if (print_readably) { if (!EXTENT_LIVE_P (XEXTENT (obj))) - printing_unreadable_object ("#"); + printing_unreadable_object_fmt ("#", + LISP_OBJECT_UID (obj)); else - printing_unreadable_object ("#", - (long) XEXTENT (obj)); + printing_unreadable_object_fmt ("#", + LISP_OBJECT_UID (obj)); } if (!EXTENT_LIVE_P (XEXTENT (obj))) @@ -3368,17 +2936,19 @@ write_ascstring (printcharfun, "#"); + printing_unreadable_object_fmt ("#", + LISP_OBJECT_UID (obj)); write_ascstring (printcharfun, "#"); + + write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); } static int @@ -3432,13 +3002,13 @@ } static Hashcode -extent_hash (Lisp_Object obj, int depth) +extent_hash (Lisp_Object obj, int depth, Boolint UNUSED (equalp)) { struct extent *e = XEXTENT (obj); /* No need to hash all of the elements; that would take too long. Just hash the most common ones. */ return HASH3 (extent_start (e), extent_end (e), - internal_hash (extent_object (e), depth + 1)); + internal_hash (extent_object (e), depth + 1, 0)); } static const struct memory_description extent_description[] = { @@ -3479,20 +3049,17 @@ return Fextent_properties (obj); } -DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("extent", extent, - 1, /*dumpable-flag*/ - mark_extent, - print_extent, - /* NOTE: If you declare a - finalization method here, - it will NOT be called. - Shaft city. */ - 0, - extent_equal, extent_hash, - extent_description, - extent_getprop, extent_putprop, - extent_remprop, extent_plist, - struct extent); +DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("extent", extent, + mark_extent, + print_extent, + /* NOTE: If you declare a + finalization method here, + it will NOT be called. + Shaft city. */ + 0, + extent_equal, extent_hash, + extent_description, + struct extent); /************************************************************************/ /* basic extent accessors */ @@ -4059,12 +3626,10 @@ /* also need to copy the aux struct. It won't work for this extent to share the same aux struct as the original one. */ - struct extent_auxiliary *data = - ALLOC_LCRECORD_TYPE (struct extent_auxiliary, - &lrecord_extent_auxiliary); - - COPY_LCRECORD (data, XEXTENT_AUXILIARY (XCAR (original->plist))); - XCAR (e->plist) = wrap_extent_auxiliary (data); + Lisp_Object ea = ALLOC_NORMAL_LISP_OBJECT (extent_auxiliary); + + copy_lisp_object (ea, XCAR (original->plist)); + XCAR (e->plist) = ea; } { @@ -4844,7 +4409,7 @@ /* ------------------------------- */ /* verify_extent_modification() is called when a buffer or string is - modified to check whether the modification is occuring inside a + modified to check whether the modification is occurring inside a read-only extent. */ @@ -4883,7 +4448,7 @@ #endif while (1) - Fsignal (Qbuffer_read_only, (list1 (closure->object))); + Fsignal (Qextent_read_only, (list1 (wrap_extent (extent)))); RETURN_NOT_REACHED(0); } @@ -4944,12 +4509,8 @@ the insertion overlaps any existing extent, something is wrong. */ #ifdef ERROR_CHECK_EXTENTS - if (extent_start (extent) > indice && - extent_start (extent) < indice + closure->length) - ABORT (); - if (extent_end (extent) > indice && - extent_end (extent) < indice + closure->length) - ABORT (); + assert (extent_start (extent) <= indice || extent_start (extent) >= indice + closure->length); + assert (extent_end (extent) <= indice || extent_end (extent) >= indice + closure->length); #endif /* The extent-adjustment code adjusted the extent's endpoints as if @@ -7375,7 +6936,7 @@ use the text-property primitives.) This function looks only at extents created using the text-property primitives. -To look at all extents, use `next-single-char-property-change'. +To look at all extents, use `previous-single-char-property-change'. */ (pos, prop, object, limit)) { @@ -7402,7 +6963,7 @@ use the text-property primitives.) This function looks at all extents. To look at only extents created using the -text-property primitives, use `next-single-char-property-change'. +text-property primitives, use `next-single-property-change'. */ (pos, prop, object, limit)) { @@ -7430,7 +6991,7 @@ use the text-property primitives.) This function looks at all extents. To look at only extents created using the -text-property primitives, use `next-single-char-property-change'. +text-property primitives, use `previous-single-property-change'. */ (pos, prop, object, limit)) { @@ -7440,9 +7001,8 @@ #ifdef MEMORY_USAGE_STATS -int -compute_buffer_extent_usage (struct buffer *UNUSED (b), - struct overhead_stats *UNUSED (ovstats)) +Bytecount +compute_buffer_extent_usage (struct buffer *UNUSED (b)) { /* #### not yet written */ return 0; @@ -7456,17 +7016,24 @@ /************************************************************************/ void +extent_objects_create (void) +{ + OBJECT_HAS_METHOD (extent, getprop); + OBJECT_HAS_METHOD (extent, putprop); + OBJECT_HAS_METHOD (extent, remprop); + OBJECT_HAS_METHOD (extent, plist); +} + +void syms_of_extents (void) { - INIT_LRECORD_IMPLEMENTATION (extent); - INIT_LRECORD_IMPLEMENTATION (extent_info); - INIT_LRECORD_IMPLEMENTATION (extent_auxiliary); + INIT_LISP_OBJECT (extent); + INIT_LISP_OBJECT (extent_info); + INIT_LISP_OBJECT (extent_auxiliary); #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (gap_array_marker); - INIT_LRECORD_IMPLEMENTATION (gap_array); - INIT_LRECORD_IMPLEMENTATION (extent_list_marker); - INIT_LRECORD_IMPLEMENTATION (extent_list); - INIT_LRECORD_IMPLEMENTATION (stack_of_extents); + INIT_LISP_OBJECT (extent_list_marker); + INIT_LISP_OBJECT (extent_list); + INIT_LISP_OBJECT (stack_of_extents); #endif /* NEW_GC */ DEFSYMBOL (Qextentp); @@ -7586,24 +7153,17 @@ } void -reinit_vars_of_extents (void) -{ - extent_auxiliary_defaults.begin_glyph = Qnil; - extent_auxiliary_defaults.end_glyph = Qnil; - extent_auxiliary_defaults.parent = Qnil; - extent_auxiliary_defaults.children = Qnil; - extent_auxiliary_defaults.priority = 0; - extent_auxiliary_defaults.invisible = Qnil; - extent_auxiliary_defaults.read_only = Qnil; - extent_auxiliary_defaults.mouse_face = Qnil; - extent_auxiliary_defaults.initial_redisplay_function = Qnil; - extent_auxiliary_defaults.before_change_functions = Qnil; - extent_auxiliary_defaults.after_change_functions = Qnil; -} - -void vars_of_extents (void) { +#ifdef DEBUG_XEMACS + DEFVAR_BOOL ("debug-soe", &debug_soe /* +If non-nil, display debugging information about the SOE ("stack of extents"). +The SOE is a cache of extents overlapping a specified region, used to +speed up `map-extents' and certain other functions. +*/ ); + debug_soe = 0; +#endif /* DEBUG_XEMACS */ + DEFVAR_INT ("mouse-highlight-priority", &mouse_highlight_priority /* The priority to use for the mouse-highlighting pseudo-extent that is used to highlight extents with the `mouse-face' attribute set. @@ -7638,11 +7198,15 @@ to do `eq' comparison because the lists of faces are already memoized. */ Vextent_face_memoize_hash_table = - make_lisp_hash_table (100, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (100, HASH_TABLE_VALUE_WEAK, Qequal); staticpro (&Vextent_face_reverse_memoize_hash_table); Vextent_face_reverse_memoize_hash_table = - make_lisp_hash_table (100, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (100, HASH_TABLE_KEY_WEAK, Qeq); QSin_map_extents_internal = build_defer_string ("(in map-extents-internal)"); staticpro (&QSin_map_extents_internal); -} + + Vextent_auxiliary_defaults = + allocate_extent_auxiliary (); + staticpro (&Vextent_auxiliary_defaults); +} diff -r 861f2601a38b -r 1f0b15040456 src/extents.h --- a/src/extents.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/extents.h Sun May 01 18:44:03 2011 +0100 @@ -1,12 +1,12 @@ /* Copyright (c) 1994, 1995 Free Software Foundation. - Copyright (c) 1995, 1996, 2002 Ben Wing. + Copyright (c) 1995, 1996, 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,16 +14,14 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ #ifndef INCLUDED_extents_h_ #define INCLUDED_extents_h_ -DECLARE_LRECORD (extent, struct extent); +DECLARE_LISP_OBJECT (extent, struct extent); #define XEXTENT(x) XRECORD (x, extent, struct extent) #define wrap_extent(p) wrap_record (p, extent) #define EXTENTP(x) RECORDP (x, extent) @@ -32,7 +30,7 @@ struct extent_auxiliary; -DECLARE_LRECORD (extent_auxiliary, struct extent_auxiliary); +DECLARE_LISP_OBJECT (extent_auxiliary, struct extent_auxiliary); #define XEXTENT_AUXILIARY(x) \ XRECORD (x, extent_auxiliary, struct extent_auxiliary) #define wrap_extent_auxiliary(p) wrap_record (p, extent_auxiliary) @@ -42,7 +40,7 @@ struct extent_info; -DECLARE_LRECORD (extent_info, struct extent_info); +DECLARE_LISP_OBJECT (extent_info, struct extent_info); #define XEXTENT_INFO(x) XRECORD (x, extent_info, struct extent_info) #define wrap_extent_info(p) wrap_record (p, extent_info) #define EXTENT_INFOP(x) RECORDP (x, extent_info) @@ -50,28 +48,9 @@ #define CONCHECK_EXTENT_INFO(x) CONCHECK_RECORD (x, extent_info) #ifdef NEW_GC -struct gap_array_marker; - -DECLARE_LRECORD (gap_array_marker, struct gap_array_marker); -#define XGAP_ARRAY_MARKER(x) \ - XRECORD (x, gap_array_marker, struct gap_array_marker) -#define wrap_gap_array_marker(p) wrap_record (p, gap_array_marker) -#define GAP_ARRAY_MARKERP(x) RECORDP (x, gap_array_marker) -#define CHECK_GAP_ARRAY_MARKER(x) CHECK_RECORD (x, gap_array_marker) -#define CONCHECK_GAP_ARRAY_MARKER(x) CONCHECK_RECORD (x, gap_array_marker) - -struct gap_array; - -DECLARE_LRECORD (gap_array, struct gap_array); -#define XGAP_ARRAY(x) XRECORD (x, gap_array, struct gap_array) -#define wrap_gap_array(p) wrap_record (p, gap_array) -#define GAP_ARRAYP(x) RECORDP (x, gap_array) -#define CHECK_GAP_ARRAY(x) CHECK_RECORD (x, gap_array) -#define CONCHECK_GAP_ARRAY(x) CONCHECK_RECORD (x, gap_array) - struct extent_list_marker; -DECLARE_LRECORD (extent_list_marker, struct extent_list_marker); +DECLARE_LISP_OBJECT (extent_list_marker, struct extent_list_marker); #define XEXTENT_LIST_MARKER(x) \ XRECORD (x, extent_list_marker, struct extent_list_marker) #define wrap_extent_list_marker(p) wrap_record (p, extent_list_marker) @@ -81,7 +60,7 @@ struct extent_list; -DECLARE_LRECORD (extent_list, struct extent_list); +DECLARE_LISP_OBJECT (extent_list, struct extent_list); #define XEXTENT_LIST(x) XRECORD (x, extent_list, struct extent_list) #define wrap_extent_list(p) wrap_record (p, extent_list) #define EXTENT_LISTP(x) RECORDP (x, extent_list) @@ -90,7 +69,7 @@ struct stack_of_extents; -DECLARE_LRECORD (stack_of_extents, struct stack_of_extents); +DECLARE_LISP_OBJECT (stack_of_extents, struct stack_of_extents); #define XSTACK_OF_EXTENTS(x) \ XRECORD (x, stack_of_extents, struct stack_of_extents) #define wrap_stack_of_extents(p) wrap_record (p, stack_of_extents) @@ -228,7 +207,7 @@ /* from alloc.c */ struct extent *allocate_extent (void); -void allocate_extent_auxiliary (EXTENT ext); +void attach_extent_auxiliary (EXTENT ext); void init_buffer_extents (struct buffer *b); void uninit_buffer_extents (struct buffer *b); @@ -237,8 +216,7 @@ #endif #ifdef MEMORY_USAGE_STATS -int compute_buffer_extent_usage (struct buffer *b, - struct overhead_stats *ovstats); +Bytecount compute_buffer_extent_usage (struct buffer *b); #endif #endif /* INCLUDED_extents_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/extw-Xlib.c --- a/src/extw-Xlib.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/extw-Xlib.c Sun May 01 18:44:03 2011 +0100 @@ -1,20 +1,18 @@ /* Common code between client and shell widgets; not Xt-specific. Copyright (C) 1993, 1994 Sun Microsystems, Inc. -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. +This library 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 3 of the License, or (at your +option) any later version. -This library 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 -Library General Public License for more details. +This library 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 Library General Public -License along with this library; 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 this library. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/extw-Xlib.h --- a/src/extw-Xlib.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/extw-Xlib.h Sun May 01 18:44:03 2011 +0100 @@ -1,19 +1,17 @@ /* Copyright (C) 1993, 1994 Sun Microsystems, Inc. -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. +This library 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 3 of the License, or (at your +option) any later version. -This library 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 -Library General Public License for more details. +This library 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 Library General Public -License along with this library; 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 this library. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/extw-Xt.c --- a/src/extw-Xt.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/extw-Xt.c Sun May 01 18:44:03 2011 +0100 @@ -1,20 +1,18 @@ /* Common code between client and shell widgets -- Xt only. Copyright (C) 1993, 1994 Sun Microsystems, Inc. -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. +This library 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 3 of the License, or (at your +option) any later version. -This library 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 -Library General Public License for more details. +This library 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 Library General Public -License along with this library; 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 this library. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/extw-Xt.h --- a/src/extw-Xt.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/extw-Xt.h Sun May 01 18:44:03 2011 +0100 @@ -2,20 +2,18 @@ This file is part of XEmacs. -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. +This library 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 3 of the License, or (at your +option) any later version. -This library 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 -Library General Public License for more details. +This library 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 Library General Public -License along with this library; 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 this library. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/faces.c --- a/src/faces.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/faces.c Sun May 01 18:44:03 2011 +0100 @@ -3,13 +3,14 @@ Copyright (C) 1995 Board of Trustees, University of Illinois. Copyright (C) 1995, 1996, 2001, 2002, 2005, 2010 Ben Wing. Copyright (C) 1995 Sun Microsystems, Inc. + Copyright (C) 2010 Didier Verna This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +18,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -36,14 +35,14 @@ #include "faces.h" #include "frame-impl.h" #include "glyphs.h" -#include "objects-impl.h" +#include "fontcolor-impl.h" #include "specifier.h" #include "window.h" Lisp_Object Qfacep; Lisp_Object Qforeground, Qbackground, Qdisplay_table; -Lisp_Object Qbackground_pixmap, Qunderline, Qdim; -Lisp_Object Qblinking, Qstrikethru; +Lisp_Object Qbackground_pixmap, Qbackground_placement, Qunderline, Qdim; +Lisp_Object Qblinking, Qstrikethru, Q_name; Lisp_Object Qinit_face_from_resources; Lisp_Object Qinit_frame_faces; @@ -111,6 +110,7 @@ mark_object (face->font); mark_object (face->display_table); mark_object (face->background_pixmap); + mark_object (face->background_placement); mark_object (face->underline); mark_object (face->strikethru); mark_object (face->highlight); @@ -130,7 +130,7 @@ if (print_readably) { - write_fmt_string_lisp (printcharfun, "#s(face name %S)", 1, face->name); + write_fmt_string_lisp (printcharfun, "#s(face :name %S)", 1, face->name); } else { @@ -162,6 +162,9 @@ internal_equal (f1->font, f2->font, depth) && internal_equal (f1->display_table, f2->display_table, depth) && internal_equal (f1->background_pixmap, f2->background_pixmap, depth) && + internal_equal (f1->background_placement, + f2->background_placement, + depth) && internal_equal (f1->underline, f2->underline, depth) && internal_equal (f1->strikethru, f2->strikethru, depth) && internal_equal (f1->highlight, f2->highlight, depth) && @@ -173,7 +176,7 @@ } static Hashcode -face_hash (Lisp_Object obj, int depth) +face_hash (Lisp_Object obj, int depth, Boolint UNUSED (equalp)) { Lisp_Face *f = XFACE (obj); @@ -181,9 +184,9 @@ /* No need to hash all of the elements; that would take too long. Just hash the most common ones. */ - return HASH3 (internal_hash (f->foreground, depth), - internal_hash (f->background, depth), - internal_hash (f->font, depth)); + return HASH3 (internal_hash (f->foreground, depth, 0), + internal_hash (f->background, depth, 0), + internal_hash (f->font, depth, 0)); } static Lisp_Object @@ -192,18 +195,19 @@ Lisp_Face *f = XFACE (obj); return - (EQ (prop, Qforeground) ? f->foreground : - EQ (prop, Qbackground) ? f->background : - EQ (prop, Qfont) ? f->font : - EQ (prop, Qdisplay_table) ? f->display_table : - EQ (prop, Qbackground_pixmap) ? f->background_pixmap : - EQ (prop, Qunderline) ? f->underline : - EQ (prop, Qstrikethru) ? f->strikethru : - EQ (prop, Qhighlight) ? f->highlight : - EQ (prop, Qdim) ? f->dim : - EQ (prop, Qblinking) ? f->blinking : - EQ (prop, Qreverse) ? f->reverse : - EQ (prop, Qdoc_string) ? f->doc_string : + (EQ (prop, Qforeground) ? f->foreground : + EQ (prop, Qbackground) ? f->background : + EQ (prop, Qfont) ? f->font : + EQ (prop, Qdisplay_table) ? f->display_table : + EQ (prop, Qbackground_pixmap) ? f->background_pixmap : + EQ (prop, Qbackground_placement) ? f->background_placement : + EQ (prop, Qunderline) ? f->underline : + EQ (prop, Qstrikethru) ? f->strikethru : + EQ (prop, Qhighlight) ? f->highlight : + EQ (prop, Qdim) ? f->dim : + EQ (prop, Qblinking) ? f->blinking : + EQ (prop, Qreverse) ? f->reverse : + EQ (prop, Qdoc_string) ? f->doc_string : external_plist_get (&f->plist, prop, 0, ERROR_ME)); } @@ -212,16 +216,17 @@ { Lisp_Face *f = XFACE (obj); - if (EQ (prop, Qforeground) || - EQ (prop, Qbackground) || - EQ (prop, Qfont) || - EQ (prop, Qdisplay_table) || - EQ (prop, Qbackground_pixmap) || - EQ (prop, Qunderline) || - EQ (prop, Qstrikethru) || - EQ (prop, Qhighlight) || - EQ (prop, Qdim) || - EQ (prop, Qblinking) || + if (EQ (prop, Qforeground) || + EQ (prop, Qbackground) || + EQ (prop, Qfont) || + EQ (prop, Qdisplay_table) || + EQ (prop, Qbackground_pixmap) || + EQ (prop, Qbackground_placement) || + EQ (prop, Qunderline) || + EQ (prop, Qstrikethru) || + EQ (prop, Qhighlight) || + EQ (prop, Qdim) || + EQ (prop, Qblinking) || EQ (prop, Qreverse)) return 0; @@ -242,16 +247,17 @@ { Lisp_Face *f = XFACE (obj); - if (EQ (prop, Qforeground) || - EQ (prop, Qbackground) || - EQ (prop, Qfont) || - EQ (prop, Qdisplay_table) || - EQ (prop, Qbackground_pixmap) || - EQ (prop, Qunderline) || - EQ (prop, Qstrikethru) || - EQ (prop, Qhighlight) || - EQ (prop, Qdim) || - EQ (prop, Qblinking) || + if (EQ (prop, Qforeground) || + EQ (prop, Qbackground) || + EQ (prop, Qfont) || + EQ (prop, Qdisplay_table) || + EQ (prop, Qbackground_pixmap) || + EQ (prop, Qbackground_placement) || + EQ (prop, Qunderline) || + EQ (prop, Qstrikethru) || + EQ (prop, Qhighlight) || + EQ (prop, Qdim) || + EQ (prop, Qblinking) || EQ (prop, Qreverse)) return -1; @@ -270,17 +276,18 @@ Lisp_Face *face = XFACE (obj); Lisp_Object result = face->plist; - result = cons3 (Qreverse, face->reverse, result); - result = cons3 (Qblinking, face->blinking, result); - result = cons3 (Qdim, face->dim, result); - result = cons3 (Qhighlight, face->highlight, result); - result = cons3 (Qstrikethru, face->strikethru, result); - result = cons3 (Qunderline, face->underline, result); - result = cons3 (Qbackground_pixmap, face->background_pixmap, result); - result = cons3 (Qdisplay_table, face->display_table, result); - result = cons3 (Qfont, face->font, result); - result = cons3 (Qbackground, face->background, result); - result = cons3 (Qforeground, face->foreground, result); + result = cons3 (Qreverse, face->reverse, result); + result = cons3 (Qblinking, face->blinking, result); + result = cons3 (Qdim, face->dim, result); + result = cons3 (Qhighlight, face->highlight, result); + result = cons3 (Qstrikethru, face->strikethru, result); + result = cons3 (Qunderline, face->underline, result); + result = cons3 (Qbackground_placement, face->background_placement, result); + result = cons3 (Qbackground_pixmap, face->background_pixmap, result); + result = cons3 (Qdisplay_table, face->display_table, result); + result = cons3 (Qfont, face->font, result); + result = cons3 (Qbackground, face->background, result); + result = cons3 (Qforeground, face->foreground, result); return result; } @@ -293,6 +300,7 @@ { XD_LISP_OBJECT, offsetof (Lisp_Face, font) }, { XD_LISP_OBJECT, offsetof (Lisp_Face, display_table) }, { XD_LISP_OBJECT, offsetof (Lisp_Face, background_pixmap) }, + { XD_LISP_OBJECT, offsetof (Lisp_Face, background_placement) }, { XD_LISP_OBJECT, offsetof (Lisp_Face, underline) }, { XD_LISP_OBJECT, offsetof (Lisp_Face, strikethru) }, { XD_LISP_OBJECT, offsetof (Lisp_Face, highlight) }, @@ -304,13 +312,10 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("face", face, - 1, /*dumpable-flag*/ - mark_face, print_face, 0, face_equal, - face_hash, face_description, - face_getprop, - face_putprop, face_remprop, - face_plist, Lisp_Face); +DEFINE_DUMPABLE_LISP_OBJECT ("face", face, + mark_face, print_face, 0, face_equal, + face_hash, face_description, + Lisp_Face); /************************************************************************/ /* face read syntax */ @@ -335,6 +340,8 @@ int name_seen = 0; Lisp_Object valw = Qnil; + /* #### This syntax is very limited, given all the face properties that + actually exist. At least implement those in reset_face()! */ data = Fcdr (data); /* skip over Qface */ while (!NILP (data)) { @@ -343,7 +350,7 @@ data = Fcdr (data); valw = Fcar (data); data = Fcdr (data); - if (EQ (keyw, Qname)) + if (EQ (keyw, Qname) || EQ (keyw, Q_name)) name_seen = 1; else ABORT (); @@ -386,6 +393,7 @@ f->font = Qnil; f->display_table = Qnil; f->background_pixmap = Qnil; + f->background_placement = Qnil; f->underline = Qnil; f->strikethru = Qnil; f->highlight = Qnil; @@ -399,7 +407,8 @@ static Lisp_Face * allocate_face (void) { - Lisp_Face *result = ALLOC_LCRECORD_TYPE (Lisp_Face, &lrecord_face); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (face); + Lisp_Face *result = XFACE (obj); reset_face (result); return result; @@ -723,7 +732,7 @@ void default_face_font_info (Lisp_Object domain, int *ascent, int *descent, - int *height, int *width, int *proportional_p) + int *width, int *height, int *proportional_p) { Lisp_Object font_instance; struct face_cachel *cachel; @@ -782,25 +791,9 @@ } void -default_face_height_and_width (Lisp_Object domain, - int *height, int *width) -{ - default_face_font_info (domain, 0, 0, height, width, 0); -} - -void -default_face_height_and_width_1 (Lisp_Object domain, - int *height, int *width) +default_face_width_and_height (Lisp_Object domain, int *width, int *height) { - if (window_system_pixelated_geometry (domain)) - { - if (height) - *height = 1; - if (width) - *width = 1; - } - else - default_face_height_and_width (domain, height, width); + default_face_font_info (domain, 0, 0, width, height, 0); } DEFUN ("face-list", Fface_list, 0, 1, 0, /* @@ -861,6 +854,8 @@ set_font_attached_to (f->font, face, Qfont); f->background_pixmap = Fmake_specifier (Qimage); set_image_attached_to (f->background_pixmap, face, Qbackground_pixmap); + f->background_placement = Fmake_specifier (Qface_background_placement); + set_face_background_placement_attached_to (f->background_placement, face); f->display_table = Fmake_specifier (Qdisplay_table); f->underline = Fmake_specifier (Qface_boolean); set_face_boolean_attached_to (f->underline, face, Qunderline); @@ -889,6 +884,9 @@ set_specifier_fallback (f->background_pixmap, Fget (Vdefault_face, Qbackground_pixmap, Qunbound)); + set_specifier_fallback (f->background_placement, + Fget (Vdefault_face, Qbackground_placement, + Qunbound)); set_specifier_fallback (f->display_table, Fget (Vdefault_face, Qdisplay_table, Qunbound)); set_specifier_fallback (f->underline, @@ -1083,6 +1081,7 @@ mark_object (cachel->background); mark_object (cachel->display_table); mark_object (cachel->background_pixmap); + mark_object (cachel->background_placement); } } @@ -1417,7 +1416,7 @@ - BARF !!!!! To sum up, this means that it is in general unsafe to instantiate - images before face cache updating is complete (appart from image + images before face cache updating is complete (apart from image related face attributes). The solution we use below is to actually detect whether we're building the window's face_cachels for the first time, and simply NOT frob the background pixmap in that case. If @@ -1426,7 +1425,7 @@ One note: * See comment in `default_face_font_info' in face.c. Who wrote it ? - Maybe we have the begining of an answer here ? + Maybe we have the beginning of an answer here ? Footnotes: [1] See comment at the top of `allocate_window' in window.c. @@ -1439,6 +1438,9 @@ FROB (background_pixmap); MAYBE_UNFROB_BACKGROUND_PIXMAP; } + + FROB (background_placement); + #undef FROB #undef MAYBE_UNFROB_BACKGROUND_PIXMAP @@ -1502,6 +1504,7 @@ FROB (background); FROB (display_table); FROB (background_pixmap); + FROB (background_placement); FROB (underline); FROB (strikethru); FROB (highlight); @@ -1552,6 +1555,7 @@ } cachel->display_table = Qunbound; cachel->background_pixmap = Qunbound; + cachel->background_placement = Qunbound; FACE_CACHEL_FONT_SPECIFIED (cachel)->size = sizeof(cachel->font_specified); FACE_CACHEL_FONT_UPDATED (cachel)->size = sizeof(cachel->font_updated); } @@ -1645,7 +1649,7 @@ int compute_face_cachel_usage (face_cachel_dynarr *face_cachels, - struct overhead_stats *ovstats) + struct usage_stats *ustats) { int total = 0; @@ -1653,12 +1657,12 @@ { int i; - total += Dynarr_memory_usage (face_cachels, ovstats); + total += Dynarr_memory_usage (face_cachels, ustats); for (i = 0; i < Dynarr_length (face_cachels); i++) { int_dynarr *merged = Dynarr_at (face_cachels, i).merged_faces; if (merged) - total += Dynarr_memory_usage (merged, ovstats); + total += Dynarr_memory_usage (merged, ustats); } } @@ -1917,8 +1921,8 @@ /* If the locale could affect the frame value, then call update_EmacsFrames just in case. */ if (default_face && - (EQ (property, Qforeground) || - EQ (property, Qbackground) || + (EQ (property, Qforeground) || + EQ (property, Qbackground) || EQ (property, Qfont))) update_EmacsFrames (locale, property); @@ -2012,6 +2016,7 @@ COPY_PROPERTY (font); COPY_PROPERTY (display_table); COPY_PROPERTY (background_pixmap); + COPY_PROPERTY (background_placement); COPY_PROPERTY (underline); COPY_PROPERTY (strikethru); COPY_PROPERTY (highlight); @@ -2104,9 +2109,18 @@ void +face_objects_create (void) +{ + OBJECT_HAS_METHOD (face, getprop); + OBJECT_HAS_METHOD (face, putprop); + OBJECT_HAS_METHOD (face, remprop); + OBJECT_HAS_METHOD (face, plist); +} + +void syms_of_faces (void) { - INIT_LRECORD_IMPLEMENTATION (face); + INIT_LISP_OBJECT (face); /* Qdefault, Qwidget, Qleft_margin, Qright_margin defined in general.c */ DEFSYMBOL (Qmodeline); @@ -2142,6 +2156,7 @@ /* Qfont defined in general.c */ DEFSYMBOL (Qdisplay_table); DEFSYMBOL (Qbackground_pixmap); + DEFSYMBOL (Qbackground_placement); DEFSYMBOL (Qunderline); DEFSYMBOL (Qstrikethru); /* Qhighlight, Qreverse defined in general.c */ @@ -2155,6 +2170,8 @@ DEFSYMBOL (Qinit_global_faces); DEFSYMBOL (Qinit_device_faces); DEFSYMBOL (Qinit_frame_faces); + + DEFKEYWORD (Q_name); } void @@ -2163,8 +2180,10 @@ struct structure_type *st; st = define_structure_type (Qface, face_validate, face_instantiate); - +#ifdef NEED_TO_HANDLE_21_4_CODE define_structure_type_keyword (st, Qname, face_name_validate); +#endif + define_structure_type_keyword (st, Q_name, face_name_validate); } void @@ -2172,10 +2191,10 @@ { staticpro (&Vpermanent_faces_cache); Vpermanent_faces_cache = - make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, Qeq); staticpro (&Vtemporary_faces_cache); Vtemporary_faces_cache = - make_lisp_hash_table (0, HASH_TABLE_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (0, HASH_TABLE_WEAK, Qeq); staticpro (&Vdefault_face); Vdefault_face = Qnil; @@ -2206,25 +2225,11 @@ debug_x_faces = 0; #endif - { - Lisp_Object syms[20]; - int n = 0; - - syms[n++] = Qforeground; - syms[n++] = Qbackground; - syms[n++] = Qfont; - syms[n++] = Qdisplay_table; - syms[n++] = Qbackground_pixmap; - syms[n++] = Qunderline; - syms[n++] = Qstrikethru; - syms[n++] = Qhighlight; - syms[n++] = Qdim; - syms[n++] = Qblinking; - syms[n++] = Qreverse; - - Vbuilt_in_face_specifiers = Flist (n, syms); - staticpro (&Vbuilt_in_face_specifiers); - } + Vbuilt_in_face_specifiers = + listu (Qforeground, Qbackground, Qfont, Qdisplay_table, Qbackground_pixmap, + Qbackground_placement, Qunderline, Qstrikethru, Qhighlight, Qdim, + Qblinking, Qreverse, Qunbound); + staticpro (&Vbuilt_in_face_specifiers); } void @@ -2244,22 +2249,22 @@ Lisp_Object fg_fb = Qnil, bg_fb = Qnil; #ifdef HAVE_GTK - fg_fb = acons (list1 (Qgtk), build_ascstring ("black"), fg_fb); - bg_fb = acons (list1 (Qgtk), build_ascstring ("white"), bg_fb); + fg_fb = Facons (list1 (Qgtk), build_ascstring ("black"), fg_fb); + bg_fb = Facons (list1 (Qgtk), build_ascstring ("white"), bg_fb); #endif #ifdef HAVE_X_WINDOWS - fg_fb = acons (list1 (Qx), build_ascstring ("black"), fg_fb); - bg_fb = acons (list1 (Qx), build_ascstring ("gray80"), bg_fb); + fg_fb = Facons (list1 (Qx), build_ascstring ("black"), fg_fb); + bg_fb = Facons (list1 (Qx), build_ascstring ("gray80"), bg_fb); #endif #ifdef HAVE_TTY - fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb); - bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb); + fg_fb = Facons (list1 (Qtty), Fvector (0, 0), fg_fb); + bg_fb = Facons (list1 (Qtty), Fvector (0, 0), bg_fb); #endif #ifdef HAVE_MS_WINDOWS - fg_fb = acons (list1 (Qmsprinter), build_ascstring ("black"), fg_fb); - bg_fb = acons (list1 (Qmsprinter), build_ascstring ("white"), bg_fb); - fg_fb = acons (list1 (Qmswindows), build_ascstring ("black"), fg_fb); - bg_fb = acons (list1 (Qmswindows), build_ascstring ("white"), bg_fb); + fg_fb = Facons (list1 (Qmsprinter), build_ascstring ("black"), fg_fb); + bg_fb = Facons (list1 (Qmsprinter), build_ascstring ("white"), bg_fb); + fg_fb = Facons (list1 (Qmswindows), build_ascstring ("black"), fg_fb); + bg_fb = Facons (list1 (Qmswindows), build_ascstring ("white"), bg_fb); #endif set_specifier_fallback (Fget (Vdefault_face, Qforeground, Qnil), fg_fb); set_specifier_fallback (Fget (Vdefault_face, Qbackground, Qnil), bg_fb); @@ -2497,22 +2502,22 @@ /* We need to put something in there, or error checking gets #%!@#ed up before the styles are set, which override the fallbacks. */ - fg_fb = acons (list1 (Qgtk), build_ascstring ("black"), fg_fb); - bg_fb = acons (list1 (Qgtk), build_ascstring ("Gray80"), bg_fb); + fg_fb = Facons (list1 (Qgtk), build_ascstring ("black"), fg_fb); + bg_fb = Facons (list1 (Qgtk), build_ascstring ("Gray80"), bg_fb); #endif #ifdef HAVE_X_WINDOWS - fg_fb = acons (list1 (Qx), build_ascstring ("black"), fg_fb); - bg_fb = acons (list1 (Qx), build_ascstring ("Gray80"), bg_fb); + fg_fb = Facons (list1 (Qx), build_ascstring ("black"), fg_fb); + bg_fb = Facons (list1 (Qx), build_ascstring ("Gray80"), bg_fb); #endif #ifdef HAVE_TTY - fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb); - bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb); + fg_fb = Facons (list1 (Qtty), Fvector (0, 0), fg_fb); + bg_fb = Facons (list1 (Qtty), Fvector (0, 0), bg_fb); #endif #ifdef HAVE_MS_WINDOWS - fg_fb = acons (list1 (Qmsprinter), build_ascstring ("black"), fg_fb); - bg_fb = acons (list1 (Qmsprinter), build_ascstring ("white"), bg_fb); - fg_fb = acons (list1 (Qmswindows), build_ascstring ("black"), fg_fb); - bg_fb = acons (list1 (Qmswindows), build_ascstring ("Gray75"), bg_fb); + fg_fb = Facons (list1 (Qmsprinter), build_ascstring ("black"), fg_fb); + bg_fb = Facons (list1 (Qmsprinter), build_ascstring ("white"), bg_fb); + fg_fb = Facons (list1 (Qmswindows), build_ascstring ("black"), fg_fb); + bg_fb = Facons (list1 (Qmswindows), build_ascstring ("Gray75"), bg_fb); #endif set_specifier_fallback (Fget (Vgui_element_face, Qforeground, Qnil), fg_fb); set_specifier_fallback (Fget (Vgui_element_face, Qbackground, Qnil), bg_fb); @@ -2533,6 +2538,9 @@ set_specifier_fallback (Fget (Vmodeline_face, Qbackground_pixmap, Qnil), Fget (Vgui_element_face, Qbackground_pixmap, Qunbound)); + set_specifier_fallback (Fget (Vmodeline_face, Qbackground_placement, Qnil), + Fget (Vgui_element_face, Qbackground_placement, + Qunbound)); /* toolbar is another gui element */ Vtoolbar_face = Fmake_face (Qtoolbar, @@ -2545,6 +2553,9 @@ set_specifier_fallback (Fget (Vtoolbar_face, Qbackground_pixmap, Qnil), Fget (Vgui_element_face, Qbackground_pixmap, Qunbound)); + set_specifier_fallback (Fget (Vtoolbar_face, Qbackground_placement, Qnil), + Fget (Vgui_element_face, Qbackground_placement, + Qunbound)); /* vertical divider is another gui element */ Vvertical_divider_face = Fmake_face (Qvertical_divider, @@ -2559,6 +2570,10 @@ Qunbound), Fget (Vgui_element_face, Qbackground_pixmap, Qunbound)); + set_specifier_fallback (Fget (Vvertical_divider_face, Qbackground_placement, + Qnil), + Fget (Vgui_element_face, Qbackground_placement, + Qunbound)); /* widget is another gui element */ Vwidget_face = Fmake_face (Qwidget, diff -r 861f2601a38b -r 1f0b15040456 src/faces.h --- a/src/faces.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/faces.h Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,14 @@ /* Face data structures. Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 2002 Ben Wing + Copyright (C) 1995, 2002, 2010 Ben Wing + Copyright (C) 2010 Didier Verna This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -34,7 +33,7 @@ struct Lisp_Face { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; Lisp_Object name; Lisp_Object doc_string; @@ -47,6 +46,7 @@ Lisp_Object display_table; Lisp_Object background_pixmap; + Lisp_Object background_placement; Lisp_Object underline; Lisp_Object strikethru; @@ -119,7 +119,7 @@ struct face_cachel { #ifdef NEW_GC - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; #endif /* NEW_GC */ /* There are two kinds of cachels; those created from a single face and those created by merging more than one face. In the former @@ -172,6 +172,7 @@ Lisp_Object display_table; Lisp_Object background_pixmap; + Lisp_Object background_placement; unsigned int underline :1; unsigned int strikethru :1; @@ -188,6 +189,7 @@ unsigned int background_specified :1; unsigned int display_table_specified :1; unsigned int background_pixmap_specified :1; + unsigned int background_placement_specified :1; unsigned int strikethru_specified :1; unsigned int underline_specified :1; @@ -236,7 +238,7 @@ #ifdef NEW_GC typedef struct face_cachel Lisp_Face_Cachel; -DECLARE_LRECORD (face_cachel, Lisp_Face_Cachel); +DECLARE_LISP_OBJECT (face_cachel, Lisp_Face_Cachel); #define XFACE_CACHEL(x) \ XRECORD (x, face_cachel, Lisp_Face_Cachel) @@ -246,7 +248,7 @@ #define CONCHECK_FACE_CACHEL(x) CONCHECK_RECORD (x, face_cachel) #endif /* NEW_GC */ -DECLARE_LRECORD (face, Lisp_Face); +DECLARE_LISP_OBJECT (face, Lisp_Face); #define XFACE(x) XRECORD (x, face, Lisp_Face) #define wrap_face(p) wrap_record (p, face) #define FACEP(x) RECORDP (x, face) @@ -277,7 +279,7 @@ #ifdef MEMORY_USAGE_STATS int compute_face_cachel_usage (face_cachel_dynarr *face_cachels, - struct overhead_stats *ovstats); + struct usage_stats *ustats); #endif /* MEMORY_USAGE_STATS */ EXFUN (Fface_name, 1); @@ -299,12 +301,10 @@ void face_property_was_changed (Lisp_Object face, Lisp_Object property, Lisp_Object locale); void default_face_font_info (Lisp_Object domain, int *ascent, - int *descent, int *height, int *width, + int *descent, int *width, int *height, int *proportional_p); -void default_face_height_and_width (Lisp_Object domain, - int *height, int *width); -void default_face_height_and_width_1 (Lisp_Object domain, - int *height, int *width); +void default_face_width_and_height (Lisp_Object domain, int *width, + int *height); #define FACE_CACHEL_FONT(cachel, charset) \ (cachel->font[XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE]) @@ -342,6 +342,8 @@ (WINDOW_FACE_CACHEL (window, index)->display_table) #define WINDOW_FACE_CACHEL_BACKGROUND_PIXMAP(window, index) \ (WINDOW_FACE_CACHEL (window, index)->background_pixmap) +#define WINDOW_FACE_CACHEL_BACKGROUND_PLACEMENT(window, index) \ + (WINDOW_FACE_CACHEL (window, index)->background_placement) #define WINDOW_FACE_CACHEL_DIRTY(window, index) \ (WINDOW_FACE_CACHEL (window, index)->dirty) #define WINDOW_FACE_CACHEL_UNDERLINE_P(window, index) \ @@ -398,6 +400,11 @@ FACE_PROPERTY_INSTANCE (face, Qdisplay_table, domain, 0, Qzero) #define FACE_BACKGROUND_PIXMAP(face, domain) \ FACE_PROPERTY_INSTANCE (face, Qbackground_pixmap, domain, 0, Qzero) + +extern Lisp_Object Qbackground_placement; +#define FACE_BACKGROUND_PLACEMENT(face, domain) \ + FACE_PROPERTY_INSTANCE (face, Qbackground_placement, domain, 0, Qzero) + #define FACE_UNDERLINE_P(face, domain) \ (!NILP (FACE_PROPERTY_INSTANCE (face, Qunderline, domain, 0, Qzero))) #define FACE_STRIKETHRU_P(face, domain) \ diff -r 861f2601a38b -r 1f0b15040456 src/file-coding.c --- a/src/file-coding.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/file-coding.c Sun May 01 18:44:03 2011 +0100 @@ -2,14 +2,14 @@ #### rename me to coding-system.c or coding.c Copyright (C) 1991, 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2000, 2001, 2002, 2003, 2005 Ben Wing. + Copyright (C) 2000, 2001, 2002, 2003, 2005, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -297,7 +295,7 @@ { Lisp_Coding_System *c = XCODING_SYSTEM (obj); if (print_readably) - printing_unreadable_lcrecord (obj, 0); + printing_unreadable_lisp_object (obj, 0); write_fmt_string_lisp (printcharfun, "#name); print_coding_system_properties (obj, printcharfun); @@ -318,21 +316,19 @@ #ifndef NEW_GC static void -finalize_coding_system (void *header, int for_disksave) +finalize_coding_system (Lisp_Object obj) { - Lisp_Object cs = wrap_coding_system ((Lisp_Coding_System *) header); /* Since coding systems never go away, this function is not necessary. But it would be necessary if we changed things so that coding systems could go away. */ - if (!for_disksave) /* see comment in lstream.c */ - MAYBE_XCODESYSMETH (cs, finalize, (cs)); + MAYBE_XCODESYSMETH (obj, finalize, (obj)); } #endif /* not NEW_GC */ static Bytecount -sizeof_coding_system (const void *header) +sizeof_coding_system (Lisp_Object obj) { - const Lisp_Coding_System *p = (const Lisp_Coding_System *) header; + const Lisp_Coding_System *p = XCODING_SYSTEM (obj); return offsetof (Lisp_Coding_System, data) + p->methods->extra_data_size; } @@ -379,24 +375,13 @@ 0, coding_system_empty_extra_description_1 }; -#ifdef NEW_GC -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("coding-system", coding_system, - 1, /*dumpable-flag*/ - mark_coding_system, - print_coding_system, - 0, 0, 0, coding_system_description, - sizeof_coding_system, - Lisp_Coding_System); -#else /* not NEW_GC */ -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("coding-system", coding_system, - 1, /*dumpable-flag*/ - mark_coding_system, - print_coding_system, - finalize_coding_system, - 0, 0, coding_system_description, - sizeof_coding_system, - Lisp_Coding_System); -#endif /* not NEW_GC */ +DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("coding-system", coding_system, + mark_coding_system, + print_coding_system, + IF_OLD_GC (finalize_coding_system), + 0, 0, coding_system_description, + sizeof_coding_system, + Lisp_Coding_System); /************************************************************************/ /* Creating coding systems */ @@ -1005,9 +990,8 @@ Lisp_Object name) { Bytecount total_size = offsetof (Lisp_Coding_System, data) + data_size; - Lisp_Coding_System *codesys = - (Lisp_Coding_System *) BASIC_ALLOC_LCRECORD (total_size, - &lrecord_coding_system); + Lisp_Object obj = ALLOC_SIZED_LISP_OBJECT (total_size, coding_system); + Lisp_Coding_System *codesys = XCODING_SYSTEM (obj); codesys->methods = codesys_meths; #define MARKED_SLOT(x) codesys->x = Qnil; @@ -1407,13 +1391,15 @@ } DEFUN ("make-coding-system-internal", Fmake_coding_system_internal, 2, 4, 0, /* -See `make-coding-system'. This does much of the work of that function. - +Create a new coding system object, and register NAME as its name. + +With Mule support, this does much of the work of `make-coding-system'. Without Mule support, it does all the work of that function, and an alias -exists, mapping `make-coding-system' to -`make-coding-system-internal'. You'll need a non-Mule XEmacs to read the -complete docstring. Or you can just read it in make-coding-system.el; -something like the following should work: +exists, mapping `make-coding-system' to `make-coding-system-internal'. + +You'll need a Mule XEmacs to read the complete docstring. Or you can +just read it in make-coding-system.el; something like the following +should work: \\[find-function-other-window] find-file RET \\[find-file] mule/make-coding-system.el RET @@ -1452,12 +1438,8 @@ invalid_operation_2 ("Coding systems not same type", old_coding_system, new_coding_system); - { - Lisp_Coding_System *to = XCODING_SYSTEM (new_coding_system); - Lisp_Coding_System *from = XCODING_SYSTEM (old_coding_system); - COPY_SIZED_LCRECORD (to, from, sizeof_coding_system (from)); - to->name = new_name; - } + copy_lisp_object (new_coding_system, old_coding_system); + XCODING_SYSTEM (new_coding_system)->name = new_name; return new_coding_system; } @@ -1864,7 +1846,7 @@ Dynarr_atp (str->convert_from, rejected), readmore); /* Trim size down to how much we actually got */ - Dynarr_set_length (str->convert_from, rejected + max (0, read_size)); + Dynarr_set_lengthr (str->convert_from, rejected + max (0, read_size)); } if (read_size < 0) /* LSTREAM_ERROR */ @@ -1898,7 +1880,7 @@ memmove (Dynarr_begin (str->convert_from), Dynarr_atp (str->convert_from, processed), to_process - processed); - Dynarr_set_length (str->convert_from, to_process - processed); + Dynarr_set_lengthr (str->convert_from, to_process - processed); } } @@ -2720,6 +2702,7 @@ Lstream_delete (XLSTREAM ((data->lstreams)[i])); } xfree (data->lstreams); + data->lstreams = 0; } } @@ -4325,8 +4308,7 @@ data->level = -1; else { - CHECK_INT (value); - check_int_range (XINT (value), 0, 9); + check_integer_range (value, Qzero, make_int (9)); data->level = XINT (value); } } @@ -4423,7 +4405,7 @@ data->stream.avail_out = reserved; zerr = inflate (&data->stream, Z_NO_FLUSH); /* Lop off the unused portion */ - Dynarr_set_length (dst, Dynarr_length (dst) - data->stream.avail_out); + Dynarr_set_lengthr (dst, Dynarr_length (dst) - data->stream.avail_out); if (zerr != Z_OK) break; } @@ -4483,7 +4465,7 @@ deflate (&data->stream, str->eof ? Z_FINISH : Z_NO_FLUSH); /* Lop off the unused portion */ - Dynarr_set_length (dst, Dynarr_length (dst) - data->stream.avail_out); + Dynarr_set_lengthr (dst, Dynarr_length (dst) - data->stream.avail_out); if (zerr != Z_OK) break; } @@ -4508,7 +4490,7 @@ void syms_of_file_coding (void) { - INIT_LRECORD_IMPLEMENTATION (coding_system); + INIT_LISP_OBJECT (coding_system); DEFSUBR (Fvalid_coding_system_type_p); DEFSUBR (Fcoding_system_type_list); @@ -4620,7 +4602,7 @@ staticpro (&Vcoding_system_hash_table); Vcoding_system_hash_table = - make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, Qeq); the_coding_system_type_entry_dynarr = Dynarr_new (coding_system_type_entry); dump_add_root_block_ptr (&the_coding_system_type_entry_dynarr, @@ -4759,7 +4741,7 @@ DEFVAR_LISP ("keyboard-coding-system", &Vkeyboard_coding_system /* Default coding system used for TTY and X11 keyboard input. -Under X11, used only to interpet the character for a key event when that +Under X11, used only to interpret the character for a key event when that event has a KeySym of NoSymbol but does have an associated string keysym, something that's seen with input methods. @@ -4807,7 +4789,7 @@ enable_multibyte_characters = 1; Vchain_canonicalize_hash_table = - make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, Qequal); staticpro (&Vchain_canonicalize_hash_table); #ifdef DEBUG_XEMACS @@ -4820,7 +4802,7 @@ #ifdef MULE Vdefault_query_coding_region_chartab_cache - = make_lisp_hash_table (25, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); + = make_lisp_hash_table (25, HASH_TABLE_NON_WEAK, Qequal); staticpro (&Vdefault_query_coding_region_chartab_cache); #endif } @@ -4833,142 +4815,143 @@ Fmake_coding_system_internal (Qconvert_eol_cr, Qconvert_eol, build_defer_string ("Convert CR to LF"), - nconc2 (list6 (Qdocumentation, - build_defer_string ( + listu (Qdocumentation, + build_defer_string ( "Converts CR (used to mark the end of a line on Macintosh systems) to LF\n" "(used internally and under Unix to mark the end of a line)."), - Qmnemonic, build_ascstring ("CR->LF"), - Qsubtype, Qcr), - /* VERY IMPORTANT! Tell make-coding-system not to generate - subsidiaries -- it needs the coding systems we're creating + Qmnemonic, build_ascstring ("CR->LF"), + Qsubtype, Qcr, + /* VERY IMPORTANT! Tell make-coding-system not to generate + subsidiaries -- it needs the coding systems we're creating to do so! */ - list4 (Qeol_type, Qlf, - Qsafe_charsets, Qt))); - + Qeol_type, Qlf, + Qsafe_charsets, Qt, + Qunbound)); Fmake_coding_system_internal (Qconvert_eol_lf, Qconvert_eol, build_defer_string ("Convert LF to LF (do nothing)"), - nconc2 (list6 (Qdocumentation, - build_defer_string ( -"Do nothing."), - Qmnemonic, build_ascstring ("LF->LF"), - Qsubtype, Qlf), - /* VERY IMPORTANT! Tell make-coding-system not to generate + listu (Qdocumentation, + build_defer_string ("Do nothing."), + Qmnemonic, build_ascstring ("LF->LF"), + Qsubtype, Qlf, + /* VERY IMPORTANT! Tell make-coding-system not to generate subsidiaries -- it needs the coding systems we're creating to do so! */ - list4 (Qeol_type, Qlf, - Qsafe_charsets, Qt))); + Qeol_type, Qlf, + Qsafe_charsets, Qt, + Qunbound)); Fmake_coding_system_internal (Qconvert_eol_crlf, Qconvert_eol, build_defer_string ("Convert CRLF to LF"), - nconc2 (list6 (Qdocumentation, - build_defer_string ( + listu (Qdocumentation, + build_defer_string ( "Converts CR+LF (used to mark the end of a line on Macintosh systems) to LF\n" "(used internally and under Unix to mark the end of a line)."), - Qmnemonic, build_ascstring ("CRLF->LF"), - Qsubtype, Qcrlf), - - /* VERY IMPORTANT! Tell make-coding-system not to generate - subsidiaries -- it needs the coding systems we're creating - to do so! */ - list4 (Qeol_type, Qlf, - Qsafe_charsets, Qt))); + Qmnemonic, build_ascstring ("CRLF->LF"), + Qsubtype, Qcrlf, + /* VERY IMPORTANT! Tell make-coding-system not to generate + subsidiaries -- it needs the coding systems we're creating + to do so! */ + Qeol_type, Qlf, + Qsafe_charsets, Qt, + Qunbound)); Fmake_coding_system_internal (Qconvert_eol_autodetect, Qconvert_eol, build_defer_string ("Autodetect EOL type"), - nconc2 (list6 (Qdocumentation, - build_defer_string ( -"Autodetect the end-of-line type."), - Qmnemonic, build_ascstring ("Auto-EOL"), - Qsubtype, Qnil), - /* VERY IMPORTANT! Tell make-coding-system not to generate - subsidiaries -- it needs the coding systems we're creating - to do so! */ - list4 (Qeol_type, Qlf, - Qsafe_charsets, Qt))); + listu (Qdocumentation, + build_defer_string ("Autodetect the end-of-line type."), + Qmnemonic, build_ascstring ("Auto-EOL"), + Qsubtype, Qnil, + /* VERY IMPORTANT! Tell make-coding-system not to generate + subsidiaries -- it needs the coding systems we're creating + to do so! */ + Qeol_type, Qlf, + Qsafe_charsets, Qt, + Qunbound)); Fmake_coding_system_internal (Qundecided, Qundecided, build_defer_string ("Undecided (auto-detect)"), - nconc2 (list4 (Qdocumentation, - build_defer_string - ("Automatically detects the correct encoding."), - Qmnemonic, build_ascstring ("Auto")), - list6 (Qdo_eol, Qt, Qdo_coding, Qt, - /* We do EOL detection ourselves so we don't need to be - wrapped in an EOL detector. (It doesn't actually hurt, - though, I don't think.) */ - Qeol_type, Qlf))); + listu (Qdocumentation, + build_defer_string ("Automatically detects the correct encoding."), + Qmnemonic, build_ascstring ("Auto"), + Qdo_eol, Qt, Qdo_coding, Qt, + /* We do EOL detection ourselves so we don't need to be + wrapped in an EOL detector. (It doesn't actually hurt, + though, I don't think.) */ + Qeol_type, Qlf, + Qunbound)); Fmake_coding_system_internal (intern ("undecided-dos"), Qundecided, build_defer_string ("Undecided (auto-detect) (CRLF)"), - nconc2 (list4 (Qdocumentation, - build_defer_string - ("Automatically detects the correct encoding; EOL type of CRLF forced."), - Qmnemonic, build_ascstring ("Auto")), - list4 (Qdo_coding, Qt, - Qeol_type, Qcrlf))); + listu (Qdocumentation, + build_defer_string + ("Automatically detects the correct encoding; EOL type of CRLF forced."), + Qmnemonic, build_ascstring ("Auto"), + Qdo_coding, Qt, + Qeol_type, Qcrlf, + Qunbound)); Fmake_coding_system_internal (intern ("undecided-unix"), Qundecided, build_defer_string ("Undecided (auto-detect) (LF)"), - nconc2 (list4 (Qdocumentation, - build_defer_string - ("Automatically detects the correct encoding; EOL type of LF forced."), - Qmnemonic, build_ascstring ("Auto")), - list4 (Qdo_coding, Qt, - Qeol_type, Qlf))); + listu (Qdocumentation, + build_defer_string + ("Automatically detects the correct encoding; EOL type of LF forced."), + Qmnemonic, build_ascstring ("Auto"), + Qdo_coding, Qt, + Qeol_type, Qlf, + Qunbound));; Fmake_coding_system_internal (intern ("undecided-mac"), Qundecided, build_defer_string ("Undecided (auto-detect) (CR)"), - nconc2 (list4 (Qdocumentation, - build_defer_string - ("Automatically detects the correct encoding; EOL type of CR forced."), - Qmnemonic, build_ascstring ("Auto")), - list4 (Qdo_coding, Qt, - Qeol_type, Qcr))); + listu (Qdocumentation, + build_defer_string + ("Automatically detects the correct encoding; EOL type of CR forced."), + Qmnemonic, build_ascstring ("Auto"), + Qdo_coding, Qt, + Qeol_type, Qcr, + Qunbound)); /* Need to create this here or we're really screwed. */ Fmake_coding_system_internal (Qraw_text, Qno_conversion, build_defer_string ("Raw Text"), - nconc2 (list4 (Qdocumentation, - build_defer_string ("Raw text converts only line-break " - "codes, and acts otherwise like " - "`binary'."), - Qmnemonic, build_ascstring ("Raw")), + listu (Qdocumentation, + build_defer_string ("Raw text converts only line-break " + "codes, and acts otherwise like " + "`binary'."), + Qmnemonic, build_ascstring ("Raw"), #ifdef MULE - list2 (Qsafe_charsets, list3 (Vcharset_ascii, Vcharset_control_1, - Vcharset_latin_iso8859_1)))); - -#else - Qnil)); + Qsafe_charsets, list3 (Vcharset_ascii, Vcharset_control_1, + Vcharset_latin_iso8859_1), + #endif + Qunbound)); + Fmake_coding_system_internal (Qbinary, Qno_conversion, build_defer_string ("Binary"), - nconc2 (list6 (Qdocumentation, - build_defer_string ( + listu (Qdocumentation, + build_defer_string ( "This coding system is as close as it comes to doing no conversion.\n" "On input, each byte is converted directly into the character\n" "with the corresponding code -- i.e. from the `ascii', `control-1',\n" "or `latin-1' character sets. On output, these characters are\n" "converted back to the corresponding bytes, and other characters\n" "are converted to the default character, i.e. `~'."), - Qeol_type, Qlf, - Qmnemonic, build_ascstring ("Binary")), + Qeol_type, Qlf, + Qmnemonic, build_ascstring ("Binary"), #ifdef MULE - list2 (Qsafe_charsets, list3 (Vcharset_ascii, Vcharset_control_1, - Vcharset_latin_iso8859_1)))); - -#else - Qnil)); + Qsafe_charsets, list3 (Vcharset_ascii, Vcharset_control_1, + Vcharset_latin_iso8859_1), #endif + Qunbound)); /* Formerly aliased to raw-text! Completely bogus and not even the same as FSF Emacs. */ diff -r 861f2601a38b -r 1f0b15040456 src/file-coding.h --- a/src/file-coding.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/file-coding.h Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.3. Not in FSF. */ @@ -188,7 +186,7 @@ struct Lisp_Coding_System { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; struct coding_system_methods *methods; #define CODING_SYSTEM_SLOT_DECLARATION @@ -208,7 +206,7 @@ }; typedef struct Lisp_Coding_System Lisp_Coding_System; -DECLARE_LRECORD (coding_system, Lisp_Coding_System); +DECLARE_LISP_OBJECT (coding_system, Lisp_Coding_System); #define XCODING_SYSTEM(x) XRECORD (x, coding_system, Lisp_Coding_System) #define wrap_coding_system(p) wrap_record (p, coding_system) #define CODING_SYSTEMP(x) RECORDP (x, coding_system) @@ -363,14 +361,13 @@ stick around until GC time. (File handles can also be closed when EOF is signalled; but some data must stick around after this point, for the benefit of canonicalize_after_coding. See the convert method.) - Called only once (NOT called at disksave time). Optional. */ + Called only once. Optional. */ void (*finalize_coding_stream_method) (struct coding_stream *str); /* Finalize method: Clean up type-specific data (e.g. free allocated data) attached to the coding system (i.e. in struct TYPE_coding_system), when the coding system is about to be garbage - collected. (Currently not called.) Called only once (NOT called at - disksave time). Optional. */ + collected. (Currently not called.) Called only once. Optional. */ void (*finalize_method) (Lisp_Object codesys); /* Conversion end type method: Does this coding system encode bytes -> @@ -807,8 +804,7 @@ void (*detect_method) (struct detection_state *st, const unsigned char *src, Bytecount n); /* Finalize detection state method: Clean up any allocated data in the - detection state. Called only once (NOT called at disksave time). - Optional. */ + detection state. Called only once. Optional. */ void (*finalize_detection_state_method) (struct detection_state *st); }; diff -r 861f2601a38b -r 1f0b15040456 src/fileio.c --- a/src/fileio.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/fileio.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.0, FSF 19.30. */ /* More syncing: FSF Emacs 19.34.6 by Marc Paquette @@ -108,6 +106,8 @@ Lisp_Object Vdirectory_sep_char; +int default_file_system_ignore_case; + #ifdef HAVE_FSYNC /* Nonzero means skip the call to fsync in Fwrite-region. */ int write_region_inhibit_fsync; @@ -130,8 +130,6 @@ Lisp_Object Qauto_save_error; Lisp_Object Qauto_saving; -Lisp_Object Qcar_less_than_car; - Lisp_Object Qcompute_buffer_file_truename; Lisp_Object QSin_expand_file_name; @@ -611,7 +609,7 @@ does not specify an existing file. To make this work, PREFIX should be an absolute file name. -This function is analagous to mktemp(3) under POSIX, and as with it, there +This function is analogous to mktemp(3) under POSIX, and as with it, there exists a race condition between the test for the existence of the new file and its creation. See `make-temp-file' for a function which avoids this race condition by specifying the appropriate flags to `write-region'. @@ -2322,7 +2320,7 @@ GENERIC_MAPPING genericMapping; DWORD accessMask; PRIVILEGE_SET PrivilegeSet; - DWORD dwPrivSetSize = sizeof( PRIVILEGE_SET ); + DWORD dwPrivSetSize = sizeof ( PRIVILEGE_SET ); BOOL fAccessGranted = FALSE; DWORD dwAccessAllowed; Extbyte *fnameext; @@ -2330,48 +2328,57 @@ LOCAL_FILE_FORMAT_TO_TSTR (filename, fnameext); // First check for a normal file with the old-style readonly bit - attributes = qxeGetFileAttributes(fnameext); - if (FILE_ATTRIBUTE_READONLY == (attributes & (FILE_ATTRIBUTE_DIRECTORY|FILE_ATTRIBUTE_READONLY))) + attributes = qxeGetFileAttributes (fnameext); + if (FILE_ATTRIBUTE_READONLY == + (attributes & (FILE_ATTRIBUTE_DIRECTORY|FILE_ATTRIBUTE_READONLY))) return 0; /* Win32 prototype lacks const. */ - error = qxeGetNamedSecurityInfo(fnameext, SE_FILE_OBJECT, - DACL_SECURITY_INFORMATION|GROUP_SECURITY_INFORMATION|OWNER_SECURITY_INFORMATION, - &psidOwner, &psidGroup, &pDacl, &pSacl, &pDesc); - if(error != ERROR_SUCCESS) { // FAT? - attributes = qxeGetFileAttributes(fnameext); - return (attributes & FILE_ATTRIBUTE_DIRECTORY) || (0 == (attributes & FILE_ATTRIBUTE_READONLY)); - } + error = qxeGetNamedSecurityInfo (fnameext, SE_FILE_OBJECT, + DACL_SECURITY_INFORMATION| + GROUP_SECURITY_INFORMATION| + OWNER_SECURITY_INFORMATION, + &psidOwner, &psidGroup, &pDacl, &pSacl, + &pDesc); + if (error != ERROR_SUCCESS) + { // FAT? + attributes = qxeGetFileAttributes (fnameext); + return (attributes & FILE_ATTRIBUTE_DIRECTORY) || + (0 == (attributes & FILE_ATTRIBUTE_READONLY)); + } genericMapping.GenericRead = FILE_GENERIC_READ; genericMapping.GenericWrite = FILE_GENERIC_WRITE; genericMapping.GenericExecute = FILE_GENERIC_EXECUTE; genericMapping.GenericAll = FILE_ALL_ACCESS; - if(!ImpersonateSelf(SecurityDelegation)) { - return 0; - } - if(!OpenThreadToken(GetCurrentThread(), TOKEN_ALL_ACCESS, TRUE, &tokenHandle)) { - return 0; - } + if (!ImpersonateSelf (SecurityDelegation)) + { + return 0; + } + if (!OpenThreadToken (GetCurrentThread(), TOKEN_ALL_ACCESS, TRUE, + &tokenHandle)) + { + return 0; + } accessMask = GENERIC_WRITE; - MapGenericMask(&accessMask, &genericMapping); - - if(!AccessCheck(pDesc, tokenHandle, accessMask, &genericMapping, + MapGenericMask (&accessMask, &genericMapping); + + if (!AccessCheck(pDesc, tokenHandle, accessMask, &genericMapping, &PrivilegeSet, // receives privileges used in check &dwPrivSetSize, // size of PrivilegeSet buffer &dwAccessAllowed, // receives mask of allowed access rights &fAccessGranted)) { - CloseHandle(tokenHandle); + CloseHandle (tokenHandle); RevertToSelf(); - LocalFree(pDesc); + LocalFree (pDesc); return 0; } - CloseHandle(tokenHandle); + CloseHandle (tokenHandle); RevertToSelf(); - LocalFree(pDesc); + LocalFree (pDesc); return fAccessGranted == TRUE; #elif defined (HAVE_EACCESS) return (qxe_eaccess (filename, W_OK) >= 0); @@ -2959,7 +2966,7 @@ RETURN_UNGCPRO (Fsignal (Qfile_error, - list2 (build_msg_string("not a regular file"), + list2 (build_msg_string ("not a regular file"), filename))); } } @@ -3283,7 +3290,7 @@ Lisp_Object insval = call1 (p, make_int (inserted)); if (!NILP (insval)) { - CHECK_NATNUM (insval); + check_integer_range (insval, Qzero, make_int (EMACS_INT_MAX)); inserted = XINT (insval); } } @@ -3666,7 +3673,8 @@ annotations = Qnil; } Flength (res); /* Check basic validity of return value */ - annotations = merge (annotations, res, Qcar_less_than_car); + annotations = list_merge (annotations, res, check_lss_key_car, Qnil, + Qnil); p = Fcdr (p); } @@ -3697,7 +3705,8 @@ annotations = Qnil; } Flength (res); - annotations = merge (annotations, res, Qcar_less_than_car); + annotations = list_merge (annotations, res, check_lss_key_car, Qnil, + Qnil); p = Fcdr (p); } @@ -4261,7 +4270,7 @@ auto_saved++; /* Handler killed their own buffer! */ - if (!BUFFER_LIVE_P(b)) + if (!BUFFER_LIVE_P (b)) continue; b->auto_save_modified = BUF_MODIFF (b); @@ -4370,7 +4379,6 @@ DEFSYMBOL (Qwrite_region); DEFSYMBOL (Qverify_visited_file_modtime); DEFSYMBOL (Qset_visited_file_modtime); - DEFSYMBOL (Qcar_less_than_car); /* Vomitous! */ DEFSYMBOL (Qexcl); DEFSYMBOL (Qauto_save_hook); @@ -4551,6 +4559,16 @@ what the normal separator is. */ ); Vdirectory_sep_char = make_char (DEFAULT_DIRECTORY_SEP); + + DEFVAR_CONST_BOOL ("default-file-system-ignore-case", &default_file_system_ignore_case /* +What `file-system-ignore-case-p' returns by default. +This is in the case that nothing in `file-system-case-alist' matches. +*/ ); +#ifdef DEFAULT_FILE_SYSTEM_IGNORE_CASE + default_file_system_ignore_case = DEFAULT_FILE_SYSTEM_IGNORE_CASE; +#else + default_file_system_ignore_case = 0; +#endif } void diff -r 861f2601a38b -r 1f0b15040456 src/filelock.c --- a/src/filelock.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/filelock.c Sun May 01 18:44:03 2011 +0100 @@ -3,20 +3,18 @@ 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synced with FSF 20.2 */ diff -r 861f2601a38b -r 1f0b15040456 src/filemode.c --- a/src/filemode.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/filemode.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ diff -r 861f2601a38b -r 1f0b15040456 src/floatfns.c --- a/src/floatfns.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/floatfns.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ @@ -183,22 +181,19 @@ } static Hashcode -float_hash (Lisp_Object obj, int UNUSED (depth)) +float_hash (Lisp_Object obj, int UNUSED (depth), Boolint UNUSED (equalp)) { - /* mod the value down to 32-bit range */ - /* #### change for 64-bit machines */ - return (unsigned long) fmod (extract_float (obj), 4e9); + return FLOAT_HASHCODE_FROM_DOUBLE (extract_float (obj)); } static const struct memory_description float_description[] = { { XD_END } }; -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("float", float, - 1, /*dumpable-flag*/ - mark_float, print_float, 0, float_equal, - float_hash, float_description, - Lisp_Float); +DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("float", float, + mark_float, print_float, 0, + float_equal, float_hash, + float_description, Lisp_Float); /* Extract a Lisp number as a `double', or signal an error. */ @@ -792,6 +787,11 @@ if (FLOATP (number)) /* give 'em the same float back */ return number; + if (BIGFLOATP (number)) + { + return number; + } + return Ffloat (wrong_type_argument (Qnumberp, number)); } @@ -1303,11 +1303,7 @@ } else { -#ifdef HAVE_BIGNUM if (INTEGERP (number)) -#else - if (INTP (number)) -#endif { return values2 (number, Qzero); } @@ -1569,11 +1565,7 @@ floor_one_mundane_arg (Lisp_Object number, Lisp_Object divisor, int return_float) { -#ifdef HAVE_BIGNUM if (INTEGERP (number)) -#else - if (INTP (number)) -#endif { if (return_float) { @@ -1974,11 +1966,7 @@ round_one_mundane_arg (Lisp_Object number, Lisp_Object divisor, int return_float) { -#ifdef HAVE_BIGNUM if (INTEGERP (number)) -#else - if (INTP (number)) -#endif { if (return_float) { @@ -2261,11 +2249,7 @@ truncate_one_mundane_arg (Lisp_Object number, Lisp_Object divisor, int return_float) { -#ifdef HAVE_BIGNUM if (INTEGERP (number)) -#else - if (INTP (number)) -#endif { if (return_float) { @@ -2304,7 +2288,7 @@ */ (number, divisor)) { - ROUNDING_CONVERT(ceiling, 0); + ROUNDING_CONVERT (ceiling, 0); } DEFUN ("floor", Ffloor, 1, 2, 0, /* @@ -2319,7 +2303,7 @@ */ (number, divisor)) { - ROUNDING_CONVERT(floor, 0); + ROUNDING_CONVERT (floor, 0); } DEFUN ("round", Fround, 1, 2, 0, /* @@ -2336,7 +2320,7 @@ */ (number, divisor)) { - ROUNDING_CONVERT(round, 0); + ROUNDING_CONVERT (round, 0); } DEFUN ("truncate", Ftruncate, 1, 2, 0, /* @@ -2350,7 +2334,7 @@ */ (number, divisor)) { - ROUNDING_CONVERT(truncate, 0); + ROUNDING_CONVERT (truncate, 0); } /* Float-rounding functions. */ @@ -2367,7 +2351,7 @@ */ (number, divisor)) { - ROUNDING_CONVERT(ceiling, 1); + ROUNDING_CONVERT (ceiling, 1); } DEFUN ("ffloor", Fffloor, 1, 2, 0, /* @@ -2382,7 +2366,7 @@ */ (number, divisor)) { - ROUNDING_CONVERT(floor, 1); + ROUNDING_CONVERT (floor, 1); } DEFUN ("fround", Ffround, 1, 2, 0, /* @@ -2398,7 +2382,7 @@ */ (number, divisor)) { - ROUNDING_CONVERT(round, 1); + ROUNDING_CONVERT (round, 1); } DEFUN ("ftruncate", Fftruncate, 1, 2, 0, /* @@ -2413,7 +2397,7 @@ */ (number, divisor)) { - ROUNDING_CONVERT(truncate, 1); + ROUNDING_CONVERT (truncate, 1); } #ifdef FLOAT_CATCH_SIGILL @@ -2483,7 +2467,7 @@ void syms_of_floatfns (void) { - INIT_LRECORD_IMPLEMENTATION (float); + INIT_LISP_OBJECT (float); /* Trig functions. */ diff -r 861f2601a38b -r 1f0b15040456 src/fns.c --- a/src/fns.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/fns.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.0, FSF 19.30. */ @@ -54,17 +52,44 @@ /* NOTE: This symbol is also used in lread.c */ #define FEATUREP_SYNTAX -Lisp_Object Qstring_lessp; -Lisp_Object Qidentity; -Lisp_Object Qvector, Qarray, Qbit_vector; +Lisp_Object Qstring_lessp, Qmerge, Qfill, Qreplace, QassocX, QrassocX; +Lisp_Object Qposition, Qfind, QdeleteX, QremoveX, Qidentity, Qadjoin; +Lisp_Object Qvector, Qarray, Qbit_vector, QsortX, Q_from_end, Q_initial_value; +Lisp_Object Qmapconcat, QmapcarX, Qmapvector, Qmapcan, Qmapc, Qmap, Qmap_into; +Lisp_Object Qsome, Qevery, Qmaplist, Qmapl, Qmapcon, Qreduce, Qsubstitute; +Lisp_Object Q_start1, Q_start2, Q_end1, Q_end2, Q_if_, Q_if_not, Q_stable; +Lisp_Object Q_test_not, Q_count, Qnsubstitute, Qdelete_duplicates, Qmismatch; + +Lisp_Object Qintersection, Qset_difference, Qnset_difference; +Lisp_Object Qnunion, Qnintersection, Qsubsetp, Qcar_less_than_car; Lisp_Object Qbase64_conversion_error; Lisp_Object Vpath_separator; -static int internal_old_equal (Lisp_Object, Lisp_Object, int); +extern Fixnum max_lisp_eval_depth; +extern int lisp_eval_depth; + Lisp_Object safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth); +static DOESNT_RETURN +mapping_interaction_error (Lisp_Object func, Lisp_Object object) +{ + invalid_state_2 ("object modified while traversing it", func, object); +} + +static void +check_sequence_range (Lisp_Object sequence, Lisp_Object start, + Lisp_Object end, Lisp_Object length) +{ + Lisp_Object args[] = { Qzero, start, NILP (end) ? length : end, length }; + + if (NILP (Fleq (countof (args), args))) + { + args_out_of_range_3 (sequence, start, end); + } +} + static Lisp_Object mark_bit_vector (Lisp_Object UNUSED (obj)) { @@ -108,10 +133,49 @@ sizeof (long))); } +/* This needs to be algorithmically identical to internal_array_hash in + elhash.c when equalp is one, so arrays and bit vectors with the same + contents hash the same. It would be possible to enforce this by giving + internal_ARRAYLIKE_hash its own file and including it twice, but right + now that doesn't seem worth it. */ static Hashcode -bit_vector_hash (Lisp_Object obj, int UNUSED (depth)) +internal_bit_vector_equalp_hash (Lisp_Bit_Vector *v) +{ + int ii, size = bit_vector_length (v); + Hashcode hash = 0; + + if (size <= 5) + { + for (ii = 0; ii < size; ii++) + { + hash = HASH2 + (hash, + FLOAT_HASHCODE_FROM_DOUBLE ((double) (bit_vector_bit (v, ii)))); + } + return hash; + } + + /* just pick five elements scattered throughout the array. + A slightly better approach would be to offset by some + noise factor from the points chosen below. */ + for (ii = 0; ii < 5; ii++) + hash = HASH2 (hash, + FLOAT_HASHCODE_FROM_DOUBLE + ((double) (bit_vector_bit (v, ii * size / 5)))); + + return hash; +} + +static Hashcode +bit_vector_hash (Lisp_Object obj, int UNUSED (depth), Boolint equalp) { Lisp_Bit_Vector *v = XBIT_VECTOR (obj); + if (equalp) + { + return HASH2 (bit_vector_length (v), + internal_bit_vector_equalp_hash (v)); + } + return HASH2 (bit_vector_length (v), memory_hash (v->bits, BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)) * @@ -119,9 +183,9 @@ } static Bytecount -size_bit_vector (const void *lheader) -{ - Lisp_Bit_Vector *v = (Lisp_Bit_Vector *) lheader; +size_bit_vector (Lisp_Object obj) +{ + Lisp_Bit_Vector *v = XBIT_VECTOR (obj); return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, unsigned long, bits, BIT_VECTOR_LONG_STORAGE (bit_vector_length (v))); } @@ -131,16 +195,594 @@ }; -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("bit-vector", bit_vector, - 1, /*dumpable-flag*/ - mark_bit_vector, - print_bit_vector, 0, - bit_vector_equal, - bit_vector_hash, - bit_vector_description, - size_bit_vector, - Lisp_Bit_Vector); - +DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("bit-vector", bit_vector, + mark_bit_vector, + print_bit_vector, 0, + bit_vector_equal, + bit_vector_hash, + bit_vector_description, + size_bit_vector, + Lisp_Bit_Vector); + +/* Various test functions for #'member*, #'assoc* and the other functions + that take both TEST and KEY arguments. */ + +static Boolint +check_eq_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key), + Lisp_Object item, Lisp_Object elt) +{ + return EQ (item, elt); +} + +static Boolint +check_eq_key (Lisp_Object UNUSED (test), Lisp_Object key, Lisp_Object item, + Lisp_Object elt) +{ + elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt)); + return EQ (item, elt); +} + +/* The next two are not used by #'member* and #'assoc*, since we can decide + on #'eq vs. #'equal when we have the type of ITEM. */ +static Boolint +check_eql_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key), + Lisp_Object elt1, Lisp_Object elt2) +{ + return EQ (elt1, elt2) + || (NON_FIXNUM_NUMBER_P (elt1) && internal_equal (elt1, elt2, 0)); +} + +static Boolint +check_eql_key (Lisp_Object UNUSED (test), Lisp_Object key, Lisp_Object item, + Lisp_Object elt) +{ + elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt)); + return EQ (item, elt) + || (NON_FIXNUM_NUMBER_P (item) && internal_equal (item, elt, 0)); +} + +static Boolint +check_equal_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key), + Lisp_Object item, Lisp_Object elt) +{ + return internal_equal (item, elt, 0); +} + +static Boolint +check_equal_key (Lisp_Object UNUSED (test), Lisp_Object key, Lisp_Object item, + Lisp_Object elt) +{ + elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt)); + return internal_equal (item, elt, 0); +} + +static Boolint +check_equalp_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key), + Lisp_Object item, Lisp_Object elt) +{ + return internal_equalp (item, elt, 0); +} + +static Boolint +check_equalp_key (Lisp_Object UNUSED (test), Lisp_Object key, + Lisp_Object item, Lisp_Object elt) +{ + elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt)); + return internal_equalp (item, elt, 0); +} + +static Boolint +check_string_match_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key), + Lisp_Object item, Lisp_Object elt) +{ + return !NILP (Fstring_match (item, elt, Qnil, Qnil)); +} + +static Boolint +check_string_match_key (Lisp_Object UNUSED (test), Lisp_Object key, + Lisp_Object item, Lisp_Object elt) +{ + elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt)); + return !NILP (Fstring_match (item, elt, Qnil, Qnil)); +} + +static Boolint +check_other_nokey (Lisp_Object test, Lisp_Object UNUSED (key), + Lisp_Object item, Lisp_Object elt) +{ + Lisp_Object args[] = { test, item, elt }; + struct gcpro gcpro1; + + GCPRO1 (args[0]); + gcpro1.nvars = countof (args); + item = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args)); + UNGCPRO; + + return !NILP (item); +} + +static Boolint +check_other_key (Lisp_Object test, Lisp_Object key, + Lisp_Object item, Lisp_Object elt) +{ + Lisp_Object args[] = { item, key, elt }; + struct gcpro gcpro1; + + GCPRO1 (args[0]); + gcpro1.nvars = countof (args); + args[2] = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args) - 1, args + 1)); + args[1] = item; + args[0] = test; + item = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args)); + UNGCPRO; + + return !NILP (item); +} + +static Boolint +check_if_nokey (Lisp_Object test, Lisp_Object UNUSED (key), + Lisp_Object UNUSED (item), Lisp_Object elt) +{ + elt = IGNORE_MULTIPLE_VALUES (call1 (test, elt)); + return !NILP (elt); +} + +static Boolint +check_if_key (Lisp_Object test, Lisp_Object key, + Lisp_Object UNUSED (item), Lisp_Object elt) +{ + Lisp_Object args[] = { key, elt }; + struct gcpro gcpro1; + + GCPRO1 (args[0]); + gcpro1.nvars = countof (args); + args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args)); + args[0] = test; + elt = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args)); + UNGCPRO; + + return !NILP (elt); +} + +static Boolint +check_match_eq_key (Lisp_Object UNUSED (test), Lisp_Object key, + Lisp_Object elt1, Lisp_Object elt2) +{ + Lisp_Object args[] = { key, elt1, elt2 }; + struct gcpro gcpro1; + + GCPRO1 (args[0]); + gcpro1.nvars = countof (args); + args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args)); + args[1] = key; + args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1)); + UNGCPRO; + + return EQ (args[0], args[1]); +} + +static Boolint +check_match_eql_key (Lisp_Object UNUSED (test), Lisp_Object key, + Lisp_Object elt1, Lisp_Object elt2) +{ + Lisp_Object args[] = { key, elt1, elt2 }; + struct gcpro gcpro1; + + GCPRO1 (args[0]); + gcpro1.nvars = countof (args); + args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args)); + args[1] = key; + args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1)); + UNGCPRO; + + return EQ (args[0], args[1]) || + (NON_FIXNUM_NUMBER_P (args[0]) && internal_equal (args[0], args[1], 0)); +} + +static Boolint +check_match_equal_key (Lisp_Object UNUSED (test), Lisp_Object key, + Lisp_Object elt1, Lisp_Object elt2) +{ + Lisp_Object args[] = { key, elt1, elt2 }; + struct gcpro gcpro1; + + GCPRO1 (args[0]); + gcpro1.nvars = countof (args); + args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args)); + args[1] = key; + args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1)); + UNGCPRO; + + return internal_equal (args[0], args[1], 0); +} + +static Boolint +check_match_equalp_key (Lisp_Object UNUSED (test), Lisp_Object key, + Lisp_Object elt1, Lisp_Object elt2) +{ + Lisp_Object args[] = { key, elt1, elt2 }; + struct gcpro gcpro1; + + GCPRO1 (args[0]); + gcpro1.nvars = countof (args); + args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args)); + args[1] = key; + args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1)); + UNGCPRO; + + return internal_equalp (args[0], args[1], 0); +} + +static Boolint +check_match_other_key (Lisp_Object test, Lisp_Object key, + Lisp_Object elt1, Lisp_Object elt2) +{ + Lisp_Object args[] = { key, elt1, elt2 }; + struct gcpro gcpro1; + + GCPRO1 (args[0]); + gcpro1.nvars = countof (args); + args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args)); + args[1] = key; + args[2] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1)); + args[1] = args[0]; + args[0] = test; + + elt1 = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args)); + UNGCPRO; + + return !NILP (elt1); +} + +static Boolint +check_lss_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key), + Lisp_Object elt1, Lisp_Object elt2) +{ + return bytecode_arithcompare (elt1, elt2) < 0; +} + +static Boolint +check_lss_key (Lisp_Object UNUSED (test), Lisp_Object key, + Lisp_Object elt1, Lisp_Object elt2) +{ + Lisp_Object args[] = { key, elt1, elt2 }; + struct gcpro gcpro1; + + GCPRO1 (args[0]); + gcpro1.nvars = countof (args); + args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args)); + args[1] = key; + args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1)); + UNGCPRO; + + return bytecode_arithcompare (args[0], args[1]) < 0; +} + +Boolint +check_lss_key_car (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key), + Lisp_Object elt1, Lisp_Object elt2) +{ + struct gcpro gcpro1, gcpro2; + + GCPRO2 (elt1, elt2); + elt1 = CONSP (elt1) ? XCAR (elt1) : Fcar (elt1); + elt2 = CONSP (elt2) ? XCAR (elt2) : Fcar (elt2); + UNGCPRO; + + return bytecode_arithcompare (elt1, elt2) < 0; +} + +Boolint +check_string_lessp_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key), + Lisp_Object elt1, Lisp_Object elt2) +{ + return !NILP (Fstring_lessp (elt1, elt2)); +} + +static Boolint +check_string_lessp_key (Lisp_Object UNUSED (test), Lisp_Object key, + Lisp_Object elt1, Lisp_Object elt2) +{ + Lisp_Object args[] = { key, elt1, elt2 }; + struct gcpro gcpro1; + + GCPRO1 (args[0]); + gcpro1.nvars = countof (args); + args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args)); + args[1] = key; + args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1)); + UNGCPRO; + + return !NILP (Fstring_lessp (args[0], args[1])); +} + +static Boolint +check_string_lessp_key_car (Lisp_Object UNUSED (test), + Lisp_Object UNUSED (key), + Lisp_Object elt1, Lisp_Object elt2) +{ + struct gcpro gcpro1, gcpro2; + + GCPRO2 (elt1, elt2); + elt1 = CONSP (elt1) ? XCAR (elt1) : Fcar (elt1); + elt2 = CONSP (elt2) ? XCAR (elt2) : Fcar (elt2); + UNGCPRO; + + return !NILP (Fstring_lessp (elt1, elt2)); +} + +static check_test_func_t +get_check_match_function_1 (Lisp_Object item, + Lisp_Object *test_inout, Lisp_Object test_not, + Lisp_Object if_, Lisp_Object if_not, + Lisp_Object key, Boolint *test_not_unboundp_out, + check_test_func_t *test_func_out) +{ + Lisp_Object test = *test_inout; + check_test_func_t result = NULL, test_func = NULL; + Boolint force_if = 0; + + if (!NILP (if_)) + { + if (!(NILP (test) && NILP (test_not) && NILP (if_not))) + { + invalid_argument ("only one keyword among :test :test-not " + ":if :if-not allowed", if_); + } + + test = *test_inout = if_; + force_if = 1; + } + else if (!NILP (if_not)) + { + if (!(NILP (test) && NILP (test_not))) + { + invalid_argument ("only one keyword among :test :test-not " + ":if :if-not allowed", if_not); + } + + test_not = if_not; + force_if = 1; + } + + if (NILP (test)) + { + if (!NILP (test_not)) + { + test = *test_inout = test_not; + if (NULL != test_not_unboundp_out) + { + *test_not_unboundp_out = 0; + } + } + else + { + test = Qeql; + if (NULL != test_not_unboundp_out) + { + *test_not_unboundp_out = 1; + } + } + } + else if (!NILP (test_not)) + { + invalid_argument_2 ("conflicting :test and :test-not keyword arguments", + test, test_not); + } + + test = indirect_function (test, 1); + + if (NILP (key) || + EQ (indirect_function (key, 1), XSYMBOL_FUNCTION (Qidentity))) + { + key = Qidentity; + } + + if (force_if) + { + result = EQ (key, Qidentity) ? check_if_nokey : check_if_key; + + if (NULL != test_func_out) + { + *test_func_out = result; + } + + return result; + } + + if (!UNBOUNDP (item) && EQ (test, XSYMBOL_FUNCTION (Qeql))) + { + test = XSYMBOL_FUNCTION (NON_FIXNUM_NUMBER_P (item) ? Qequal : Qeq); + } + +#define FROB(known_test, eq_condition) \ + if (EQ (test, XSYMBOL_FUNCTION (Q##known_test))) do \ + { \ + if (eq_condition) \ + { \ + test = XSYMBOL_FUNCTION (Qeq); \ + goto force_eq_check; \ + } \ + \ + if (!EQ (Qidentity, key)) \ + { \ + test_func = check_##known_test##_key; \ + result = check_match_##known_test##_key; \ + } \ + else \ + { \ + result = test_func = check_##known_test##_nokey; \ + } \ + } while (0) + + FROB (eql, 0); + else if (SUBRP (test)) + { + force_eq_check: + FROB (eq, 0); + else FROB (equal, (SYMBOLP (item) || INTP (item) || CHARP (item))); + else FROB (equalp, (SYMBOLP (item))); + else if (EQ (test, XSYMBOL_FUNCTION (Qstring_match))) + { + if (EQ (Qidentity, key)) + { + test_func = result = check_string_match_nokey; + } + else + { + test_func = check_string_match_key; + result = check_other_key; + } + } + } + + if (NULL == result) + { + if (EQ (Qidentity, key)) + { + test_func = result = check_other_nokey; + } + else + { + test_func = check_other_key; + result = check_match_other_key; + } + } + + if (NULL != test_func_out) + { + *test_func_out = test_func; + } + + return result; +} +#undef FROB + +/* Given TEST, TEST_NOT, IF, IF_NOT, KEY, and ITEM, return a C function + pointer appropriate for use in deciding whether a given element of a + sequence satisfies TEST. + + Set *test_not_unboundp_out to 1 if TEST_NOT was not bound; set it to zero + if it was bound, and set *test_inout to the value it was bound to. If + TEST was not bound, leave *test_inout alone; the value is not used by + check_eq_*key() or check_equal_*key(), which are the defaults, depending + on the type of ITEM. + + The returned function takes arguments (TEST, KEY, ITEM, ELT), where ITEM + is the item being searched for and ELT is the element of the sequence + being examined. + + Error if both TEST and TEST_NOT were specified, which Common Lisp says is + undefined behaviour. */ + +static check_test_func_t +get_check_test_function (Lisp_Object item, + Lisp_Object *test_inout, Lisp_Object test_not, + Lisp_Object if_, Lisp_Object if_not, + Lisp_Object key, Boolint *test_not_unboundp_out) +{ + check_test_func_t result = NULL; + get_check_match_function_1 (item, test_inout, test_not, if_, if_not, + key, test_not_unboundp_out, &result); + return result; +} + +/* Given TEST, TEST_NOT, IF, IF_NOT and KEY, return a C function pointer + appropriate for use in deciding whether two given elements of a sequence + satisfy TEST. + + Set *test_not_unboundp_out to 1 if TEST_NOT was not bound; set it to zero + if it was bound, and set *test_inout to the value it was bound to. If + TEST was not bound, leave *test_inout alone; the value is not used by + check_eql_*key(). + + The returned function takes arguments (TEST, KEY, ELT1, ELT2), where ELT1 + and ELT2 are elements of the sequence being examined. + + The value that would be given by get_check_test_function() is returned in + *TEST_FUNC_OUT, which allows calling functions to do their own key checks + if they're processing one element at a time. + + Error if both TEST and TEST_NOT were specified, which Common Lisp says is + undefined behaviour. */ + +static check_test_func_t +get_check_match_function (Lisp_Object *test_inout, Lisp_Object test_not, + Lisp_Object if_, Lisp_Object if_not, + Lisp_Object key, Boolint *test_not_unboundp_out, + check_test_func_t *test_func_out) +{ + return get_check_match_function_1 (Qunbound, test_inout, test_not, + if_, if_not, key, + test_not_unboundp_out, test_func_out); +} + +/* Given PREDICATE and KEY, return a C function pointer appropriate for use + in deciding whether one given elements of a sequence is less than + another. */ + +static check_test_func_t +get_merge_predicate (Lisp_Object predicate, Lisp_Object key) +{ + predicate = indirect_function (predicate, 1); + + if (NILP (key)) + { + key = Qidentity; + } + else + { + key = indirect_function (key, 1); + if (EQ (key, XSYMBOL_FUNCTION (Qidentity))) + { + key = Qidentity; + } + } + + if (EQ (key, Qidentity) && EQ (predicate, + XSYMBOL_FUNCTION (Qcar_less_than_car))) + { + key = XSYMBOL_FUNCTION (Qcar); + predicate = XSYMBOL_FUNCTION (Qlss); + } + + if (EQ (predicate, XSYMBOL_FUNCTION (Qlss))) + { + if (EQ (key, Qidentity)) + { + return check_lss_nokey; + } + + if (EQ (key, XSYMBOL_FUNCTION (Qcar))) + { + return check_lss_key_car; + } + + return check_lss_key; + } + + if (EQ (predicate, XSYMBOL_FUNCTION (Qstring_lessp))) + { + if (EQ (key, Qidentity)) + { + return check_string_lessp_nokey; + } + + if (EQ (key, XSYMBOL_FUNCTION (Qcar))) + { + return check_string_lessp_key_car; + } + + return check_string_lessp_key; + } + + if (EQ (key, Qidentity)) + { + return check_other_nokey; + } + + return check_match_other_key; +} DEFUN ("identity", Fidentity, 1, 1, 0, /* Return the argument unchanged. @@ -153,9 +795,10 @@ DEFUN ("random", Frandom, 0, 1, 0, /* Return a pseudo-random number. All fixnums are equally likely. On most systems, this is 31 bits' worth. -With positive integer argument N, return random number in interval [0,N). -N can be a bignum, in which case the range of possible values is extended. -With argument t, set the random number seed from the current time and pid. +With positive integer argument LIMIT, return random number in interval [0, +LIMIT). LIMIT can be a bignum, in which case the range of possible values +is extended. With argument t, set the random number seed from the current +time and pid. */ (limit)) { @@ -166,6 +809,13 @@ seed_random (qxe_getpid () + time (NULL)); if (NATNUMP (limit) && !ZEROP (limit)) { +#ifdef HAVE_BIGNUM + if (BIGNUMP (limit)) + { + bignum_random (scratch_bignum, XBIGNUM_DATA (limit)); + return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); + } +#endif /* Try to take our random number from the higher bits of VAL, not the lower, since (says Gentzel) the low bits of `random' are less random than the higher ones. We do this by using the @@ -178,13 +828,6 @@ val = get_random () / denominator; while (val >= XINT (limit)); } -#ifdef HAVE_BIGNUM - else if (BIGNUMP (limit)) - { - bignum_random (scratch_bignum, XBIGNUM_DATA (limit)); - return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); - } -#endif else val = get_random (); @@ -278,6 +921,338 @@ return make_int (len); } +/* This is almost the above, but is defined by Common Lisp. We need it in C + for shortest_length_among_sequences(), below, for the various sequence + functions that can usefully operate on circular lists. */ + +DEFUN ("list-length", Flist_length, 1, 1, 0, /* +Return the length of LIST. Return nil if LIST is circular. +Error if LIST is dotted. +*/ + (list)) +{ + Lisp_Object hare, tortoise; + Elemcount len; + + for (hare = tortoise = list, len = 0; + CONSP (hare) && (! EQ (hare, tortoise) || len == 0); + hare = XCDR (hare), len++) + { + if (len & 1) + tortoise = XCDR (tortoise); + } + + if (!LISTP (hare)) + { + signal_malformed_list_error (list); + } + + return EQ (hare, tortoise) && len != 0 ? Qnil : make_int (len); +} + +static Lisp_Object string_count_from_end (Lisp_Object, Lisp_Object , + check_test_func_t, Boolint, + Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object); + +static Lisp_Object list_count_from_end (Lisp_Object, Lisp_Object, + check_test_func_t, Boolint, + Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object); + +/* Count the number of occurrences of ITEM in SEQUENCE; if SEQUENCE is a + list, store the cons cell of which the car is the last ITEM in SEQUENCE, + at the address given by tail_out. */ + +static Lisp_Object +count_with_tail (Lisp_Object *tail_out, int nargs, Lisp_Object *args, + Lisp_Object caller) +{ + Lisp_Object item = args[0], sequence = args[1]; + Elemcount starting = 0, ending = EMACS_INT_MAX, encountered = 0; + Elemcount len, ii = 0, counting = EMACS_INT_MAX; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; + + PARSE_KEYWORDS_8 (caller, nargs, args, 9, + (test, key, start, end, from_end, test_not, count, + if_, if_not), (start = Qzero), 2, 0); + + CHECK_SEQUENCE (sequence); + CHECK_NATNUM (start); + starting = BIGNUMP (start) ? 1 + EMACS_INT_MAX : XINT (start); + + if (!NILP (end)) + { + CHECK_NATNUM (end); + ending = BIGNUMP (end) ? 1 + EMACS_INT_MAX : XINT (end); + } + + if (!NILP (count)) + { + CHECK_INTEGER (count); + counting = BIGNUMP (count) ? EMACS_INT_MAX + 1 : XINT (count); + + /* Our callers should have filtered out non-positive COUNT. */ + assert (counting >= 0); + /* And we're not prepared to handle COUNT from any other caller at the + moment. */ + assert (EQ (caller, QremoveX)|| EQ (caller, QdeleteX)); + } + + check_test = get_check_test_function (item, &test, test_not, if_, if_not, + key, &test_not_unboundp); + + *tail_out = Qnil; + + if (CONSP (sequence)) + { + if (EQ (caller, Qcount) && !NILP (from_end) + && (!EQ (key, Qnil) || + check_test == check_other_nokey || check_test == check_if_nokey)) + { + /* #'count, #'count-if, and #'count-if-not are documented to have + a given traversal order if :from-end t is passed in, even + though forward traversal of the sequence has the same result + and is algorithmically less expensive for lists and strings. + This order isn't necessary for other callers, though. */ + return list_count_from_end (item, sequence, check_test, + test_not_unboundp, test, key, + start, end); + } + + /* If COUNT is non-nil and FROM-END is t, we can give the tail + containing the last match, since that's what #'remove* is + interested in (a zero or negative COUNT won't ever reach + count_with_tail(), our callers will return immediately on seeing + it). */ + if (!NILP (count) && !NILP (from_end)) + { + counting = EMACS_INT_MAX; + } + + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) + { + if (!(ii < ending)) + { + break; + } + + if (starting <= ii && + check_test (test, key, item, elt) == test_not_unboundp) + { + encountered++; + *tail_out = tail; + + if (encountered == counting) + { + break; + } + } + + ii++; + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + if ((ii < starting || (ii < ending && !NILP (end))) && + encountered != counting) + { + check_sequence_range (args[1], start, end, Flength (args[1])); + } + } + else if (STRINGP (sequence)) + { + Ibyte *startp = XSTRING_DATA (sequence), *cursor = startp; + Bytecount byte_len = XSTRING_LENGTH (sequence), cursor_offset = 0; + Lisp_Object character = Qnil; + + if (EQ (caller, Qcount) && !NILP (from_end) + && (!EQ (key, Qnil) || + check_test == check_other_nokey || check_test == check_if_nokey)) + { + /* See comment above in the list code. */ + return string_count_from_end (item, sequence, + check_test, test_not_unboundp, + test, key, start, end); + } + + while (cursor_offset < byte_len && ii < ending && encountered < counting) + { + if (ii >= starting) + { + character = make_char (itext_ichar (cursor)); + + if (check_test (test, key, item, character) + == test_not_unboundp) + { + encountered++; + } + + startp = XSTRING_DATA (sequence); + cursor = startp + cursor_offset; + if (byte_len != XSTRING_LENGTH (sequence) + || !valid_ibyteptr_p (cursor)) + { + mapping_interaction_error (caller, sequence); + } + } + + INC_IBYTEPTR (cursor); + cursor_offset = cursor - startp; + ii++; + } + + if (ii < starting || (ii < ending && !NILP (end))) + { + check_sequence_range (sequence, start, end, Flength (sequence)); + } + } + else + { + Lisp_Object object = Qnil; + + len = XINT (Flength (sequence)); + check_sequence_range (sequence, start, end, make_int (len)); + + ending = min (ending, len); + if (0 == len) + { + /* Catches the case where we have nil. */ + return make_integer (encountered); + } + + if (NILP (from_end)) + { + for (ii = starting; ii < ending && encountered < counting; ii++) + { + object = Faref (sequence, make_int (ii)); + if (check_test (test, key, item, object) == test_not_unboundp) + { + encountered++; + } + } + } + else + { + for (ii = ending - 1; ii >= starting && encountered < counting; ii--) + { + object = Faref (sequence, make_int (ii)); + if (check_test (test, key, item, object) == test_not_unboundp) + { + encountered++; + } + } + } + } + + return make_integer (encountered); +} + +static Lisp_Object +list_count_from_end (Lisp_Object item, Lisp_Object sequence, + check_test_func_t check_test, Boolint test_not_unboundp, + Lisp_Object test, Lisp_Object key, + Lisp_Object start, Lisp_Object end) +{ + Elemcount length = XINT (Flength (sequence)), ii = 0, starting = XINT (start); + Elemcount ending = NILP (end) ? length : XINT (end), encountered = 0; + Lisp_Object *storage; + struct gcpro gcpro1; + + check_sequence_range (sequence, start, end, make_integer (length)); + + storage = alloca_array (Lisp_Object, ending - starting); + + { + EXTERNAL_LIST_LOOP_2 (elt, sequence) + { + if (starting <= ii && ii < ending) + { + storage[ii - starting] = elt; + } + ii++; + } + } + + GCPRO1 (storage[0]); + gcpro1.nvars = ending - starting; + + for (ii = ending - 1; ii >= starting; ii--) + { + if (check_test (test, key, item, storage[ii - starting]) + == test_not_unboundp) + { + encountered++; + } + } + + UNGCPRO; + + return make_integer (encountered); +} + +static Lisp_Object +string_count_from_end (Lisp_Object item, Lisp_Object sequence, + check_test_func_t check_test, Boolint test_not_unboundp, + Lisp_Object test, Lisp_Object key, + Lisp_Object start, Lisp_Object end) +{ + Elemcount length = string_char_length (sequence), ii = 0; + Elemcount starting = XINT (start), ending = NILP (end) ? length : XINT (end); + Elemcount encountered = 0; + Ibyte *cursor = XSTRING_DATA (sequence); + Ibyte *endp = cursor + XSTRING_LENGTH (sequence); + Ichar *storage; + + check_sequence_range (sequence, start, end, make_integer (length)); + + storage = alloca_array (Ichar, ending - starting); + + while (cursor < endp && ii < ending) + { + if (starting <= ii && ii < ending) + { + storage [ii - starting] = itext_ichar (cursor); + } + + ii++; + INC_IBYTEPTR (cursor); + } + + for (ii = ending - 1; ii >= starting; ii--) + { + if (check_test (test, key, item, make_char (storage [ii - starting])) + == test_not_unboundp) + { + encountered++; + } + } + + return make_integer (encountered); +} + +DEFUN ("count", Fcount, 2, MANY, 0, /* +Count the number of occurrences of ITEM in SEQUENCE. + +See `remove*' for the meaning of the keywords. + +arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) END FROM-END TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object tail = Qnil; + + /* count_with_tail() accepts more keywords than we do, check those we've + been given. */ + PARSE_KEYWORDS (Fcount, nargs, args, 8, + (test, test_not, if_, if_not, key, start, end, from_end), + NULL); + + return count_with_tail (&tail, nargs, args, Qcount); +} + /*** string functions. ***/ DEFUN ("string-equal", Fstring_equal, 2, 2, 0, /* @@ -839,7 +1814,7 @@ { CHECK_CHAR_COERCE_INT (elt); string_result_ptr += set_itext_ichar (string_result_ptr, - XCHAR (elt)); + XCHAR (elt)); } } if (args_mse) @@ -913,7 +1888,7 @@ Lisp_Object safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth) { - if (depth > 200) + if (depth + lisp_eval_depth > max_lisp_eval_depth) stack_overflow ("Stack overflow in copy-tree", arg); if (CONSP (arg)) @@ -947,11 +1922,163 @@ return arg; } -DEFUN ("substring", Fsubstring, 2, 3, 0, /* -Return the substring of STRING starting at START and ending before END. +DEFUN ("subseq", Fsubseq, 2, 3, 0, /* +Return the subsequence of SEQUENCE starting at START and ending before END. +END may be omitted; then the subsequence runs to the end of SEQUENCE. + +If START or END is negative, it counts from the end, in contravention of +Common Lisp. +The returned subsequence is always of the same type as SEQUENCE. +If SEQUENCE is a string, relevant parts of the string-extent-data +are copied to the new string. + +See also `substring-no-properties', which only operates on strings, and does +not copy extent data. +*/ + (sequence, start, end)) +{ + Elemcount len, ss, ee = EMACS_INT_MAX, ii; + Lisp_Object result = Qnil; + + CHECK_SEQUENCE (sequence); + CHECK_INT (start); + ss = XINT (start); + + if (!NILP (end)) + { + CHECK_INT (end); + ee = XINT (end); + } + + if (STRINGP (sequence)) + { + Bytecount bstart, blen; + + get_string_range_char (sequence, start, end, &ss, &ee, + GB_HISTORICAL_STRING_BEHAVIOR); + bstart = string_index_char_to_byte (sequence, ss); + blen = string_offset_char_to_byte_len (sequence, bstart, ee - ss); + + result = make_string (XSTRING_DATA (sequence) + bstart, blen); + /* Copy any applicable extent information into the new string. */ + copy_string_extents (result, sequence, 0, bstart, blen); + } + else if (CONSP (sequence)) + { + Lisp_Object result_tail, saved = sequence; + + if (ss < 0 || ee < 0) + { + len = XINT (Flength (sequence)); + if (ss < 0) + { + ss = len + ss; + start = make_integer (ss); + } + + if (ee < 0) + { + ee = len + ee; + end = make_integer (ee); + } + else + { + ee = min (ee, len); + } + } + + if (0 != ss) + { + sequence = Fnthcdr (make_int (ss), sequence); + } + + ii = ss + 1; + + if (ss < ee && !NILP (sequence)) + { + result = result_tail = Fcons (Fcar (sequence), Qnil); + sequence = Fcdr (sequence); + + { + EXTERNAL_LIST_LOOP_2 (elt, sequence) + { + if (!(ii < ee)) + { + break; + } + + XSETCDR (result_tail, Fcons (elt, Qnil)); + result_tail = XCDR (result_tail); + ii++; + } + } + } + + if (NILP (result) || (ii < ee && !NILP (end))) + { + /* We were handed a cons, which definitely has elements. nil + result means either ss >= ee or SEQUENCE was nil after the + nthcdr; in both cases that means START and END were incorrectly + specified for this sequence. ii < ee with a non-nil end means + the user handed us a bogus end value. */ + check_sequence_range (saved, start, end, Flength (saved)); + } + } + else + { + len = XINT (Flength (sequence)); + if (ss < 0) + { + ss = len + ss; + start = make_integer (ss); + } + + if (ee < 0) + { + ee = len + ee; + end = make_integer (ee); + } + else + { + ee = min (len, ee); + } + + check_sequence_range (sequence, start, end, make_int (len)); + + if (VECTORP (sequence)) + { + result = Fvector (ee - ss, XVECTOR_DATA (sequence) + ss); + } + else if (BIT_VECTORP (sequence)) + { + result = make_bit_vector (ee - ss, Qzero); + + for (ii = ss; ii < ee; ii++) + { + set_bit_vector_bit (XBIT_VECTOR (result), ii - ss, + bit_vector_bit (XBIT_VECTOR (sequence), ii)); + } + } + else if (NILP (sequence)) + { + DO_NOTHING; + } + else + { + /* Won't happen, since CHECK_SEQUENCE didn't error. */ + ABORT (); + } + } + + return result; +} + +DEFUN ("substring-no-properties", Fsubstring_no_properties, 1, 3, 0, /* +Return a substring of STRING, without copying the extents. END may be nil or omitted; then the substring runs to the end of STRING. If START or END is negative, it counts from the end. -Relevant parts of the string-extent-data are copied to the new string. + +With one argument, copy STRING without its properties. */ (string, start, end)) { @@ -960,124 +2087,139 @@ Lisp_Object val; CHECK_STRING (string); - CHECK_INT (start); get_string_range_char (string, start, end, &ccstart, &ccend, - GB_HISTORICAL_STRING_BEHAVIOR); + GB_HISTORICAL_STRING_BEHAVIOR); bstart = string_index_char_to_byte (string, ccstart); blen = string_offset_char_to_byte_len (string, bstart, ccend - ccstart); val = make_string (XSTRING_DATA (string) + bstart, blen); - /* Copy any applicable extent information into the new string. */ - copy_string_extents (val, string, 0, bstart, blen); + return val; } -DEFUN ("subseq", Fsubseq, 2, 3, 0, /* -Return the subsequence of SEQUENCE starting at START and ending before END. -END may be omitted; then the subsequence runs to the end of SEQUENCE. -If START or END is negative, it counts from the end. -The returned subsequence is always of the same type as SEQUENCE. -If SEQUENCE is a string, relevant parts of the string-extent-data -are copied to the new string. -*/ - (sequence, start, end)) -{ - EMACS_INT len, s, e; - - CHECK_SEQUENCE (sequence); - - if (STRINGP (sequence)) - return Fsubstring (sequence, start, end); - - len = XINT (Flength (sequence)); - - CHECK_INT (start); - s = XINT (start); - if (s < 0) - s = len + s; - - if (NILP (end)) - e = len; - else - { - CHECK_INT (end); - e = XINT (end); - if (e < 0) - e = len + e; - } - - if (!(0 <= s && s <= e && e <= len)) - args_out_of_range_3 (sequence, make_int (s), make_int (e)); - - if (VECTORP (sequence)) - { - Lisp_Object result = make_vector (e - s, Qnil); - EMACS_INT i; - Lisp_Object *in_elts = XVECTOR_DATA (sequence); - Lisp_Object *out_elts = XVECTOR_DATA (result); - - for (i = s; i < e; i++) - out_elts[i - s] = in_elts[i]; - return result; - } - else if (LISTP (sequence)) - { - Lisp_Object result = Qnil; - EMACS_INT i; - - sequence = Fnthcdr (make_int (s), sequence); - - for (i = s; i < e; i++) - { - result = Fcons (Fcar (sequence), result); - sequence = Fcdr (sequence); - } - - return Fnreverse (result); - } - else if (BIT_VECTORP (sequence)) - { - Lisp_Object result = make_bit_vector (e - s, Qzero); - EMACS_INT i; - - for (i = s; i < e; i++) - set_bit_vector_bit (XBIT_VECTOR (result), i - s, - bit_vector_bit (XBIT_VECTOR (sequence), i)); - return result; - } - else - { - ABORT (); /* unreachable, since CHECK_SEQUENCE (sequence) did not - error */ - return Qnil; - } -} - /* Split STRING into a list of substrings. The substrings are the - parts of original STRING separated by SEPCHAR. */ + parts of original STRING separated by SEPCHAR. + + If UNESCAPE is non-zero, ESCAPECHAR specifies a character that will quote + SEPCHAR, and cause it not to split STRING. A double ESCAPECHAR is + necessary for ESCAPECHAR to appear once in a substring. */ + static Lisp_Object split_string_by_ichar_1 (const Ibyte *string, Bytecount size, - Ichar sepchar) + Ichar sepchar, int unescape, Ichar escapechar) { Lisp_Object result = Qnil; const Ibyte *end = string + size; - while (1) - { - const Ibyte *p = string; - while (p < end) - { - if (itext_ichar (p) == sepchar) - break; - INC_IBYTEPTR (p); - } - result = Fcons (make_string (string, p - string), result); - if (p < end) - { - string = p; - INC_IBYTEPTR (string); /* skip sepchar */ - } - else - break; + if (unescape) + { + Ibyte unescape_buffer[64], *unescape_buffer_ptr = unescape_buffer, + escaped[MAX_ICHAR_LEN], *unescape_cursor; + Bytecount unescape_buffer_size = countof (unescape_buffer), + escaped_len = set_itext_ichar (escaped, escapechar); + Boolint deleting_escapes, previous_escaped; + Ichar pchar; + + while (1) + { + const Ibyte *p = string, *cursor; + deleting_escapes = 0; + previous_escaped = 0; + + while (p < end) + { + pchar = itext_ichar (p); + + if (pchar == sepchar) + { + if (!previous_escaped) + { + break; + } + } + else if (pchar == escapechar + /* Doubled escapes don't escape: */ + && !previous_escaped) + { + ++deleting_escapes; + previous_escaped = 1; + } + else + { + previous_escaped = 0; + } + + INC_IBYTEPTR (p); + } + + if (deleting_escapes) + { + if (((p - string) - (escaped_len * deleting_escapes)) + > unescape_buffer_size) + { + unescape_buffer_size = + ((p - string) - (escaped_len * deleting_escapes)) * 1.5; + unescape_buffer_ptr = alloca_ibytes (unescape_buffer_size); + } + + cursor = string; + unescape_cursor = unescape_buffer_ptr; + previous_escaped = 0; + + while (cursor < p) + { + pchar = itext_ichar (cursor); + + if (pchar != escapechar || previous_escaped) + { + memcpy (unescape_cursor, cursor, + itext_ichar_len (cursor)); + INC_IBYTEPTR (unescape_cursor); + } + + previous_escaped = !previous_escaped + && (pchar == escapechar); + + INC_IBYTEPTR (cursor); + } + + result = Fcons (make_string (unescape_buffer_ptr, + unescape_cursor + - unescape_buffer_ptr), + result); + } + else + { + result = Fcons (make_string (string, p - string), result); + } + if (p < end) + { + string = p; + INC_IBYTEPTR (string); /* skip sepchar */ + } + else + break; + } + } + else + { + while (1) + { + const Ibyte *p = string; + while (p < end) + { + if (itext_ichar (p) == sepchar) + break; + INC_IBYTEPTR (p); + } + result = Fcons (make_string (string, p - string), result); + if (p < end) + { + string = p; + INC_IBYTEPTR (string); /* skip sepchar */ + } + else + break; + } } return Fnreverse (result); } @@ -1102,7 +2244,7 @@ if (!newlen) return Qnil; - return split_string_by_ichar_1 (newpath, newlen, SEPCHAR); + return split_string_by_ichar_1 (newpath, newlen, SEPCHAR, 0, 0); } Lisp_Object @@ -1115,22 +2257,34 @@ path = default_; if (!path) return Qnil; - return split_string_by_ichar_1 (path, qxestrlen (path), SEPCHAR); + return split_string_by_ichar_1 (path, qxestrlen (path), SEPCHAR, 0, 0); } /* Ben thinks this function should not exist or be exported to Lisp. We use it to define split-path-string in subr.el (not!). */ -DEFUN ("split-string-by-char", Fsplit_string_by_char, 2, 2, 0, /* +DEFUN ("split-string-by-char", Fsplit_string_by_char, 2, 3, 0, /* Split STRING into a list of substrings originally separated by SEPCHAR. -*/ - (string, sepchar)) -{ + +With optional ESCAPE-CHAR, any instances of SEPCHAR preceded by that +character will not split the string, and a double instance of ESCAPE-CHAR +will be necessary for a single ESCAPE-CHAR to appear in the output string. +*/ + (string, sepchar, escape_char)) +{ + Ichar escape_ichar = 0; + CHECK_STRING (string); CHECK_CHAR (sepchar); + if (!NILP (escape_char)) + { + CHECK_CHAR (escape_char); + escape_ichar = XCHAR (escape_char); + } return split_string_by_ichar_1 (XSTRING_DATA (string), - XSTRING_LENGTH (string), - XCHAR (sepchar)); + XSTRING_LENGTH (string), + XCHAR (sepchar), + !NILP (escape_char), escape_ichar); } /* #### This was supposed to be in subr.el, but is used VERY early in @@ -1154,7 +2308,7 @@ return (split_string_by_ichar_1 (XSTRING_DATA (path), XSTRING_LENGTH (path), - itext_ichar (XSTRING_DATA (Vpath_separator)))); + itext_ichar (XSTRING_DATA (Vpath_separator)), 0, 0)); } @@ -1167,7 +2321,7 @@ REGISTER EMACS_INT i; REGISTER Lisp_Object tail = list; CHECK_NATNUM (n); - for (i = XINT (n); i; i--) + for (i = BIGNUMP (n) ? 1 + EMACS_INT_MAX : XINT (n); i; i--) { if (CONSP (tail)) tail = XCDR (tail); @@ -1287,7 +2441,7 @@ else { CHECK_NATNUM (n); - int_n = XINT (n); + int_n = BIGNUMP (n) ? 1 + EMACS_INT_MAX : XINT (n); } for (retval = tortoise = hare = list, count = 0; @@ -1309,72 +2463,99 @@ DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /* Modify LIST to remove the last N (default 1) elements. + If LIST has N or fewer elements, nil is returned and LIST is unmodified. +Otherwise, LIST may be dotted, but not circular. */ (list, n)) { - EMACS_INT int_n; + Elemcount int_n = 1; CHECK_LIST (list); - if (NILP (n)) - int_n = 1; - else + if (!NILP (n)) { CHECK_NATNUM (n); - int_n = XINT (n); - } - - { - Lisp_Object last_cons = list; - - EXTERNAL_LIST_LOOP_1 (list) - { - if (int_n-- < 0) - last_cons = XCDR (last_cons); - } - - if (int_n >= 0) - return Qnil; - - XCDR (last_cons) = Qnil; - return list; - } + int_n = BIGNUMP (n) ? 1 + EMACS_INT_MAX : XINT (n); + } + + if (CONSP (list)) + { + Lisp_Object last_cons = list; + + EXTERNAL_LIST_LOOP_3 (elt, list, tail) + { + if (int_n-- < 0) + { + last_cons = XCDR (last_cons); + } + + if (!CONSP (XCDR (tail))) + { + break; + } + } + + if (int_n >= 0) + { + return Qnil; + } + + XCDR (last_cons) = Qnil; + } + + return list; } DEFUN ("butlast", Fbutlast, 1, 2, 0, /* Return a copy of LIST with the last N (default 1) elements removed. + If LIST has N or fewer elements, nil is returned. +Otherwise, LIST may be dotted, but not circular, and `(butlast LIST 0)' +converts a dotted into a true list. */ (list, n)) { - EMACS_INT int_n; + Lisp_Object retval = Qnil, retval_tail = Qnil; + Elemcount int_n = 1; CHECK_LIST (list); - if (NILP (n)) - int_n = 1; - else + if (!NILP (n)) { CHECK_NATNUM (n); - int_n = XINT (n); - } - - { - Lisp_Object retval = Qnil; - Lisp_Object tail = list; - - EXTERNAL_LIST_LOOP_1 (list) - { - if (--int_n < 0) - { - retval = Fcons (XCAR (tail), retval); - tail = XCDR (tail); - } - } - - return Fnreverse (retval); - } + int_n = BIGNUMP (n) ? 1 + EMACS_INT_MAX : XINT (n); + } + + if (CONSP (list)) + { + Lisp_Object tail = list; + + EXTERNAL_LIST_LOOP_3 (elt, list, list_tail) + { + if (--int_n < 0) + { + if (NILP (retval_tail)) + { + retval = retval_tail = Fcons (XCAR (tail), Qnil); + } + else + { + XSETCDR (retval_tail, Fcons (XCAR (tail), Qnil)); + retval_tail = XCDR (retval_tail); + } + + tail = XCDR (tail); + } + + if (!CONSP (XCDR (list_tail))) + { + break; + } + } + } + + return retval; } DEFUN ("member", Fmember, 2, 2, 0, /* @@ -1391,22 +2572,6 @@ return Qnil; } -DEFUN ("old-member", Fold_member, 2, 2, 0, /* -Return non-nil if ELT is an element of LIST. Comparison done with `old-equal'. -The value is actually the tail of LIST whose car is ELT. -This function is provided only for byte-code compatibility with v19. -Do not use it. -*/ - (elt, list)) -{ - EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) - { - if (internal_old_equal (elt, list_elt, 0)) - return tail; - } - return Qnil; -} - DEFUN ("memq", Fmemq, 2, 2, 0, /* Return non-nil if ELT is an element of LIST. Comparison done with `eq'. The value is actually the tail of LIST whose car is ELT. @@ -1421,22 +2586,6 @@ return Qnil; } -DEFUN ("old-memq", Fold_memq, 2, 2, 0, /* -Return non-nil if ELT is an element of LIST. Comparison done with `old-eq'. -The value is actually the tail of LIST whose car is ELT. -This function is provided only for byte-code compatibility with v19. -Do not use it. -*/ - (elt, list)) -{ - EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) - { - if (HACKEQ_UNSAFE (elt, list_elt)) - return tail; - } - return Qnil; -} - Lisp_Object memq_no_quit (Lisp_Object elt, Lisp_Object list) { @@ -1448,6 +2597,178 @@ return Qnil; } +/* Return the first index of ITEM in LIST. In CONS_OUT, return the cons cell + before that containing the element. If the element is in the first cons + cell, return Qnil in CONS_OUT. TEST, KEY, START, END are as in + #'remove*; CHECK_TEST and TEST_NOT_UNBOUNDP should have been initialized + with get_check_match_function() or get_check_test_function(). A non-zero + REVERSE_TEST_ORDER means call TEST with the element from LIST as its + first argument and ITEM as its second. Error if LIST is ill-formed, or + circular. */ +static Lisp_Object +list_position_cons_before (Lisp_Object *cons_out, + Lisp_Object item, Lisp_Object list, + check_test_func_t check_test, + Boolint test_not_unboundp, + Lisp_Object test, Lisp_Object key, + Boolint reverse_test_order, + Lisp_Object start, Lisp_Object end) +{ + struct gcpro gcpro1; + Lisp_Object tail_before = Qnil; + Elemcount ii = 0, starting = XINT (start); + Elemcount ending = NILP (end) ? EMACS_INT_MAX : XINT (end); + + GCPRO1 (tail_before); + + if (check_test == check_eq_nokey) + { + /* TEST is #'eq, no need to call any C functions, and the test order + won't be visible. */ + EXTERNAL_LIST_LOOP_3 (elt, list, tail) + { + if (starting <= ii && ii < ending && + EQ (item, elt) == test_not_unboundp) + { + *cons_out = tail_before; + RETURN_UNGCPRO (make_integer (ii)); + } + else + { + if (ii >= ending) + { + break; + } + } + ii++; + tail_before = tail; + } + } + else + { + GC_EXTERNAL_LIST_LOOP_3 (elt, list, tail) + { + if (starting <= ii && ii < ending && + (reverse_test_order ? + check_test (test, key, elt, item) : + check_test (test, key, item, elt)) == test_not_unboundp) + { + *cons_out = tail_before; + XUNGCPRO (elt); + UNGCPRO; + return make_integer (ii); + } + else + { + if (ii >= ending) + { + break; + } + } + ii++; + tail_before = tail; + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + RETURN_UNGCPRO (Qnil); +} + +DEFUN ("member*", FmemberX, 2, MANY, 0, /* +Return the first sublist of LIST with car ITEM, or nil if no such sublist. + +The keyword :test specifies a two-argument function that is used to compare +ITEM with elements in LIST; if omitted, it defaults to `eql'. + +The keyword :test-not is similar, but specifies a negated function. That +is, ITEM is considered equal to an element in LIST if the given function +returns nil. Common Lisp deprecates :test-not, and if both are specified, +XEmacs signals an error. + +:key specifies a one-argument function that transforms elements of LIST into +\"comparison keys\" before the test predicate is applied. For example, +if :key is #'car, then ITEM is compared with the car of elements from LIST. +The :key function, however, is not applied to ITEM, and does not affect the +elements in the returned list, which are taken directly from the elements in +LIST. + +arguments: (ITEM LIST &key (TEST #'eql) TEST-NOT (KEY #'identity)) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object item = args[0], list = args[1], result = Qnil, position0; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; + + PARSE_KEYWORDS (FmemberX, nargs, args, 5, (test, if_not, if_, test_not, key), + NULL); + check_test = get_check_test_function (item, &test, test_not, if_, if_not, + key, &test_not_unboundp); + position0 + = list_position_cons_before (&result, item, list, check_test, + test_not_unboundp, test, key, 0, Qzero, Qnil); + + return CONSP (result) ? XCDR (result) : ZEROP (position0) ? list : Qnil; +} + +/* This macro might eventually find a better home than here. */ + +#define CHECK_KEY_ARGUMENT(key) \ + do { \ + if (NILP (key)) \ + { \ + key = Qidentity; \ + } \ + \ + if (!EQ (key, Qidentity)) \ + { \ + key = indirect_function (key, 1); \ + if (EQ (key, XSYMBOL_FUNCTION (Qidentity))) \ + { \ + key = Qidentity; \ + } \ + } \ + } while (0) + +#define KEY(key, item) (EQ (Qidentity, key) ? item : \ + IGNORE_MULTIPLE_VALUES (call1 (key, item))) + +DEFUN ("adjoin", Fadjoin, 2, MANY, 0, /* +Return ITEM consed onto the front of LIST, if not already in LIST. + +Otherwise, return LIST unmodified. + +See `member*' for the meaning of the keywords. + +arguments: (ITEM LIST &key (TEST #'eql) (KEY #'identity) TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object item = args[0], list = args[1], keyed = Qnil, ignore = Qnil; + struct gcpro gcpro1; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; + + PARSE_KEYWORDS (Fadjoin, nargs, args, 3, (test, key, test_not), + NULL); + + CHECK_KEY_ARGUMENT (key); + + keyed = KEY (key, item); + + GCPRO1 (keyed); + check_test = get_check_test_function (keyed, &test, test_not, Qnil, Qnil, + key, &test_not_unboundp); + if (NILP (list_position_cons_before (&ignore, keyed, list, check_test, + test_not_unboundp, test, key, 0, Qzero, + Qnil))) + { + RETURN_UNGCPRO (Fcons (item, list)); + } + + RETURN_UNGCPRO (list); +} + DEFUN ("assoc", Fassoc, 2, 2, 0, /* Return non-nil if KEY is `equal' to the car of an element of ALIST. The value is actually the element of ALIST whose car equals KEY. @@ -1463,21 +2784,6 @@ return Qnil; } -DEFUN ("old-assoc", Fold_assoc, 2, 2, 0, /* -Return non-nil if KEY is `old-equal' to the car of an element of ALIST. -The value is actually the element of ALIST whose car equals KEY. -*/ - (key, alist)) -{ - /* This function can GC. */ - EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) - { - if (internal_old_equal (key, elt_car, 0)) - return elt; - } - return Qnil; -} - Lisp_Object assoc_no_quit (Lisp_Object key, Lisp_Object alist) { @@ -1501,23 +2807,6 @@ return Qnil; } -DEFUN ("old-assq", Fold_assq, 2, 2, 0, /* -Return non-nil if KEY is `old-eq' to the car of an element of ALIST. -The value is actually the element of ALIST whose car is KEY. -Elements of ALIST that are not conses are ignored. -This function is provided only for byte-code compatibility with v19. -Do not use it. -*/ - (key, alist)) -{ - EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) - { - if (HACKEQ_UNSAFE (key, elt_car)) - return elt; - } - return Qnil; -} - /* Like Fassq but never report an error and do not allow quits. Use only on lists known never to be circular. */ @@ -1534,6 +2823,53 @@ return Qnil; } +DEFUN ("assoc*", FassocX, 2, MANY, 0, /* +Find the first item whose car matches ITEM in ALIST. + +See `member*' for the meaning of :test, :test-not and :key. + +arguments: (ITEM ALIST &key (TEST #'eql) (KEY #'identity) TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object item = args[0], alist = args[1]; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; + + PARSE_KEYWORDS (FassocX, nargs, args, 5, (test, if_, if_not, test_not, key), + NULL); + + check_test = get_check_test_function (item, &test, test_not, if_, if_not, + key, &test_not_unboundp); + + if (check_test == check_eq_nokey) + { + /* TEST is #'eq, no need to call any C functions. */ + EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) + { + if (EQ (item, elt_car) == test_not_unboundp) + { + return elt; + } + } + } + else + { + GC_EXTERNAL_LIST_LOOP_2 (elt, alist) + { + if (CONSP (elt) && + check_test (test, key, item, XCAR (elt)) == test_not_unboundp) + { + XUNGCPRO (elt); + return elt; + } + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + return Qnil; +} + DEFUN ("rassoc", Frassoc, 2, 2, 0, /* Return non-nil if VALUE is `equal' to the cdr of an element of ALIST. The value is actually the element of ALIST whose cdr equals VALUE. @@ -1548,20 +2884,6 @@ return Qnil; } -DEFUN ("old-rassoc", Fold_rassoc, 2, 2, 0, /* -Return non-nil if VALUE is `old-equal' to the cdr of an element of ALIST. -The value is actually the element of ALIST whose cdr equals VALUE. -*/ - (value, alist)) -{ - EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) - { - if (internal_old_equal (value, elt_cdr, 0)) - return elt; - } - return Qnil; -} - DEFUN ("rassq", Frassq, 2, 2, 0, /* Return non-nil if VALUE is `eq' to the cdr of an element of ALIST. The value is actually the element of ALIST whose cdr is VALUE. @@ -1604,64 +2926,256 @@ return Qnil; } +DEFUN ("rassoc*", FrassocX, 2, MANY, 0, /* +Find the first item whose cdr matches ITEM in ALIST. + +See `member*' for the meaning of :test, :test-not and :key. + +arguments: (ITEM ALIST &key (TEST #'eql) (KEY #'identity) TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object item = args[0], alist = args[1]; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; + + PARSE_KEYWORDS (FrassocX, nargs, args, 5, (test, if_, if_not, test_not, key), + NULL); + + check_test = get_check_test_function (item, &test, test_not, if_, if_not, + key, &test_not_unboundp); + + if (check_test == check_eq_nokey) + { + /* TEST is #'eq, no need to call any C functions. */ + EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) + { + if (EQ (item, elt_cdr) == test_not_unboundp) + { + return elt; + } + } + } + else + { + GC_EXTERNAL_LIST_LOOP_2 (elt, alist) + { + if (CONSP (elt) && + check_test (test, key, item, XCDR (elt)) == test_not_unboundp) + { + XUNGCPRO (elt); + return elt; + } + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + return Qnil; +} -DEFUN ("delete", Fdelete, 2, 2, 0, /* -Delete by side effect any occurrences of ELT as a member of LIST. -The modified LIST is returned. Comparison is done with `equal'. -If the first member of LIST is ELT, there is no way to remove it by side -effect; therefore, write `(setq foo (delete element foo))' to be sure -of changing the value of `foo'. -Also see: `remove'. -*/ - (elt, list)) -{ - EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, - (internal_equal (elt, list_elt, 0))); - return list; -} - -DEFUN ("old-delete", Fold_delete, 2, 2, 0, /* -Delete by side effect any occurrences of ELT as a member of LIST. -The modified LIST is returned. Comparison is done with `old-equal'. -If the first member of LIST is ELT, there is no way to remove it by side -effect; therefore, write `(setq foo (old-delete element foo))' to be sure -of changing the value of `foo'. -*/ - (elt, list)) -{ - EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, - (internal_old_equal (elt, list_elt, 0))); - return list; -} - -DEFUN ("delq", Fdelq, 2, 2, 0, /* -Delete by side effect any occurrences of ELT as a member of LIST. -The modified LIST is returned. Comparison is done with `eq'. -If the first member of LIST is ELT, there is no way to remove it by side -effect; therefore, write `(setq foo (delq element foo))' to be sure of -changing the value of `foo'. -*/ - (elt, list)) -{ - EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, - (EQ_WITH_EBOLA_NOTICE (elt, list_elt))); - return list; -} - -DEFUN ("old-delq", Fold_delq, 2, 2, 0, /* -Delete by side effect any occurrences of ELT as a member of LIST. -The modified LIST is returned. Comparison is done with `old-eq'. -If the first member of LIST is ELT, there is no way to remove it by side -effect; therefore, write `(setq foo (old-delq element foo))' to be sure of -changing the value of `foo'. -*/ - (elt, list)) -{ - EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, - (HACKEQ_UNSAFE (elt, list_elt))); - return list; -} - +/* This is the implementation of both #'find and #'position. */ +static Lisp_Object +position (Lisp_Object *object_out, Lisp_Object item, Lisp_Object sequence, + check_test_func_t check_test, Boolint test_not_unboundp, + Lisp_Object test, Lisp_Object key, Lisp_Object start, Lisp_Object end, + Lisp_Object from_end, Lisp_Object default_, Lisp_Object caller) +{ + Lisp_Object result = Qnil; + Elemcount starting = 0, ending = EMACS_INT_MAX, len, ii = 0; + + CHECK_SEQUENCE (sequence); + CHECK_NATNUM (start); + starting = INTP (start) ? XINT (start) : 1 + EMACS_INT_MAX; + + if (!NILP (end)) + { + CHECK_NATNUM (end); + ending = INTP (end) ? XINT (end) : 1 + EMACS_INT_MAX; + } + + *object_out = default_; + + if (CONSP (sequence)) + { + if (!(starting < ending)) + { + check_sequence_range (sequence, start, end, Flength (sequence)); + /* starting could be equal to ending, in which case nil is what + we want to return. */ + return Qnil; + } + + { + GC_EXTERNAL_LIST_LOOP_2 (elt, sequence) + { + if (starting <= ii && ii < ending + && check_test (test, key, item, elt) == test_not_unboundp) + { + result = make_integer (ii); + *object_out = elt; + + if (NILP (from_end)) + { + XUNGCPRO (elt); + return result; + } + } + else if (ii == ending) + { + break; + } + + ii++; + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + if (ii < starting || (ii < ending && !NILP (end))) + { + check_sequence_range (sequence, start, end, Flength (sequence)); + } + } + else if (STRINGP (sequence)) + { + Ibyte *startp = XSTRING_DATA (sequence), *cursor = startp; + Bytecount byte_len = XSTRING_LENGTH (sequence), cursor_offset = 0; + Lisp_Object character = Qnil; + + while (cursor_offset < byte_len && ii < ending) + { + if (ii >= starting) + { + character = make_char (itext_ichar (cursor)); + + if (check_test (test, key, item, character) == test_not_unboundp) + { + result = make_integer (ii); + *object_out = character; + + if (NILP (from_end)) + { + return result; + } + } + + startp = XSTRING_DATA (sequence); + cursor = startp + cursor_offset; + if (byte_len != XSTRING_LENGTH (sequence) + || !valid_ibyteptr_p (cursor)) + { + mapping_interaction_error (caller, sequence); + } + } + + INC_IBYTEPTR (cursor); + cursor_offset = cursor - startp; + ii++; + } + + if (ii < starting || (ii < ending && !NILP (end))) + { + check_sequence_range (sequence, start, end, Flength (sequence)); + } + } + else + { + Lisp_Object object = Qnil; + len = XINT (Flength (sequence)); + check_sequence_range (sequence, start, end, make_int (len)); + + ending = min (ending, len); + if (0 == len) + { + /* Catches the case where we have nil. */ + return result; + } + + if (NILP (from_end)) + { + for (ii = starting; ii < ending; ii++) + { + object = Faref (sequence, make_int (ii)); + if (check_test (test, key, item, object) == test_not_unboundp) + { + result = make_integer (ii); + *object_out = object; + return result; + } + } + } + else + { + for (ii = ending - 1; ii >= starting; ii--) + { + object = Faref (sequence, make_int (ii)); + if (check_test (test, key, item, object) == test_not_unboundp) + { + result = make_integer (ii); + *object_out = object; + return result; + } + } + } + } + + return result; +} + +DEFUN ("position", Fposition, 2, MANY, 0, /* +Return the index of the first occurrence of ITEM in SEQUENCE. + +Return nil if not found. See `remove*' for the meaning of the keywords. + +arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object object = Qnil, item = args[0], sequence = args[1]; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; + + PARSE_KEYWORDS (Fposition, nargs, args, 8, + (test, if_, test_not, if_not, key, start, end, from_end), + (start = Qzero)); + + check_test = get_check_test_function (item, &test, test_not, if_, if_not, + key, &test_not_unboundp); + + return position (&object, item, sequence, check_test, test_not_unboundp, + test, key, start, end, from_end, Qnil, Qposition); +} + +DEFUN ("find", Ffind, 2, MANY, 0, /* +Find the first occurrence of ITEM in SEQUENCE. + +Return the matching ITEM, or nil if not found. See `remove*' for the +meaning of the keywords. + +The keyword :default, not specified by Common Lisp, designates an object to +return instead of nil if ITEM is not found. + +arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) DEFAULT FROM-END TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object object = Qnil, item = args[0], sequence = args[1]; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; + + PARSE_KEYWORDS (Ffind, nargs, args, 9, + (test, if_, test_not, if_not, key, start, end, from_end, + default_), + (start = Qzero)); + + check_test = get_check_test_function (item, &test, test_not, if_, if_not, + key, &test_not_unboundp); + + position (&object, item, sequence, check_test, test_not_unboundp, + test, key, start, end, from_end, default_, Qposition); + + return object; +} + /* Like Fdelq, but caller must ensure that LIST is properly nil-terminated and ebola-free. */ @@ -1708,6 +3222,525 @@ return list; } +DEFUN ("delete*", FdeleteX, 2, MANY, 0, /* +Remove all occurrences of ITEM in SEQUENCE, destructively. + +If SEQUENCE is a non-nil list, this modifies the list directly. A non-list +SEQUENCE will not be destructively modified, rather, if ITEM occurs in it, a +new SEQUENCE of the same type without ITEM will be returned. + +See `remove*' for a non-destructive alternative, and for explanation of the +keyword arguments. + +arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END COUNT TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object item = args[0], sequence = args[1]; + Elemcount starting = 0, ending = EMACS_INT_MAX, counting = EMACS_INT_MAX; + Elemcount len, ii = 0, encountered = 0, presenting = 0; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; + + PARSE_KEYWORDS (FdeleteX, nargs, args, 9, + (test, if_not, if_, test_not, key, start, end, from_end, + count), (start = Qzero, count = Qunbound)); + + CHECK_SEQUENCE (sequence); + CHECK_NATNUM (start); + starting = BIGNUMP (start) ? 1 + EMACS_INT_MAX : XINT (start); + + if (!NILP (end)) + { + CHECK_NATNUM (end); + ending = BIGNUMP (end) ? 1 + EMACS_INT_MAX : XINT (end); + } + + if (!UNBOUNDP (count)) + { + if (!NILP (count)) + { + CHECK_INTEGER (count); + if (INTP (count)) + { + counting = XINT (count); + } +#ifdef HAVE_BIGNUM + else + { + counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ? + 1 + EMACS_INT_MAX : EMACS_INT_MIN - 1; + } +#endif + + if (counting < 1) + { + return sequence; + } + + if (!NILP (from_end)) + { + /* Sigh, this is inelegant. Force count_with_tail () to ignore + the count keyword, so we get the actual number of matching + elements, and can start removing from the beginning for the + from-end case. */ + for (ii = XSUBR (GET_DEFUN_LISP_OBJECT (FdeleteX))->min_args; + ii < nargs; ii += 2) + { + if (EQ (args[ii], Q_count)) + { + args[ii + 1] = Qnil; + break; + } + } + ii = 0; + } + } + } + + check_test = get_check_test_function (item, &test, test_not, if_, if_not, + key, &test_not_unboundp); + + if (CONSP (sequence)) + { + Lisp_Object prev_tail_list_elt = Qnil, ignore = Qnil; + Elemcount list_len = 0, deleted = 0; + struct gcpro gcpro1; + + if (!NILP (count) && !NILP (from_end)) + { + /* Both COUNT and FROM-END were specified; we need to traverse the + list twice. */ + Lisp_Object present = count_with_tail (&ignore, nargs, args, + QdeleteX); + + if (ZEROP (present)) + { + return sequence; + } + + presenting = XINT (present); + + /* If there are fewer items in the list than we have permission to + delete, we don't need to differentiate between the :from-end + nil and :from-end t cases. Otherwise, presenting is the number + of matching items we need to ignore before we start to + delete. */ + presenting = presenting <= counting ? 0 : presenting - counting; + } + + GCPRO1 (prev_tail_list_elt); + ii = -1; + + { + GC_EXTERNAL_LIST_LOOP_4 (list_elt, sequence, tail, list_len) + { + ii++; + + if (starting <= ii && ii < ending && + (check_test (test, key, item, list_elt) == test_not_unboundp) + && (presenting ? encountered++ >= presenting + : encountered++ < counting)) + { + if (NILP (prev_tail_list_elt)) + { + sequence = XCDR (tail); + } + else + { + XSETCDR (prev_tail_list_elt, XCDR (tail)); + } + + /* Keep tortoise from ever passing hare. */ + list_len = 0; + deleted++; + } + else + { + prev_tail_list_elt = tail; + if (ii >= ending || (!presenting && encountered > counting)) + { + break; + } + } + } + END_GC_EXTERNAL_LIST_LOOP (list_elt); + } + + UNGCPRO; + + if ((ii < starting || (ii < ending && !NILP (end))) && + !(presenting ? encountered == presenting : encountered == counting)) + { + check_sequence_range (args[1], start, end, + make_int (deleted + XINT (Flength (args[1])))); + } + + return sequence; + } + else if (STRINGP (sequence)) + { + Ibyte *staging = alloca_ibytes (XSTRING_LENGTH (sequence)); + Ibyte *staging_cursor = staging, *startp = XSTRING_DATA (sequence); + Ibyte *cursor = startp; + Bytecount cursor_offset = 0, byte_len = XSTRING_LENGTH (sequence); + Lisp_Object character, result = sequence; + + if (!NILP (count) && !NILP (from_end)) + { + Lisp_Object present = count_with_tail (&character, nargs, args, + QdeleteX); + + if (ZEROP (present)) + { + return sequence; + } + + presenting = XINT (present); + + /* If there are fewer items in the list than we have permission to + delete, we don't need to differentiate between the :from-end + nil and :from-end t cases. Otherwise, presenting is the number + of matching items we need to ignore before we start to + delete. */ + presenting = presenting <= counting ? 0 : presenting - counting; + } + + ii = 0; + while (cursor_offset < byte_len) + { + if (ii >= starting && ii < ending) + { + character = make_char (itext_ichar (cursor)); + + if ((check_test (test, key, item, character) + == test_not_unboundp) + && (presenting ? encountered++ >= presenting : + encountered++ < counting)) + { + DO_NOTHING; + } + else + { + staging_cursor + += set_itext_ichar (staging_cursor, XCHAR (character)); + } + + startp = XSTRING_DATA (sequence); + cursor = startp + cursor_offset; + if (byte_len != XSTRING_LENGTH (sequence) + || !valid_ibyteptr_p (cursor)) + { + mapping_interaction_error (QdeleteX, sequence); + } + } + else + { + staging_cursor += itext_copy_ichar (cursor, staging_cursor); + } + + INC_IBYTEPTR (cursor); + cursor_offset = cursor - startp; + ii++; + } + + if (ii < starting || (ii < ending && !NILP (end))) + { + check_sequence_range (sequence, start, end, Flength (sequence)); + } + + if (0 != encountered) + { + result = make_string (staging, staging_cursor - staging); + copy_string_extents (result, sequence, 0, 0, + staging_cursor - staging); + sequence = result; + } + + return sequence; + } + else + { + Lisp_Object position0 = Qnil, object = Qnil; + Lisp_Object *staging = NULL, *staging_cursor, *staging_limit; + Elemcount positioning; + + len = XINT (Flength (sequence)); + + check_sequence_range (sequence, start, end, make_int (len)); + + position0 = position (&object, item, sequence, check_test, + test_not_unboundp, test, key, start, end, + from_end, Qnil, QdeleteX); + if (NILP (position0)) + { + return sequence; + } + + ending = min (ending, len); + positioning = XINT (position0); + encountered = 1; + + if (NILP (from_end)) + { + staging = alloca_array (Lisp_Object, len - 1); + staging_cursor = staging; + + ii = 0; + while (ii < positioning) + { + *staging_cursor++ = Faref (sequence, make_int (ii)); + ii++; + } + + ii = positioning + 1; + while (ii < ending) + { + object = Faref (sequence, make_int (ii)); + if (encountered < counting + && (check_test (test, key, item, object) + == test_not_unboundp)) + { + encountered++; + } + else + { + *staging_cursor++ = object; + } + ii++; + } + + while (ii < len) + { + *staging_cursor++ = Faref (sequence, make_int (ii)); + ii++; + } + } + else + { + staging = alloca_array (Lisp_Object, len - 1); + staging_cursor = staging_limit = staging + len - 1; + + ii = len - 1; + while (ii > positioning) + { + *--staging_cursor = Faref (sequence, make_int (ii)); + ii--; + } + + ii = positioning - 1; + while (ii >= starting) + { + object = Faref (sequence, make_int (ii)); + if (encountered < counting + && (check_test (test, key, item, object) == + test_not_unboundp)) + { + encountered++; + } + else + { + *--staging_cursor = object; + } + + ii--; + } + + while (ii >= 0) + { + *--staging_cursor = Faref (sequence, make_int (ii)); + ii--; + } + + staging = staging_cursor; + staging_cursor = staging_limit; + } + + if (VECTORP (sequence)) + { + return Fvector (staging_cursor - staging, staging); + } + else if (BIT_VECTORP (sequence)) + { + return Fbit_vector (staging_cursor - staging, staging); + } + + /* A nil sequence will have given us a nil #'position, + above. */ + ABORT (); + + return Qnil; + } +} + +DEFUN ("remove*", FremoveX, 2, MANY, 0, /* +Remove all occurrences of ITEM in SEQUENCE, non-destructively. + +If SEQUENCE is a list, `remove*' makes a copy if that is necessary to avoid +corrupting the original SEQUENCE. + +The keywords :test and :test-not specify two-argument test and negated-test +predicates, respectively; :test defaults to `eql'. :key specifies a +one-argument function that transforms elements of SEQUENCE into \"comparison +keys\" before the test predicate is applied. See `member*' for more +information on these keywords. + +:start and :end, if given, specify indices of a subsequence of SEQUENCE to +be processed. Indices are 0-based and processing involves the subsequence +starting at the index given by :start and ending just before the index given +by :end. + +:count, if given, limits the number of items removed to the number +specified. :from-end, if given, causes processing to proceed starting from +the end instead of the beginning; in this case, this matters only if :count +is given. + +arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END COUNT TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object item = args[0], sequence = args[1], matched_count = Qnil, + tail = Qnil; + Elemcount starting = 0, ending = EMACS_INT_MAX, counting = EMACS_INT_MAX; + Elemcount ii = 0, encountered = 0, presenting = 0; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; + + PARSE_KEYWORDS (FremoveX, nargs, args, 9, + (test, if_not, if_, test_not, key, start, end, from_end, + count), (start = Qzero)); + + if (!CONSP (sequence)) + { + return FdeleteX (nargs, args); + } + + CHECK_NATNUM (start); + starting = BIGNUMP (start) ? 1 + EMACS_INT_MAX : XINT (start); + + if (!NILP (end)) + { + CHECK_NATNUM (end); + ending = BIGNUMP (end) ? 1 + EMACS_INT_MAX : XINT (end); + } + + if (!NILP (count)) + { + CHECK_INTEGER (count); + if (INTP (count)) + { + counting = XINT (count); + } +#ifdef HAVE_BIGNUM + else + { + counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ? + 1 + EMACS_INT_MAX : -1 + EMACS_INT_MIN; + } +#endif + + if (counting <= 0) + { + return sequence; + } + + if (!NILP (from_end)) + { + /* Sigh, this is inelegant. Force count_with_tail () to ignore the + count keyword, so we get the actual number of matching + elements, and can start removing from the beginning for the + from-end case. */ + for (ii = XSUBR (GET_DEFUN_LISP_OBJECT (FremoveX))->min_args; + ii < nargs; ii += 2) + { + if (EQ (args[ii], Q_count)) + { + args[ii + 1] = Qnil; + break; + } + } + ii = 0; + } + } + + check_test = get_check_test_function (item, &test, test_not, if_, if_not, + key, &test_not_unboundp); + + matched_count = count_with_tail (&tail, nargs, args, QremoveX); + + if (!ZEROP (matched_count)) + { + Lisp_Object result = Qnil, result_tail = Qnil; + struct gcpro gcpro1, gcpro2; + + if (!NILP (count) && !NILP (from_end)) + { + presenting = XINT (matched_count); + + /* If there are fewer matching elements in the list than we have + permission to delete, we don't need to differentiate between + the :from-end nil and :from-end t cases. Otherwise, presenting + is the number of matching items we need to ignore before we + start to delete. */ + presenting = presenting <= counting ? 0 : presenting - counting; + } + + GCPRO2 (result, tail); + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tailing) + { + if (EQ (tail, tailing)) + { + XUNGCPRO (elt); + UNGCPRO; + + if (NILP (result)) + { + return XCDR (tail); + } + + XSETCDR (result_tail, XCDR (tail)); + return result; + } + else if (starting <= ii && ii < ending && + (check_test (test, key, item, elt) == test_not_unboundp) + && (presenting ? encountered++ >= presenting + : encountered++ < counting)) + { + DO_NOTHING; + } + else if (NILP (result)) + { + result = result_tail = Fcons (elt, Qnil); + } + else + { + XSETCDR (result_tail, Fcons (elt, Qnil)); + result_tail = XCDR (result_tail); + } + + if (ii == ending) + { + break; + } + + ii++; + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + UNGCPRO; + + if (ii < starting || (ii < ending && !NILP (end))) + { + check_sequence_range (args[0], start, end, Flength (args[0])); + } + + return result; + } + + return sequence; +} + DEFUN ("remassoc", Fremassoc, 2, 2, 0, /* Delete by side effect any elements of ALIST whose car is `equal' to KEY. The modified ALIST is returned. If the first member of ALIST has a car @@ -1796,141 +3829,957 @@ EQ_WITH_EBOLA_NOTICE (value, XCDR (elt)))); return alist; } - -DEFUN ("nreverse", Fnreverse, 1, 1, 0, /* -Reverse LIST by destructively modifying cdr pointers. -Return the beginning of the reversed list. -Also see: `reverse'. -*/ - (list)) -{ + +/* Remove duplicate elements between START and END from LIST, a non-nil + list; if COPY is zero, do so destructively. Items to delete are selected + according to the algorithm used when :from-end t is passed to + #'delete-duplicates. Error if LIST is ill-formed or circular. + + TEST and KEY are as in #'remove*; CHECK_TEST and TEST_NOT_UNBOUNDP should + reflect them, having been initialised with get_check_match_function() or + get_check_test_function(). */ +static Lisp_Object +list_delete_duplicates_from_end (Lisp_Object list, + check_test_func_t check_test, + Boolint test_not_unboundp, + Lisp_Object test, Lisp_Object key, + Lisp_Object start, + Lisp_Object end, Boolint copy) +{ + Lisp_Object checking = Qnil, result = list; + Lisp_Object keyed, positioned, position_cons = Qnil, result_tail; + Elemcount len = XINT (Flength (list)), pos, starting = XINT (start); + Elemcount ending = (NILP (end) ? len : XINT (end)), greatest_pos_seen = -1; + Elemcount ii = 0; + struct gcpro gcpro1; + + /* We can't delete (or remove) as we go, because that breaks START and + END. We could if END were nil, and that would change an ON(N + 2) + algorithm to an ON^2 algorithm; list_position_cons_before() would need to + be modified to return the cons *before* the one containing the item for + that. Here and now it doesn't matter, though, #'delete-duplicates is + relatively expensive no matter what. */ + struct Lisp_Bit_Vector *deleting + = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector) + + (sizeof (long) + * (BIT_VECTOR_LONG_STORAGE (len) + - 1))); + + check_sequence_range (list, start, end, make_integer (len)); + + deleting->size = len; + memset (&(deleting->bits), 0, + sizeof (long) * BIT_VECTOR_LONG_STORAGE (len)); + + GCPRO1 (keyed); + + { + GC_EXTERNAL_LIST_LOOP_3 (elt, list, tail) + { + if (!(starting <= ii && ii <= ending) || bit_vector_bit (deleting, ii)) + { + ii++; + continue; + } + + keyed = KEY (key, elt); + checking = XCDR (tail); + pos = ii + 1; + + while (!NILP ((positioned = list_position_cons_before + (&position_cons, keyed, checking, check_test, + test_not_unboundp, test, key, 0, + make_int (max (starting - pos, 0)), + make_int (ending - pos))))) + { + pos = XINT (positioned) + pos; + set_bit_vector_bit (deleting, pos, 1); + greatest_pos_seen = max (greatest_pos_seen, pos); + checking = NILP (position_cons) ? + XCDR (checking) : XCDR (XCDR (position_cons)); + pos += 1; + } + ii++; + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + UNGCPRO; + + ii = 0; + + if (greatest_pos_seen > -1) + { + if (copy) + { + result = result_tail = Fcons (XCAR (list), Qnil); + list = XCDR (list); + ii = 1; + + { + EXTERNAL_LIST_LOOP_3 (elt, list, tail) + { + if (ii == greatest_pos_seen) + { + XSETCDR (result_tail, XCDR (tail)); + break; + } + else if (!bit_vector_bit (deleting, ii)) + { + XSETCDR (result_tail, Fcons (elt, Qnil)); + result_tail = XCDR (result_tail); + } + ii++; + } + } + } + else + { + EXTERNAL_LIST_LOOP_DELETE_IF (elt, list, + bit_vector_bit (deleting, ii++)); + } + } + + return result; +} + +DEFUN ("delete-duplicates", Fdelete_duplicates, 1, MANY, 0, /* +Remove all duplicate elements from SEQUENCE, destructively. + +If SEQUENCE is a list and has duplicates, modify and return it. Note that +SEQUENCE may start with an element to be deleted; because of this, if +modifying a variable, be sure to write `(setq VARIABLE (delete-duplicates +VARIABLE))' to be certain to have a list without duplicate elements. + +If SEQUENCE is an array and has duplicates, return a newly-allocated array +of the same type comprising all unique elements of SEQUENCE. + +If there are no duplicate elements in SEQUENCE, return it unmodified. + +See `remove*' for the meaning of the keywords. See `remove-duplicates' for +a non-destructive version of this function. + +arguments: (SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) END FROM-END TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object sequence = args[0], keyed = Qnil; + Lisp_Object positioned = Qnil, ignore = Qnil; + Elemcount starting = 0, ending = EMACS_INT_MAX, len, ii = 0, jj = 0; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; struct gcpro gcpro1, gcpro2; - Lisp_Object prev = Qnil; - Lisp_Object tail = list; - - /* We gcpro our args; see `nconc' */ - GCPRO2 (prev, tail); - while (!NILP (tail)) - { - REGISTER Lisp_Object next; - CONCHECK_CONS (tail); - next = XCDR (tail); - XCDR (tail) = prev; - prev = tail; - tail = next; - } - UNGCPRO; - return prev; + + PARSE_KEYWORDS (Fdelete_duplicates, nargs, args, 6, + (test, key, test_not, start, end, from_end), + (start = Qzero)); + + CHECK_SEQUENCE (sequence); + CHECK_NATNUM (start); + starting = BIGNUMP (start) ? 1 + EMACS_INT_MAX : XINT (start); + + if (!NILP (end)) + { + CHECK_NATNUM (end); + ending = BIGNUMP (end) ? 1 + EMACS_INT_MAX : XINT (end); + } + + CHECK_KEY_ARGUMENT (key); + + get_check_match_function (&test, test_not, Qnil, Qnil, key, + &test_not_unboundp, &check_test); + + if (CONSP (sequence)) + { + if (NILP (from_end)) + { + Lisp_Object prev_tail = Qnil; + Elemcount deleted = 0; + + GCPRO2 (keyed, prev_tail); + + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) + { + if (starting <= ii && ii < ending) + { + keyed = KEY (key, elt); + positioned + = list_position_cons_before (&ignore, keyed, + XCDR (tail), check_test, + test_not_unboundp, test, key, + 0, make_int (max (starting + - (ii + 1), + 0)), + make_int (ending + - (ii + 1))); + if (!NILP (positioned)) + { + sequence = XCDR (tail); + deleted++; + } + else + { + break; + } + } + else + { + break; + } + + ii++; + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) + { + if (!(starting <= ii && ii <= ending)) + { + prev_tail = tail; + ii++; + continue; + } + + keyed = KEY (key, elt); + positioned + = list_position_cons_before (&ignore, keyed, XCDR (tail), + check_test, test_not_unboundp, + test, key, 0, + make_int (max (starting + - (ii + 1), 0)), + make_int (ending - (ii + 1))); + if (!NILP (positioned)) + { + /* We know this isn't the first iteration of the loop, + because we advanced above to the point where we have at + least one non-duplicate entry at the head of the + list. */ + XSETCDR (prev_tail, XCDR (tail)); + len = 0; + deleted++; + } + else + { + prev_tail = tail; + if (ii >= ending) + { + break; + } + } + + ii++; + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + UNGCPRO; + + if ((ii < starting || (ii < ending && !NILP (end)))) + { + check_sequence_range (args[0], start, end, + make_int (deleted + + XINT (Flength (args[0])))); + } + } + else + { + sequence = list_delete_duplicates_from_end (sequence, check_test, + test_not_unboundp, + test, key, start, end, + 0); + } + } + else if (STRINGP (sequence)) + { + Lisp_Object elt = Qnil; + + if (EQ (Qidentity, key)) + { + /* We know all the elements will be characters; set check_test to + reflect that. This isn't useful if KEY is not #'identity, since + it may return non-characters for the elements. */ + check_test = get_check_test_function (make_char ('a'), + &test, test_not, + Qnil, Qnil, key, + &test_not_unboundp); + } + + if (NILP (from_end)) + { + Bytecount byte_len = XSTRING_LENGTH (sequence), cursor_offset = 0; + Ibyte *staging = alloca_ibytes (byte_len), *staging_cursor = staging; + Ibyte *cursor = XSTRING_DATA (sequence), *startp = cursor; + Elemcount deleted = 0; + + GCPRO1 (elt); + + while (cursor_offset < byte_len) + { + if (starting <= ii && ii < ending) + { + Ibyte *cursor0 = cursor; + Bytecount cursor0_offset; + Boolint delete_this = 0; + + elt = KEY (key, make_char (itext_ichar (cursor))); + INC_IBYTEPTR (cursor0); + cursor0_offset = cursor0 - startp; + + for (jj = ii + 1; jj < ending && cursor0_offset < byte_len; + jj++) + { + if (check_test (test, key, elt, + make_char (itext_ichar (cursor0))) + == test_not_unboundp) + { + delete_this = 1; + deleted++; + break; + } + + startp = XSTRING_DATA (sequence); + cursor0 = startp + cursor0_offset; + if (byte_len != XSTRING_LENGTH (sequence) + || !valid_ibyteptr_p (cursor0)) + { + mapping_interaction_error (Qdelete_duplicates, + sequence); + } + + INC_IBYTEPTR (cursor0); + cursor0_offset = cursor0 - startp; + } + + startp = XSTRING_DATA (sequence); + cursor = startp + cursor_offset; + + if (byte_len != XSTRING_LENGTH (sequence) + || !valid_ibyteptr_p (cursor)) + { + mapping_interaction_error (Qdelete_duplicates, sequence); + } + + if (!delete_this) + { + staging_cursor + += itext_copy_ichar (cursor, staging_cursor); + + } + } + else + { + staging_cursor += itext_copy_ichar (cursor, staging_cursor); + } + + INC_IBYTEPTR (cursor); + cursor_offset = cursor - startp; + ii++; + } + + UNGCPRO; + + if (ii < starting || (ii < ending && !NILP (end))) + { + check_sequence_range (sequence, start, end, Flength (sequence)); + } + + if (0 != deleted) + { + sequence = make_string (staging, staging_cursor - staging); + } + } + else + { + Elemcount deleted = 0; + Ibyte *staging = alloca_ibytes ((len = string_char_length (sequence)) + * MAX_ICHAR_LEN); + Ibyte *staging_cursor = staging, *startp = XSTRING_DATA (sequence); + Ibyte *endp = startp + XSTRING_LENGTH (sequence); + struct Lisp_Bit_Vector *deleting + = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector) + + (sizeof (long) + * (BIT_VECTOR_LONG_STORAGE (len) + - 1))); + + check_sequence_range (sequence, start, end, make_integer (len)); + + /* For the from_end t case; transform contents to an array with + elements addressable in constant time, use the same algorithm + as for vectors. */ + deleting->size = len; + memset (&(deleting->bits), 0, + sizeof (long) * BIT_VECTOR_LONG_STORAGE (len)); + + while (startp < endp) + { + itext_copy_ichar (startp, staging + (ii * MAX_ICHAR_LEN)); + INC_IBYTEPTR (startp); + ii++; + } + + GCPRO1 (elt); + + ending = min (ending, len); + + for (ii = ending - 1; ii >= starting; ii--) + { + elt = KEY (key, make_char (itext_ichar (staging + + (ii * MAX_ICHAR_LEN)))); + for (jj = ii - 1; jj >= starting; jj--) + { + if (check_test (test, key, elt, + make_char (itext_ichar + (staging + (jj * MAX_ICHAR_LEN)))) + == test_not_unboundp) + { + set_bit_vector_bit (deleting, ii, 1); + deleted++; + break; + } + } + } + + UNGCPRO; + + if (0 != deleted) + { + startp = XSTRING_DATA (sequence); + + for (ii = 0; ii < len; ii++) + { + if (!bit_vector_bit (deleting, ii)) + { + staging_cursor + += itext_copy_ichar (startp, staging_cursor); + } + + INC_IBYTEPTR (startp); + } + + sequence = make_string (staging, staging_cursor - staging); + } + } + } + else if (VECTORP (sequence)) + { + Elemcount deleted = 0; + Lisp_Object *content = XVECTOR_DATA (sequence); + struct Lisp_Bit_Vector *deleting; + Lisp_Object elt = Qnil; + + len = XVECTOR_LENGTH (sequence); + check_sequence_range (sequence, start, end, make_integer (len)); + + deleting = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector) + + (sizeof (long) + * (BIT_VECTOR_LONG_STORAGE (len) + - 1))); + deleting->size = len; + memset (&(deleting->bits), 0, + sizeof (long) * BIT_VECTOR_LONG_STORAGE (len)); + + GCPRO1 (elt); + + ending = min (ending, len); + + if (NILP (from_end)) + { + for (ii = starting; ii < ending; ii++) + { + elt = KEY (key, content[ii]); + + for (jj = ii + 1; jj < ending; jj++) + { + if (check_test (test, key, elt, content[jj]) + == test_not_unboundp) + { + set_bit_vector_bit (deleting, ii, 1); + deleted++; + break; + } + } + } + } + else + { + for (ii = ending - 1; ii >= starting; ii--) + { + elt = KEY (key, content[ii]); + + for (jj = ii - 1; jj >= starting; jj--) + { + if (check_test (test, key, elt, content[jj]) + == test_not_unboundp) + { + set_bit_vector_bit (deleting, ii, 1); + deleted++; + break; + } + } + } + } + + UNGCPRO; + + if (deleted) + { + Lisp_Object res = make_vector (len - deleted, Qnil), + *res_content = XVECTOR_DATA (res); + + for (ii = jj = 0; ii < len; ii++) + { + if (!bit_vector_bit (deleting, ii)) + { + res_content[jj++] = content[ii]; + } + } + + sequence = res; + } + } + else if (BIT_VECTORP (sequence)) + { + Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence); + Elemcount deleted = 0; + /* I'm a little irritated at this. Basically, the only reasonable + thing delete-duplicates should do if handed a bit vector is return + something of maximum length two and minimum length 0 (because + that's the possible number of distinct elements if EQ is regarded + as identity, which it should be). But to support arbitrary TEST + and KEY arguments, which may be non-deterministic from our + perspective, we need the same algorithm as for vectors. */ + struct Lisp_Bit_Vector *deleting; + Lisp_Object elt = Qnil; + + len = bit_vector_length (bv); + + if (EQ (Qidentity, key)) + { + /* We know all the elements will be bits; set check_test to + reflect that. This isn't useful if KEY is not #'identity, since + it may return non-bits for the elements. */ + check_test = get_check_test_function (Qzero, &test, test_not, + Qnil, Qnil, key, + &test_not_unboundp); + } + + check_sequence_range (sequence, start, end, make_integer (len)); + + deleting = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector) + + (sizeof (long) + * (BIT_VECTOR_LONG_STORAGE (len) + - 1))); + deleting->size = len; + memset (&(deleting->bits), 0, + sizeof (long) * BIT_VECTOR_LONG_STORAGE (len)); + + ending = min (ending, len); + + GCPRO1 (elt); + + if (NILP (from_end)) + { + for (ii = starting; ii < ending; ii++) + { + elt = KEY (key, make_int (bit_vector_bit (bv, ii))); + + for (jj = ii + 1; jj < ending; jj++) + { + if (check_test (test, key, elt, + make_int (bit_vector_bit (bv, jj))) + == test_not_unboundp) + { + set_bit_vector_bit (deleting, ii, 1); + deleted++; + break; + } + } + } + } + else + { + for (ii = ending - 1; ii >= starting; ii--) + { + elt = KEY (key, make_int (bit_vector_bit (bv, ii))); + + for (jj = ii - 1; jj >= starting; jj--) + { + if (check_test (test, key, elt, + make_int (bit_vector_bit (bv, jj))) + == test_not_unboundp) + { + set_bit_vector_bit (deleting, ii, 1); + deleted++; + break; + } + } + } + } + + UNGCPRO; + + if (deleted) + { + Lisp_Object res = make_bit_vector (len - deleted, Qzero); + Lisp_Bit_Vector *resbv = XBIT_VECTOR (res); + + for (ii = jj = 0; ii < len; ii++) + { + if (!bit_vector_bit (deleting, ii)) + { + set_bit_vector_bit (resbv, jj++, bit_vector_bit (bv, ii)); + } + } + + sequence = res; + } + } + + return sequence; +} + +DEFUN ("remove-duplicates", Fremove_duplicates, 1, MANY, 0, /* +Remove duplicate elements from SEQUENCE, non-destructively. + +If there are no duplicate elements in SEQUENCE, return it unmodified; +otherwise, return a new object. If SEQUENCE is a list, the new object may +share list structure with SEQUENCE. + +See `remove*' for the meaning of the keywords. + +arguments: (SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) END FROM-END TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object sequence = args[0], keyed, positioned = Qnil; + Lisp_Object result = sequence, result_tail = result, cursor = Qnil; + Lisp_Object cons_with_shared_tail = Qnil; + Elemcount starting = 0, ending = EMACS_INT_MAX, ii = 0; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; + struct gcpro gcpro1, gcpro2; + + PARSE_KEYWORDS (Fremove_duplicates, nargs, args, 6, + (test, key, test_not, start, end, from_end), + (start = Qzero)); + + CHECK_SEQUENCE (sequence); + + if (!CONSP (sequence)) + { + return Fdelete_duplicates (nargs, args); + } + + CHECK_NATNUM (start); + starting = BIGNUMP (start) ? 1 + EMACS_INT_MAX : XINT (start); + + if (!NILP (end)) + { + CHECK_NATNUM (end); + ending = BIGNUMP (end) ? 1 + EMACS_INT_MAX : XINT (end); + } + + if (NILP (key)) + { + key = Qidentity; + } + + get_check_match_function (&test, test_not, Qnil, Qnil, key, + &test_not_unboundp, &check_test); + + if (NILP (from_end)) + { + Lisp_Object ignore = Qnil; + + GCPRO2 (keyed, result); + + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) + { + if (starting <= ii && ii <= ending) + { + keyed = KEY (key, elt); + positioned + = list_position_cons_before (&ignore, keyed, XCDR (tail), + check_test, test_not_unboundp, + test, key, 0, + make_int (max (starting + - (ii + 1), 0)), + make_int (ending - (ii + 1))); + if (!NILP (positioned)) + { + sequence = result = result_tail = XCDR (tail); + } + else + { + break; + } + } + else + { + break; + } + + ii++; + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) + { + if (!(starting <= ii && ii <= ending)) + { + ii++; + continue; + } + + /* For this algorithm, each time we encounter an object to be + removed, copy the output list from the tail beyond the last + removed cons to this one. Otherwise, the tail of the output list + is shared with the input list, which is OK. */ + + keyed = KEY (key, elt); + positioned + = list_position_cons_before (&ignore, keyed, XCDR (tail), + check_test, test_not_unboundp, + test, key, 0, + make_int (max (starting - (ii + 1), + 0)), + make_int (ending - (ii + 1))); + if (!NILP (positioned)) + { + if (EQ (result, sequence)) + { + result = cons_with_shared_tail + = Fcons (XCAR (sequence), XCDR (sequence)); + } + + result_tail = cons_with_shared_tail; + cursor = XCDR (cons_with_shared_tail); + + while (!EQ (cursor, tail) && !NILP (cursor)) + { + XSETCDR (result_tail, Fcons (XCAR (cursor), Qnil)); + result_tail = XCDR (result_tail); + cursor = XCDR (cursor); + } + + XSETCDR (result_tail, XCDR (tail)); + cons_with_shared_tail = result_tail; + } + + ii++; + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + UNGCPRO; + + if ((ii < starting || (ii < ending && !NILP (end)))) + { + check_sequence_range (args[0], start, end, Flength (args[0])); + } + } + else + { + result = list_delete_duplicates_from_end (sequence, check_test, + test_not_unboundp, test, key, + start, end, 1); + } + + return result; +} +#undef KEY + +DEFUN ("nreverse", Fnreverse, 1, 1, 0, /* +Reverse SEQUENCE, destructively. + +Return the beginning of the reversed sequence, which will be a distinct Lisp +object if SEQUENCE is a list with length greater than one. See also +`reverse', the non-destructive version of this function. +*/ + (sequence)) +{ + CHECK_SEQUENCE (sequence); + + if (CONSP (sequence)) + { + struct gcpro gcpro1, gcpro2; + Lisp_Object prev = Qnil; + Lisp_Object tail = sequence; + + /* We gcpro our args; see `nconc' */ + GCPRO2 (prev, tail); + while (!NILP (tail)) + { + REGISTER Lisp_Object next; + CONCHECK_CONS (tail); + next = XCDR (tail); + XCDR (tail) = prev; + prev = tail; + tail = next; + } + UNGCPRO; + return prev; + } + else if (VECTORP (sequence)) + { + Elemcount length = XVECTOR_LENGTH (sequence), ii = length; + Elemcount half = length / 2; + Lisp_Object swap = Qnil; + CHECK_LISP_WRITEABLE (sequence); + + while (ii > half) + { + swap = XVECTOR_DATA (sequence) [length - ii]; + XVECTOR_DATA (sequence) [length - ii] + = XVECTOR_DATA (sequence) [ii - 1]; + XVECTOR_DATA (sequence) [ii - 1] = swap; + --ii; + } + } + else if (STRINGP (sequence)) + { + Elemcount length = XSTRING_LENGTH (sequence); + Ibyte *staging = alloca_ibytes (length), *staging_end = staging + length; + Ibyte *cursor = XSTRING_DATA (sequence), *endp = cursor + length; + + CHECK_LISP_WRITEABLE (sequence); + while (cursor < endp) + { + staging_end -= itext_ichar_len (cursor); + itext_copy_ichar (cursor, staging_end); + INC_IBYTEPTR (cursor); + } + + assert (staging == staging_end); + + memcpy (XSTRING_DATA (sequence), staging, length); + init_string_ascii_begin (sequence); + bump_string_modiff (sequence); + sledgehammer_check_ascii_begin (sequence); + } + else if (BIT_VECTORP (sequence)) + { + Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence); + Elemcount length = bit_vector_length (bv), ii = length; + Elemcount half = length / 2; + int swap = 0; + + CHECK_LISP_WRITEABLE (sequence); + while (ii > half) + { + swap = bit_vector_bit (bv, length - ii); + set_bit_vector_bit (bv, length - ii, bit_vector_bit (bv, ii - 1)); + set_bit_vector_bit (bv, ii - 1, swap); + --ii; + } + } + else + { + assert (NILP (sequence)); + } + + return sequence; } DEFUN ("reverse", Freverse, 1, 1, 0, /* -Reverse LIST, copying. Return the beginning of the reversed list. +Reverse SEQUENCE, copying. Return the reversed sequence. See also the function `nreverse', which is used more often. */ - (list)) -{ - Lisp_Object reversed_list = Qnil; - EXTERNAL_LIST_LOOP_2 (elt, list) - { - reversed_list = Fcons (elt, reversed_list); - } - return reversed_list; + (sequence)) +{ + Lisp_Object result = Qnil; + + CHECK_SEQUENCE (sequence); + + if (CONSP (sequence)) + { + EXTERNAL_LIST_LOOP_2 (elt, sequence) + { + result = Fcons (elt, result); + } + } + else if (VECTORP (sequence)) + { + Elemcount length = XVECTOR_LENGTH (sequence), ii = length; + Lisp_Object *staging = alloca_array (Lisp_Object, length); + + while (ii > 0) + { + staging[length - ii] = XVECTOR_DATA (sequence) [ii - 1]; + --ii; + } + + result = Fvector (length, staging); + } + else if (STRINGP (sequence)) + { + Elemcount length = XSTRING_LENGTH (sequence); + Ibyte *staging = alloca_ibytes (length), *staging_end = staging + length; + Ibyte *cursor = XSTRING_DATA (sequence), *endp = cursor + length; + + while (cursor < endp) + { + staging_end -= itext_ichar_len (cursor); + itext_copy_ichar (cursor, staging_end); + INC_IBYTEPTR (cursor); + } + + assert (staging == staging_end); + + result = make_string (staging, length); + } + else if (BIT_VECTORP (sequence)) + { + Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence), *res; + Elemcount length = bit_vector_length (bv), ii = length; + + result = make_bit_vector (length, Qzero); + res = XBIT_VECTOR (result); + + while (ii > 0) + { + set_bit_vector_bit (res, length - ii, bit_vector_bit (bv, ii - 1)); + --ii; + } + } + else + { + assert (NILP (sequence)); + } + + return result; } -static Lisp_Object list_merge (Lisp_Object org_l1, Lisp_Object org_l2, - Lisp_Object lisp_arg, - int (*pred_fn) (Lisp_Object, Lisp_Object, - Lisp_Object lisp_arg)); - -/* The sort function should return > 0 if OBJ1 < OBJ2, < 0 otherwise. - NOTE: This is backwards from the way qsort() works. */ - Lisp_Object -list_sort (Lisp_Object list, - Lisp_Object lisp_arg, - int (*pred_fn) (Lisp_Object obj1, Lisp_Object obj2, - Lisp_Object lisp_arg)) -{ - struct gcpro gcpro1, gcpro2, gcpro3; - Lisp_Object back, tem; - Lisp_Object front = list; - Lisp_Object len = Flength (list); - - if (XINT (len) < 2) - return list; - - len = make_int (XINT (len) / 2 - 1); - tem = Fnthcdr (len, list); - back = Fcdr (tem); - Fsetcdr (tem, Qnil); - - GCPRO3 (front, back, lisp_arg); - front = list_sort (front, lisp_arg, pred_fn); - back = list_sort (back, lisp_arg, pred_fn); - UNGCPRO; - return list_merge (front, back, lisp_arg, pred_fn); -} - - -static int -merge_pred_function (Lisp_Object obj1, Lisp_Object obj2, - Lisp_Object pred) -{ - Lisp_Object tmp; - - /* prevents the GC from happening in call2 */ - /* Emacs' GC doesn't actually relocate pointers, so this probably - isn't strictly necessary */ - int speccount = begin_gc_forbidden (); - tmp = call2 (pred, obj1, obj2); - unbind_to (speccount); - - if (NILP (tmp)) - return -1; - else - return 1; -} - -DEFUN ("sort", Fsort, 2, 2, 0, /* -Sort LIST, stably, comparing elements using PREDICATE. -Returns the sorted list. LIST is modified by side effects. -PREDICATE is called with two elements of LIST, and should return T -if the first element is "less" than the second. -*/ - (list, predicate)) -{ - return list_sort (list, predicate, merge_pred_function); -} - -Lisp_Object -merge (Lisp_Object org_l1, Lisp_Object org_l2, - Lisp_Object pred) -{ - return list_merge (org_l1, org_l2, pred, merge_pred_function); -} - - -static Lisp_Object list_merge (Lisp_Object org_l1, Lisp_Object org_l2, - Lisp_Object lisp_arg, - int (*pred_fn) (Lisp_Object, Lisp_Object, Lisp_Object lisp_arg)) + check_test_func_t check_merge, + Lisp_Object predicate, Lisp_Object key) { Lisp_Object value; Lisp_Object tail; Lisp_Object tem; Lisp_Object l1, l2; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + Lisp_Object tortoises[2]; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; + int l1_count = 0, l2_count = 0; l1 = org_l1; l2 = org_l2; tail = Qnil; value = Qnil; - - /* It is sufficient to protect org_l1 and org_l2. - When l1 and l2 are updated, we copy the new values - back into the org_ vars. */ - - GCPRO4 (org_l1, org_l2, lisp_arg, value); + tortoises[0] = org_l1; + tortoises[1] = org_l2; + + /* It is sufficient to protect org_l1 and org_l2. When l1 and l2 are + updated, we copy the new values back into the org_ vars. */ + + GCPRO5 (org_l1, org_l2, predicate, value, tortoises[0]); + gcpro5.nvars = 2; while (1) { @@ -1951,26 +4800,665 @@ return value; } - if (((*pred_fn) (Fcar (l2), Fcar (l1), lisp_arg)) < 0) + if (check_merge (predicate, key, Fcar (l2), Fcar (l1)) == 0) { tem = l1; l1 = Fcdr (l1); org_l1 = l1; + + if (l1_count++ > CIRCULAR_LIST_SUSPICION_LENGTH) + { + if (l1_count & 1) + { + if (!CONSP (tortoises[0])) + { + mapping_interaction_error (Qmerge, tortoises[0]); + } + + tortoises[0] = XCDR (tortoises[0]); + } + + if (EQ (org_l1, tortoises[0])) + { + signal_circular_list_error (org_l1); + } + } } else { tem = l2; l2 = Fcdr (l2); org_l2 = l2; - } + + if (l2_count++ > CIRCULAR_LIST_SUSPICION_LENGTH) + { + if (l2_count & 1) + { + if (!CONSP (tortoises[1])) + { + mapping_interaction_error (Qmerge, tortoises[1]); + } + + tortoises[1] = XCDR (tortoises[1]); + } + + if (EQ (org_l2, tortoises[1])) + { + signal_circular_list_error (org_l2); + } + } + } + if (NILP (tail)) value = tem; else Fsetcdr (tail, tem); + tail = tem; } } +static void +array_merge (Lisp_Object *dest, Elemcount dest_len, + Lisp_Object *front, Elemcount front_len, + Lisp_Object *back, Elemcount back_len, + check_test_func_t check_merge, + Lisp_Object predicate, Lisp_Object key) +{ + Elemcount ii, fronting, backing; + Lisp_Object *front_staging = front; + Lisp_Object *back_staging = back; + struct gcpro gcpro1, gcpro2; + + assert (dest_len == (back_len + front_len)); + + if (0 == dest_len) + { + return; + } + + if (front >= dest && front < (dest + dest_len)) + { + front_staging = alloca_array (Lisp_Object, front_len); + + for (ii = 0; ii < front_len; ++ii) + { + front_staging[ii] = front[ii]; + } + } + + if (back >= dest && back < (dest + dest_len)) + { + back_staging = alloca_array (Lisp_Object, back_len); + + for (ii = 0; ii < back_len; ++ii) + { + back_staging[ii] = back[ii]; + } + } + + GCPRO2 (front_staging[0], back_staging[0]); + gcpro1.nvars = front_len; + gcpro2.nvars = back_len; + + for (ii = fronting = backing = 0; ii < dest_len; ++ii) + { + if (fronting >= front_len) + { + while (ii < dest_len) + { + dest[ii] = back_staging[backing]; + ++ii, ++backing; + } + UNGCPRO; + return; + } + + if (backing >= back_len) + { + while (ii < dest_len) + { + dest[ii] = front_staging[fronting]; + ++ii, ++fronting; + } + UNGCPRO; + return; + } + + if (check_merge (predicate, key, back_staging[backing], + front_staging[fronting]) == 0) + { + dest[ii] = front_staging[fronting]; + ++fronting; + } + else + { + dest[ii] = back_staging[backing]; + ++backing; + } + } + + UNGCPRO; +} + +static Lisp_Object +list_array_merge_into_list (Lisp_Object list, + Lisp_Object *array, Elemcount array_len, + check_test_func_t check_merge, + Lisp_Object predicate, Lisp_Object key, + Boolint reverse_order) +{ + Lisp_Object tail = Qnil, value = Qnil, tortoise = list; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + Elemcount array_index = 0; + int looped = 0; + + GCPRO4 (list, tail, value, tortoise); + + while (1) + { + if (NILP (list)) + { + UNGCPRO; + + if (NILP (tail)) + { + return Flist (array_len, array); + } + + Fsetcdr (tail, Flist (array_len - array_index, array + array_index)); + return value; + } + + if (array_index >= array_len) + { + UNGCPRO; + if (NILP (tail)) + { + return list; + } + + Fsetcdr (tail, list); + return value; + } + + + if (reverse_order ? + check_merge (predicate, key, Fcar (list), array [array_index]) + : !check_merge (predicate, key, array [array_index], Fcar (list))) + { + if (NILP (tail)) + { + value = tail = list; + } + else + { + Fsetcdr (tail, list); + tail = XCDR (tail); + } + + list = Fcdr (list); + } + else + { + if (NILP (tail)) + { + value = tail = Fcons (array [array_index], Qnil); + } + else + { + Fsetcdr (tail, Fcons (array [array_index], tail)); + tail = XCDR (tail); + } + ++array_index; + } + + if (++looped > CIRCULAR_LIST_SUSPICION_LENGTH) + { + if (looped & 1) + { + tortoise = XCDR (tortoise); + } + + if (EQ (list, tortoise)) + { + signal_circular_list_error (list); + } + } + } +} + +static void +list_list_merge_into_array (Lisp_Object *output, Elemcount output_len, + Lisp_Object list_one, Lisp_Object list_two, + check_test_func_t check_merge, + Lisp_Object predicate, Lisp_Object key) +{ + Elemcount output_index = 0; + + while (output_index < output_len) + { + if (NILP (list_one)) + { + while (output_index < output_len) + { + output [output_index] = Fcar (list_two); + list_two = Fcdr (list_two), ++output_index; + } + return; + } + + if (NILP (list_two)) + { + while (output_index < output_len) + { + output [output_index] = Fcar (list_one); + list_one = Fcdr (list_one), ++output_index; + } + return; + } + + if (check_merge (predicate, key, Fcar (list_two), Fcar (list_one)) + == 0) + { + output [output_index] = XCAR (list_one); + list_one = XCDR (list_one); + } + else + { + output [output_index] = XCAR (list_two); + list_two = XCDR (list_two); + } + + ++output_index; + + /* No need to check for circularity. */ + } +} + +static void +list_array_merge_into_array (Lisp_Object *output, Elemcount output_len, + Lisp_Object list, + Lisp_Object *array, Elemcount array_len, + check_test_func_t check_merge, + Lisp_Object predicate, Lisp_Object key, + Boolint reverse_order) +{ + Elemcount output_index = 0, array_index = 0; + + while (output_index < output_len) + { + if (NILP (list)) + { + if (array_len - array_index != output_len - output_index) + { + mapping_interaction_error (Qmerge, list); + } + + while (array_index < array_len) + { + output [output_index++] = array [array_index++]; + } + + return; + } + + if (array_index >= array_len) + { + while (output_index < output_len) + { + output [output_index++] = Fcar (list); + list = Fcdr (list); + } + + return; + } + + if (reverse_order ? + check_merge (predicate, key, Fcar (list), array [array_index]) : + !check_merge (predicate, key, array [array_index], Fcar (list))) + { + output [output_index] = XCAR (list); + list = XCDR (list); + } + else + { + output [output_index] = array [array_index]; + ++array_index; + } + + ++output_index; + } +} + +#define STRING_DATA_TO_OBJECT_ARRAY(strdata, c_array, counter, len) \ + do { \ + c_array = alloca_array (Lisp_Object, len); \ + for (counter = 0; counter < len; ++counter) \ + { \ + c_array[counter] = make_char (itext_ichar (strdata)); \ + INC_IBYTEPTR (strdata); \ + } \ + } while (0) + +#define BIT_VECTOR_TO_OBJECT_ARRAY(v, c_array, counter, len) do { \ + c_array = alloca_array (Lisp_Object, len); \ + for (counter = 0; counter < len; ++counter) \ + { \ + c_array[counter] = make_int (bit_vector_bit (v, counter)); \ + } \ + } while (0) + +DEFUN ("merge", Fmerge, 4, MANY, 0, /* +Destructively merge SEQUENCE-ONE and SEQUENCE-TWO, producing a new sequence. + +TYPE is the type of sequence to return. PREDICATE is a `less-than' +predicate on the elements. + +Optional keyword argument KEY is a function used to extract an object to be +used for comparison from each element of SEQUENCE-ONE and SEQUENCE-TWO. + +arguments: (TYPE SEQUENCE-ONE SEQUENCE-TWO PREDICATE &key (KEY #'IDENTITY)) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object type = args[0], sequence_one = args[1], sequence_two = args[2], + predicate = args[3], result = Qnil; + check_test_func_t check_merge = NULL; + + PARSE_KEYWORDS (Fmerge, nargs, args, 1, (key), NULL); + + CHECK_SEQUENCE (sequence_one); + CHECK_SEQUENCE (sequence_two); + + CHECK_KEY_ARGUMENT (key); + + check_merge = get_merge_predicate (predicate, key); + + if (EQ (type, Qlist) && (LISTP (sequence_one) || LISTP (sequence_two))) + { + if (NILP (sequence_two)) + { + result = Fappend (2, args + 1); + } + else if (NILP (sequence_one)) + { + args[3] = Qnil; /* Overwriting PREDICATE, and losing its GC + protection, but that doesn't matter. */ + result = Fappend (2, args + 2); + } + else if (CONSP (sequence_one) && CONSP (sequence_two)) + { + result = list_merge (sequence_one, sequence_two, check_merge, + predicate, key); + } + else + { + Lisp_Object *array_storage, swap; + Elemcount array_length, i; + Boolint reverse_order = 0; + + if (!CONSP (sequence_one)) + { + /* Make sequence_one the cons, sequence_two the array: */ + swap = sequence_one; + sequence_one = sequence_two; + sequence_two = swap; + reverse_order = 1; + } + + if (VECTORP (sequence_two)) + { + array_storage = XVECTOR_DATA (sequence_two); + array_length = XVECTOR_LENGTH (sequence_two); + } + else if (STRINGP (sequence_two)) + { + Ibyte *strdata = XSTRING_DATA (sequence_two); + array_length = string_char_length (sequence_two); + /* No need to GCPRO, characters are immediate. */ + STRING_DATA_TO_OBJECT_ARRAY (strdata, array_storage, i, + array_length); + + } + else + { + Lisp_Bit_Vector *v = XBIT_VECTOR (sequence_two); + array_length = bit_vector_length (v); + /* No need to GCPRO, fixnums are immediate. */ + BIT_VECTOR_TO_OBJECT_ARRAY (v, array_storage, i, array_length); + } + + result = list_array_merge_into_list (sequence_one, + array_storage, array_length, + check_merge, predicate, key, + reverse_order); + } + } + else + { + Elemcount sequence_one_len = XINT (Flength (sequence_one)), + sequence_two_len = XINT (Flength (sequence_two)), i; + Elemcount output_len = 1 + sequence_one_len + sequence_two_len; + Lisp_Object *output = alloca_array (Lisp_Object, output_len), + *sequence_one_storage = NULL, *sequence_two_storage = NULL; + Boolint do_coerce = !(EQ (type, Qvector) || EQ (type, Qstring) + || EQ (type, Qbit_vector) || EQ (type, Qlist)); + Ibyte *strdata = NULL; + Lisp_Bit_Vector *v = NULL; + struct gcpro gcpro1; + + output[0] = do_coerce ? Qlist : type; + for (i = 1; i < output_len; ++i) + { + output[i] = Qnil; + } + + GCPRO1 (output[0]); + gcpro1.nvars = output_len; + + if (VECTORP (sequence_one)) + { + sequence_one_storage = XVECTOR_DATA (sequence_one); + } + else if (STRINGP (sequence_one)) + { + strdata = XSTRING_DATA (sequence_one); + STRING_DATA_TO_OBJECT_ARRAY (strdata, sequence_one_storage, + i, sequence_one_len); + } + else if (BIT_VECTORP (sequence_one)) + { + v = XBIT_VECTOR (sequence_one); + BIT_VECTOR_TO_OBJECT_ARRAY (v, sequence_one_storage, + i, sequence_one_len); + } + + if (VECTORP (sequence_two)) + { + sequence_two_storage = XVECTOR_DATA (sequence_two); + } + else if (STRINGP (sequence_two)) + { + strdata = XSTRING_DATA (sequence_two); + STRING_DATA_TO_OBJECT_ARRAY (strdata, sequence_two_storage, + i, sequence_two_len); + } + else if (BIT_VECTORP (sequence_two)) + { + v = XBIT_VECTOR (sequence_two); + BIT_VECTOR_TO_OBJECT_ARRAY (v, sequence_two_storage, + i, sequence_two_len); + } + + if (LISTP (sequence_one) && LISTP (sequence_two)) + { + list_list_merge_into_array (output + 1, output_len - 1, + sequence_one, sequence_two, + check_merge, predicate, key); + } + else if (LISTP (sequence_one)) + { + list_array_merge_into_array (output + 1, output_len - 1, + sequence_one, + sequence_two_storage, + sequence_two_len, + check_merge, predicate, key, 0); + } + else if (LISTP (sequence_two)) + { + list_array_merge_into_array (output + 1, output_len - 1, + sequence_two, + sequence_one_storage, + sequence_one_len, + check_merge, predicate, key, 1); + } + else + { + array_merge (output + 1, output_len - 1, + sequence_one_storage, sequence_one_len, + sequence_two_storage, sequence_two_len, + check_merge, predicate, + key); + } + + result = Ffuncall (output_len, output); + + if (do_coerce) + { + result = call2 (Qcoerce, result, type); + } + + UNGCPRO; + } + + return result; +} + +Lisp_Object +list_sort (Lisp_Object list, check_test_func_t check_merge, + Lisp_Object predicate, Lisp_Object key) +{ + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + Lisp_Object back, tem; + Lisp_Object front = list; + Lisp_Object len = Flength (list); + + if (XINT (len) < 2) + return list; + + len = make_int (XINT (len) / 2 - 1); + tem = Fnthcdr (len, list); + back = Fcdr (tem); + Fsetcdr (tem, Qnil); + + GCPRO4 (front, back, predicate, key); + front = list_sort (front, check_merge, predicate, key); + back = list_sort (back, check_merge, predicate, key); + + RETURN_UNGCPRO (list_merge (front, back, check_merge, predicate, key)); +} + +static void +array_sort (Lisp_Object *array, Elemcount array_len, + check_test_func_t check_merge, + Lisp_Object predicate, Lisp_Object key) +{ + Elemcount split; + + if (array_len < 2) + return; + + split = array_len / 2; + + array_sort (array, split, check_merge, predicate, key); + array_sort (array + split, array_len - split, check_merge, predicate, + key); + array_merge (array, array_len, array, split, array + split, + array_len - split, check_merge, predicate, key); +} + +DEFUN ("sort*", FsortX, 2, MANY, 0, /* +Sort SEQUENCE, comparing elements using PREDICATE. +Returns the sorted sequence. SEQUENCE is modified by side effect. + +PREDICATE is called with two elements of SEQUENCE, and should return t if +the first element is `less' than the second. + +Optional keyword argument KEY is a function used to extract an object to be +used for comparison from each element of SEQUENCE. + +In this implementation, sorting is always stable; but call `stable-sort' if +this stability is important to you, other implementations may not make the +same guarantees. + +arguments: (SEQUENCE PREDICATE &key (KEY #'IDENTITY)) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object sequence = args[0], predicate = args[1]; + Lisp_Object *sequence_carray; + check_test_func_t check_merge = NULL; + Elemcount sequence_len, i; + + PARSE_KEYWORDS (FsortX, nargs, args, 1, (key), NULL); + + CHECK_SEQUENCE (sequence); + + CHECK_KEY_ARGUMENT (key); + + check_merge = get_merge_predicate (predicate, key); + + if (LISTP (sequence)) + { + sequence = list_sort (sequence, check_merge, predicate, key); + } + else if (VECTORP (sequence)) + { + array_sort (XVECTOR_DATA (sequence), XVECTOR_LENGTH (sequence), + check_merge, predicate, key); + } + else if (STRINGP (sequence)) + { + Ibyte *strdata = XSTRING_DATA (sequence); + + sequence_len = string_char_length (sequence); + + STRING_DATA_TO_OBJECT_ARRAY (strdata, sequence_carray, i, sequence_len); + + /* No GCPRO necessary, characters are immediate. */ + array_sort (sequence_carray, sequence_len, check_merge, predicate, key); + + strdata = XSTRING_DATA (sequence); + + CHECK_LISP_WRITEABLE (sequence); + for (i = 0; i < sequence_len; ++i) + { + strdata += set_itext_ichar (strdata, XCHAR (sequence_carray[i])); + } + + init_string_ascii_begin (sequence); + bump_string_modiff (sequence); + sledgehammer_check_ascii_begin (sequence); + } + else if (BIT_VECTORP (sequence)) + { + Lisp_Bit_Vector *v = XBIT_VECTOR (sequence); + sequence_len = bit_vector_length (v); + + BIT_VECTOR_TO_OBJECT_ARRAY (v, sequence_carray, i, sequence_len); + + /* No GCPRO necessary, bits are immediate. */ + array_sort (sequence_carray, sequence_len, check_merge, predicate, key); + + for (i = 0; i < sequence_len; ++i) + { + set_bit_vector_bit (v, i, XINT (sequence_carray [i])); + } + } + + return sequence; +} /************************************************************************/ /* property-list functions */ @@ -2720,7 +6208,8 @@ This is the last VALUE stored with `(put OBJECT PROPERTY VALUE)'. If there is no such property, return optional third arg DEFAULT \(which defaults to `nil'). OBJECT can be a symbol, string, extent, -face, or glyph. See also `put', `remprop', and `object-plist'. +face, glyph, or process. See also `put', `remprop', `object-plist', and +`object-setplist'. */ (object, property, default_)) { @@ -2764,9 +6253,10 @@ DEFUN ("remprop", Fremprop, 2, 2, 0, /* Remove, from OBJECT's property list, PROPERTY and its corresponding value. -OBJECT can be a symbol, string, extent, face, or glyph. Return non-nil -if the property list was actually modified (i.e. if PROPERTY was present -in the property list). See also `get', `put', and `object-plist'. +OBJECT can be a symbol, string, extent, face, glyph, or process. +Return non-nil if the property list was actually modified (i.e. if PROPERTY +was present in the property list). See also `get', `put', `object-plist', +and `object-setplist'. */ (object, property)) { @@ -2803,6 +6293,26 @@ return Qnil; } +DEFUN ("object-setplist", Fobject_setplist, 2, 2, 0, /* +Set OBJECT's property list to NEWPLIST, and return NEWPLIST. +For a symbol, this is equivalent to `setplist'. + +OBJECT can be a symbol or a process, other objects with visible plists do +not allow their modification with `object-setplist'. +*/ + (object, newplist)) +{ + if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->setplist) + { + return XRECORD_LHEADER_IMPLEMENTATION (object)->setplist (object, + newplist); + } + + invalid_operation ("Not possible to set object's plist", object); + return Qnil; +} + + static Lisp_Object tweaked_internal_equal (Lisp_Object obj1, Lisp_Object obj2, @@ -2834,7 +6344,7 @@ int internal_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { - if (depth > 200) + if (depth + lisp_eval_depth > max_lisp_eval_depth) stack_overflow ("Stack overflow in equal", Qunbound); QUIT; if (EQ_WITH_EBOLA_NOTICE (obj1, obj2)) @@ -2879,7 +6389,7 @@ int internal_equalp (Lisp_Object obj1, Lisp_Object obj2, int depth) { - if (depth > 200) + if (depth + lisp_eval_depth > max_lisp_eval_depth) stack_overflow ("Stack overflow in equalp", Qunbound); QUIT; @@ -2947,26 +6457,6 @@ return internal_equal (obj1, obj2, depth); } -/* Note that we may be calling sub-objects that will use - internal_equal() (instead of internal_old_equal()). Oh well. - We will get an Ebola note if there's any possibility of confusion, - but that seems unlikely. */ - -static int -internal_old_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) -{ - if (depth > 200) - stack_overflow ("Stack overflow in equal", Qunbound); - QUIT; - if (HACKEQ_UNSAFE (obj1, obj2)) - return 1; - /* Note that (equal 20 20.0) should be nil */ - if (XTYPE (obj1) != XTYPE (obj2)) - return 0; - - return internal_equal (obj1, obj2, depth); -} - DEFUN ("equal", Fequal, 2, 2, 0, /* Return t if two Lisp objects have similar structure and contents. They must have the same data type. @@ -3010,6 +6500,134 @@ return internal_equalp (object1, object2, 0) ? Qt : Qnil; } +#ifdef SUPPORT_CONFOUNDING_FUNCTIONS + +/* Note that we may be calling sub-objects that will use + internal_equal() (instead of internal_old_equal()). Oh well. + We will get an Ebola note if there's any possibility of confusion, + but that seems unlikely. */ + +static int +internal_old_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) +{ + if (depth + lisp_eval_depth > max_lisp_eval_depth) + stack_overflow ("Stack overflow in equal", Qunbound); + QUIT; + if (HACKEQ_UNSAFE (obj1, obj2)) + return 1; + /* Note that (equal 20 20.0) should be nil */ + if (XTYPE (obj1) != XTYPE (obj2)) + return 0; + + return internal_equal (obj1, obj2, depth); +} + +DEFUN ("old-member", Fold_member, 2, 2, 0, /* +Return non-nil if ELT is an element of LIST. Comparison done with `old-equal'. +The value is actually the tail of LIST whose car is ELT. +This function is provided only for byte-code compatibility with v19. +Do not use it. +*/ + (elt, list)) +{ + EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) + { + if (internal_old_equal (elt, list_elt, 0)) + return tail; + } + return Qnil; +} + +DEFUN ("old-memq", Fold_memq, 2, 2, 0, /* +Return non-nil if ELT is an element of LIST. Comparison done with `old-eq'. +The value is actually the tail of LIST whose car is ELT. +This function is provided only for byte-code compatibility with v19. +Do not use it. +*/ + (elt, list)) +{ + EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) + { + if (HACKEQ_UNSAFE (elt, list_elt)) + return tail; + } + return Qnil; +} + +DEFUN ("old-assoc", Fold_assoc, 2, 2, 0, /* +Return non-nil if KEY is `old-equal' to the car of an element of ALIST. +The value is actually the element of ALIST whose car equals KEY. +*/ + (key, alist)) +{ + /* This function can GC. */ + EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) + { + if (internal_old_equal (key, elt_car, 0)) + return elt; + } + return Qnil; +} + +DEFUN ("old-assq", Fold_assq, 2, 2, 0, /* +Return non-nil if KEY is `old-eq' to the car of an element of ALIST. +The value is actually the element of ALIST whose car is KEY. +Elements of ALIST that are not conses are ignored. +This function is provided only for byte-code compatibility with v19. +Do not use it. +*/ + (key, alist)) +{ + EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) + { + if (HACKEQ_UNSAFE (key, elt_car)) + return elt; + } + return Qnil; +} + +DEFUN ("old-rassoc", Fold_rassoc, 2, 2, 0, /* +Return non-nil if VALUE is `old-equal' to the cdr of an element of ALIST. +The value is actually the element of ALIST whose cdr equals VALUE. +*/ + (value, alist)) +{ + EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) + { + if (internal_old_equal (value, elt_cdr, 0)) + return elt; + } + return Qnil; +} + +DEFUN ("old-delete", Fold_delete, 2, 2, 0, /* +Delete by side effect any occurrences of ELT as a member of LIST. +The modified LIST is returned. Comparison is done with `old-equal'. +If the first member of LIST is ELT, there is no way to remove it by side +effect; therefore, write `(setq foo (old-delete element foo))' to be sure +of changing the value of `foo'. +*/ + (elt, list)) +{ + EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, + (internal_old_equal (elt, list_elt, 0))); + return list; +} + +DEFUN ("old-delq", Fold_delq, 2, 2, 0, /* +Delete by side effect any occurrences of ELT as a member of LIST. +The modified LIST is returned. Comparison is done with `old-eq'. +If the first member of LIST is ELT, there is no way to remove it by side +effect; therefore, write `(setq foo (old-delq element foo))' to be sure of +changing the value of `foo'. +*/ + (elt, list)) +{ + EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, + (HACKEQ_UNSAFE (elt, list_elt))); + return list; +} + DEFUN ("old-equal", Fold_equal, 2, 2, 0, /* Return t if two Lisp objects have similar structure and contents. They must have the same data type. @@ -3024,70 +6642,152 @@ return internal_old_equal (object1, object2, 0) ? Qt : Qnil; } +DEFUN ("old-eq", Fold_eq, 2, 2, 0, /* +Return t if the two args are (in most cases) the same Lisp object. + +Special kludge: A character is considered `old-eq' to its equivalent integer +even though they are not the same object and are in fact of different +types. This is ABSOLUTELY AND UTTERLY HORRENDOUS but is necessary to +preserve byte-code compatibility with v19. This kludge is known as the +\"char-int confoundance disease\" and appears in a number of other +functions with `old-foo' equivalents. + +Do not use this function! +*/ + (object1, object2)) +{ + /* #### blasphemy */ + return HACKEQ_UNSAFE (object1, object2) ? Qt : Qnil; +} + +#endif + -DEFUN ("fillarray", Ffillarray, 2, 2, 0, /* -Destructively modify ARRAY by replacing each element with ITEM. -ARRAY is a vector, bit vector, or string. -*/ - (array, item)) -{ +static Lisp_Object replace_string_range_1 (Lisp_Object dest, + Lisp_Object start, + Lisp_Object end, + const Ibyte *source, + const Ibyte *source_limit, + Lisp_Object item); + +/* Fill the substring of DEST beginning at START and ending before END with + the character ITEM. If DEST does not have sufficient space for END - + START characters at START, write as many as is possible without changing + the character length of DEST. Update the string modification flag and do + any sledgehammer checks we have turned on. + + START must be a Lisp integer. END can be nil, indicating the length of the + string, or a Lisp integer. The condition (<= 0 START END (length DEST)) + must hold, or fill_string_range() will signal an error. */ +static Lisp_Object +fill_string_range (Lisp_Object dest, Lisp_Object item, Lisp_Object start, + Lisp_Object end) +{ + return replace_string_range_1 (dest, start, end, NULL, NULL, item); +} + +DEFUN ("fill", Ffill, 2, MANY, 0, /* +Destructively modify SEQUENCE by replacing each element with ITEM. +SEQUENCE is a list, vector, bit vector, or string. + +Optional keyword START is the index of the first element of SEQUENCE +to be modified, and defaults to zero. Optional keyword END is the +exclusive upper bound on the elements of SEQUENCE to be modified, and +defaults to the length of SEQUENCE. + +arguments: (SEQUENCE ITEM &key (START 0) (END (length SEQUENCE))) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object sequence = args[0]; + Lisp_Object item = args[1]; + Elemcount starting, ending = EMACS_INT_MAX + 1, ii, len; + + PARSE_KEYWORDS (Ffill, nargs, args, 2, (start, end), (start = Qzero)); + + CHECK_NATNUM (start); + starting = BIGNUMP (start) ? EMACS_INT_MAX + 1 : XINT (start); + + if (!NILP (end)) + { + CHECK_NATNUM (end); + ending = BIGNUMP (end) ? EMACS_INT_MAX + 1 : XINT (end); + } + retry: - if (STRINGP (array)) - { - Bytecount old_bytecount = XSTRING_LENGTH (array); - Bytecount new_bytecount; - Bytecount item_bytecount; - Ibyte item_buf[MAX_ICHAR_LEN]; - Ibyte *p; - Ibyte *end; - + if (STRINGP (sequence)) + { CHECK_CHAR_COERCE_INT (item); - - CHECK_LISP_WRITEABLE (array); - sledgehammer_check_ascii_begin (array); - item_bytecount = set_itext_ichar (item_buf, XCHAR (item)); - new_bytecount = item_bytecount * (Bytecount) string_char_length (array); - - resize_string (array, -1, new_bytecount - old_bytecount); - - for (p = XSTRING_DATA (array), end = p + new_bytecount; - p < end; - p += item_bytecount) - memcpy (p, item_buf, item_bytecount); - *p = '\0'; - - XSET_STRING_ASCII_BEGIN (array, - item_bytecount == 1 ? - min (new_bytecount, MAX_STRING_ASCII_BEGIN) : - 0); - bump_string_modiff (array); - sledgehammer_check_ascii_begin (array); - } - else if (VECTORP (array)) - { - Lisp_Object *p = XVECTOR_DATA (array); - Elemcount len = XVECTOR_LENGTH (array); - CHECK_LISP_WRITEABLE (array); - while (len--) - *p++ = item; - } - else if (BIT_VECTORP (array)) - { - Lisp_Bit_Vector *v = XBIT_VECTOR (array); - Elemcount len = bit_vector_length (v); + CHECK_LISP_WRITEABLE (sequence); + + fill_string_range (sequence, item, start, end); + } + else if (VECTORP (sequence)) + { + Lisp_Object *p = XVECTOR_DATA (sequence); + + CHECK_LISP_WRITEABLE (sequence); + len = XVECTOR_LENGTH (sequence); + + check_sequence_range (sequence, start, end, make_int (len)); + ending = min (ending, len); + + for (ii = starting; ii < ending; ++ii) + { + p[ii] = item; + } + } + else if (BIT_VECTORP (sequence)) + { + Lisp_Bit_Vector *v = XBIT_VECTOR (sequence); int bit; + CHECK_BIT (item); bit = XINT (item); - CHECK_LISP_WRITEABLE (array); - while (len--) - set_bit_vector_bit (v, len, bit); + CHECK_LISP_WRITEABLE (sequence); + len = bit_vector_length (v); + + check_sequence_range (sequence, start, end, make_int (len)); + ending = min (ending, len); + + for (ii = starting; ii < ending; ++ii) + { + set_bit_vector_bit (v, ii, bit); + } + } + else if (LISTP (sequence)) + { + Elemcount counting = 0; + + { + EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) + { + if (counting >= starting) + { + if (counting < ending) + { + XSETCAR (tail, item); + } + else if (counting == ending) + { + break; + } + } + ++counting; + } + } + + if (counting < starting || (counting != ending && !NILP (end))) + { + check_sequence_range (args[0], start, end, Flength (args[0])); + } } else { - array = wrong_type_argument (Qarrayp, array); + sequence = wrong_type_argument (Qsequencep, sequence); goto retry; } - return array; + return sequence; } Lisp_Object @@ -3225,49 +6925,67 @@ } +/* Replace the substring of DEST beginning at START and ending before END + with the text at SOURCE, which is END - START characters long and + SOURCE_LIMIT - SOURCE octets long. If DEST does not have sufficient + space for END - START characters at START, write as many as is possible + without changing the length of DEST. Update the string modification flag + and do any sledgehammer checks we have turned on in this build. + + START must be a Lisp integer. END can be nil, indicating the length of the + string, or a Lisp integer. The condition (<= 0 START END (length DEST)) + must hold, or replace_string_range() will signal an error. */ +static Lisp_Object +replace_string_range (Lisp_Object dest, Lisp_Object start, Lisp_Object end, + const Ibyte *source, const Ibyte *source_limit) +{ + return replace_string_range_1 (dest, start, end, source, source_limit, + Qnil); +} + /* This is the guts of several mapping functions. Call FUNCTION CALL_COUNT times, with NSEQUENCES arguments each time, taking the elements from SEQUENCES. If VALS is non-NULL, store the results into VALS, a C array of Lisp_Objects; else, if LISP_VALS is non-nil, store the results into LISP_VALS, a sequence with sufficient - room for CALL_COUNT results. Else, do not accumulate any result. + room for CALL_COUNT results (but see the documentation of SOME_OR_EVERY.) + Else, do not accumulate any result. If VALS is non-NULL, NSEQUENCES is one, and SEQUENCES[0] is a cons, mapcarX will store the elements of SEQUENCES[0] in stack and GCPRO them, so FUNCTION cannot insert a non-cons into SEQUENCES[0] and throw off mapcarX. - Otherwise, mapcarX signals a wrong-type-error if it encounters a - non-cons, non-array when traversing SEQUENCES. Common Lisp specifies in + Otherwise, mapcarX signals an invalid state error (see + mapping_interaction_error(), above) if it encounters a non-cons, + non-array when traversing SEQUENCES. Common Lisp specifies in MAPPING-DESTRUCTIVE-INTERACTION that it is an error when FUNCTION destructively modifies SEQUENCES in a way that might affect the ongoing traversal operation. - If SOME_OR_EVERY is SOME_OR_EVERY_SOME, return the (possibly multiple) - values given by FUNCTION the first time it is non-nil, and abandon the - iterations. LISP_VALS in this case must be an object created by - make_opaque_ptr, dereferenced as pointing to a Lisp object. If - SOME_OR_EVERY is SOME_OR_EVERY_EVERY, store Qnil at the Lisp_Object - pointer address provided by LISP_VALS if FUNCTION gives nil; otherwise - leave it alone. */ - -#define SOME_OR_EVERY_NEITHER 0 -#define SOME_OR_EVERY_SOME 1 -#define SOME_OR_EVERY_EVERY 2 + CALLER is a symbol describing the Lisp-visible function that was called, + and any errors thrown because SEQUENCES was modified will reflect it. + + If CALLER is Qsome, return the (possibly multiple) values given by + FUNCTION the first time it is non-nil, and abandon the iterations. + LISP_VALS must be the result of calling STORE_VOID_IN_LISP on the address + of a Lisp object, and the return value will be stored at that address. + If CALLER is Qevery, LISP_VALS must also reflect a pointer to a Lisp + object, and Qnil will be stored at that address if FUNCTION gives nil; + otherwise it will be left alone. */ static void mapcarX (Elemcount call_count, Lisp_Object *vals, Lisp_Object lisp_vals, Lisp_Object function, int nsequences, Lisp_Object *sequences, - int some_or_every) + Lisp_Object caller) { Lisp_Object called, *args; struct gcpro gcpro1, gcpro2; + Ibyte *lisp_vals_staging = NULL, *cursor = NULL; int i, j; - enum lrecord_type lisp_vals_type; - - assert (LRECORDP (lisp_vals)); - lisp_vals_type = (enum lrecord_type) XRECORD_LHEADER (lisp_vals)->type; + + assert ((EQ (caller, Qsome) || EQ (caller, Qevery)) ? vals == NULL : 1); args = alloca_array (Lisp_Object, nsequences + 1); args[0] = function; @@ -3306,17 +7024,36 @@ for (i = 0; i < call_count; ++i) { args[1] = vals[i]; - vals[i] = Ffuncall (nsequences + 1, args); + vals[i] = IGNORE_MULTIPLE_VALUES (Ffuncall (nsequences + 1, args)); } } else { + enum lrecord_type lisp_vals_type = lrecord_type_symbol; Binbyte *sequence_types = alloca_array (Binbyte, nsequences); for (j = 0; j < nsequences; ++j) { sequence_types[j] = XRECORD_LHEADER (sequences[j])->type; } + if (!EQ (caller, Qsome) && !EQ (caller, Qevery)) + { + assert (LRECORDP (lisp_vals)); + + lisp_vals_type + = (enum lrecord_type) XRECORD_LHEADER (lisp_vals)->type; + + if (lrecord_type_string == lisp_vals_type) + { + lisp_vals_staging = cursor + = alloca_ibytes (call_count * MAX_ICHAR_LEN); + } + else if (ARRAYP (lisp_vals)) + { + CHECK_LISP_WRITEABLE (lisp_vals); + } + } + for (i = 0; i < call_count; ++i) { for (j = 0; j < nsequences; ++j) @@ -3327,13 +7064,12 @@ { if (!CONSP (sequences[j])) { - /* This means FUNCTION has probably messed - around with a cons in one of the sequences, - since we checked the type - (CHECK_SEQUENCE()) and the length and + /* This means FUNCTION has messed around with a cons + in one of the sequences, since we checked the + type (CHECK_SEQUENCE()) and the length and structure (with Flength()) correctly in our callers. */ - dead_wrong_type_argument (Qconsp, sequences[j]); + mapping_interaction_error (caller, sequences[j]); } args[j + 1] = XCAR (sequences[j]); sequences[j] = XCDR (sequences[j]); @@ -3366,96 +7102,128 @@ vals[i] = IGNORE_MULTIPLE_VALUES (called); gcpro2.nvars += 1; } - else - { - switch (lisp_vals_type) - { - case lrecord_type_symbol: - break; - case lrecord_type_cons: - { - if (SOME_OR_EVERY_NEITHER == some_or_every) - { - called = IGNORE_MULTIPLE_VALUES (called); - if (!CONSP (lisp_vals)) - { - /* If FUNCTION has inserted a non-cons non-nil - cdr into the list before we've processed the - relevant part, error. */ - dead_wrong_type_argument (Qconsp, lisp_vals); - } - - XSETCAR (lisp_vals, called); - lisp_vals = XCDR (lisp_vals); - break; - } - - if (SOME_OR_EVERY_SOME == some_or_every) - { - if (!NILP (IGNORE_MULTIPLE_VALUES (called))) - { - XCAR (lisp_vals) = called; - UNGCPRO; - return; - } - break; - } - - if (SOME_OR_EVERY_EVERY == some_or_every) - { - called = IGNORE_MULTIPLE_VALUES (called); - if (NILP (called)) - { - XCAR (lisp_vals) = Qnil; - UNGCPRO; - return; - } - break; - } - - goto bad_show_or_every_flag; - } - case lrecord_type_vector: - { - called = IGNORE_MULTIPLE_VALUES (called); - i < XVECTOR_LENGTH (lisp_vals) ? - (XVECTOR_DATA (lisp_vals)[i] = called) : - /* Let #'aset error. */ - Faset (lisp_vals, make_int (i), called); - break; - } - case lrecord_type_string: - { - /* If this ever becomes a code hotspot, we can keep - around pointers into the data of the string, checking - each time that it hasn't been relocated. */ - called = IGNORE_MULTIPLE_VALUES (called); - Faset (lisp_vals, make_int (i), called); - break; - } - case lrecord_type_bit_vector: - { - called = IGNORE_MULTIPLE_VALUES (called); - (BITP (called) && - i < bit_vector_length (XBIT_VECTOR (lisp_vals))) ? - set_bit_vector_bit (XBIT_VECTOR (lisp_vals), i, - XINT (called)) : - (void) Faset (lisp_vals, make_int (i), called); - break; - } - bad_show_or_every_flag: - default: - { - ABORT(); - break; - } - } - } - } - } + else if (EQ (Qsome, caller)) + { + if (!NILP (IGNORE_MULTIPLE_VALUES (called))) + { + Lisp_Object *result + = (Lisp_Object *) GET_VOID_FROM_LISP (lisp_vals); + *result = called; + UNGCPRO; + return; + } + } + else if (EQ (Qevery, caller)) + { + if (NILP (IGNORE_MULTIPLE_VALUES (called))) + { + Lisp_Object *result + = (Lisp_Object *) GET_VOID_FROM_LISP (lisp_vals); + *result = Qnil; + UNGCPRO; + return; + } + } + else + { + called = IGNORE_MULTIPLE_VALUES (called); + switch (lisp_vals_type) + { + case lrecord_type_symbol: + /* Discard the result of funcall. */ + break; + case lrecord_type_cons: + { + if (!CONSP (lisp_vals)) + { + /* If FUNCTION has inserted a non-cons non-nil + cdr into the list before we've processed the + relevant part, error. */ + mapping_interaction_error (caller, lisp_vals); + } + XSETCAR (lisp_vals, called); + lisp_vals = XCDR (lisp_vals); + break; + } + case lrecord_type_vector: + { + i < XVECTOR_LENGTH (lisp_vals) ? + (XVECTOR_DATA (lisp_vals)[i] = called) : + /* Let #'aset error. */ + Faset (lisp_vals, make_int (i), called); + break; + } + case lrecord_type_string: + { + CHECK_CHAR_COERCE_INT (called); + cursor += set_itext_ichar (cursor, XCHAR (called)); + break; + } + case lrecord_type_bit_vector: + { + (BITP (called) && + i < bit_vector_length (XBIT_VECTOR (lisp_vals))) ? + set_bit_vector_bit (XBIT_VECTOR (lisp_vals), i, + XINT (called)) : + (void) Faset (lisp_vals, make_int (i), called); + break; + } + default: + { + ABORT(); + break; + } + } + } + } + + if (lisp_vals_staging != NULL) + { + CHECK_LISP_WRITEABLE (lisp_vals); + replace_string_range (lisp_vals, Qzero, make_int (call_count), + lisp_vals_staging, cursor); + } + } + UNGCPRO; } +/* Given NSEQUENCES objects at the address pointed to by SEQUENCES, return + the length of the shortest sequence. Error if all are circular, or if any + one of them is not a sequence. */ +static Elemcount +shortest_length_among_sequences (int nsequences, Lisp_Object *sequences) +{ + Elemcount len = 1 + EMACS_INT_MAX; + Lisp_Object length = Qnil; + int i; + + for (i = 0; i < nsequences; ++i) + { + if (CONSP (sequences[i])) + { + length = Flist_length (sequences[i]); + if (!NILP (length)) + { + len = min (len, XINT (length)); + } + } + else + { + CHECK_SEQUENCE (sequences[i]); + length = Flength (sequences[i]); + len = min (len, XINT (length)); + } + } + + if (len == 1 + EMACS_INT_MAX) + { + signal_circular_list_error (sequences[0]); + } + + return len; +} + DEFUN ("mapconcat", Fmapconcat, 3, MANY, 0, /* Call FUNCTION on each element of SEQUENCE, and concat results to a string. Between each pair of results, insert SEPARATOR. @@ -3483,11 +7251,7 @@ args[2] = sequence; args[1] = separator; - for (i = 2; i < nargs; ++i) - { - CHECK_SEQUENCE (args[i]); - len = min (len, XINT (Flength (args[i]))); - } + len = shortest_length_among_sequences (nargs - 2, args + 2); if (len == 0) return build_ascstring (""); @@ -3507,8 +7271,7 @@ } else { - mapcarX (len, args0, Qnil, function, nargs - 2, args + 2, - SOME_OR_EVERY_NEITHER); + mapcarX (len, args0, Qnil, function, nargs - 2, args + 2, Qmapconcat); } for (i = len - 1; i >= 0; i--) @@ -3535,19 +7298,11 @@ (int nargs, Lisp_Object *args)) { Lisp_Object function = args[0]; - Elemcount len = EMACS_INT_MAX; + Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1); Lisp_Object *args0; - int i; - - for (i = 1; i < nargs; ++i) - { - CHECK_SEQUENCE (args[i]); - len = min (len, XINT (Flength (args[i]))); - } args0 = alloca_array (Lisp_Object, len); - mapcarX (len, args0, Qnil, function, nargs - 1, args + 1, - SOME_OR_EVERY_NEITHER); + mapcarX (len, args0, Qnil, function, nargs - 1, args + 1, QmapcarX); return Flist ((int) len, args0); } @@ -3567,26 +7322,16 @@ (int nargs, Lisp_Object *args)) { Lisp_Object function = args[0]; - Elemcount len = EMACS_INT_MAX; - Lisp_Object result; + Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1); + Lisp_Object result = make_vector (len, Qnil); + struct gcpro gcpro1; - int i; - - for (i = 1; i < nargs; ++i) - { - CHECK_SEQUENCE (args[i]); - len = min (len, XINT (Flength (args[i]))); - } - - result = make_vector (len, Qnil); GCPRO1 (result); /* Don't pass result as the lisp_object argument, we want mapcarX to protect a single list argument's elements from being garbage-collected. */ mapcarX (len, XVECTOR_DATA (result), Qnil, function, nargs - 1, args +1, - SOME_OR_EVERY_NEITHER); - UNGCPRO; - - return result; + Qmapvector); + RETURN_UNGCPRO (result); } DEFUN ("mapcan", Fmapcan, 2, MANY, 0, /* @@ -3604,40 +7349,13 @@ */ (int nargs, Lisp_Object *args)) { - Lisp_Object function = args[0], nconcing; - Elemcount len = EMACS_INT_MAX; - Lisp_Object *args0; - struct gcpro gcpro1; - int i; - - for (i = 1; i < nargs; ++i) - { - CHECK_SEQUENCE (args[i]); - len = min (len, XINT (Flength (args[i]))); - } - - args0 = alloca_array (Lisp_Object, len + 1); - mapcarX (len, args0 + 1, Qnil, function, nargs - 1, args + 1, - SOME_OR_EVERY_NEITHER); - - if (len < 2) - { - return len ? args0[1] : Qnil; - } - - /* bytecode_nconc2 can signal and return, we need to GCPRO the args, since - mapcarX is no longer doing this for us. */ - args0[0] = Fcons (Qnil, Qnil); - GCPRO1 (args0[0]); - gcpro1.nvars = len + 1; - - for (i = 0; i < len; ++i) - { - nconcing = bytecode_nconc2 (args0 + i); - args0[i + 1] = nconcing; - } - - RETURN_UNGCPRO (XCDR (nconcing)); + Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1); + Lisp_Object function = args[0], *result = alloca_array (Lisp_Object, len); + + mapcarX (len, result, Qnil, function, nargs - 1, args + 1, Qmapcan); + + /* #'nconc GCPROs its args in case of signals and error. */ + return Fnconc (len, result); } DEFUN ("mapc", Fmapc, 2, MANY, 0, /* @@ -3658,23 +7376,14 @@ */ (int nargs, Lisp_Object *args)) { - Elemcount len = EMACS_INT_MAX; + Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1); Lisp_Object sequence = args[1]; struct gcpro gcpro1; - int i; - - for (i = 1; i < nargs; ++i) - { - CHECK_SEQUENCE (args[i]); - len = min (len, XINT (Flength (args[i]))); - } - /* We need to GCPRO sequence, because mapcarX will modify the elements of the args array handed to it, and this may involve elements of sequence getting garbage collected. */ GCPRO1 (sequence); - mapcarX (len, NULL, Qnil, args[0], nargs - 1, args + 1, - SOME_OR_EVERY_NEITHER); + mapcarX (len, NULL, Qnil, args[0], nargs - 1, args + 1, Qmapc); RETURN_UNGCPRO (sequence); } @@ -3699,23 +7408,15 @@ Lisp_Object function = args[1]; Lisp_Object result = Qnil; Lisp_Object *args0 = NULL; - Elemcount len = EMACS_INT_MAX; - int i; + Elemcount len = shortest_length_among_sequences (nargs - 2, args + 2); struct gcpro gcpro1; - for (i = 2; i < nargs; ++i) - { - CHECK_SEQUENCE (args[i]); - len = min (len, XINT (Flength (args[i]))); - } - if (!NILP (type)) { args0 = alloca_array (Lisp_Object, len); } - mapcarX (len, args0, Qnil, function, nargs - 2, args + 2, - SOME_OR_EVERY_NEITHER); + mapcarX (len, args0, Qnil, function, nargs - 2, args + 2, Qmap); if (EQ (type, Qnil)) { @@ -3765,22 +7466,17 @@ */ (int nargs, Lisp_Object *args)) { - Elemcount len = EMACS_INT_MAX; + Elemcount len; Lisp_Object result_sequence = args[0]; Lisp_Object function = args[1]; - int i; args[0] = function; args[1] = result_sequence; - for (i = 1; i < nargs; ++i) - { - CHECK_SEQUENCE (args[i]); - len = min (len, XINT (Flength (args[i]))); - } + len = shortest_length_among_sequences (nargs - 1, args + 1); mapcarX (len, NULL, result_sequence, function, nargs - 2, args + 2, - SOME_OR_EVERY_NEITHER); + Qmap_into); return result_sequence; } @@ -3793,27 +7489,21 @@ With optional SEQUENCES, call PREDICATE each time with as many arguments as there are SEQUENCES (plus one for the element from SEQUENCE). +See also `find-if', which returns the corresponding element of SEQUENCE, +rather than the value given by PREDICATE, and accepts bounding index +keywords. + arguments: (PREDICATE SEQUENCE &rest SEQUENCES) */ (int nargs, Lisp_Object *args)) { - Lisp_Object result_box = Fcons (Qnil, Qnil); - struct gcpro gcpro1; - Elemcount len = EMACS_INT_MAX; - int i; - - GCPRO1 (result_box); - - for (i = 1; i < nargs; ++i) - { - CHECK_SEQUENCE (args[i]); - len = min (len, XINT (Flength (args[i]))); - } - - mapcarX (len, NULL, result_box, args[0], nargs - 1, args +1, - SOME_OR_EVERY_SOME); - - RETURN_UNGCPRO (XCAR (result_box)); + Lisp_Object result = Qnil, + result_ptr = STORE_VOID_IN_LISP ((void *) &result); + Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1); + + mapcarX (len, NULL, result_ptr, args[0], nargs - 1, args +1, Qsome); + + return result; } DEFUN ("every", Fevery, 2, MANY, 0, /* @@ -3828,43 +7518,35 @@ */ (int nargs, Lisp_Object *args)) { - Lisp_Object result_box = Fcons (Qt, Qnil); - struct gcpro gcpro1; - Elemcount len = EMACS_INT_MAX; - int i; - - GCPRO1 (result_box); - - for (i = 1; i < nargs; ++i) - { - CHECK_SEQUENCE (args[i]); - len = min (len, XINT (Flength (args[i]))); - } - - mapcarX (len, NULL, result_box, args[0], nargs - 1, args +1, - SOME_OR_EVERY_EVERY); - - RETURN_UNGCPRO (XCAR (result_box)); + Lisp_Object result = Qt, result_ptr = STORE_VOID_IN_LISP ((void *) &result); + Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1); + + mapcarX (len, NULL, result_ptr, args[0], nargs - 1, args +1, Qevery); + + return result; } /* Call FUNCTION with NLISTS arguments repeatedly, each Nth argument corresponding to the result of calling (nthcdr ITERATION-COUNT LISTS[N]), until that #'nthcdr expression gives nil for some element of LISTS. - If MAPLP is zero, return LISTS[0]. Otherwise, return a list of the return - values from FUNCTION; if NCONCP is non-zero, nconc them together. + CALLER is a symbol reflecting the Lisp-visible function that was called, + and any errors thrown because SEQUENCES was modified will reflect it. + + If CALLER is Qmapl, return LISTS[0]. Otherwise, return a list of the + return values from FUNCTION; if caller is Qmapcan, nconc them together. In contrast to mapcarX, we don't require our callers to check LISTS for well-formedness, we signal wrong-type-argument if it's not a list, or circular-list if it's circular. */ static Lisp_Object -maplist (Lisp_Object function, int nlists, Lisp_Object *lists, int maplp, - int nconcp) -{ - Lisp_Object result = maplp ? lists[0] : Fcons (Qnil, Qnil), funcalled; - Lisp_Object nconcing[2], accum = result, *args; - struct gcpro gcpro1, gcpro2, gcpro3; +maplist (Lisp_Object function, int nlists, Lisp_Object *lists, + Lisp_Object caller) +{ + Lisp_Object nconcing[2], accum = Qnil, *args, *tortoises, funcalled; + Lisp_Object result = EQ (caller, Qmapl) ? lists[0] : Qnil; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; int i, j, continuing = (nlists > 0), called_count = 0; args = alloca_array (Lisp_Object, nlists + 1); @@ -3874,18 +7556,23 @@ args[i] = Qnil; } - if (nconcp) - { - nconcing[0] = result; + tortoises = alloca_array (Lisp_Object, nlists); + memcpy (tortoises, lists, nlists * sizeof (Lisp_Object)); + + if (EQ (caller, Qmapcon)) + { + nconcing[0] = Qnil; nconcing[1] = Qnil; - GCPRO3 (args[0], nconcing[0], result); + GCPRO4 (args[0], nconcing[0], tortoises[0], result); gcpro1.nvars = 1; gcpro2.nvars = 2; + gcpro3.nvars = nlists; } else { - GCPRO2 (args[0], result); + GCPRO3 (args[0], tortoises[0], result); gcpro1.nvars = 1; + gcpro2.nvars = nlists; } while (continuing) @@ -3904,45 +7591,64 @@ } else { - dead_wrong_type_argument (Qlistp, lists[j]); + lists[j] = wrong_type_argument (Qlistp, lists[j]); } } if (!continuing) break; funcalled = IGNORE_MULTIPLE_VALUES (Ffuncall (nlists + 1, args)); - if (!maplp) - { - if (nconcp) - { - /* This order of calls means we check that each list is - well-formed once and once only. The last result does - not have to be a list. */ - nconcing[1] = funcalled; - nconcing[0] = bytecode_nconc2 (nconcing); - } - else - { - /* Add to the end, avoiding the need to call nreverse - once we're done: */ - XSETCDR (accum, Fcons (funcalled, Qnil)); - accum = XCDR (accum); - } - } - - if (++called_count % CIRCULAR_LIST_SUSPICION_LENGTH) continue; - - for (j = 0; j < nlists; ++j) - { - EXTERNAL_LIST_LOOP_1 (lists[j]) - { - /* Just check the lists aren't circular, using the - EXTERNAL_LIST_LOOP_1 macro. */ - } - } - } - - if (!maplp) - { - result = XCDR (result); + + if (EQ (caller, Qmapl)) + { + DO_NOTHING; + } + else if (EQ (caller, Qmapcon)) + { + nconcing[1] = funcalled; + accum = bytecode_nconc2 (nconcing); + if (NILP (result)) + { + result = accum; + } + /* Only check a given stretch of result for well-formedness + once: */ + nconcing[0] = funcalled; + } + else if (NILP (accum)) + { + accum = result = Fcons (funcalled, Qnil); + } + else + { + /* Add to the end, avoiding the need to call nreverse + once we're done: */ + XSETCDR (accum, Fcons (funcalled, Qnil)); + accum = XCDR (accum); + } + + if (++called_count > CIRCULAR_LIST_SUSPICION_LENGTH) + { + if (called_count & 1) + { + for (j = 0; j < nlists; ++j) + { + tortoises[j] = XCDR (tortoises[j]); + if (EQ (lists[j], tortoises[j])) + { + signal_circular_list_error (lists[j]); + } + } + } + else + { + for (j = 0; j < nlists; ++j) + { + if (EQ (lists[j], tortoises[j])) + { + signal_circular_list_error (lists[j]); + } + } + } + } } RETURN_UNGCPRO (result); @@ -3957,7 +7663,7 @@ */ (int nargs, Lisp_Object *args)) { - return maplist (args[0], nargs - 1, args + 1, 0, 0); + return maplist (args[0], nargs - 1, args + 1, Qmaplist); } DEFUN ("mapl", Fmapl, 2, MANY, 0, /* @@ -3967,7 +7673,7 @@ */ (int nargs, Lisp_Object *args)) { - return maplist (args[0], nargs - 1, args + 1, 1, 0); + return maplist (args[0], nargs - 1, args + 1, Qmapl); } DEFUN ("mapcon", Fmapcon, 2, MANY, 0, /* @@ -3980,11 +7686,418 @@ */ (int nargs, Lisp_Object *args)) { - return maplist (args[0], nargs - 1, args + 1, 0, 1); + return maplist (args[0], nargs - 1, args + 1, Qmapcon); } /* Extra random functions */ +DEFUN ("reduce", Freduce, 2, MANY, 0, /* +Combine the elements of sequence using FUNCTION, a binary operation. + +For example, `(reduce #'+ SEQUENCE)' returns the sum of all elements in +SEQUENCE, and `(reduce #'union SEQUENCE)' returns the union of all elements +in SEQUENCE. + +Keywords supported: :start :end :from-end :initial-value :key +See `remove*' for the meaning of :start, :end, :from-end and :key. + +:initial-value specifies an element (typically an identity element, such as +0) that is conceptually prepended to the sequence (or appended, when +:from-end is given). + +If the sequence has one element, that element is returned directly. +If the sequence has no elements, :initial-value is returned if given; +otherwise, FUNCTION is called with no arguments, and its result returned. + +arguments: (FUNCTION SEQUENCE &key (START 0) (END (length SEQUENCE)) FROM-END INITIAL-VALUE (KEY #'identity)) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object function = args[0], sequence = args[1], accum = Qunbound; + Elemcount starting, ending = EMACS_INT_MAX + 1, ii = 0; + + PARSE_KEYWORDS (Freduce, nargs, args, 5, + (start, end, from_end, initial_value, key), + (start = Qzero, initial_value = Qunbound)); + + CHECK_SEQUENCE (sequence); + CHECK_NATNUM (start); + starting = BIGNUMP (start) ? EMACS_INT_MAX + 1 : XINT (start); + CHECK_KEY_ARGUMENT (key); + +#define KEY(key, item) (EQ (Qidentity, key) ? item : \ + IGNORE_MULTIPLE_VALUES (call1 (key, item))) +#define CALL2(function, accum, item) \ + IGNORE_MULTIPLE_VALUES (call2 (function, accum, item)) + + if (!NILP (end)) + { + CHECK_NATNUM (end); + ending = BIGNUMP (end) ? EMACS_INT_MAX + 1 : XINT (end); + } + + if (VECTORP (sequence)) + { + Lisp_Vector *vv = XVECTOR (sequence); + struct gcpro gcpro1; + + check_sequence_range (sequence, start, end, make_int (vv->size)); + + ending = min (ending, vv->size); + + GCPRO1 (accum); + + if (!UNBOUNDP (initial_value)) + { + accum = initial_value; + } + else if (ending - starting) + { + if (NILP (from_end)) + { + accum = KEY (key, vv->contents[starting]); + starting++; + } + else + { + accum = KEY (key, vv->contents[ending - 1]); + ending--; + } + } + + if (NILP (from_end)) + { + for (ii = starting; ii < ending; ++ii) + { + accum = CALL2 (function, accum, KEY (key, vv->contents[ii])); + } + } + else + { + for (ii = ending - 1; ii >= starting; --ii) + { + accum = CALL2 (function, KEY (key, vv->contents[ii]), accum); + } + } + + UNGCPRO; + } + else if (BIT_VECTORP (sequence)) + { + Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence); + struct gcpro gcpro1; + + check_sequence_range (sequence, start, end, make_int (bv->size)); + ending = min (ending, bv->size); + + GCPRO1 (accum); + + if (!UNBOUNDP (initial_value)) + { + accum = initial_value; + } + else if (ending - starting) + { + if (NILP (from_end)) + { + accum = KEY (key, make_int (bit_vector_bit (bv, starting))); + starting++; + } + else + { + accum = KEY (key, make_int (bit_vector_bit (bv, ending - 1))); + ending--; + } + } + + if (NILP (from_end)) + { + for (ii = starting; ii < ending; ++ii) + { + accum = CALL2 (function, accum, + KEY (key, make_int (bit_vector_bit (bv, ii)))); + } + } + else + { + for (ii = ending - 1; ii >= starting; --ii) + { + accum = CALL2 (function, KEY (key, + make_int (bit_vector_bit (bv, + ii))), + accum); + } + } + + UNGCPRO; + + } + else if (STRINGP (sequence)) + { + struct gcpro gcpro1; + + GCPRO1 (accum); + + if (NILP (from_end)) + { + Bytecount byte_len = XSTRING_LENGTH (sequence); + Bytecount cursor_offset = 0; + const Ibyte *startp = XSTRING_DATA (sequence); + const Ibyte *cursor = startp; + + for (ii = 0; ii != starting && cursor_offset < byte_len; ++ii) + { + INC_IBYTEPTR (cursor); + cursor_offset = cursor - startp; + } + + if (!UNBOUNDP (initial_value)) + { + accum = initial_value; + } + else if (ending - starting && cursor_offset < byte_len) + { + accum = KEY (key, make_char (itext_ichar (cursor))); + starting++; + startp = XSTRING_DATA (sequence); + cursor = startp + cursor_offset; + + if (byte_len != XSTRING_LENGTH (sequence) + || !valid_ibyteptr_p (cursor)) + { + mapping_interaction_error (Qreduce, sequence); + } + + INC_IBYTEPTR (cursor); + cursor_offset = cursor - startp; + ii++; + } + + while (cursor_offset < byte_len && ii < ending) + { + accum = CALL2 (function, accum, + KEY (key, make_char (itext_ichar (cursor)))); + + startp = XSTRING_DATA (sequence); + cursor = startp + cursor_offset; + + if (byte_len != XSTRING_LENGTH (sequence) + || !valid_ibyteptr_p (cursor)) + { + mapping_interaction_error (Qreduce, sequence); + } + + INC_IBYTEPTR (cursor); + cursor_offset = cursor - startp; + ++ii; + } + + if (ii < starting || (ii < ending && !NILP (end))) + { + check_sequence_range (sequence, start, end, Flength (sequence)); + } + } + else + { + Elemcount len = string_char_length (sequence); + Bytecount cursor_offset, byte_len = XSTRING_LENGTH (sequence); + const Ibyte *cursor; + + check_sequence_range (sequence, start, end, make_int (len)); + ending = min (ending, len); + starting = XINT (start); + + cursor = string_char_addr (sequence, ending - 1); + cursor_offset = cursor - XSTRING_DATA (sequence); + + if (!UNBOUNDP (initial_value)) + { + accum = initial_value; + } + else if (ending - starting) + { + accum = KEY (key, make_char (itext_ichar (cursor))); + ending--; + if (ending > 0) + { + cursor = XSTRING_DATA (sequence) + cursor_offset; + + if (!valid_ibyteptr_p (cursor)) + { + mapping_interaction_error (Qreduce, sequence); + } + + DEC_IBYTEPTR (cursor); + cursor_offset = cursor - XSTRING_DATA (sequence); + } + } + + for (ii = ending - 1; ii >= starting; --ii) + { + accum = CALL2 (function, KEY (key, + make_char (itext_ichar (cursor))), + accum); + if (ii > 0) + { + cursor = XSTRING_DATA (sequence) + cursor_offset; + + if (byte_len != XSTRING_LENGTH (sequence) + || !valid_ibyteptr_p (cursor)) + { + mapping_interaction_error (Qreduce, sequence); + } + + DEC_IBYTEPTR (cursor); + cursor_offset = cursor - XSTRING_DATA (sequence); + } + } + } + + UNGCPRO; + } + else if (LISTP (sequence)) + { + if (NILP (from_end)) + { + struct gcpro gcpro1; + + GCPRO1 (accum); + + if (!UNBOUNDP (initial_value)) + { + accum = initial_value; + } + else if (ending - starting) + { + GC_EXTERNAL_LIST_LOOP_2 (elt, sequence) + { + if (ii == starting) + { + accum = KEY (key, elt); + starting++; + break; + } + ++ii; + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + ii = 0; + + if (ending - starting) + { + GC_EXTERNAL_LIST_LOOP_2 (elt, sequence) + { + if (ii >= starting) + { + if (ii < ending) + { + accum = CALL2 (function, accum, KEY (key, elt)); + } + else if (ii == ending) + { + break; + } + } + ++ii; + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + UNGCPRO; + + if (ii < starting || (ii < ending && !NILP (end))) + { + check_sequence_range (sequence, start, end, Flength (sequence)); + } + } + else + { + Boolint need_accum = 0; + Lisp_Object *subsequence = NULL; + Elemcount counting = 0, len = 0; + struct gcpro gcpro1; + + len = XINT (Flength (sequence)); + check_sequence_range (sequence, start, end, make_int (len)); + ending = min (ending, len); + + /* :from-end with a list; make an alloca copy of the relevant list + data, attempting to go backwards isn't worth the trouble. */ + if (!UNBOUNDP (initial_value)) + { + accum = initial_value; + if (ending - starting && starting < ending) + { + subsequence = alloca_array (Lisp_Object, ending - starting); + } + } + else if (ending - starting && starting < ending) + { + subsequence = alloca_array (Lisp_Object, ending - starting); + need_accum = 1; + } + + if (ending - starting && starting < ending) + { + EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) + { + if (counting >= starting) + { + if (counting < ending) + { + subsequence[ii++] = elt; + } + else if (counting == ending) + { + break; + } + } + ++counting; + } + } + + if (subsequence != NULL) + { + len = ending - starting; + /* If we could be sure that neither FUNCTION nor KEY modify + SEQUENCE, this wouldn't be necessary, since all the + elements of SUBSEQUENCE would definitely always be + reachable via SEQUENCE. */ + GCPRO1 (subsequence[0]); + gcpro1.nvars = len; + } + + if (need_accum) + { + accum = KEY (key, subsequence[len - 1]); + --len; + } + + for (ii = len; ii != 0;) + { + --ii; + accum = CALL2 (function, KEY (key, subsequence[ii]), accum); + } + + if (subsequence != NULL) + { + UNGCPRO; + } + } + } + + /* At this point, if ACCUM is unbound, SEQUENCE has no elements; we + need to return the result of calling FUNCTION with zero + arguments. */ + if (UNBOUNDP (accum)) + { + accum = IGNORE_MULTIPLE_VALUES (call0 (function)); + } + + return accum; +} + DEFUN ("replace-list", Freplace_list, 2, 2, 0, /* Destructively replace the list OLD with NEW. This is like (copy-sequence NEW) except that it reuses the @@ -4025,6 +8138,2994 @@ return old; } +/* This function is the implementation of fill_string_range() and + replace_string_range(); see the comments for those functions. */ +static Lisp_Object +replace_string_range_1 (Lisp_Object dest, Lisp_Object start, Lisp_Object end, + const Ibyte *source, const Ibyte *source_limit, + Lisp_Object item) +{ + Ibyte *destp = XSTRING_DATA (dest), *p = destp, + *pend = p + XSTRING_LENGTH (dest), *pcursor, item_buf[MAX_ICHAR_LEN]; + Bytecount prefix_bytecount, source_len = source_limit - source; + Charcount ii = 0, ending, len; + Charcount starting = BIGNUMP (start) ? EMACS_INT_MAX + 1 : XINT (start); + Elemcount delta; + + while (ii < starting && p < pend) + { + INC_IBYTEPTR (p); + ii++; + } + + pcursor = p; + + if (NILP (end)) + { + while (pcursor < pend) + { + INC_IBYTEPTR (pcursor); + ii++; + } + + ending = len = ii; + } + else + { + ending = BIGNUMP (end) ? EMACS_INT_MAX + 1 : XINT (end); + while (ii < ending && pcursor < pend) + { + INC_IBYTEPTR (pcursor); + ii++; + } + } + + if (pcursor == pend) + { + /* We have the length, check it for our callers. */ + check_sequence_range (dest, start, end, make_int (ii)); + } + + if (!(p == pend || p == pcursor)) + { + prefix_bytecount = p - destp; + + if (!NILP (item)) + { + assert (source == NULL && source_limit == NULL); + source_len = set_itext_ichar (item_buf, XCHAR (item)); + delta = (source_len * (ending - starting)) - (pcursor - p); + } + else + { + assert (source != NULL && source_limit != NULL); + delta = source_len - (pcursor - p); + } + + if (delta) + { + resize_string (dest, prefix_bytecount, delta); + destp = XSTRING_DATA (dest); + pcursor = destp + prefix_bytecount + (pcursor - p); + p = destp + prefix_bytecount; + } + + if (CHARP (item)) + { + while (starting < ending) + { + memcpy (p, item_buf, source_len); + p += source_len; + starting++; + } + } + else + { + while (starting < ending && source < source_limit) + { + source_len = itext_copy_ichar (source, p); + p += source_len, source += source_len; + } + } + + init_string_ascii_begin (dest); + bump_string_modiff (dest); + sledgehammer_check_ascii_begin (dest); + } + + return dest; +} + +DEFUN ("replace", Freplace, 2, MANY, 0, /* +Replace the elements of SEQUENCE-ONE with the elements of SEQUENCE-TWO. + +SEQUENCE-ONE is destructively modified, and returned. Its length is not +changed. + +Keywords :start1 and :end1 specify a subsequence of SEQUENCE-ONE, and +:start2 and :end2 a subsequence of SEQUENCE-TWO. See `search' for more +information. + +arguments: (SEQUENCE-ONE SEQUENCE-TWO &key (START1 0) (END1 (length SEQUENCE-ONE)) (START2 0) (END2 (length SEQUENCE-TWO))) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object sequence1 = args[0], sequence2 = args[1], + result = sequence1; + Elemcount starting1, ending1 = EMACS_INT_MAX + 1, starting2; + Elemcount ending2 = EMACS_INT_MAX + 1, counting = 0, startcounting; + Boolint sequence1_listp, sequence2_listp, + overwriting = EQ (sequence1, sequence2); + + PARSE_KEYWORDS (Freplace, nargs, args, 4, (start1, end1, start2, end2), + (start1 = start2 = Qzero)); + + CHECK_SEQUENCE (sequence1); + CHECK_LISP_WRITEABLE (sequence1); + + CHECK_SEQUENCE (sequence2); + + CHECK_NATNUM (start1); + starting1 = BIGNUMP (start1) ? EMACS_INT_MAX + 1 : XINT (start1); + CHECK_NATNUM (start2); + starting2 = BIGNUMP (start2) ? EMACS_INT_MAX + 1 : XINT (start2); + + if (!NILP (end1)) + { + CHECK_NATNUM (end1); + ending1 = BIGNUMP (end1) ? EMACS_INT_MAX + 1 : XINT (end1); + } + + if (!NILP (end2)) + { + CHECK_NATNUM (end2); + ending2 = BIGNUMP (end2) ? EMACS_INT_MAX + 1 : XINT (end2); + } + + sequence1_listp = LISTP (sequence1); + sequence2_listp = LISTP (sequence2); + + overwriting = overwriting && starting2 <= starting1; + + if (sequence1_listp && !ZEROP (start1)) + { + sequence1 = Fnthcdr (start1, sequence1); + + if (NILP (sequence1)) + { + check_sequence_range (args[0], start1, end1, Flength (args[0])); + /* Give up early here. */ + return result; + } + + ending1 -= starting1; + starting1 = 0; + } + + if (sequence2_listp && !ZEROP (start2)) + { + sequence2 = Fnthcdr (start2, sequence2); + + if (NILP (sequence2)) + { + check_sequence_range (args[1], start1, end1, Flength (args[1])); + /* Nothing available to replace sequence1's contents. */ + return result; + } + + ending2 -= starting2; + starting2 = 0; + } + + if (overwriting) + { + if (EQ (start1, start2)) + { + return result; + } + + /* Our ranges may overlap. Save the data that might be overwritten. */ + + if (CONSP (sequence2)) + { + Elemcount len = XINT (Flength (sequence2)); + Lisp_Object *subsequence + = alloca_array (Lisp_Object, min (ending2, len)); + Elemcount ii = 0; + + LIST_LOOP_2 (elt, sequence2) + { + if (counting == ending2) + { + break; + } + + subsequence[ii++] = elt; + counting++; + } + + check_sequence_range (sequence1, start1, end1, + /* The XINT (start2) is intentional here; we + called #'length after doing (nthcdr + start2 sequence2). */ + make_int (XINT (start2) + len)); + check_sequence_range (sequence2, start2, end2, + make_int (XINT (start2) + len)); + + while (starting1 < ending1 + && starting2 < ending2 && !NILP (sequence1)) + { + XSETCAR (sequence1, subsequence[starting2]); + sequence1 = XCDR (sequence1); + starting1++; + starting2++; + } + } + else if (STRINGP (sequence2)) + { + Ibyte *p = XSTRING_DATA (sequence2), + *pend = p + XSTRING_LENGTH (sequence2), *pcursor, + *staging; + Bytecount ii = 0; + + while (ii < starting2 && p < pend) + { + INC_IBYTEPTR (p); + ii++; + } + + pcursor = p; + + while (ii < ending2 && starting1 < ending1 && pcursor < pend) + { + INC_IBYTEPTR (pcursor); + starting1++; + ii++; + } + + if (pcursor == pend) + { + check_sequence_range (sequence1, start1, end1, make_int (ii)); + check_sequence_range (sequence2, start2, end2, make_int (ii)); + } + else + { + assert ((pcursor - p) > 0); + staging = alloca_ibytes (pcursor - p); + memcpy (staging, p, pcursor - p); + replace_string_range (result, start1, + make_int (starting1), + staging, staging + (pcursor - p)); + } + } + else + { + Elemcount seq_len = XINT (Flength (sequence2)), ii = 0, + subseq_len = min (min (ending1 - starting1, seq_len - starting1), + min (ending2 - starting2, seq_len - starting2)); + Lisp_Object *subsequence = alloca_array (Lisp_Object, subseq_len); + + check_sequence_range (sequence1, start1, end1, make_int (seq_len)); + check_sequence_range (sequence2, start2, end2, make_int (seq_len)); + + while (starting2 < ending2 && ii < seq_len) + { + subsequence[ii] = Faref (sequence2, make_int (starting2)); + ii++, starting2++; + } + + ii = 0; + + while (starting1 < ending1 && ii < seq_len) + { + Faset (sequence1, make_int (starting1), subsequence[ii]); + ii++, starting1++; + } + } + } + else if (sequence1_listp && sequence2_listp) + { + Lisp_Object sequence1_tortoise = sequence1, + sequence2_tortoise = sequence2; + Elemcount shortest_len = 0; + + counting = startcounting = min (ending1, ending2); + + while (counting-- > 0 && !NILP (sequence1) && !NILP (sequence2)) + { + XSETCAR (sequence1, + CONSP (sequence2) ? XCAR (sequence2) + : Fcar (sequence2)); + sequence1 = CONSP (sequence1) ? XCDR (sequence1) + : Fcdr (sequence1); + sequence2 = CONSP (sequence2) ? XCDR (sequence2) + : Fcdr (sequence2); + + shortest_len++; + + if (startcounting - counting > CIRCULAR_LIST_SUSPICION_LENGTH) + { + if (counting & 1) + { + sequence1_tortoise = XCDR (sequence1_tortoise); + sequence2_tortoise = XCDR (sequence2_tortoise); + } + + if (EQ (sequence1, sequence1_tortoise)) + { + signal_circular_list_error (sequence1); + } + + if (EQ (sequence2, sequence2_tortoise)) + { + signal_circular_list_error (sequence2); + } + } + } + + if (NILP (sequence1)) + { + check_sequence_range (args[0], start1, end1, + make_int (XINT (start1) + shortest_len)); + } + else if (NILP (sequence2)) + { + check_sequence_range (args[1], start2, end2, + make_int (XINT (start2) + shortest_len)); + } + } + else if (sequence1_listp) + { + if (STRINGP (sequence2)) + { + Ibyte *s2_data = XSTRING_DATA (sequence2), + *s2_end = s2_data + XSTRING_LENGTH (sequence2); + Elemcount char_count = 0; + Lisp_Object character; + + while (char_count < starting2 && s2_data < s2_end) + { + INC_IBYTEPTR (s2_data); + char_count++; + } + + while (starting1 < ending1 && starting2 < ending2 + && s2_data < s2_end && !NILP (sequence1)) + { + character = make_char (itext_ichar (s2_data)); + CONSP (sequence1) ? + XSETCAR (sequence1, character) + : Fsetcar (sequence1, character); + sequence1 = XCDR (sequence1); + starting1++; + starting2++; + char_count++; + INC_IBYTEPTR (s2_data); + } + + if (NILP (sequence1)) + { + check_sequence_range (sequence1, start1, end1, + make_int (XINT (start1) + starting1)); + } + + if (s2_data == s2_end) + { + check_sequence_range (sequence2, start2, end2, + make_int (char_count)); + } + } + else + { + Elemcount len2 = XINT (Flength (sequence2)); + check_sequence_range (sequence2, start2, end2, make_int (len2)); + + ending2 = min (ending2, len2); + while (starting2 < ending2 + && starting1 < ending1 && !NILP (sequence1)) + { + CHECK_CONS (sequence1); + XSETCAR (sequence1, Faref (sequence2, make_int (starting2))); + sequence1 = XCDR (sequence1); + starting1++; + starting2++; + } + + if (NILP (sequence1)) + { + check_sequence_range (args[0], start1, end1, + make_int (XINT (start1) + starting1)); + } + } + } + else if (sequence2_listp) + { + if (STRINGP (sequence1)) + { + Elemcount ii = 0, count, len = string_char_length (sequence1); + Ibyte *staging, *cursor; + Lisp_Object obj; + + check_sequence_range (sequence1, start1, end1, make_int (len)); + ending1 = min (ending1, len); + count = ending1 - starting1; + staging = cursor = alloca_ibytes (count * MAX_ICHAR_LEN); + + while (ii < count && !NILP (sequence2)) + { + obj = CONSP (sequence2) ? XCAR (sequence2) + : Fcar (sequence2); + + CHECK_CHAR_COERCE_INT (obj); + cursor += set_itext_ichar (cursor, XCHAR (obj)); + ii++; + sequence2 = XCDR (sequence2); + } + + if (NILP (sequence2)) + { + check_sequence_range (sequence2, start2, end2, + make_int (XINT (start2) + ii)); + } + + replace_string_range (result, start1, make_int (XINT (start1) + ii), + staging, cursor); + } + else + { + Elemcount len = XINT (Flength (sequence1)); + + check_sequence_range (sequence1, start2, end1, make_int (len)); + ending1 = min (ending2, min (ending1, len)); + + while (starting1 < ending1 && !NILP (sequence2)) + { + Faset (sequence1, make_int (starting1), + CONSP (sequence2) ? XCAR (sequence2) + : Fcar (sequence2)); + sequence2 = XCDR (sequence2); + starting1++; + starting2++; + } + + if (NILP (sequence2)) + { + check_sequence_range (args[1], start2, end2, + make_int (XINT (start2) + starting2)); + } + } + } + else + { + if (STRINGP (sequence1) && STRINGP (sequence2)) + { + Ibyte *p2 = XSTRING_DATA (sequence2), + *p2end = p2 + XSTRING_LENGTH (sequence2), *p2cursor; + Charcount ii = 0, len1 = string_char_length (sequence1); + + check_sequence_range (sequence1, start1, end1, make_int (len1)); + + while (ii < starting2 && p2 < p2end) + { + INC_IBYTEPTR (p2); + ii++; + } + + p2cursor = p2; + ending1 = min (ending1, len1); + + while (ii < ending2 && starting1 < ending1 && p2cursor < p2end) + { + INC_IBYTEPTR (p2cursor); + ii++; + starting1++; + } + + if (p2cursor == p2end) + { + check_sequence_range (sequence2, start2, end2, make_int (ii)); + } + + /* This isn't great; any error message won't necessarily reflect + the END1 that was supplied to #'replace. */ + replace_string_range (result, start1, make_int (starting1), + p2, p2cursor); + } + else if (STRINGP (sequence1)) + { + Ibyte *staging, *cursor; + Elemcount count, len1 = string_char_length (sequence1); + Elemcount len2 = XINT (Flength (sequence2)), ii = 0; + Lisp_Object obj; + + check_sequence_range (sequence1, start1, end1, make_int (len1)); + check_sequence_range (sequence2, start2, end2, make_int (len2)); + + ending1 = min (ending1, len1); + ending2 = min (ending2, len2); + count = min (ending1 - starting1, ending2 - starting2); + staging = cursor = alloca_ibytes (count * MAX_ICHAR_LEN); + + ii = 0; + while (ii < count) + { + obj = Faref (sequence2, make_int (starting2)); + + CHECK_CHAR_COERCE_INT (obj); + cursor += set_itext_ichar (cursor, XCHAR (obj)); + starting2++, ii++; + } + + replace_string_range (result, start1, + make_int (XINT (start1) + count), + staging, cursor); + } + else if (STRINGP (sequence2)) + { + Ibyte *p2 = XSTRING_DATA (sequence2), + *p2end = p2 + XSTRING_LENGTH (sequence2); + Elemcount len1 = XINT (Flength (sequence1)), ii = 0; + + check_sequence_range (sequence1, start1, end1, make_int (len1)); + ending1 = min (ending1, len1); + + while (ii < starting2 && p2 < p2end) + { + INC_IBYTEPTR (p2); + ii++; + } + + while (p2 < p2end && starting1 < ending1 && starting2 < ending2) + { + Faset (sequence1, make_int (starting1), + make_char (itext_ichar (p2))); + INC_IBYTEPTR (p2); + starting1++; + starting2++; + ii++; + } + + if (p2 == p2end) + { + check_sequence_range (sequence2, start2, end2, make_int (ii)); + } + } + else + { + Elemcount len1 = XINT (Flength (sequence1)), + len2 = XINT (Flength (sequence2)); + + check_sequence_range (sequence1, start1, end1, make_int (len1)); + check_sequence_range (sequence2, start2, end2, make_int (len2)); + + ending1 = min (ending1, len1); + ending2 = min (ending2, len2); + + while (starting1 < ending1 && starting2 < ending2) + { + Faset (sequence1, make_int (starting1), + Faref (sequence2, make_int (starting2))); + starting1++; + starting2++; + } + } + } + + return result; +} + +DEFUN ("nsubstitute", Fnsubstitute, 3, MANY, 0, /* +Substitute NEW for OLD in SEQUENCE. + +This is a destructive function; it reuses the storage of SEQUENCE whenever +possible. See `remove*' for the meaning of the keywords. + +arguments: (NEW OLD SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END COUNT) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object new_ = args[0], item = args[1], sequence = args[2]; + Lisp_Object object_, position0; + Elemcount starting = 0, ending = EMACS_INT_MAX, encountered = 0; + Elemcount len, ii = 0, counting = EMACS_INT_MAX, presenting = 0; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; + + PARSE_KEYWORDS (Fnsubstitute, nargs, args, 9, + (test, if_, if_not, test_not, key, start, end, count, + from_end), (start = Qzero)); + + CHECK_SEQUENCE (sequence); + CHECK_NATNUM (start); + starting = BIGNUMP (start) ? 1 + EMACS_INT_MAX : XINT (start); + + if (!NILP (end)) + { + CHECK_NATNUM (end); + ending = BIGNUMP (end) ? 1 + EMACS_INT_MAX : XINT (end); + } + + if (!NILP (count)) + { + CHECK_INTEGER (count); + if (INTP (count)) + { + counting = XINT (count); + } +#ifdef HAVE_BIGNUM + else + { + counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ? + 1 + EMACS_INT_MAX : -1 + EMACS_INT_MIN; + } +#endif + + if (counting <= 0) + { + return sequence; + } + } + + check_test = get_check_test_function (item, &test, test_not, if_, if_not, + key, &test_not_unboundp); + + if (CONSP (sequence)) + { + if (!NILP (count) && !NILP (from_end)) + { + Lisp_Object present = count_with_tail (&object_, nargs - 1, args + 1, + Qnsubstitute); + + if (ZEROP (present)) + { + return sequence; + } + + presenting = XINT (present); + presenting = presenting <= counting ? 0 : presenting - counting; + } + + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) + { + if (!(ii < ending)) + { + break; + } + + if (starting <= ii && + check_test (test, key, item, elt) == test_not_unboundp + && (presenting ? encountered++ >= presenting + : encountered++ < counting)) + { + CHECK_LISP_WRITEABLE (tail); + XSETCAR (tail, new_); + } + else if (!presenting && encountered >= counting) + { + break; + } + + ii++; + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + if ((ii < starting || (ii < ending && !NILP (end))) + && encountered < counting) + { + check_sequence_range (args[0], start, end, Flength (args[0])); + } + } + else if (STRINGP (sequence)) + { + Ibyte *staging, new_bytes[MAX_ICHAR_LEN], *staging_cursor; + Ibyte *startp = XSTRING_DATA (sequence), *cursor = startp; + Bytecount cursor_offset = 0, byte_len = XSTRING_LENGTH (sequence); + Bytecount new_len; + Lisp_Object character; + + CHECK_CHAR_COERCE_INT (new_); + + new_len = set_itext_ichar (new_bytes, XCHAR (new_)); + + /* Worst case scenario; new char is four octets long, all the old ones + were one octet long, all the old ones match. */ + staging = alloca_ibytes (XSTRING_LENGTH (sequence) * new_len); + staging_cursor = staging; + + if (!NILP (count) && !NILP (from_end)) + { + Lisp_Object present = count_with_tail (&character, nargs - 1, + args + 1, Qnsubstitute); + + if (ZEROP (present)) + { + return sequence; + } + + presenting = XINT (present); + + /* If there are fewer items in the string than we have + permission to change, we don't need to differentiate + between the :from-end nil and :from-end t + cases. Otherwise, presenting is the number of matching + items we need to ignore before we start to change. */ + presenting = presenting <= counting ? 0 : presenting - counting; + } + + ii = 0; + while (cursor_offset < byte_len && ii < ending) + { + if (ii >= starting) + { + character = make_char (itext_ichar (cursor)); + + if ((check_test (test, key, item, character) + == test_not_unboundp) + && (presenting ? encountered++ >= presenting : + encountered++ < counting)) + { + staging_cursor + += itext_copy_ichar (new_bytes, staging_cursor); + } + else + { + staging_cursor + += itext_copy_ichar (cursor, staging_cursor); + } + + startp = XSTRING_DATA (sequence); + cursor = startp + cursor_offset; + + if (byte_len != XSTRING_LENGTH (sequence) + || !valid_ibyteptr_p (cursor)) + { + mapping_interaction_error (Qnsubstitute, sequence); + } + } + else + { + staging_cursor += itext_copy_ichar (cursor, staging_cursor); + } + + INC_IBYTEPTR (cursor); + cursor_offset = cursor - startp; + ii++; + } + + if (ii < starting || (ii < ending && !NILP (end))) + { + check_sequence_range (sequence, start, end, Flength (sequence)); + } + + if (0 != encountered) + { + CHECK_LISP_WRITEABLE (sequence); + replace_string_range (sequence, Qzero, make_int (ii), + staging, staging_cursor); + } + } + else + { + Elemcount positioning; + Lisp_Object object = Qnil; + + len = XINT (Flength (sequence)); + check_sequence_range (sequence, start, end, make_int (len)); + + position0 = position (&object, item, sequence, check_test, + test_not_unboundp, test, key, start, end, from_end, + Qnil, Qnsubstitute); + + if (NILP (position0)) + { + return sequence; + } + + positioning = XINT (position0); + ending = min (len, ending); + + Faset (sequence, position0, new_); + encountered = 1; + + if (NILP (from_end)) + { + for (ii = positioning + 1; ii < ending; ii++) + { + object_ = Faref (sequence, make_int (ii)); + + if (check_test (test, key, item, object_) == test_not_unboundp + && encountered++ < counting) + { + Faset (sequence, make_int (ii), new_); + } + else if (encountered == counting) + { + break; + } + } + } + else + { + for (ii = positioning - 1; ii >= starting; ii--) + { + object_ = Faref (sequence, make_int (ii)); + + if (check_test (test, key, item, object_) == test_not_unboundp + && encountered++ < counting) + { + Faset (sequence, make_int (ii), new_); + } + else if (encountered == counting) + { + break; + } + } + } + } + + return sequence; +} + +DEFUN ("substitute", Fsubstitute, 3, MANY, 0, /* +Substitute NEW for OLD in SEQUENCE. + +This is a non-destructive function; it makes a copy of SEQUENCE if necessary +to avoid corrupting the original SEQUENCE. + +See `remove*' for the meaning of the keywords. + +arguments: (NEW OLD SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) COUNT) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object new_ = args[0], item = args[1], sequence = args[2], tail = Qnil; + Lisp_Object result = Qnil, result_tail = Qnil; + Lisp_Object object, position0, matched_count; + Elemcount starting = 0, ending = EMACS_INT_MAX, encountered = 0; + Elemcount ii = 0, counting = EMACS_INT_MAX, presenting = 0; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; + struct gcpro gcpro1; + + PARSE_KEYWORDS (Fsubstitute, nargs, args, 9, + (test, if_, if_not, test_not, key, start, end, count, + from_end), (start = Qzero, count = Qunbound)); + + CHECK_SEQUENCE (sequence); + + CHECK_NATNUM (start); + starting = BIGNUMP (start) ? 1 + EMACS_INT_MAX : XINT (start); + + if (!NILP (end)) + { + CHECK_NATNUM (end); + ending = BIGNUMP (end) ? 1 + EMACS_INT_MAX : XINT (end); + } + + check_test = get_check_test_function (item, &test, test_not, if_, if_not, + key, &test_not_unboundp); + + if (!UNBOUNDP (count)) + { + if (!NILP (count)) + { + CHECK_INTEGER (count); + if (INTP (count)) + { + counting = XINT (count); + } +#ifdef HAVE_BIGNUM + else + { + counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ? + 1 + EMACS_INT_MAX : -1 + EMACS_INT_MIN; + } +#endif + + if (counting <= 0) + { + return sequence; + } + } + } + + if (!CONSP (sequence)) + { + position0 = position (&object, item, sequence, check_test, + test_not_unboundp, test, key, start, end, from_end, + Qnil, Qsubstitute); + + if (NILP (position0)) + { + return sequence; + } + else + { + args[2] = Fcopy_sequence (sequence); + return Fnsubstitute (nargs, args); + } + } + + matched_count = count_with_tail (&tail, nargs - 1, args + 1, Qsubstitute); + + if (ZEROP (matched_count)) + { + return sequence; + } + + if (!NILP (count) && !NILP (from_end)) + { + presenting = XINT (matched_count); + presenting = presenting <= counting ? 0 : presenting - counting; + } + + GCPRO1 (result); + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tailing) + { + if (EQ (tail, tailing)) + { + XUNGCPRO (elt); + UNGCPRO; + + if (NILP (result)) + { + return XCDR (tail); + } + + XSETCDR (result_tail, XCDR (tail)); + return result; + } + else if (starting <= ii && ii < ending && + (check_test (test, key, item, elt) == test_not_unboundp) + && (presenting ? encountered++ >= presenting + : encountered++ < counting)) + { + if (NILP (result)) + { + result = result_tail = Fcons (new_, Qnil); + } + else + { + XSETCDR (result_tail, Fcons (new_, Qnil)); + result_tail = XCDR (result_tail); + } + } + else if (NILP (result)) + { + result = result_tail = Fcons (elt, Qnil); + } + else + { + XSETCDR (result_tail, Fcons (elt, Qnil)); + result_tail = XCDR (result_tail); + } + + if (ii == ending) + { + break; + } + + ii++; + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + UNGCPRO; + + if (ii < starting || (ii < ending && !NILP (end))) + { + check_sequence_range (args[0], start, end, Flength (args[0])); + } + + return result; +} + +static Lisp_Object +subst (Lisp_Object new_, Lisp_Object old, Lisp_Object tree, int depth) +{ + if (depth + lisp_eval_depth > max_lisp_eval_depth) + { + stack_overflow ("Stack overflow in subst", tree); + } + + if (EQ (tree, old)) + { + return new_; + } + else if (CONSP (tree)) + { + Lisp_Object aa = subst (new_, old, XCAR (tree), depth + 1); + Lisp_Object dd = subst (new_, old, XCDR (tree), depth + 1); + + if (EQ (aa, XCAR (tree)) && EQ (dd, XCDR (tree))) + { + return tree; + } + else + { + return Fcons (aa, dd); + } + } + else + { + return tree; + } +} + +static Lisp_Object +sublis (Lisp_Object alist, Lisp_Object tree, + check_test_func_t check_test, Boolint test_not_unboundp, + Lisp_Object test, Lisp_Object key, int depth) +{ + Lisp_Object keyed = KEY (key, tree), aa, dd; + struct gcpro gcpro1; + + if (depth + lisp_eval_depth > max_lisp_eval_depth) + { + stack_overflow ("Stack overflow in sublis", tree); + } + + { + GC_EXTERNAL_LIST_LOOP_2 (elt, alist) + { + if (CONSP (elt) && + check_test (test, key, XCAR (elt), keyed) == test_not_unboundp) + { + XUNGCPRO (elt); + return XCDR (elt); + } + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + if (!CONSP (tree)) + { + return tree; + } + + aa = sublis (alist, XCAR (tree), check_test, test_not_unboundp, test, key, + depth + 1); + dd = sublis (alist, XCDR (tree), check_test, test_not_unboundp, test, key, + depth + 1); + + if (EQ (aa, XCAR (tree)) && EQ (dd, XCDR (tree))) + { + return tree; + } + + return Fcons (aa, dd); +} + +DEFUN ("sublis", Fsublis, 2, MANY, 0, /* +Perform substitutions indicated by ALIST in TREE (non-destructively). +Return a copy of TREE with all matching elements replaced. + +See `member*' for the meaning of :test, :test-not and :key. + +arguments: (ALIST TREE &key (TEST #'eql) (KEY #'identity) TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object alist = args[0], tree = args[1]; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; + + PARSE_KEYWORDS (Fsublis, nargs, args, 5, (test, if_, test_not, if_not, key), + (key = Qidentity)); + + if (NILP (key)) + { + key = Qidentity; + } + + get_check_match_function (&test, test_not, if_, if_not, + /* sublis() is going to apply the key, don't ask + for a match function that will do it for + us. */ + Qidentity, &test_not_unboundp, &check_test); + + if (CONSP (alist) && NILP (XCDR (alist)) && CONSP (XCAR (alist)) + && EQ (key, Qidentity) && 1 == test_not_unboundp + && (check_eq_nokey == check_test || + (check_eql_nokey == check_test && + !NON_FIXNUM_NUMBER_P (XCAR (XCAR (alist)))))) + { + /* #'subst with #'eq is very cheap indeed; call it. */ + return subst (XCDR (XCAR (alist)), XCAR (XCAR (alist)), tree, 0); + } + + return sublis (alist, tree, check_test, test_not_unboundp, test, key, 0); +} + +static Lisp_Object +nsublis (Lisp_Object alist, Lisp_Object tree, + check_test_func_t check_test, + Boolint test_not_unboundp, + Lisp_Object test, Lisp_Object key, int depth) +{ + Lisp_Object tree_saved = tree, tortoise = tree, keyed = Qnil; + struct gcpro gcpro1, gcpro2; + int count = 0; + + if (depth + lisp_eval_depth > max_lisp_eval_depth) + { + stack_overflow ("Stack overflow in nsublis", tree); + } + + GCPRO2 (tree_saved, keyed); + + while (CONSP (tree)) + { + Boolint replaced = 0; + keyed = KEY (key, XCAR (tree)); + + { + GC_EXTERNAL_LIST_LOOP_2 (elt, alist) + { + if (CONSP (elt) && + check_test (test, key, XCAR (elt), keyed) == test_not_unboundp) + { + CHECK_LISP_WRITEABLE (tree); + /* See comment in sublis() on using elt_cdr. */ + XSETCAR (tree, XCDR (elt)); + replaced = 1; + break; + } + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + if (!replaced) + { + if (CONSP (XCAR (tree))) + { + nsublis (alist, XCAR (tree), check_test, test_not_unboundp, + test, key, depth + 1); + } + } + + keyed = KEY (key, XCDR (tree)); + replaced = 0; + + { + GC_EXTERNAL_LIST_LOOP_2 (elt, alist) + { + if (CONSP (elt) && + check_test (test, key, XCAR (elt), keyed) == test_not_unboundp) + { + CHECK_LISP_WRITEABLE (tree); + XSETCDR (tree, XCDR (elt)); + tree = Qnil; + break; + } + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + if (!NILP (tree)) + { + tree = XCDR (tree); + } + + if (++count > CIRCULAR_LIST_SUSPICION_LENGTH) + { + if (count & 1) + { + tortoise = XCDR (tortoise); + } + + if (EQ (tortoise, tree)) + { + signal_circular_list_error (tree); + } + } + } + + RETURN_UNGCPRO (tree_saved); +} + +DEFUN ("nsublis", Fnsublis, 2, MANY, 0, /* +Perform substitutions indicated by ALIST in TREE (destructively). +Any matching element of TREE is changed via a call to `setcar'. + +See `member*' for the meaning of :test, :test-not and :key. + +arguments: (ALIST TREE &key (TEST #'eql) (KEY #'identity) TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object alist = args[0], tree = args[1], tailed = Qnil, keyed = Qnil; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; + struct gcpro gcpro1, gcpro2; + + PARSE_KEYWORDS (Fnsublis, nargs, args, 5, (test, if_, test_not, if_not, key), + (key = Qidentity)); + + if (NILP (key)) + { + key = Qidentity; + } + + get_check_match_function (&test, test_not, if_, if_not, + /* nsublis() is going to apply the key, don't ask + for a match function that will do it for + us. */ + Qidentity, &test_not_unboundp, &check_test); + + GCPRO2 (tailed, keyed); + + keyed = KEY (key, tree); + + { + /* nsublis() won't attempt to replace a cons handed to it, do that + ourselves. */ + GC_EXTERNAL_LIST_LOOP_2 (elt, alist) + { + if (CONSP (elt) && + check_test (test, key, XCAR (elt), keyed) == test_not_unboundp) + { + XUNGCPRO (elt); + return XCDR (elt); + } + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + UNGCPRO; + + return nsublis (alist, tree, check_test, test_not_unboundp, test, key, 0); +} + +DEFUN ("subst", Fsubst, 3, MANY, 0, /* +Substitute NEW for OLD everywhere in TREE (non-destructively). + +Return a copy of TREE with all elements `eql' to OLD replaced by NEW. + +See `member*' for the meaning of :test, :test-not and :key. + +arguments: (NEW OLD TREE &key (TEST #'eql) (KEY #'identity) TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object result, alist = noseeum_cons (noseeum_cons (args[1], args[0]), + Qnil); + args[1] = alist; + result = Fsublis (nargs - 1, args + 1); + free_cons (XCAR (alist)); + free_cons (alist); + + return result; +} + +DEFUN ("nsubst", Fnsubst, 3, MANY, 0, /* +Substitute NEW for OLD everywhere in TREE (destructively). + +Any element of TREE which is `eql' to OLD is changed to NEW (via a call to +`setcar'). + +See `member*' for the meaning of the keywords. + +arguments: (NEW OLD TREE &key (TEST #'eql) (KEY #'identity) TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object result, alist = noseeum_cons (noseeum_cons (args[1], args[0]), + Qnil); + args[1] = alist; + result = Fnsublis (nargs - 1, args + 1); + free_cons (XCAR (alist)); + free_cons (alist); + + return result; +} + +static Boolint +tree_equal (Lisp_Object tree1, Lisp_Object tree2, + check_test_func_t check_test, Boolint test_not_unboundp, + Lisp_Object test, Lisp_Object key, int depth) +{ + Lisp_Object tortoise1 = tree1, tortoise2 = tree2; + struct gcpro gcpro1, gcpro2; + int count = 0; + Boolint result; + + if (depth + lisp_eval_depth > max_lisp_eval_depth) + { + stack_overflow ("Stack overflow in tree-equal", tree1); + } + + GCPRO2 (tree1, tree2); + + while (CONSP (tree1) && CONSP (tree2) + && tree_equal (XCAR (tree1), XCAR (tree2), check_test, + test_not_unboundp, test, key, depth + 1)) + { + tree1 = XCDR (tree1); + tree2 = XCDR (tree2); + + if (++count > CIRCULAR_LIST_SUSPICION_LENGTH) + { + if (count & 1) + { + tortoise1 = XCDR (tortoise1); + tortoise2 = XCDR (tortoise2); + } + + if (EQ (tortoise1, tree1)) + { + signal_circular_list_error (tree1); + } + + if (EQ (tortoise2, tree2)) + { + signal_circular_list_error (tree2); + } + } + } + + if (CONSP (tree1) || CONSP (tree2)) + { + UNGCPRO; + return 0; + } + + result = check_test (test, key, tree1, tree2) == test_not_unboundp; + UNGCPRO; + + return result; +} + +DEFUN ("tree-equal", Ftree_equal, 2, MANY, 0, /* +Return t if TREE1 and TREE2 have `eql' leaves. + +Atoms are compared by `eql', unless another test is specified using +:test; cons cells are compared recursively. + +See `union' for the meaning of :test, :test-not and :key. + +arguments: (TREE1 TREE2 &key (TEST #'eql) (KEY #'identity) TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object tree1 = args[0], tree2 = args[1]; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; + + PARSE_KEYWORDS (Ftree_equal, nargs, args, 3, (test, key, test_not), + (key = Qidentity)); + + get_check_match_function (&test, test_not, Qnil, Qnil, key, + &test_not_unboundp, &check_test); + + return tree_equal (tree1, tree2, check_test, test_not_unboundp, test, key, + 0) ? Qt : Qnil; +} + +static Lisp_Object +mismatch_from_end (Lisp_Object sequence1, Lisp_Object start1, Lisp_Object end1, + Lisp_Object sequence2, Lisp_Object start2, Lisp_Object end2, + check_test_func_t check_match, Boolint test_not_unboundp, + Lisp_Object test, Lisp_Object key, + Boolint UNUSED (return_sequence1_index)) +{ + Elemcount sequence1_len = XINT (Flength (sequence1)); + Elemcount sequence2_len = XINT (Flength (sequence2)), ii = 0; + Elemcount starting1, ending1, starting2, ending2; + Lisp_Object *sequence1_storage = NULL, *sequence2_storage = NULL; + struct gcpro gcpro1, gcpro2; + + check_sequence_range (sequence1, start1, end1, make_int (sequence1_len)); + starting1 = XINT (start1); + ending1 = INTP (end1) ? XINT (end1) : 1 + EMACS_INT_MAX; + ending1 = min (ending1, sequence1_len); + + check_sequence_range (sequence2, start2, end2, make_int (sequence2_len)); + starting2 = XINT (start2); + ending2 = INTP (end2) ? XINT (end2) : 1 + EMACS_INT_MAX; + ending2 = min (ending2, sequence2_len); + + if (LISTP (sequence1)) + { + Lisp_Object *saving; + sequence1_storage = saving + = alloca_array (Lisp_Object, ending1 - starting1); + + { + EXTERNAL_LIST_LOOP_2 (elt, sequence1) + { + if (starting1 <= ii && ii < ending1) + { + *saving++ = elt; + } + else if (ii == ending1) + { + break; + } + + ++ii; + } + } + } + else if (STRINGP (sequence1)) + { + const Ibyte *cursor = string_char_addr (sequence1, starting1); + + STRING_DATA_TO_OBJECT_ARRAY (cursor, sequence1_storage, ii, + ending1 - starting1); + + } + else if (BIT_VECTORP (sequence1)) + { + Lisp_Bit_Vector *vv = XBIT_VECTOR (sequence1); + sequence1_storage = alloca_array (Lisp_Object, ending1 - starting1); + for (ii = starting1; ii < ending1; ++ii) + { + sequence1_storage[ii - starting1] + = make_int (bit_vector_bit (vv, ii)); + } + } + else + { + sequence1_storage = XVECTOR_DATA (sequence1) + starting1; + } + + ii = 0; + + if (LISTP (sequence2)) + { + Lisp_Object *saving; + sequence2_storage = saving + = alloca_array (Lisp_Object, ending2 - starting2); + + { + EXTERNAL_LIST_LOOP_2 (elt, sequence2) + { + if (starting2 <= ii && ii < ending2) + { + *saving++ = elt; + } + else if (ii == ending2) + { + break; + } + + ++ii; + } + } + } + else if (STRINGP (sequence2)) + { + const Ibyte *cursor = string_char_addr (sequence2, starting2); + + STRING_DATA_TO_OBJECT_ARRAY (cursor, sequence2_storage, ii, + ending2 - starting2); + + } + else if (BIT_VECTORP (sequence2)) + { + Lisp_Bit_Vector *vv = XBIT_VECTOR (sequence2); + sequence2_storage = alloca_array (Lisp_Object, ending2 - starting2); + for (ii = starting2; ii < ending2; ++ii) + { + sequence2_storage[ii - starting2] + = make_int (bit_vector_bit (vv, ii)); + } + } + else + { + sequence2_storage = XVECTOR_DATA (sequence2) + starting2; + } + + GCPRO2 (sequence1_storage[0], sequence2_storage[0]); + gcpro1.nvars = ending1 - starting1; + gcpro2.nvars = ending2 - starting2; + + while (ending1 > starting1 && ending2 > starting2) + { + --ending1; + --ending2; + + if (check_match (test, key, sequence1_storage[ending1 - starting1], + sequence2_storage[ending2 - starting2]) + != test_not_unboundp) + { + UNGCPRO; + return make_integer (ending1 + 1); + } + } + + UNGCPRO; + + if (ending1 > starting1 || ending2 > starting2) + { + return make_integer (ending1); + } + + return Qnil; +} + +static Lisp_Object +mismatch_list_list (Lisp_Object sequence1, Lisp_Object start1, Lisp_Object end1, + Lisp_Object sequence2, Lisp_Object start2, Lisp_Object end2, + check_test_func_t check_match, Boolint test_not_unboundp, + Lisp_Object test, Lisp_Object key, + Boolint UNUSED (return_list_index)) +{ + Lisp_Object sequence1_tortoise = sequence1, sequence2_tortoise = sequence2; + Lisp_Object orig_sequence1 = sequence1, orig_sequence2 = sequence2; + Elemcount ending1 = EMACS_INT_MAX, ending2 = EMACS_INT_MAX; + Elemcount starting1, starting2, counting, startcounting; + Elemcount shortest_len = 0; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + + starting1 = INTP (start1) ? XINT (start1) : 1 + EMACS_INT_MAX; + starting2 = INTP (start2) ? XINT (start2) : 1 + EMACS_INT_MAX; + + if (!NILP (end1)) + { + ending1 = INTP (end1) ? XINT (end1) : 1 + EMACS_INT_MAX; + } + + if (!NILP (end2)) + { + ending2 = INTP (end2) ? XINT (end2) : 1 + EMACS_INT_MAX; + } + + if (!ZEROP (start1)) + { + sequence1 = Fnthcdr (start1, sequence1); + + if (NILP (sequence1)) + { + check_sequence_range (sequence1_tortoise, start1, end1, + Flength (sequence1_tortoise)); + /* Give up early here. */ + return Qnil; + } + + ending1 -= starting1; + starting1 = 0; + sequence1_tortoise = sequence1; + } + + if (!ZEROP (start2)) + { + sequence2 = Fnthcdr (start2, sequence2); + + if (NILP (sequence2)) + { + check_sequence_range (sequence2_tortoise, start2, end2, + Flength (sequence2_tortoise)); + return Qnil; + } + + ending2 -= starting2; + starting2 = 0; + sequence2_tortoise = sequence2; + } + + GCPRO4 (sequence1, sequence2, sequence1_tortoise, sequence2_tortoise); + + counting = startcounting = min (ending1, ending2); + + while (counting-- > 0 && !NILP (sequence1) && !NILP (sequence2)) + { + if (check_match (test, key, + CONSP (sequence1) ? XCAR (sequence1) + : Fcar (sequence1), + CONSP (sequence2) ? XCAR (sequence2) + : Fcar (sequence2) ) != test_not_unboundp) + { + UNGCPRO; + return make_integer (XINT (start1) + shortest_len); + } + + sequence1 = CONSP (sequence1) ? XCDR (sequence1) : Fcdr (sequence1); + sequence2 = CONSP (sequence2) ? XCDR (sequence2) : Fcdr (sequence2); + + shortest_len++; + + if (startcounting - counting > CIRCULAR_LIST_SUSPICION_LENGTH) + { + if (counting & 1) + { + sequence1_tortoise = XCDR (sequence1_tortoise); + sequence2_tortoise = XCDR (sequence2_tortoise); + } + + if (EQ (sequence1, sequence1_tortoise)) + { + signal_circular_list_error (sequence1); + } + + if (EQ (sequence2, sequence2_tortoise)) + { + signal_circular_list_error (sequence2); + } + } + } + + UNGCPRO; + + if (NILP (sequence1)) + { + Lisp_Object args[] = { start1, make_int (shortest_len) }; + check_sequence_range (orig_sequence1, start1, end1, + Fplus (countof (args), args)); + } + + if (NILP (sequence2)) + { + Lisp_Object args[] = { start2, make_int (shortest_len) }; + check_sequence_range (orig_sequence2, start2, end2, + Fplus (countof (args), args)); + } + + if ((!NILP (end1) && shortest_len != ending1 - starting1) || + (!NILP (end2) && shortest_len != ending2 - starting2)) + { + return make_integer (XINT (start1) + shortest_len); + } + + if ((NILP (end1) && CONSP (sequence1)) || (NILP (end2) && CONSP (sequence2))) + { + return make_integer (XINT (start1) + shortest_len); + } + + return Qnil; +} + +static Lisp_Object +mismatch_list_string (Lisp_Object list, Lisp_Object list_start, + Lisp_Object list_end, + Lisp_Object string, Lisp_Object string_start, + Lisp_Object string_end, + check_test_func_t check_match, + Boolint test_not_unboundp, + Lisp_Object test, Lisp_Object key, + Boolint return_list_index) +{ + Ibyte *string_data = XSTRING_DATA (string), *startp = string_data; + Bytecount string_offset = 0, string_len = XSTRING_LENGTH (string); + Elemcount char_count = 0, list_starting, list_ending; + Elemcount string_starting, string_ending; + Lisp_Object character, orig_list = list; + struct gcpro gcpro1; + + list_ending = INTP (list_end) ? XINT (list_end) : 1 + EMACS_INT_MAX; + list_starting = INTP (list_start) ? XINT (list_start) : 1 + EMACS_INT_MAX; + + string_ending = INTP (string_end) ? XINT (string_end) : 1 + EMACS_INT_MAX; + string_starting + = INTP (string_start) ? XINT (string_start) : 1 + EMACS_INT_MAX; + + while (char_count < string_starting && string_offset < string_len) + { + INC_IBYTEPTR (string_data); + string_offset = string_data - startp; + char_count++; + } + + if (!ZEROP (list_start)) + { + list = Fnthcdr (list_start, list); + if (NILP (list)) + { + check_sequence_range (orig_list, list_start, list_end, + Flength (orig_list)); + return Qnil; + } + + list_ending -= list_starting; + list_starting = 0; + } + + GCPRO1 (list); + + while (list_starting < list_ending && string_starting < string_ending + && string_offset < string_len && !NILP (list)) + { + character = make_char (itext_ichar (string_data)); + + if (return_list_index) + { + if (check_match (test, key, CONSP (list) ? XCAR (list) : Fcar (list), + character) + != test_not_unboundp) + { + UNGCPRO; + return make_integer (XINT (list_start) + char_count); + } + } + else + { + if (check_match (test, key, character, + CONSP (list) ? XCAR (list) : Fcar (list)) + != test_not_unboundp) + { + UNGCPRO; + return make_integer (char_count); + } + } + + list = CONSP (list) ? XCDR (list) : Fcdr (list); + + startp = XSTRING_DATA (string); + string_data = startp + string_offset; + if (string_len != XSTRING_LENGTH (string) + || !valid_ibyteptr_p (string_data)) + { + mapping_interaction_error (Qmismatch, string); + } + + list_starting++; + string_starting++; + char_count++; + INC_IBYTEPTR (string_data); + string_offset = string_data - startp; + } + + UNGCPRO; + + if (NILP (list)) + { + Lisp_Object args[] = { list_start, make_int (char_count) }; + check_sequence_range (orig_list, list_start, list_end, + Fplus (countof (args), args)); + } + + if (string_data == XSTRING_DATA (string) + XSTRING_LENGTH (string)) + { + check_sequence_range (string, string_start, string_end, + make_int (char_count)); + } + + if ((NILP (string_end) ? + string_offset < string_len : string_starting < string_ending) || + (NILP (list_end) ? !NILP (list) : list_starting < list_ending)) + { + return make_integer (return_list_index ? XINT (list_start) + char_count : + char_count); + } + + return Qnil; +} + +static Lisp_Object +mismatch_list_array (Lisp_Object list, Lisp_Object list_start, + Lisp_Object list_end, + Lisp_Object array, Lisp_Object array_start, + Lisp_Object array_end, + check_test_func_t check_match, + Boolint test_not_unboundp, + Lisp_Object test, Lisp_Object key, + Boolint return_list_index) +{ + Elemcount ii = 0, list_starting, list_ending; + Elemcount array_starting, array_ending, array_len; + Lisp_Object orig_list = list; + struct gcpro gcpro1; + + list_ending = INTP (list_end) ? XINT (list_end) : 1 + EMACS_INT_MAX; + list_starting = INTP (list_start) ? XINT (list_start) : 1 + EMACS_INT_MAX; + + array_ending = INTP (array_end) ? XINT (array_end) : 1 + EMACS_INT_MAX; + array_starting = INTP (array_start) ? XINT (array_start) : 1 + EMACS_INT_MAX; + array_len = XINT (Flength (array)); + + array_ending = min (array_ending, array_len); + + check_sequence_range (array, array_start, array_end, make_int (array_len)); + + if (!ZEROP (list_start)) + { + list = Fnthcdr (list_start, list); + if (NILP (list)) + { + check_sequence_range (orig_list, list_start, list_end, + Flength (orig_list)); + return Qnil; + } + + list_ending -= list_starting; + list_starting = 0; + } + + GCPRO1 (list); + + while (list_starting < list_ending && array_starting < array_ending + && !NILP (list)) + { + if (return_list_index) + { + if (check_match (test, key, CONSP (list) ? XCAR (list) : Fcar (list), + Faref (array, make_int (array_starting))) + != test_not_unboundp) + { + UNGCPRO; + return make_integer (XINT (list_start) + ii); + } + } + else + { + if (check_match (test, key, Faref (array, make_int (array_starting)), + CONSP (list) ? XCAR (list) : Fcar (list)) + != test_not_unboundp) + { + UNGCPRO; + return make_integer (array_starting); + } + } + + list = CONSP (list) ? XCDR (list) : Fcdr (list); + list_starting++; + array_starting++; + ii++; + } + + UNGCPRO; + + if (NILP (list)) + { + Lisp_Object args[] = { list_start, make_int (ii) }; + check_sequence_range (orig_list, list_start, list_end, + Fplus (countof (args), args)); + } + + if (array_starting < array_ending || + (NILP (list_end) ? !NILP (list) : list_starting < list_ending)) + { + return make_integer (return_list_index ? XINT (list_start) + ii : + array_starting); + } + + return Qnil; +} + +static Lisp_Object +mismatch_string_array (Lisp_Object string, Lisp_Object string_start, + Lisp_Object string_end, + Lisp_Object array, Lisp_Object array_start, + Lisp_Object array_end, + check_test_func_t check_match, Boolint test_not_unboundp, + Lisp_Object test, Lisp_Object key, + Boolint return_string_index) +{ + Ibyte *string_data = XSTRING_DATA (string), *startp = string_data; + Bytecount string_offset = 0, string_len = XSTRING_LENGTH (string); + Elemcount char_count = 0, array_starting, array_ending, array_length; + Elemcount string_starting, string_ending; + Lisp_Object character; + + array_starting = INTP (array_start) ? XINT (array_start) : 1 + EMACS_INT_MAX; + array_ending = INTP (array_end) ? XINT (array_end) : 1 + EMACS_INT_MAX; + array_length = XINT (Flength (array)); + check_sequence_range (array, array_start, array_end, make_int (array_length)); + array_ending = min (array_ending, array_length); + + string_ending = INTP (string_end) ? XINT (string_end) : 1 + EMACS_INT_MAX; + string_starting + = INTP (string_start) ? XINT (string_start) : 1 + EMACS_INT_MAX; + + while (char_count < string_starting && string_offset < string_len) + { + INC_IBYTEPTR (string_data); + string_offset = string_data - startp; + char_count++; + } + + while (array_starting < array_ending && string_starting < string_ending + && string_offset < string_len) + { + character = make_char (itext_ichar (string_data)); + + if (return_string_index) + { + if (check_match (test, key, character, + Faref (array, make_int (array_starting))) + != test_not_unboundp) + { + return make_integer (char_count); + } + } + else + { + if (check_match (test, key, + Faref (array, make_int (array_starting)), + character) + != test_not_unboundp) + { + return make_integer (XINT (array_start) + char_count); + } + } + + startp = XSTRING_DATA (string); + string_data = startp + string_offset; + if (string_len != XSTRING_LENGTH (string) + || !valid_ibyteptr_p (string_data)) + { + mapping_interaction_error (Qmismatch, string); + } + + array_starting++; + string_starting++; + char_count++; + INC_IBYTEPTR (string_data); + string_offset = string_data - startp; + } + + if (string_data == XSTRING_DATA (string) + XSTRING_LENGTH (string)) + { + check_sequence_range (string, string_start, string_end, + make_int (char_count)); + } + + if ((NILP (string_end) ? + string_offset < string_len : string_starting < string_ending) || + (NILP (array_end) ? !NILP (array) : array_starting < array_ending)) + { + return make_integer (return_string_index ? char_count : + XINT (array_start) + char_count); + } + + return Qnil; +} + +static Lisp_Object +mismatch_string_string (Lisp_Object string1, + Lisp_Object string1_start, Lisp_Object string1_end, + Lisp_Object string2, Lisp_Object string2_start, + Lisp_Object string2_end, + check_test_func_t check_match, + Boolint test_not_unboundp, + Lisp_Object test, Lisp_Object key, + Boolint UNUSED (return_string1_index)) +{ + Ibyte *string1_data = XSTRING_DATA (string1), *startp1 = string1_data; + Bytecount string1_offset = 0, string1_len = XSTRING_LENGTH (string1); + Ibyte *string2_data = XSTRING_DATA (string2), *startp2 = string2_data; + Bytecount string2_offset = 0, string2_len = XSTRING_LENGTH (string2); + Elemcount char_count1 = 0, string1_starting, string1_ending; + Elemcount char_count2 = 0, string2_starting, string2_ending; + Lisp_Object character1, character2; + + string1_ending = INTP (string1_end) ? XINT (string1_end) : 1 + EMACS_INT_MAX; + string1_starting + = INTP (string1_start) ? XINT (string1_start) : 1 + EMACS_INT_MAX; + + string2_starting + = INTP (string2_start) ? XINT (string2_start) : 1 + EMACS_INT_MAX; + string2_ending = INTP (string2_end) ? XINT (string2_end) : 1 + EMACS_INT_MAX; + + while (char_count1 < string1_starting && string1_offset < string1_len) + { + INC_IBYTEPTR (string1_data); + string1_offset = string1_data - startp1; + char_count1++; + } + + while (char_count2 < string2_starting && string2_offset < string2_len) + { + INC_IBYTEPTR (string2_data); + string2_offset = string2_data - startp2; + char_count2++; + } + + while (string2_starting < string2_ending && string1_starting < string1_ending + && string1_offset < string1_len && string2_offset < string2_len) + { + character1 = make_char (itext_ichar (string1_data)); + character2 = make_char (itext_ichar (string2_data)); + + if (check_match (test, key, character1, character2) + != test_not_unboundp) + { + return make_integer (char_count1); + } + + startp1 = XSTRING_DATA (string1); + string1_data = startp1 + string1_offset; + if (string1_len != XSTRING_LENGTH (string1) + || !valid_ibyteptr_p (string1_data)) + { + mapping_interaction_error (Qmismatch, string1); + } + + startp2 = XSTRING_DATA (string2); + string2_data = startp2 + string2_offset; + if (string2_len != XSTRING_LENGTH (string2) + || !valid_ibyteptr_p (string2_data)) + { + mapping_interaction_error (Qmismatch, string2); + } + + string2_starting++; + string1_starting++; + char_count1++; + char_count2++; + INC_IBYTEPTR (string1_data); + string1_offset = string1_data - startp1; + INC_IBYTEPTR (string2_data); + string2_offset = string2_data - startp2; + } + + if (string1_data == XSTRING_DATA (string1) + XSTRING_LENGTH (string1)) + { + check_sequence_range (string1, string1_start, string1_end, + make_int (char_count1)); + } + + if (string2_data == XSTRING_DATA (string2) + XSTRING_LENGTH (string2)) + { + check_sequence_range (string2, string2_start, string2_end, + make_int (char_count2)); + } + + if ((!NILP (string1_end) && string1_starting < string1_ending) || + (!NILP (string2_end) && string2_starting < string2_ending)) + { + return make_integer (char_count1); + } + + if ((NILP (string1_end) && string1_data + < (XSTRING_DATA (string1) + XSTRING_LENGTH (string1))) || + (NILP (string2_end) && string2_data + < (XSTRING_DATA (string2) + XSTRING_LENGTH (string2)))) + { + return make_integer (char_count1); + } + + return Qnil; +} + +static Lisp_Object +mismatch_array_array (Lisp_Object array1, Lisp_Object start1, Lisp_Object end1, + Lisp_Object array2, Lisp_Object start2, Lisp_Object end2, + check_test_func_t check_match, Boolint test_not_unboundp, + Lisp_Object test, Lisp_Object key, + Boolint UNUSED (return_array1_index)) +{ + Elemcount len1 = XINT (Flength (array1)), len2 = XINT (Flength (array2)); + Elemcount ending1 = EMACS_INT_MAX, ending2 = EMACS_INT_MAX; + Elemcount starting1, starting2; + + check_sequence_range (array1, start1, end1, make_int (len1)); + check_sequence_range (array2, start2, end2, make_int (len2)); + + starting1 = INTP (start1) ? XINT (start1) : 1 + EMACS_INT_MAX; + starting2 = INTP (start2) ? XINT (start2) : 1 + EMACS_INT_MAX; + + if (!NILP (end1)) + { + ending1 = INTP (end1) ? XINT (end1) : 1 + EMACS_INT_MAX; + } + + if (!NILP (end2)) + { + ending2 = INTP (end2) ? XINT (end2) : 1 + EMACS_INT_MAX; + } + + ending1 = min (ending1, len1); + ending2 = min (ending2, len2); + + while (starting1 < ending1 && starting2 < ending2) + { + if (check_match (test, key, Faref (array1, make_int (starting1)), + Faref (array2, make_int (starting2))) + != test_not_unboundp) + { + return make_integer (starting1); + } + starting1++; + starting2++; + } + + if (starting1 < ending1 || starting2 < ending2) + { + return make_integer (starting1); + } + + return Qnil; +} + +typedef Lisp_Object +(*mismatch_func_t) (Lisp_Object sequence1, Lisp_Object start1, Lisp_Object end1, + Lisp_Object sequence2, Lisp_Object start2, Lisp_Object end2, + check_test_func_t check_match, Boolint test_not_unboundp, + Lisp_Object test, Lisp_Object key, + Boolint return_list_index); + +static mismatch_func_t +get_mismatch_func (Lisp_Object sequence1, Lisp_Object sequence2, + Lisp_Object from_end, Boolint *return_sequence1_index_out) +{ + CHECK_SEQUENCE (sequence1); + CHECK_SEQUENCE (sequence2); + + if (!NILP (from_end)) + { + *return_sequence1_index_out = 1; + return mismatch_from_end; + } + + if (LISTP (sequence1)) + { + if (LISTP (sequence2)) + { + *return_sequence1_index_out = 1; + return mismatch_list_list; + } + + if (STRINGP (sequence2)) + { + *return_sequence1_index_out = 1; + return mismatch_list_string; + } + + *return_sequence1_index_out = 1; + return mismatch_list_array; + } + + if (STRINGP (sequence1)) + { + if (STRINGP (sequence2)) + { + *return_sequence1_index_out = 1; + return mismatch_string_string; + } + + if (LISTP (sequence2)) + { + *return_sequence1_index_out = 0; + return mismatch_list_string; + } + + *return_sequence1_index_out = 1; + return mismatch_string_array; + } + + if (ARRAYP (sequence1)) + { + if (STRINGP (sequence2)) + { + *return_sequence1_index_out = 0; + return mismatch_string_array; + } + + if (LISTP (sequence2)) + { + *return_sequence1_index_out = 0; + return mismatch_list_array; + } + + *return_sequence1_index_out = 1; + return mismatch_array_array; + } + + RETURN_NOT_REACHED (NULL); + return NULL; +} + +DEFUN ("mismatch", Fmismatch, 2, MANY, 0, /* +Compare SEQUENCE1 with SEQUENCE2, return index of first mismatching element. + +Return nil if the sequences match. If one sequence is a prefix of the +other, the return value indicates the end of the shorter sequence. A +non-nil return value always reflects an index into SEQUENCE1. + +See `search' for the meaning of the keywords." + +arguments: (SEQUENCE1 SEQUENCE2 &key (TEST #'eql) (KEY #'identity) (START1 0) END1 (START2 0) END2 FROM-END TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object sequence1 = args[0], sequence2 = args[1]; + Boolint test_not_unboundp = 1, return_first_index = 0; + check_test_func_t check_match = NULL; + mismatch_func_t mismatch = NULL; + + PARSE_KEYWORDS (Fmismatch, nargs, args, 8, + (test, key, from_end, start1, end1, start2, end2, test_not), + (start1 = start2 = Qzero)); + + CHECK_SEQUENCE (sequence1); + CHECK_SEQUENCE (sequence2); + + CHECK_NATNUM (start1); + CHECK_NATNUM (start2); + + if (!NILP (end1)) + { + CHECK_NATNUM (end1); + } + + if (!NILP (end2)) + { + CHECK_NATNUM (end2); + } + + check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key, + &test_not_unboundp, NULL); + mismatch = get_mismatch_func (sequence1, sequence2, from_end, + &return_first_index); + + if (return_first_index) + { + return mismatch (sequence1, start1, end1, sequence2, start2, end2, + check_match, test_not_unboundp, test, key, 1); + } + + return mismatch (sequence2, start2, end2, sequence1, start1, end1, + check_match, test_not_unboundp, test, key, 0); +} + +DEFUN ("search", Fsearch, 2, MANY, 0, /* +Search for SEQUENCE1 as a subsequence of SEQUENCE2. + +Return the index of the leftmost element of the first match found; return +nil if there are no matches. + +In this function, :start1 and :end1 specify a subsequence of SEQUENCE1, and +:start2 and :end2 specify a subsequence of SEQUENCE2. See `remove*' for +details of the other keywords. + +arguments: (SEQUENCE1 SEQUENCE2 &key (TEST #'eql) (KEY #'identity) (START1 0) END1 (START2 0) END2 FROM-END TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object sequence1 = args[0], sequence2 = args[1], position0 = Qnil; + Boolint test_not_unboundp = 1, return_first = 0; + check_test_func_t check_test = NULL, check_match = NULL; + mismatch_func_t mismatch = NULL; + Elemcount starting1 = 0, ending1 = 1 + EMACS_INT_MAX, starting2 = 0; + Elemcount ending2 = 1 + EMACS_INT_MAX, ii = 0; + Elemcount length1; + Lisp_Object object = Qnil; + struct gcpro gcpro1, gcpro2; + + PARSE_KEYWORDS (Fsearch, nargs, args, 8, + (test, key, from_end, start1, end1, start2, end2, test_not), + (start1 = start2 = Qzero)); + + CHECK_SEQUENCE (sequence1); + CHECK_SEQUENCE (sequence2); + CHECK_KEY_ARGUMENT (key); + + CHECK_NATNUM (start1); + starting1 = INTP (start1) ? XINT (start1) : 1 + EMACS_INT_MAX; + CHECK_NATNUM (start2); + starting2 = INTP (start2) ? XINT (start2) : 1 + EMACS_INT_MAX; + + if (!NILP (end1)) + { + Lisp_Object len1 = Flength (sequence1); + + CHECK_NATNUM (end1); + check_sequence_range (sequence1, start1, end1, len1); + ending1 = min (XINT (end1), XINT (len1)); + } + else + { + end1 = Flength (sequence1); + check_sequence_range (sequence1, start1, end1, end1); + ending1 = XINT (end1); + } + + length1 = ending1 - starting1; + + if (!NILP (end2)) + { + Lisp_Object len2 = Flength (sequence2); + + CHECK_NATNUM (end2); + check_sequence_range (sequence2, start2, end2, len2); + ending2 = min (XINT (end2), XINT (len2)); + } + else + { + end2 = Flength (sequence2); + check_sequence_range (sequence2, start2, end2, end2); + ending2 = XINT (end2); + } + + check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key, + &test_not_unboundp, &check_test); + mismatch = get_mismatch_func (sequence1, sequence2, from_end, &return_first); + + if (bytecode_arithcompare (start1, make_integer (ending1)) >= 0) + { + if (NILP (from_end)) + { + return start2; + } + + if (NILP (end2)) + { + return Flength (sequence2); + } + + return end2; + } + + if (NILP (from_end)) + { + Lisp_Object mismatch_start1 = Fadd1 (start1); + Lisp_Object first = KEY (key, Felt (sequence1, start1)); + GCPRO2 (first, mismatch_start1); + + ii = starting2; + while (ii < ending2) + { + position0 = position (&object, first, sequence2, check_test, + test_not_unboundp, test, key, make_int (ii), + end2, Qnil, Qnil, Qsearch); + if (NILP (position0)) + { + UNGCPRO; + return Qnil; + } + + if (length1 + XINT (position0) <= ending2 && + (return_first ? + NILP (mismatch (sequence1, mismatch_start1, end1, + sequence2, + make_int (1 + XINT (position0)), + make_int (length1 + XINT (position0)), + check_match, test_not_unboundp, test, key, 1)) : + NILP (mismatch (sequence2, + make_int (1 + XINT (position0)), + make_int (length1 + XINT (position0)), + sequence1, mismatch_start1, end1, + check_match, test_not_unboundp, test, key, 0)))) + + + { + UNGCPRO; + return position0; + } + + ii = XINT (position0) + 1; + } + + UNGCPRO; + } + else + { + Lisp_Object mismatch_end1 = make_integer (ending1 - 1); + Lisp_Object last = KEY (key, Felt (sequence1, mismatch_end1)); + GCPRO2 (last, mismatch_end1); + + ii = ending2; + while (ii > starting2) + { + position0 = position (&object, last, sequence2, check_test, + test_not_unboundp, test, key, start2, + make_int (ii), Qt, Qnil, Qsearch); + + if (NILP (position0)) + { + UNGCPRO; + return Qnil; + } + + if (XINT (position0) - length1 + 1 >= starting2 && + (return_first ? + NILP (mismatch (sequence1, start1, mismatch_end1, + sequence2, + make_int (XINT (position0) - length1 + 1), + make_int (XINT (position0)), + check_match, test_not_unboundp, test, key, 1)) : + NILP (mismatch (sequence2, + make_int (XINT (position0) - length1 + 1), + make_int (XINT (position0)), + sequence1, start1, mismatch_end1, + check_match, test_not_unboundp, test, key, 0)))) + { + UNGCPRO; + return make_int (XINT (position0) - length1 + 1); + } + + ii = XINT (position0); + } + + UNGCPRO; + } + + return Qnil; +} + +/* These two functions do set operations, those that can be visualised with + Venn diagrams. */ +static Lisp_Object +venn (Lisp_Object caller, int nargs, Lisp_Object *args, Boolint intersectionp) +{ + Lisp_Object liszt1 = args[0], liszt2 = args[1]; + Lisp_Object result = EQ (caller, Qsubsetp) ? Qt : Qnil, result_tail = Qnil; + Lisp_Object keyed = Qnil, ignore = Qnil; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; + struct gcpro gcpro1, gcpro2; + + PARSE_KEYWORDS_8 (caller, nargs, args, 4, (test, key, test_not, stable), + NULL, 2, 0); + + CHECK_LIST (liszt1); + CHECK_LIST (liszt2); + + CHECK_KEY_ARGUMENT (key); + + if (NILP (liszt1) && intersectionp) + { + return Qnil; + } + + if (NILP (liszt2)) + { + return intersectionp ? Qnil : liszt1; + } + + get_check_match_function (&test, test_not, Qnil, Qnil, key, + &test_not_unboundp, &check_test); + + GCPRO2 (keyed, result); + + { + GC_EXTERNAL_LIST_LOOP_2 (elt, liszt1) + { + keyed = KEY (key, elt); + if (NILP (list_position_cons_before (&ignore, keyed, liszt2, + check_test, test_not_unboundp, + test, key, 0, Qzero, Qnil)) + != intersectionp) + { + if (EQ (Qsubsetp, caller)) + { + result = Qnil; + break; + } + else if (NILP (stable)) + { + result = Fcons (elt, result); + } + else if (NILP (result)) + { + result = result_tail = Fcons (elt, Qnil); + } + else + { + XSETCDR (result_tail, Fcons (elt, Qnil)); + result_tail = XCDR (result_tail); + } + } + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + UNGCPRO; + + return result; +} + +static Lisp_Object +nvenn (Lisp_Object caller, int nargs, Lisp_Object *args, Boolint intersectionp) +{ + Lisp_Object liszt1 = args[0], liszt2 = args[1], tortoise_elt, ignore = Qnil; + Lisp_Object elt = Qnil, tail = Qnil, keyed = Qnil, prev_tail = Qnil; + Elemcount count; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + + PARSE_KEYWORDS_8 (caller, nargs, args, 3, (test, key, test_not), + NULL, 2, 0); + + CHECK_LIST (liszt1); + CHECK_LIST (liszt2); + + CHECK_KEY_ARGUMENT (key); + + if (NILP (liszt1) && intersectionp) + { + return Qnil; + } + + if (NILP (liszt2)) + { + return intersectionp ? Qnil : liszt1; + } + + get_check_match_function (&test, test_not, Qnil, Qnil, key, + &test_not_unboundp, &check_test); + + tortoise_elt = tail = liszt1, count = 0; + + GCPRO4 (tail, keyed, liszt1, tortoise_elt); + + while (CONSP (tail) ? (elt = XCAR (tail), 1) : NILP (tail) ? 0 : + (signal_malformed_list_error (liszt1), 0)) + { + keyed = KEY (key, elt); + if (NILP (list_position_cons_before (&ignore, keyed, liszt2, + check_test, test_not_unboundp, + test, key, 0, Qzero, Qnil)) + == intersectionp) + { + if (NILP (prev_tail)) + { + liszt1 = XCDR (tail); + } + else + { + XSETCDR (prev_tail, XCDR (tail)); + } + + tail = XCDR (tail); + /* List is definitely not circular now! */ + count = 0; + } + else + { + prev_tail = tail; + tail = XCDR (tail); + } + + if (count++ < CIRCULAR_LIST_SUSPICION_LENGTH) continue; + + if (count & 1) + { + tortoise_elt = XCDR (tortoise_elt); + } + + if (EQ (elt, tortoise_elt)) + { + signal_circular_list_error (liszt1); + } + } + + UNGCPRO; + + return liszt1; +} + +DEFUN ("intersection", Fintersection, 2, MANY, 0, /* +Combine LIST1 and LIST2 using a set-intersection operation. + +The result list contains all items that appear in both LIST1 and LIST2. +This is a non-destructive function; it makes a copy of the data if necessary +to avoid corrupting the original LIST1 and LIST2. + +A non-nil value for the :stable keyword, not specified by Common Lisp, means +return the items in the order they appear in LIST1. + +See `union' for the meaning of :test, :test-not and :key." + +arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT STABLE) +*/ + (int nargs, Lisp_Object *args)) +{ + return venn (Qintersection, nargs, args, 1); +} + +DEFUN ("nintersection", Fnintersection, 2, MANY, 0, /* +Combine LIST1 and LIST2 using a set-intersection operation. + +The result list contains all items that appear in both LIST1 and LIST2. +This is a destructive function; it reuses the storage of LIST1 whenever +possible. + +See `union' for the meaning of :test, :test-not and :key." + +arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + return nvenn (Qnintersection, nargs, args, 1); +} + +DEFUN ("subsetp", Fsubsetp, 2, MANY, 0, /* +Return non-nil if every element of LIST1 also appears in LIST2. + +See `union' for the meaning of the keyword arguments. + +arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + return venn (Qsubsetp, nargs, args, 0); +} + +DEFUN ("set-difference", Fset_difference, 2, MANY, 0, /* +Combine LIST1 and LIST2 using a set-difference operation. + +The result list contains all items that appear in LIST1 but not LIST2. This +is a non-destructive function; it makes a copy of the data if necessary to +avoid corrupting the original LIST1 and LIST2. + +See `union' for the meaning of :test, :test-not and :key. + +A non-nil value for the :stable keyword, not specified by Common Lisp, means +return the items in the order they appear in LIST1. + +arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT STABLE) +*/ + (int nargs, Lisp_Object *args)) +{ + return venn (Qset_difference, nargs, args, 0); +} + +DEFUN ("nset-difference", Fnset_difference, 2, MANY, 0, /* +Combine LIST1 and LIST2 using a set-difference operation. + +The result list contains all items that appear in LIST1 but not LIST2. This +is a destructive function; it reuses the storage of LIST1 whenever possible. + +See `union' for the meaning of :test, :test-not and :key." + +arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + return nvenn (Qnset_difference, nargs, args, 0); +} + +DEFUN ("nunion", Fnunion, 2, MANY, 0, /* +Combine LIST1 and LIST2 using a set-union operation. +The result list contains all items that appear in either LIST1 or LIST2. + +This is a destructive function, it reuses the storage of LIST1 whenever +possible. + +See `union' for the meaning of :test, :test-not and :key. + +arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + args[0] = nvenn (Qnunion, nargs, args, 0); + return bytecode_nconc2 (args); +} + +DEFUN ("union", Funion, 2, MANY, 0, /* +Combine LIST1 and LIST2 using a set-union operation. +The result list contains all items that appear in either LIST1 or LIST2. +This is a non-destructive function; it makes a copy of the data if necessary +to avoid corrupting the original LIST1 and LIST2. + +The keywords :test and :test-not specify two-argument test and negated-test +predicates, respectively; :test defaults to `eql'. See `member*' for more +information. + +:key specifies a one-argument function that transforms elements of LIST1 +and LIST2 into \"comparison keys\" before the test predicate is applied. +For example, if :key is #'car, then the car of elements from LIST1 is +compared with the car of elements from LIST2. The :key function, however, +does not affect the elements in the returned list, which are taken directly +from the elements in LIST1 and LIST2. + +A non-nil value for the :stable keyword, not specified by Common Lisp, means +return the items of LIST1 in order, followed by the remaining items of LIST2 +in the order they occur in LIST2. + +arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT STABLE) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object liszt1 = args[0], liszt2 = args[1], ignore = Qnil; + Lisp_Object keyed = Qnil, result, result_tail; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL, check_match = NULL; + struct gcpro gcpro1, gcpro2; + + PARSE_KEYWORDS (Funion, nargs, args, 4, (test, key, test_not, stable), NULL); + + CHECK_LIST (liszt1); + CHECK_LIST (liszt2); + + CHECK_KEY_ARGUMENT (key); + + if (NILP (liszt1)) + { + return liszt2; + } + + if (NILP (liszt2)) + { + return liszt1; + } + + check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key, + &test_not_unboundp, &check_test); + + GCPRO2 (keyed, result); + + if (NILP (stable)) + { + result = liszt2; + { + GC_EXTERNAL_LIST_LOOP_2 (elt, liszt1) + { + keyed = KEY (key, elt); + if (NILP (list_position_cons_before (&ignore, keyed, liszt2, + check_test, test_not_unboundp, + test, key, 0, Qzero, Qnil))) + { + /* The Lisp version of #'union used to check which list was + longer, and use that as the tail of the constructed + list. That fails when the order of arguments to TEST is + specified, as is the case for these functions. We could + pass the reverse_check argument to + list_position_cons_before, but that means any key argument + is called an awful lot more, so it's a space win but not + a time win. */ + result = Fcons (elt, result); + } + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + } + else + { + result = result_tail = Qnil; + + /* The standard `union' doesn't produce a "stable" union -- it + iterates over the second list instead of the first one, and returns + the values in backwards order. According to the CLTL2 + documentation, `union' is not required to preserve the ordering of + elements in any fashion; providing the functionality for a stable + union is an XEmacs extension. */ + { + GC_EXTERNAL_LIST_LOOP_2 (elt, liszt2) + { + if (NILP (list_position_cons_before (&ignore, elt, liszt1, + check_match, test_not_unboundp, + test, key, 1, Qzero, Qnil))) + { + if (NILP (result)) + { + result = result_tail = Fcons (elt, Qnil); + } + else + { + XSETCDR (result_tail, Fcons (elt, Qnil)); + result_tail = XCDR (result_tail); + } + } + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + result = NILP (result) ? liszt1 : nconc2 (Fcopy_list (liszt1), result); + } + + UNGCPRO; + + return result; +} + +DEFUN ("set-exclusive-or", Fset_exclusive_or, 2, MANY, 0, /* +Combine LIST1 and LIST2 using a set-exclusive-or operation. + +The result list contains all items that appear in exactly one of LIST1, LIST2. +This is a non-destructive function; it makes a copy of the data if necessary +to avoid corrupting the original LIST1 and LIST2. + +See `union' for the meaning of :test, :test-not and :key. + +A non-nil value for the :stable keyword, not specified by Common Lisp, means +return the items in the order they appear in LIST1, followed by the +remaining items in the order they appear in LIST2. + +arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT STABLE) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object liszt1 = args[0], liszt2 = args[1]; + Lisp_Object result = Qnil, result_tail = Qnil, keyed = Qnil, ignore = Qnil; + Boolint test_not_unboundp = 1; + check_test_func_t check_match = NULL, check_test = NULL; + struct gcpro gcpro1, gcpro2; + + PARSE_KEYWORDS (Fset_exclusive_or, nargs, args, 4, + (test, key, test_not, stable), NULL); + + CHECK_LIST (liszt1); + CHECK_LIST (liszt2); + + CHECK_KEY_ARGUMENT (key); + + if (NILP (liszt2)) + { + return liszt1; + } + + check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key, + &test_not_unboundp, &check_test); + + GCPRO2 (keyed, result); + { + GC_EXTERNAL_LIST_LOOP_2 (elt, liszt1) + { + keyed = KEY (key, elt); + if (NILP (list_position_cons_before (&ignore, keyed, liszt2, + check_test, test_not_unboundp, + test, key, 0, Qzero, Qnil))) + { + if (NILP (stable)) + { + result = Fcons (elt, result); + } + else if (NILP (result)) + { + result = result_tail = Fcons (elt, Qnil); + } + else + { + XSETCDR (result_tail, Fcons (elt, Qnil)); + result_tail = XCDR (result_tail); + } + } + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + { + GC_EXTERNAL_LIST_LOOP_2 (elt, liszt2) + { + if (NILP (list_position_cons_before (&ignore, elt, liszt1, + check_match, test_not_unboundp, + test, key, 1, Qzero, Qnil))) + { + if (NILP (stable)) + { + result = Fcons (elt, result); + } + else if (NILP (result)) + { + result = result_tail = Fcons (elt, Qnil); + } + else + { + XSETCDR (result_tail, Fcons (elt, Qnil)); + result_tail = XCDR (result_tail); + } + } + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + UNGCPRO; + + return result; +} + +DEFUN ("nset-exclusive-or", Fnset_exclusive_or, 2, MANY, 0, /* +Combine LIST1 and LIST2 using a set-exclusive-or operation. + +The result list contains all items that appear in exactly one of LIST1 and +LIST2. This is a destructive function; it reuses the storage of LIST1 and +LIST2 whenever possible. + +See `union' for the meaning of :test, :test-not and :key. + +arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT) +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object liszt1 = args[0], liszt2 = args[1], elt = Qnil, tail = Qnil; + Lisp_Object result = Qnil, tortoise_elt = Qnil, keyed = Qnil, swap; + Lisp_Object prev_tail = Qnil, ignore = Qnil; + Elemcount count; + Boolint test_not_unboundp = 1; + check_test_func_t check_match = NULL, check_test = NULL; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + + PARSE_KEYWORDS (Fnset_exclusive_or, nargs, args, 4, + (test, key, test_not, stable), NULL); + + CHECK_LIST (liszt1); + CHECK_LIST (liszt2); + + CHECK_KEY_ARGUMENT (key); + + if (NILP (liszt2)) + { + return liszt1; + } + + check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key, + &test_not_unboundp, &check_test); + + tortoise_elt = tail = liszt1, count = 0; + + GCPRO4 (tail, keyed, result, tortoise_elt); + + while (CONSP (tail) ? (elt = XCAR (tail), 1) : NILP (tail) ? 0 : + (signal_malformed_list_error (liszt1), 0)) + { + keyed = KEY (key, elt); + if (NILP (list_position_cons_before (&ignore, keyed, liszt2, + check_test, test_not_unboundp, + test, key, 0, Qzero, Qnil))) + { + swap = XCDR (tail); + + if (NILP (prev_tail)) + { + liszt1 = XCDR (tail); + } + else + { + XSETCDR (prev_tail, swap); + } + + XSETCDR (tail, result); + result = tail; + tail = swap; + + /* List is definitely not circular now! */ + count = 0; + } + else + { + prev_tail = tail; + tail = XCDR (tail); + } + + if (count++ < CIRCULAR_LIST_SUSPICION_LENGTH) continue; + + if (count & 1) + { + tortoise_elt = XCDR (tortoise_elt); + } + + if (EQ (elt, tortoise_elt)) + { + signal_circular_list_error (liszt1); + } + } + + tortoise_elt = tail = liszt2, count = 0; + + while (CONSP (tail) ? (elt = XCAR (tail), 1) : NILP (tail) ? 0 : + (signal_malformed_list_error (liszt2), 0)) + { + /* Need to leave the key calculation to list_position_cons_before(). */ + if (NILP (list_position_cons_before (&ignore, elt, liszt1, + check_match, test_not_unboundp, + test, key, 1, Qzero, Qnil))) + { + swap = XCDR (tail); + XSETCDR (tail, result); + result = tail; + tail = swap; + count = 0; + } + else + { + tail = XCDR (tail); + } + + if (count++ < CIRCULAR_LIST_SUSPICION_LENGTH) continue; + + if (count & 1) + { + tortoise_elt = XCDR (tortoise_elt); + } + + if (EQ (elt, tortoise_elt)) + { + signal_circular_list_error (liszt1); + } + } + + UNGCPRO; + + return result; +} + Lisp_Object add_suffix_to_symbol (Lisp_Object symbol, const Ascbyte *ascii_string) @@ -4041,7 +11142,6 @@ Fsymbol_name (symbol)), Qnil); } - /* #### this function doesn't belong in this file! */ @@ -4530,8 +11630,7 @@ encoded = (Ibyte *) MALLOC_OR_ALLOCA (allength); encoded_length = base64_encode_1 (XLSTREAM (input), encoded, NILP (no_line_break)); - if (encoded_length > allength) - ABORT (); + assert (encoded_length <= allength); Lstream_delete (XLSTREAM (input)); /* Now we have encoded the region, so we insert the new contents @@ -4572,8 +11671,7 @@ encoded = (Ibyte *) MALLOC_OR_ALLOCA (allength); encoded_length = base64_encode_1 (XLSTREAM (input), encoded, NILP (no_line_break)); - if (encoded_length > allength) - ABORT (); + assert (encoded_length <= allength); Lstream_delete (XLSTREAM (input)); result = make_string (encoded, encoded_length); unbind_to (speccount); @@ -4605,8 +11703,7 @@ /* We need to allocate enough room for decoding the text. */ decoded = (Ibyte *) MALLOC_OR_ALLOCA (length * MAX_ICHAR_LEN); decoded_length = base64_decode_1 (XLSTREAM (input), decoded, &cc_decoded_length); - if (decoded_length > length * MAX_ICHAR_LEN) - ABORT (); + assert (decoded_length <= length * MAX_ICHAR_LEN); Lstream_delete (XLSTREAM (input)); /* Now we have decoded the region, so we insert the new contents @@ -4646,8 +11743,7 @@ input = make_lisp_string_input_stream (string, 0, -1); decoded_length = base64_decode_1 (XLSTREAM (input), decoded, &cc_decoded_length); - if (decoded_length > length * MAX_ICHAR_LEN) - ABORT (); + assert (decoded_length <= length * MAX_ICHAR_LEN); Lstream_delete (XLSTREAM (input)); result = make_string (decoded, decoded_length); @@ -4660,15 +11756,60 @@ void syms_of_fns (void) { - INIT_LRECORD_IMPLEMENTATION (bit_vector); + INIT_LISP_OBJECT (bit_vector); DEFSYMBOL (Qstring_lessp); + DEFSYMBOL (Qmerge); + DEFSYMBOL (Qfill); DEFSYMBOL (Qidentity); DEFSYMBOL (Qvector); DEFSYMBOL (Qarray); DEFSYMBOL (Qstring); DEFSYMBOL (Qlist); DEFSYMBOL (Qbit_vector); + defsymbol (&QsortX, "sort*"); + DEFSYMBOL (Qreduce); + DEFSYMBOL (Qreplace); + DEFSYMBOL (Qposition); + DEFSYMBOL (Qfind); + defsymbol (&QdeleteX, "delete*"); + defsymbol (&QremoveX, "remove*"); + + DEFSYMBOL (Qmapconcat); + defsymbol (&QmapcarX, "mapcar*"); + DEFSYMBOL (Qmapvector); + DEFSYMBOL (Qmapcan); + DEFSYMBOL (Qmapc); + DEFSYMBOL (Qmap); + DEFSYMBOL (Qmap_into); + DEFSYMBOL (Qsome); + DEFSYMBOL (Qevery); + DEFSYMBOL (Qmaplist); + DEFSYMBOL (Qmapl); + DEFSYMBOL (Qmapcon); + DEFSYMBOL (Qnsubstitute); + DEFSYMBOL (Qdelete_duplicates); + DEFSYMBOL (Qsubstitute); + DEFSYMBOL (Qmismatch); + DEFSYMBOL (Qintersection); + DEFSYMBOL (Qnintersection); + DEFSYMBOL (Qsubsetp); + DEFSYMBOL (Qcar_less_than_car); + DEFSYMBOL (Qset_difference); + DEFSYMBOL (Qnset_difference); + DEFSYMBOL (Qnunion); + + DEFKEYWORD (Q_from_end); + DEFKEYWORD (Q_initial_value); + DEFKEYWORD (Q_start1); + DEFKEYWORD (Q_start2); + DEFKEYWORD (Q_end1); + DEFKEYWORD (Q_end2); + defkeyword (&Q_if_, ":if"); + DEFKEYWORD (Q_if_not); + DEFKEYWORD (Q_test_not); + DEFKEYWORD (Q_count); + DEFKEYWORD (Q_stable); DEFSYMBOL (Qyes_or_no_p); @@ -4678,6 +11819,8 @@ DEFSUBR (Frandom); DEFSUBR (Flength); DEFSUBR (Fsafe_length); + DEFSUBR (Flist_length); + DEFSUBR (Fcount); DEFSUBR (Fstring_equal); DEFSUBR (Fcompare_strings); DEFSUBR (Fstring_lessp); @@ -4690,7 +11833,6 @@ DEFSUBR (Fcopy_sequence); DEFSUBR (Fcopy_alist); DEFSUBR (Fcopy_tree); - DEFSUBR (Fsubstring); DEFSUBR (Fsubseq); DEFSUBR (Fnthcdr); DEFSUBR (Fnth); @@ -4699,28 +11841,29 @@ DEFSUBR (Fbutlast); DEFSUBR (Fnbutlast); DEFSUBR (Fmember); - DEFSUBR (Fold_member); DEFSUBR (Fmemq); - DEFSUBR (Fold_memq); + DEFSUBR (FmemberX); + DEFSUBR (Fadjoin); DEFSUBR (Fassoc); - DEFSUBR (Fold_assoc); DEFSUBR (Fassq); - DEFSUBR (Fold_assq); DEFSUBR (Frassoc); - DEFSUBR (Fold_rassoc); DEFSUBR (Frassq); - DEFSUBR (Fold_rassq); - DEFSUBR (Fdelete); - DEFSUBR (Fold_delete); - DEFSUBR (Fdelq); - DEFSUBR (Fold_delq); + + DEFSUBR (Fposition); + DEFSUBR (Ffind); + + DEFSUBR (FdeleteX); + DEFSUBR (FremoveX); DEFSUBR (Fremassoc); DEFSUBR (Fremassq); DEFSUBR (Fremrassoc); DEFSUBR (Fremrassq); + DEFSUBR (Fdelete_duplicates); + DEFSUBR (Fremove_duplicates); DEFSUBR (Fnreverse); DEFSUBR (Freverse); - DEFSUBR (Fsort); + DEFSUBR (FsortX); + DEFSUBR (Fmerge); DEFSUBR (Fplists_eq); DEFSUBR (Fplists_equal); DEFSUBR (Flax_plists_eq); @@ -4742,10 +11885,27 @@ DEFSUBR (Fput); DEFSUBR (Fremprop); DEFSUBR (Fobject_plist); + DEFSUBR (Fobject_setplist); DEFSUBR (Fequal); DEFSUBR (Fequalp); + DEFSUBR (Ffill); + +#ifdef SUPPORT_CONFOUNDING_FUNCTIONS + DEFSUBR (Fold_member); + DEFSUBR (Fold_memq); + DEFSUBR (Fold_assoc); + DEFSUBR (Fold_assq); + DEFSUBR (Fold_rassoc); + DEFSUBR (Fold_rassq); + DEFSUBR (Fold_delete); + DEFSUBR (Fold_delq); DEFSUBR (Fold_equal); - DEFSUBR (Ffillarray); + DEFSUBR (Fold_eq); +#endif + + DEFSUBR (FassocX); + DEFSUBR (FrassocX); + DEFSUBR (Fnconc); DEFSUBR (FmapcarX); DEFSUBR (Fmapvector); @@ -4756,13 +11916,34 @@ DEFSUBR (Fmap_into); DEFSUBR (Fsome); DEFSUBR (Fevery); - Ffset (intern ("mapc-internal"), Fsymbol_function (intern ("mapc"))); - Ffset (intern ("mapcar"), Fsymbol_function (intern ("mapcar*"))); + Ffset (intern ("mapc-internal"), Qmapc); + Ffset (intern ("mapcar"), QmapcarX); DEFSUBR (Fmaplist); DEFSUBR (Fmapl); DEFSUBR (Fmapcon); + DEFSUBR (Freduce); DEFSUBR (Freplace_list); + DEFSUBR (Freplace); + DEFSUBR (Fsubsetp); + DEFSUBR (Fnsubstitute); + DEFSUBR (Fsubstitute); + DEFSUBR (Fsublis); + DEFSUBR (Fnsublis); + DEFSUBR (Fsubst); + DEFSUBR (Fnsubst); + DEFSUBR (Ftree_equal); + DEFSUBR (Fmismatch); + DEFSUBR (Fsearch); + DEFSUBR (Funion); + DEFSUBR (Fnunion); + DEFSUBR (Fintersection); + DEFSUBR (Fnintersection); + DEFSUBR (Fset_difference); + DEFSUBR (Fnset_difference); + DEFSUBR (Fset_exclusive_or); + DEFSUBR (Fnset_exclusive_or); + DEFSUBR (Fload_average); DEFSUBR (Ffeaturep); DEFSUBR (Frequire); @@ -4772,6 +11953,7 @@ DEFSUBR (Fbase64_decode_region); DEFSUBR (Fbase64_decode_string); + DEFSUBR (Fsubstring_no_properties); DEFSUBR (Fsplit_string_by_char); DEFSUBR (Fsplit_path); /* #### */ } diff -r 861f2601a38b -r 1f0b15040456 src/font-lock.c --- a/src/font-lock.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/font-lock.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* Routines to compute the current syntactic context, for font-lock mode. Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2002, 2003 Ben Wing. + Copyright (C) 2002, 2003, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -529,7 +527,7 @@ context_cache.context = context_comment; context_cache.ccontext = ccontext_none; context_cache.style = SINGLE_SYNTAX_STYLE (syncode); - if (context_cache.style == comment_style_none) ABORT (); + assert (context_cache.style != comment_style_none); } break; @@ -621,7 +619,7 @@ { context_cache.ccontext = ccontext_start2; context_cache.style = SYNTAX_START_STYLE (prev_syncode, syncode); - if (context_cache.style == comment_style_none) ABORT (); + assert (context_cache.style != comment_style_none); } else if ((SYNTAX_CODE_COMMENT_BITS (syncode) & SYNTAX_FIRST_CHAR_START) && @@ -659,18 +657,18 @@ of a comment-end sequence. ie, '/xxx foo xxx/' or '/xxx foo x/', where 'x' = '*' -- mct */ { - if (context_cache.style == comment_style_none) ABORT (); + assert (context_cache.style != comment_style_none); context_cache.ccontext = ccontext_end1; } else if (context_cache.ccontext == ccontext_start1) { - if (context_cache.context != context_none) ABORT (); + assert (context_cache.context == context_none); context_cache.ccontext = ccontext_none; } else if (context_cache.ccontext == ccontext_end1) { - if (context_cache.context != context_block_comment) ABORT (); + assert (context_cache.context == context_block_comment); context_cache.context = context_none; context_cache.ccontext = ccontext_start2; } @@ -679,7 +677,7 @@ context_cache.context == context_none) { context_cache.context = context_block_comment; - if (context_cache.style == comment_style_none) ABORT (); + assert (context_cache.style != comment_style_none); } else if (context_cache.ccontext == ccontext_none && context_cache.context == context_block_comment) diff -r 861f2601a38b -r 1f0b15040456 src/font-mgr.c --- a/src/font-mgr.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/font-mgr.c Sun May 01 18:44:03 2011 +0100 @@ -3,6 +3,7 @@ Copyright (C) 2003 Eric Knauel and Matthias Neubauer Copyright (C) 2005 Eric Knauel Copyright (C) 2004-2009 Free Software Foundation, Inc. +Copyright (C) 2010 Ben Wing. Authors: Eric Knauel Matthias Neubauer @@ -12,10 +13,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -23,9 +24,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in GNU Emacs. */ @@ -41,8 +40,8 @@ #include "device.h" #include "device-impl.h" #include "console-x-impl.h" -#include "objects-x.h" -#include "objects-x-impl.h" +#include "fontcolor-x.h" +#include "fontcolor-x-impl.h" #include "hash.h" #include "font-mgr.h" @@ -93,9 +92,9 @@ ****************************************************************/ static void -finalize_fc_pattern (void *header, int UNUSED (for_disksave)) +finalize_fc_pattern (Lisp_Object obj) { - struct fc_pattern *p = (struct fc_pattern *) header; + struct fc_pattern *p = XFC_PATTERN (obj); if (p->fcpatPtr) { FcPatternDestroy (p->fcpatPtr); @@ -103,16 +102,6 @@ } } -static void -print_fc_pattern (Lisp_Object obj, Lisp_Object printcharfun, - int UNUSED(escapeflag)) -{ - struct fc_pattern *c = XFCPATTERN (obj); - if (print_readably) - printing_unreadable_object ("#", c->header.uid); - write_fmt_string (printcharfun, "#", c->header.uid); -} - /* #### We really need an equal method and a hash method (required if you have an equal method). For the equal method, we can probably use one or both of @@ -142,10 +131,10 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION("fc-pattern", fc_pattern, 0, - 0, print_fc_pattern, finalize_fc_pattern, - 0, 0, fcpattern_description, - struct fc_pattern); +DEFINE_NODUMP_LISP_OBJECT ("fc-pattern", fc_pattern, + 0, external_object_printer, finalize_fc_pattern, + 0, 0, fcpattern_description, + struct fc_pattern); /* * Helper Functions @@ -182,7 +171,8 @@ ourselves; hash.c hashtables do not interpret the value pointers. This array should be FcChar8**, but GCC 4.x bitches about signedness. */ -static const Extbyte *fc_standard_properties[] = { +static const Extbyte *fc_standard_properties[] = +{ /* treated specially, ordered first */ "family", "size", /* remaining are alphabetized by group */ @@ -221,70 +211,68 @@ return prop; } -DEFUN("fc-pattern-p", Ffc_pattern_p, 1, 1, 0, /* +DEFUN ("fc-pattern-p", Ffc_pattern_p, 1, 1, 0, /* Returns t if OBJECT is of type fc-pattern, nil otherwise. */ (object)) { - return FCPATTERNP(object) ? Qt : Qnil; + return FC_PATTERNP (object) ? Qt : Qnil; } -DEFUN("fc-pattern-create", Ffc_pattern_create, 0, 0, 0, /* +DEFUN ("fc-pattern-create", Ffc_pattern_create, 0, 0, 0, /* Return a new, empty fc-pattern object. */ ()) { - fc_pattern *fcpat = - ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern); + fc_pattern *fcpat = XFC_PATTERN (ALLOC_NORMAL_LISP_OBJECT (fc_pattern)); - fcpat->fcpatPtr = FcPatternCreate(); - return wrap_fcpattern(fcpat); + fcpat->fcpatPtr = FcPatternCreate (); + return wrap_fc_pattern (fcpat); } -DEFUN("fc-name-parse", Ffc_name_parse, 1, 1, 0, /* +DEFUN ("fc-name-parse", Ffc_name_parse, 1, 1, 0, /* Parse an Fc font name and return its representation as a fc pattern object. */ (name)) { - struct fc_pattern *fcpat = - ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern); + fc_pattern *fcpat = XFC_PATTERN (ALLOC_NORMAL_LISP_OBJECT (fc_pattern)); - CHECK_STRING(name); + CHECK_STRING (name); fcpat->fcpatPtr = FcNameParse ((FcChar8 *) extract_fcapi_string (name)); - return wrap_fcpattern(fcpat); + return wrap_fc_pattern (fcpat); } /* #### Ga-a-ack! Xft's similar function is actually a different API. We provide both. */ -DEFUN("fc-name-unparse", Ffc_name_unparse, 1, 1, 0, /* +DEFUN ("fc-name-unparse", Ffc_name_unparse, 1, 1, 0, /* Unparse an fc pattern object to a string. */ (pattern)) { FcChar8 *name; Lisp_Object result; - CHECK_FCPATTERN(pattern); - name = FcNameUnparse (XFCPATTERN_PTR (pattern)); + CHECK_FC_PATTERN (pattern); + name = FcNameUnparse (XFC_PATTERN_PTR (pattern)); result = build_fcapi_string (name); xfree (name); return result; } -DEFUN("fc-pattern-duplicate", Ffc_pattern_duplicate, 1, 1, 0, /* +DEFUN ("fc-pattern-duplicate", Ffc_pattern_duplicate, 1, 1, 0, /* Make a copy of the fc pattern object PATTERN and return it. */ (pattern)) { struct fc_pattern *copy = NULL; - CHECK_FCPATTERN(pattern); + CHECK_FC_PATTERN (pattern); - copy = ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern); - copy->fcpatPtr = FcPatternDuplicate(XFCPATTERN_PTR(pattern)); - return wrap_fcpattern(copy); + copy = XFC_PATTERN (ALLOC_NORMAL_LISP_OBJECT (fc_pattern)); + copy->fcpatPtr = FcPatternDuplicate (XFC_PATTERN_PTR (pattern)); + return wrap_fc_pattern (copy); } -DEFUN("fc-pattern-add", Ffc_pattern_add, 3, 3, 0, /* +DEFUN ("fc-pattern-add", Ffc_pattern_add, 3, 3, 0, /* Add attributes to the pattern object PATTERN. PROPERTY is a string naming the attribute to add, VALUE the value for this attribute. @@ -297,52 +285,52 @@ const Extbyte *obj; FcPattern *fcpat; - CHECK_FCPATTERN(pattern); - CHECK_STRING(property); + CHECK_FC_PATTERN (pattern); + CHECK_STRING (property); obj = fc_intern (property); - fcpat = XFCPATTERN_PTR (pattern); + fcpat = XFC_PATTERN_PTR (pattern); - if (STRINGP(value)) + if (STRINGP (value)) { FcChar8 *str = (FcChar8 *) extract_fcapi_string (value); res = FcPatternAddString (fcpat, obj, str); } - else if (INTP(value)) + else if (INTP (value)) { - res = FcPatternAddInteger (fcpat, obj, XINT(value)); + res = FcPatternAddInteger (fcpat, obj, XINT (value)); } - else if (FLOATP(value)) + else if (FLOATP (value)) { - res = FcPatternAddDouble (fcpat, obj, (double) XFLOAT_DATA(value)); + res = FcPatternAddDouble (fcpat, obj, (double) XFLOAT_DATA (value)); } - else if (SYMBOLP(value)) + else if (SYMBOLP (value)) { - res = FcPatternAddBool (fcpat, obj, !NILP(value)); + res = FcPatternAddBool (fcpat, obj, !NILP (value)); } /* else ... maybe we should wta here? */ return res ? Qt : Qnil; } -DEFUN("fc-pattern-del", Ffc_pattern_del, 2, 2, 0, /* +DEFUN ("fc-pattern-del", Ffc_pattern_del, 2, 2, 0, /* Remove attribute PROPERTY from fc pattern object OBJECT. */ (pattern, property)) { Bool res; - CHECK_FCPATTERN(pattern); - CHECK_STRING(property); + CHECK_FC_PATTERN (pattern); + CHECK_STRING (property); - res = FcPatternDel(XFCPATTERN_PTR(pattern), extract_fcapi_string (property)); + res = FcPatternDel (XFC_PATTERN_PTR (pattern), extract_fcapi_string (property)); return res ? Qt : Qnil; } /* Generic interface to FcPatternGet() * Don't support the losing symbol-for-property interface. */ -DEFUN("fc-pattern-get", Ffc_pattern_get, 2, 4, 0, /* +DEFUN ("fc-pattern-get", Ffc_pattern_get, 2, 4, 0, /* From PATTERN, extract PROPERTY for the ID'th member, of type TYPE. PATTERN is an Xft (fontconfig) pattern object. @@ -421,11 +409,12 @@ Extbyte *fc_property; FcResult fc_result; FcValue fc_value; + int int_id = 0; /* process arguments */ - CHECK_FCPATTERN (pattern); + CHECK_FC_PATTERN (pattern); #if 0 /* Don't support the losing symbol-for-property interface. */ @@ -445,14 +434,21 @@ dead_wrong_type_argument (Qstringp, property); } - if (!NILP (id)) CHECK_NATNUM (id); + if (!NILP (id)) + { +#ifdef HAVE_BIGNUM + check_integer_range (id, Qzero, make_integer (INT_MAX)); + int_id = BIGNUMP (id) ? bignum_to_int (XBIGNUM_DATA (id)) : XINT (id); +#else + check_integer_range (id, Qzero, make_integer (EMACS_INT_MAX)); + int_id = XINT (id); +#endif + } if (!NILP (type)) CHECK_SYMBOL (type); /* get property */ - fc_result = FcPatternGet (XFCPATTERN_PTR (pattern), - fc_property, - NILP (id) ? 0 : XINT(id), - &fc_value); + fc_result = FcPatternGet (XFC_PATTERN_PTR (pattern), + fc_property, int_id, &fc_value); switch (fc_result) { @@ -509,7 +505,7 @@ enum DestroyFontsetP { DestroyNo = 0, DestroyYes = 1 }; static Lisp_Object -fc_config_create_using (FcConfig * (*create_function) ()) +fc_config_create_using (FcConfig * (*create_function) (void)) { FcConfig *fc = (*create_function) (); Lisp_Object configs = XWEAK_LIST_LIST (Vfc_config_weak_list); @@ -517,17 +513,16 @@ /* Linear search: fc_configs are not going to multiply like conses. */ { LIST_LOOP_2 (cfg, configs) - if (fc == XFCCONFIG_PTR (cfg)) + if (fc == XFC_CONFIG_PTR (cfg)) return cfg; } { - fc_config *fccfg = - ALLOC_LCRECORD_TYPE (struct fc_config, &lrecord_fc_config); + fc_config *fccfg = XFC_CONFIG (ALLOC_NORMAL_LISP_OBJECT (fc_config)); fccfg->fccfgPtr = fc; - configs = Fcons (wrap_fcconfig (fccfg), configs); + configs = Fcons (wrap_fc_config (fccfg), configs); XWEAK_LIST_LIST (Vfc_config_weak_list) = configs; - return wrap_fcconfig (fccfg); + return wrap_fc_config (fccfg); } } @@ -539,8 +534,8 @@ Lisp_Object value = Qnil; FcStrList *thing_list; - CHECK_FCCONFIG (config); - thing_list = (*getter) (XFCCONFIG_PTR(config)); + CHECK_FC_CONFIG (config); + thing_list = (*getter) (XFC_CONFIG_PTR (config)); /* Yes, we need to do this check -- sheesh, Keith! */ if (!thing_list) return Qnil; @@ -562,25 +557,24 @@ invalid_state ("failed to create FcFontSet", Qunbound); for (idx = 0; idx < fontset->nfont; ++idx) { - fcpat = - ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern); + fcpat = XFC_PATTERN (ALLOC_NORMAL_LISP_OBJECT (fc_pattern)); fcpat->fcpatPtr = FcPatternDuplicate (fontset->fonts[idx]); - fontlist = Fcons (wrap_fcpattern(fcpat), fontlist); + fontlist = Fcons (wrap_fc_pattern (fcpat), fontlist); } if (destroyp) FcFontSetDestroy (fontset); return fontlist; } -DEFUN("fc-config-p", Ffc_config_p, 1, 1, 0, /* +DEFUN ("fc-config-p", Ffc_config_p, 1, 1, 0, /* Returns t if OBJECT is of type fc-config, nil otherwise. */ (object)) { - return FCCONFIGP (object) ? Qt : Qnil; + return FC_CONFIGP (object) ? Qt : Qnil; } -DEFUN("fc-config-create", Ffc_config_create, 0, 0, 0, /* +DEFUN ("fc-config-create", Ffc_config_create, 0, 0, 0, /* -- Function: FcConfig *FcConfigCreate (void) Creates an empty configuration. */ ()) @@ -591,7 +585,7 @@ #if 0 /* I'm sorry, but we just don't do this in Lisp, OK? Don't even think about implementing this. */ -DEFUN("fc-config-destroy", Ffc_config_destroy, 1, 1, 0, /* +DEFUN ("fc-config-destroy", Ffc_config_destroy, 1, 1, 0, /* -- Function: void FcConfigDestroy (FcConfig *config) Destroys a configuration and any data associated with it. Note that calling this function with the return value from @@ -604,17 +598,17 @@ } #endif -DEFUN("fc-config-up-to-date", Ffc_config_up_to_date, 1, 1, 0, /* +DEFUN ("fc-config-up-to-date", Ffc_config_up_to_date, 1, 1, 0, /* -- Function: FcBool FcConfigUptoDate (FcConfig *config) Checks all of the files related to 'config' and returns whether the in-memory version is in sync with the disk version. */ (config)) { - CHECK_FCCONFIG (config); - return FcConfigUptoDate (XFCCONFIG_PTR (config)) == FcFalse ? Qnil : Qt; + CHECK_FC_CONFIG (config); + return FcConfigUptoDate (XFC_CONFIG_PTR (config)) == FcFalse ? Qnil : Qt; } -DEFUN("fc-config-build-fonts", Ffc_config_build_fonts, 1, 1, 0, /* +DEFUN ("fc-config-build-fonts", Ffc_config_build_fonts, 1, 1, 0, /* -- Function: FcBool FcConfigBuildFonts (FcConfig *config) Builds the set of available fonts for the given configuration. Note that any changes to the configuration after this call have @@ -623,13 +617,13 @@ XEmacs: signal out-of-memory, or return nil on success. */ (config)) { - CHECK_FCCONFIG (config); - if (FcConfigBuildFonts (XFCCONFIG_PTR (config)) == FcFalse) + CHECK_FC_CONFIG (config); + if (FcConfigBuildFonts (XFC_CONFIG_PTR (config)) == FcFalse) out_of_memory ("FcConfigBuildFonts failed", config); return Qnil; } -DEFUN("fc-config-get-config-dirs", Ffc_config_get_config_dirs, 1, 1, 0, /* +DEFUN ("fc-config-get-config-dirs", Ffc_config_get_config_dirs, 1, 1, 0, /* -- Function: FcStrList *FcConfigGetConfigDirs (FcConfig *config) Returns the list of font directories specified in the configuration files for 'config'. Does not include any @@ -639,7 +633,7 @@ return fc_strlist_to_lisp_using (&FcConfigGetConfigDirs, config); } -DEFUN("fc-config-get-font-dirs", Ffc_config_get_font_dirs, 1, 1, 0, /* +DEFUN ("fc-config-get-font-dirs", Ffc_config_get_font_dirs, 1, 1, 0, /* -- Function: FcStrList *FcConfigGetFontDirs (FcConfig *config) Returns the list of font directories in 'config'. This includes the configured font directories along with any directories below those @@ -649,7 +643,7 @@ return fc_strlist_to_lisp_using (&FcConfigGetFontDirs, config); } -DEFUN("fc-config-get-config-files", Ffc_config_get_config_files, 1, 1, 0, /* +DEFUN ("fc-config-get-config-files", Ffc_config_get_config_files, 1, 1, 0, /* -- Function: FcStrList *FcConfigGetConfigFiles (FcConfig *config) Returns the list of known configuration files used to generate 'config'. Note that this will not include any configuration done @@ -659,18 +653,18 @@ return fc_strlist_to_lisp_using (&FcConfigGetConfigFiles, config); } -DEFUN("fc-config-get-cache", Ffc_config_get_cache, 1, 1, 0, /* +DEFUN ("fc-config-get-cache", Ffc_config_get_cache, 1, 1, 0, /* -- Function: char *FcConfigGetCache (FcConfig *config) Returns the name of the file used to store per-user font information. */ (config)) { - CHECK_FCCONFIG (config); + CHECK_FC_CONFIG (config); /* Surely FcConfigGetCache just casts an FcChar8* to char*. */ - return build_fcapi_string ((FcChar8 *) FcConfigGetCache (XFCCONFIG_PTR (config))); + return build_fcapi_string ((FcChar8 *) FcConfigGetCache (XFC_CONFIG_PTR (config))); } -DEFUN("fc-config-get-fonts", Ffc_config_get_fonts, 2, 2, 0, /* +DEFUN ("fc-config-get-fonts", Ffc_config_get_fonts, 2, 2, 0, /* -- Function: FcFontSet *FcConfigGetFonts (FcConfig *config, FcSetName set) Returns one of the two sets of fonts from the configuration as specified by 'set'. @@ -684,7 +678,7 @@ FcSetName name = FcSetSystem; FcFontSet *fs = NULL; - CHECK_FCCONFIG (config); + CHECK_FC_CONFIG (config); CHECK_SYMBOL (set); if (EQ (set, intern ("fc-set-system"))) @@ -694,11 +688,11 @@ else wtaerror ("must be in (fc-set-system fc-set-application)", set); - fs = FcConfigGetFonts (XFCCONFIG_PTR (config), name); + fs = FcConfigGetFonts (XFC_CONFIG_PTR (config), name); return fs ? fontset_to_list (fs, DestroyNo) : Qnil; } -DEFUN("fc-config-set-current", Ffc_config_set_current, 1, 1, 0, /* +DEFUN ("fc-config-set-current", Ffc_config_set_current, 1, 1, 0, /* -- Function: FcBool FcConfigSetCurrent (FcConfig *config) Sets the current default configuration to 'config'. Implicitly calls FcConfigBuildFonts if necessary, returning FcFalse if that @@ -708,7 +702,7 @@ */ (config)) { - CHECK_FCCONFIG (config); + CHECK_FC_CONFIG (config); /* *sigh* "Success" DOES NOT mean you have any fonts available. It is easy to crash fontconfig, and XEmacs with it. Without the following check, this will do it: @@ -717,7 +711,7 @@ (set-face-font 'default "serif-12")) */ - if (FcConfigBuildFonts (XFCCONFIG_PTR (config)) == FcFalse) + if (FcConfigBuildFonts (XFC_CONFIG_PTR (config)) == FcFalse) out_of_memory ("FcConfigBuildFonts failed", config); /* #### We'd like to avoid this consing, and FcConfigGetFonts sometimes returns NULL, but it doesn't always. This will do for now .... */ @@ -725,12 +719,12 @@ && NILP (Ffc_config_get_fonts (config, intern ("fc-set-application")))) signal_error (intern ("args-out-of-range"), "no fonts found", config); /* Should never happen, but I don't trust Keith anymore .... */ - if (FcConfigSetCurrent (XFCCONFIG_PTR (config)) == FcFalse) + if (FcConfigSetCurrent (XFC_CONFIG_PTR (config)) == FcFalse) out_of_memory ("FcConfigBuildFonts failed in set", config); return Qnil; } -DEFUN("fc-config-get-blanks", Ffc_config_get_blanks, 1, 1, 0, /* +DEFUN ("fc-config-get-blanks", Ffc_config_get_blanks, 1, 1, 0, /* -- Function: FcBlanks *FcConfigGetBlanks (FcConfig *config) Returns the FcBlanks object associated with the given configuration, if no blanks were present in the configuration, @@ -739,12 +733,12 @@ #### Unimplemented. */ (config)) { - CHECK_FCCONFIG (config); + CHECK_FC_CONFIG (config); signal_error (Qunimplemented, "no method to convert FcBlanks object", intern ("fc-config-get-blanks")); } -DEFUN("fc-config-get-rescan-interval", Ffc_config_get_rescan_interval, 1, 1, 0, /* +DEFUN ("fc-config-get-rescan-interval", Ffc_config_get_rescan_interval, 1, 1, 0, /* -- Function: int FcConfigGetRescanInterval (FcConfig *config) Returns the interval between automatic checks of the configuration (in seconds) specified in 'config'. The configuration is checked @@ -752,20 +746,20 @@ the last check. */ (config)) { - CHECK_FCCONFIG (config); - return make_int (FcConfigGetRescanInterval (XFCCONFIG_PTR (config))); + CHECK_FC_CONFIG (config); + return make_int (FcConfigGetRescanInterval (XFC_CONFIG_PTR (config))); } -DEFUN("fc-config-set-rescan-interval", Ffc_config_set_rescan_interval, 2, 2, 0, /* +DEFUN ("fc-config-set-rescan-interval", Ffc_config_set_rescan_interval, 2, 2, 0, /* -- Function: FcBool FcConfigSetRescanInterval (FcConfig *config, int rescanInterval) Sets the rescan interval; returns FcFalse if an error occurred. XEmacs: signal such error, or return nil on success. */ (config, rescan_interval)) { - CHECK_FCCONFIG (config); + CHECK_FC_CONFIG (config); CHECK_INT (rescan_interval); - if (FcConfigSetRescanInterval (XFCCONFIG_PTR (config), + if (FcConfigSetRescanInterval (XFC_CONFIG_PTR (config), XINT (rescan_interval)) == FcFalse) signal_error (Qio_error, "FcConfigSetRescanInverval barfed", intern ("fc-config-set-rescan-interval")); @@ -773,16 +767,16 @@ } /* #### This might usefully be made interactive. */ -DEFUN("fc-config-app-font-add-file", Ffc_config_app_font_add_file, 2, 2, 0, /* +DEFUN ("fc-config-app-font-add-file", Ffc_config_app_font_add_file, 2, 2, 0, /* -- Function: FcBool FcConfigAppFontAddFile (FcConfig *config, const char *file) Adds an application-specific font to the configuration. */ (config, file)) { - CHECK_FCCONFIG (config); + CHECK_FC_CONFIG (config); CHECK_STRING (file); if (FcConfigAppFontAddFile - (XFCCONFIG_PTR (config), + (XFC_CONFIG_PTR (config), /* #### FIXME! is Qfile_name right? */ (FcChar8 *) LISP_STRING_TO_EXTERNAL (file, Qfile_name)) == FcFalse) return Qnil; @@ -791,17 +785,17 @@ } /* #### This might usefully be made interactive. */ -DEFUN("fc-config-app-font-add-dir", Ffc_config_app_font_add_dir, 2, 2, 0, /* +DEFUN ("fc-config-app-font-add-dir", Ffc_config_app_font_add_dir, 2, 2, 0, /* -- Function: FcBool FcConfigAppFontAddDir (FcConfig *config, const char *dir) Scans the specified directory for fonts, adding each one found to the application-specific set of fonts. */ (config, dir)) { - CHECK_FCCONFIG (config); + CHECK_FC_CONFIG (config); CHECK_STRING (dir); if (FcConfigAppFontAddDir - (XFCCONFIG_PTR (config), + (XFC_CONFIG_PTR (config), /* #### FIXME! is Qfile_name right? */ (FcChar8 *) LISP_STRING_TO_EXTERNAL (dir, Qfile_name)) == FcFalse) return Qnil; @@ -810,13 +804,13 @@ } /* #### This might usefully be made interactive. */ -DEFUN("fc-config-app-font-clear", Ffc_config_app_font_clear, 1, 1, 0, /* +DEFUN ("fc-config-app-font-clear", Ffc_config_app_font_clear, 1, 1, 0, /* -- Function: void FcConfigAppFontClear (FcConfig *config) Clears the set of application-specific fonts. */ (config)) { - CHECK_FCCONFIG (config); - FcConfigAppFontClear (XFCCONFIG_PTR (config)); + CHECK_FC_CONFIG (config); + FcConfigAppFontClear (XFC_CONFIG_PTR (config)); return Qnil; } @@ -824,7 +818,7 @@ configuration of the library is initialized. (This configuration is normally implicitly initialized.) */ -DEFUN("fc-config-filename", Ffc_config_filename, 1, 1, 0, /* +DEFUN ("fc-config-filename", Ffc_config_filename, 1, 1, 0, /* -- Function: char *FcConfigFilename (const char *name) Given the specified external entity name, return the associated filename. This provides applications a way to convert various @@ -851,7 +845,7 @@ return (build_fcapi_string (FcConfigFilename ((FcChar8 *) fcname))); } -DEFUN("fc-init-load-config", Ffc_init_load_config, 0, 0, 0, /* +DEFUN ("fc-init-load-config", Ffc_init_load_config, 0, 0, 0, /* -- Function: FcConfig *FcInitLoadConfig (void) Loads the default configuration file and returns the resulting configuration. Does not load any font information. */ @@ -860,7 +854,7 @@ return fc_config_create_using (&FcInitLoadConfig); } -DEFUN("fc-init-load-config-and-fonts", Ffc_init_load_config_and_fonts, 0, 0, 0, /* +DEFUN ("fc-init-load-config-and-fonts", Ffc_init_load_config_and_fonts, 0, 0, 0, /* -- Function: FcConfig *FcInitLoadConfigAndFonts (void) Loads the default configuration file and builds information about the available fonts. Returns the resulting configuration. */ @@ -869,7 +863,7 @@ return fc_config_create_using (&FcInitLoadConfigAndFonts); } -DEFUN("fc-config-get-current", Ffc_config_get_current, 0, 0, 0, /* +DEFUN ("fc-config-get-current", Ffc_config_get_current, 0, 0, 0, /* -- Function: FcConfig *FcConfigGetCurrent (void) Returns the current default configuration. */ ()) @@ -879,7 +873,7 @@ /* Pattern manipulation functions. */ -DEFUN("fc-default-substitute", Ffc_default_substitute, 1, 1, 0, /* +DEFUN ("fc-default-substitute", Ffc_default_substitute, 1, 1, 0, /* Adds defaults for certain attributes if not specified in PATTERN. FcPattern PATTERN is modified in-place, and nil is returned. * Patterns without a specified style or weight are set to Medium @@ -888,8 +882,8 @@ specified point size (default 12), dpi (default 75) and scale (default 1). */ (pattern)) { - CHECK_FCPATTERN (pattern); - FcDefaultSubstitute (XFCPATTERN_PTR (pattern)); + CHECK_FC_PATTERN (pattern); + FcDefaultSubstitute (XFC_PATTERN_PTR (pattern)); return Qnil; } @@ -897,7 +891,7 @@ FcPattern *p, FcPattern *p_pat FcMatchKind kind) OMITTED: use optional arguments in `fc-config-substitute'. */ -DEFUN("fc-config-substitute", Ffc_config_substitute, 1, 4, 0, /* +DEFUN ("fc-config-substitute", Ffc_config_substitute, 1, 4, 0, /* Modifies PATTERN according to KIND and TESTPAT using operations from CONFIG. PATTERN is modified in-place. Returns an undocumented Boolean value. If optional KIND is `fc-match-pattern', then those tagged as pattern operations @@ -923,14 +917,14 @@ wtaerror ("need `fc-match-pattern' or `fc-match-font'", kind); /* Typecheck arguments */ - CHECK_FCPATTERN (pattern); - if (!NILP (testpat)) CHECK_FCPATTERN (testpat); - if (!NILP (config)) CHECK_FCCONFIG (config); + CHECK_FC_PATTERN (pattern); + if (!NILP (testpat)) CHECK_FC_PATTERN (testpat); + if (!NILP (config)) CHECK_FC_CONFIG (config); return (FcConfigSubstituteWithPat - (NILP (config) ? FcConfigGetCurrent () : XFCCONFIG_PTR (config), - XFCPATTERN_PTR (pattern), - NILP (testpat) ? NULL : XFCPATTERN_PTR (testpat), + (NILP (config) ? FcConfigGetCurrent () : XFC_CONFIG_PTR (config), + XFC_PATTERN_PTR (pattern), + NILP (testpat) ? NULL : XFC_PATTERN_PTR (testpat), knd) == FcTrue) ? Qt : Qnil; } @@ -945,7 +939,7 @@ filtering out fonts that do not provide additional characters beyond those provided by preferred fonts. */ -DEFUN("fc-font-render-prepare", Ffc_font_render_prepare, 2, 3, 0, /* +DEFUN ("fc-font-render-prepare", Ffc_font_render_prepare, 2, 3, 0, /* Return a new pattern blending PATTERN and FONT. Optional CONFIG is an FcConfig, defaulting to the current one. The returned pattern consists of elements of FONT not appearing in PATTERN, @@ -957,17 +951,17 @@ if (NILP (config)) { config = Ffc_config_get_current (); } - CHECK_FCPATTERN (pattern); - CHECK_FCPATTERN (font); - CHECK_FCCONFIG (config); + CHECK_FC_PATTERN (pattern); + CHECK_FC_PATTERN (font); + CHECK_FC_CONFIG (config); /* I don't think this can fail? */ - return wrap_fcpattern (FcFontRenderPrepare (XFCCONFIG_PTR(config), - XFCPATTERN_PTR(font), - XFCPATTERN_PTR(pattern))); + return wrap_fc_pattern (FcFontRenderPrepare (XFC_CONFIG_PTR (config), + XFC_PATTERN_PTR (font), + XFC_PATTERN_PTR (pattern))); } -DEFUN("fc-font-match", Ffc_font_match, 2, 3, 0, /* +DEFUN ("fc-font-match", Ffc_font_match, 2, 3, 0, /* Return the font on DEVICE that most closely matches PATTERN. DEVICE is an X11 device. @@ -985,18 +979,18 @@ FcPattern *p; FcConfig *fcc; - CHECK_FCPATTERN(pattern); - if (NILP(device)) + CHECK_FC_PATTERN (pattern); + if (NILP (device)) return Qnil; - CHECK_X_DEVICE(device); - if (!DEVICE_LIVE_P(XDEVICE(device))) + CHECK_X_DEVICE (device); + if (!DEVICE_LIVE_P (XDEVICE (device))) return Qnil; if (!NILP (config)) - CHECK_FCCONFIG (config); + CHECK_FC_CONFIG (config); - res_fcpat = ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern); - p = XFCPATTERN_PTR(pattern); - fcc = NILP (config) ? FcConfigGetCurrent () : XFCCONFIG_PTR (config); + res_fcpat = XFC_PATTERN (ALLOC_NORMAL_LISP_OBJECT (fc_pattern)); + p = XFC_PATTERN_PTR (pattern); + fcc = NILP (config) ? FcConfigGetCurrent () : XFC_CONFIG_PTR (config); FcConfigSubstitute (fcc, p, FcMatchPattern); FcDefaultSubstitute (p); @@ -1004,20 +998,21 @@ res_fcpat->fcpatPtr = FcFontMatch (fcc, p, &res); if (res_fcpat->fcpatPtr == NULL) - switch (res) { - case FcResultNoMatch: - return Qfc_result_no_match; - case FcResultNoId: - return Qfc_result_no_id; - default: - return Qfc_internal_error; - } + switch (res) + { + case FcResultNoMatch: + return Qfc_result_no_match; + case FcResultNoId: + return Qfc_result_no_id; + default: + return Qfc_internal_error; + } else - return wrap_fcpattern(res_fcpat); + return wrap_fc_pattern (res_fcpat); } /* #### fix this name to correspond to Ben's new nomenclature */ -DEFUN("fc-list-fonts-pattern-objects", Ffc_list_fonts_pattern_objects, +DEFUN ("fc-list-fonts-pattern-objects", Ffc_list_fonts_pattern_objects, 3, 3, 0, /* Return a list of fonts on DEVICE that match PATTERN for PROPERTIES. Each font is represented by a fontconfig pattern object. @@ -1033,13 +1028,13 @@ FcObjectSet *os; FcFontSet *fontset; - CHECK_FCPATTERN (pattern); + CHECK_FC_PATTERN (pattern); CHECK_LIST (properties); os = FcObjectSetCreate (); string_list_to_fcobjectset (properties, os); /* #### why don't we need to do the "usual substitutions"? */ - fontset = FcFontList (NULL, XFCPATTERN_PTR (pattern), os); + fontset = FcFontList (NULL, XFC_PATTERN_PTR (pattern), os); FcObjectSetDestroy (os); return fontset_to_list (fontset, DestroyYes); @@ -1047,7 +1042,7 @@ } /* #### maybe this can/should be folded into fc-list-fonts-pattern-objects? */ -DEFUN("fc-font-sort", Ffc_font_sort, 2, 4, 0, /* +DEFUN ("fc-font-sort", Ffc_font_sort, 2, 4, 0, /* Return a list of all fonts sorted by proximity to PATTERN. Each font is represented by a fontconfig pattern object. @@ -1065,18 +1060,18 @@ match other font-listing APIs. */ (UNUSED (device), pattern, trim, nosub)) { - CHECK_FCPATTERN (pattern); + CHECK_FC_PATTERN (pattern); { FcConfig *fcc = FcConfigGetCurrent(); FcFontSet *fontset; - FcPattern *p = XFCPATTERN_PTR (pattern); + FcPattern *p = XFC_PATTERN_PTR (pattern); FcResult fcresult; - if (NILP(nosub)) /* #### temporary debug hack */ + if (NILP (nosub)) /* #### temporary debug hack */ FcDefaultSubstitute (p); FcConfigSubstitute (fcc, p, FcMatchPattern); - fontset = FcFontSort (fcc, p, !NILP(trim), NULL, &fcresult); + fontset = FcFontSort (fcc, p, !NILP (trim), NULL, &fcresult); return fontset_to_list (fontset, DestroyYes); } @@ -1096,9 +1091,9 @@ */ static void -finalize_fc_config (void *header, int UNUSED (for_disksave)) +finalize_fc_config (Lisp_Object obj) { - struct fc_config *p = (struct fc_config *) header; + struct fc_config *p = XFC_CONFIG (obj); if (p->fccfgPtr && p->fccfgPtr != FcConfigGetCurrent()) { /* If we get here, all of *our* references are garbage (see comment on @@ -1109,27 +1104,17 @@ p->fccfgPtr = 0; } -static void -print_fc_config (Lisp_Object obj, Lisp_Object printcharfun, - int UNUSED(escapeflag)) -{ - struct fc_config *c = XFCCONFIG (obj); - if (print_readably) - printing_unreadable_object ("#", c->header.uid); - write_fmt_string (printcharfun, "#", c->header.uid); -} - static const struct memory_description fcconfig_description [] = { /* #### nothing here, is this right?? */ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION("fc-config", fc_config, 0, - 0, print_fc_config, finalize_fc_config, 0, 0, - fcconfig_description, - struct fc_config); +DEFINE_NODUMP_LISP_OBJECT ("fc-config", fc_config, + 0, external_object_printer, finalize_fc_config, + 0, 0, fcconfig_description, + struct fc_config); -DEFUN("fc-init", Ffc_init, 0, 0, 0, /* +DEFUN ("fc-init", Ffc_init, 0, 0, 0, /* -- Function: FcBool FcInit (void) Loads the default configuration file and the fonts referenced therein and sets the default configuration to that result. @@ -1141,7 +1126,7 @@ return (FcInit () == FcTrue) ? Qt : Qnil; } -DEFUN("fc-get-version", Ffc_get_version, 0, 0, 0, /* +DEFUN ("fc-get-version", Ffc_get_version, 0, 0, 0, /* -- Function: int FcGetVersion (void) Returns the version number of the library. XEmacs: No, this should NOT return a pretty string. @@ -1155,7 +1140,7 @@ return make_int (FcGetVersion ()); } -DEFUN("fc-init-reinitialize", Ffc_init_reinitialize, 0, 0, 0, /* +DEFUN ("fc-init-reinitialize", Ffc_init_reinitialize, 0, 0, 0, /* -- Function: FcBool FcInitReinitialize (void) Forces the default configuration file to be reloaded and resets the default configuration. */ @@ -1164,7 +1149,7 @@ return (FcInitReinitialize () == FcTrue) ? Qt : Qnil; } -DEFUN("fc-init-bring-up-to-date", Ffc_init_bring_up_to_date, 0, 0, 0, /* +DEFUN ("fc-init-bring-up-to-date", Ffc_init_bring_up_to_date, 0, 0, 0, /* -- Function: FcBool FcInitBringUptoDate (void) Checks the rescan interval in the default configuration, checking the configuration if the interval has passed and reloading the @@ -1176,13 +1161,13 @@ #endif /* FONTCONFIG_EXPOSE_CONFIG */ -DEFUN("xlfd-font-name-p", Fxlfd_font_name_p, 1, 1, 0, /* +DEFUN ("xlfd-font-name-p", Fxlfd_font_name_p, 1, 1, 0, /* Check whether the string FONTNAME is a XLFD font name. */ (fontname)) { - CHECK_STRING(fontname); + CHECK_STRING (fontname); /* #### should bind `case-fold-search' here? */ - return Fstring_match(Vxlfd_font_name_regexp, fontname, Qnil, Qnil); + return Fstring_match (Vxlfd_font_name_regexp, fontname, Qnil, Qnil); } /* FcPatternPrint: there is no point in having wrappers fc-pattern-print, @@ -1263,10 +1248,10 @@ }; GCPRO1 (reg); - for (i = 0; i < sizeof(re)/sizeof(Extbyte *); i++) + for (i = 0; i < sizeof (re)/sizeof (Extbyte *); i++) { /* #### Currently this is Host Portable Coding, not ISO 8859-1. */ - reg = concat2(reg, build_extstring (re[i], Qx_font_name_encoding)); + reg = concat2 (reg, build_extstring (re[i], Qx_font_name_encoding)); } RETURN_UNGCPRO (reg); @@ -1298,67 +1283,68 @@ } void -syms_of_font_mgr (void) { - INIT_LRECORD_IMPLEMENTATION(fc_pattern); +syms_of_font_mgr (void) +{ + INIT_LISP_OBJECT (fc_pattern); - DEFSYMBOL_MULTIWORD_PREDICATE(Qfc_patternp); + DEFSYMBOL_MULTIWORD_PREDICATE (Qfc_patternp); - DEFSYMBOL(Qfc_result_type_mismatch); - DEFSYMBOL(Qfc_result_no_match); - DEFSYMBOL(Qfc_result_no_id); - DEFSYMBOL(Qfc_internal_error); - DEFSYMBOL(Qfc_match_pattern); - DEFSYMBOL(Qfc_match_font); - DEFSYMBOL(Qfont_mgr); + DEFSYMBOL (Qfc_result_type_mismatch); + DEFSYMBOL (Qfc_result_no_match); + DEFSYMBOL (Qfc_result_no_id); + DEFSYMBOL (Qfc_internal_error); + DEFSYMBOL (Qfc_match_pattern); + DEFSYMBOL (Qfc_match_font); + DEFSYMBOL (Qfont_mgr); - DEFSUBR(Ffc_pattern_p); - DEFSUBR(Ffc_pattern_create); - DEFSUBR(Ffc_name_parse); - DEFSUBR(Ffc_name_unparse); - DEFSUBR(Ffc_pattern_duplicate); - DEFSUBR(Ffc_pattern_add); - DEFSUBR(Ffc_pattern_del); - DEFSUBR(Ffc_pattern_get); - DEFSUBR(Ffc_list_fonts_pattern_objects); - DEFSUBR(Ffc_font_sort); - DEFSUBR(Ffc_font_match); - DEFSUBR(Ffc_default_substitute); - DEFSUBR(Ffc_config_substitute); - DEFSUBR(Ffc_font_render_prepare); - DEFSUBR(Fxlfd_font_name_p); + DEFSUBR (Ffc_pattern_p); + DEFSUBR (Ffc_pattern_create); + DEFSUBR (Ffc_name_parse); + DEFSUBR (Ffc_name_unparse); + DEFSUBR (Ffc_pattern_duplicate); + DEFSUBR (Ffc_pattern_add); + DEFSUBR (Ffc_pattern_del); + DEFSUBR (Ffc_pattern_get); + DEFSUBR (Ffc_list_fonts_pattern_objects); + DEFSUBR (Ffc_font_sort); + DEFSUBR (Ffc_font_match); + DEFSUBR (Ffc_default_substitute); + DEFSUBR (Ffc_config_substitute); + DEFSUBR (Ffc_font_render_prepare); + DEFSUBR (Fxlfd_font_name_p); #ifdef FONTCONFIG_EXPOSE_CONFIG - INIT_LRECORD_IMPLEMENTATION(fc_config); + INIT_LISP_OBJECT (fc_config); - DEFSYMBOL_MULTIWORD_PREDICATE(Qfc_configp); + DEFSYMBOL_MULTIWORD_PREDICATE (Qfc_configp); - DEFSUBR(Ffc_config_p); - DEFSUBR(Ffc_config_create); + DEFSUBR (Ffc_config_p); + DEFSUBR (Ffc_config_create); #if 0 - DEFSUBR(Ffc_config_destroy); + DEFSUBR (Ffc_config_destroy); #endif - DEFSUBR(Ffc_config_set_current); - DEFSUBR(Ffc_config_get_current); - DEFSUBR(Ffc_config_up_to_date); - DEFSUBR(Ffc_config_build_fonts); - DEFSUBR(Ffc_config_get_config_dirs); - DEFSUBR(Ffc_config_get_font_dirs); - DEFSUBR(Ffc_config_get_config_files); - DEFSUBR(Ffc_config_get_cache); - DEFSUBR(Ffc_config_get_fonts); - DEFSUBR(Ffc_config_get_blanks); - DEFSUBR(Ffc_config_get_rescan_interval); - DEFSUBR(Ffc_config_set_rescan_interval); - DEFSUBR(Ffc_config_app_font_add_file); - DEFSUBR(Ffc_config_app_font_add_dir); - DEFSUBR(Ffc_config_app_font_clear); - DEFSUBR(Ffc_config_filename); - DEFSUBR(Ffc_init_load_config); - DEFSUBR(Ffc_init_load_config_and_fonts); - DEFSUBR(Ffc_init); - DEFSUBR(Ffc_get_version); - DEFSUBR(Ffc_init_reinitialize); - DEFSUBR(Ffc_init_bring_up_to_date); + DEFSUBR (Ffc_config_set_current); + DEFSUBR (Ffc_config_get_current); + DEFSUBR (Ffc_config_up_to_date); + DEFSUBR (Ffc_config_build_fonts); + DEFSUBR (Ffc_config_get_config_dirs); + DEFSUBR (Ffc_config_get_font_dirs); + DEFSUBR (Ffc_config_get_config_files); + DEFSUBR (Ffc_config_get_cache); + DEFSUBR (Ffc_config_get_fonts); + DEFSUBR (Ffc_config_get_blanks); + DEFSUBR (Ffc_config_get_rescan_interval); + DEFSUBR (Ffc_config_set_rescan_interval); + DEFSUBR (Ffc_config_app_font_add_file); + DEFSUBR (Ffc_config_app_font_add_dir); + DEFSUBR (Ffc_config_app_font_clear); + DEFSUBR (Ffc_config_filename); + DEFSUBR (Ffc_init_load_config); + DEFSUBR (Ffc_init_load_config_and_fonts); + DEFSUBR (Ffc_init); + DEFSUBR (Ffc_get_version); + DEFSUBR (Ffc_init_reinitialize); + DEFSUBR (Ffc_init_bring_up_to_date); #endif /* FONTCONFIG_EXPOSE_CONFIG */ } @@ -1368,7 +1354,7 @@ /* #### The next two DEFVARs belong somewhere else. */ /* #### I know, but the right fix is use the generic debug facility. */ - DEFVAR_INT ("xft-debug-level", &debug_xft /* + DEFVAR_INT ("debug-xft", &debug_xft /* Level of debugging messages to issue to stderr for Xft. A nonnegative integer. Set to 0 to suppress all warnings. Default is 1 to ensure a minimum of debugging output at initialization. @@ -1376,12 +1362,12 @@ */ ); debug_xft = 0; - DEFVAR_CONST_INT("xft-version", &xft_version /* + DEFVAR_CONST_INT ("xft-version", &xft_version /* The major version number of the Xft library being used. */ ); xft_version = XFT_VERSION; - DEFVAR_CONST_INT("fc-version", &fc_version /* + DEFVAR_CONST_INT ("fc-version", &fc_version /* The version number of fontconfig.h. It can be checked against `(fc-get-version)', which is the version of the .so. It's probably not a disaster if `(> (fc-get-version) fc-version)'. @@ -1399,7 +1385,7 @@ staticpro (&Vfc_config_weak_list); #endif - DEFVAR_LISP("xft-xlfd-font-regexp", &Vxlfd_font_name_regexp /* + DEFVAR_LISP ("xft-xlfd-font-regexp", &Vxlfd_font_name_regexp /* The regular expression used to match XLFD font names. */ ); Vxlfd_font_name_regexp = make_xlfd_font_regexp(); diff -r 861f2601a38b -r 1f0b15040456 src/font-mgr.h --- a/src/font-mgr.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/font-mgr.h Sun May 01 18:44:03 2011 +0100 @@ -12,10 +12,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -23,9 +23,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in GNU Emacs. */ @@ -54,38 +52,38 @@ struct fc_pattern { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; FcPattern *fcpatPtr; }; typedef struct fc_pattern fc_pattern; -DECLARE_LRECORD(fc_pattern, struct fc_pattern); -#define XFCPATTERN(x) XRECORD (x, fc_pattern, struct fc_pattern) -#define wrap_fcpattern(p) wrap_record (p, fc_pattern) -#define FCPATTERNP(x) RECORDP (x, fc_pattern) -#define CHECK_FCPATTERN(x) CHECK_RECORD (x, fc_pattern) -#define CONCHECK_FCPATTERN(x) CONCHECK_RECORD (x, fc_pattern) -#define XFCPATTERN_PTR(x) (XFCPATTERN(x)->fcpatPtr) +DECLARE_LISP_OBJECT(fc_pattern, struct fc_pattern); +#define XFC_PATTERN(x) XRECORD (x, fc_pattern, struct fc_pattern) +#define wrap_fc_pattern(p) wrap_record (p, fc_pattern) +#define FC_PATTERNP(x) RECORDP (x, fc_pattern) +#define CHECK_FC_PATTERN(x) CHECK_RECORD (x, fc_pattern) +#define CONCHECK_FC_PATTERN(x) CONCHECK_RECORD (x, fc_pattern) +#define XFC_PATTERN_PTR(x) (XFC_PATTERN(x)->fcpatPtr) #define FONTCONFIG_EXPOSE_CONFIG #ifdef FONTCONFIG_EXPOSE_CONFIG struct fc_config { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; FcConfig *fccfgPtr; }; typedef struct fc_config fc_config; -DECLARE_LRECORD(fc_config, struct fc_config); -#define XFCCONFIG(x) XRECORD (x, fc_config, struct fc_config) -#define wrap_fcconfig(p) wrap_record (p, fc_config) -#define FCCONFIGP(x) RECORDP (x, fc_config) -#define CHECK_FCCONFIG(x) CHECK_RECORD (x, fc_config) -#define CONCHECK_FCCONFIG(x) CONCHECK_RECORD (x, fc_config) -#define XFCCONFIG_PTR(x) (XFCCONFIG(x)->fccfgPtr) +DECLARE_LISP_OBJECT(fc_config, struct fc_config); +#define XFC_CONFIG(x) XRECORD (x, fc_config, struct fc_config) +#define wrap_fc_config(p) wrap_record (p, fc_config) +#define FC_CONFIGP(x) RECORDP (x, fc_config) +#define CHECK_FC_CONFIG(x) CHECK_RECORD (x, fc_config) +#define CONCHECK_FC_CONFIG(x) CONCHECK_RECORD (x, fc_config) +#define XFC_CONFIG_PTR(x) (XFC_CONFIG(x)->fccfgPtr) #endif /* FONTCONFIG_EXPOSE_CONFIG */ diff -r 861f2601a38b -r 1f0b15040456 src/fontcolor-gtk-impl.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/fontcolor-gtk-impl.h Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,62 @@ +/* Gtk-specific Lisp objects. + Copyright (C) 1993, 1994 Free Software Foundation, Inc. + Copyright (C) 1995 Board of Trustees, University of Illinois. + Copyright (C) 1995, 1996 Ben Wing. + +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 3 of the License, 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. If not, see . */ + +/* Synched up with: Not in FSF. */ +/* Gtk version by William Perry */ + +#ifndef _XEMACS_OBJECTS_GTK_IMPL_H_ +#define _XEMACS_OBJECTS_GTK_IMPL_H_ + +#include "fontcolor-impl.h" +#include "fontcolor-gtk.h" + +#ifdef HAVE_GTK + +/***************************************************************************** + Color-Instance + ****************************************************************************/ + +struct gtk_color_instance_data +{ + GdkColor *color; + char dealloc_on_gc; +}; + +#define GTK_COLOR_INSTANCE_DATA(c) ((struct gtk_color_instance_data *) (c)->data) +#define COLOR_INSTANCE_GTK_COLOR(c) (GTK_COLOR_INSTANCE_DATA (c)->color) +#define XCOLOR_INSTANCE_GTK_COLOR(c) COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (c)) +#define COLOR_INSTANCE_GTK_DEALLOC(c) (GTK_COLOR_INSTANCE_DATA (c)->dealloc_on_gc) + +/***************************************************************************** + Font-Instance + ****************************************************************************/ + +struct gtk_font_instance_data +{ + /* Gtk-specific information */ + GdkFont *font; +}; + +#define GTK_FONT_INSTANCE_DATA(f) ((struct gtk_font_instance_data *) (f)->data) +#define FONT_INSTANCE_GTK_FONT(f) (GTK_FONT_INSTANCE_DATA (f)->font) +#define XFONT_INSTANCE_GTK_FONT(c) FONT_INSTANCE_GTK_FONT (XFONT_INSTANCE (c)) + +#endif /* HAVE_GTK */ +#endif /* _XEMACS_OBJECTS_GTK_IMPL_H_ */ diff -r 861f2601a38b -r 1f0b15040456 src/fontcolor-gtk.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/fontcolor-gtk.c Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,510 @@ +/* X-specific Lisp objects. + Copyright (C) 1993, 1994 Free Software Foundation, Inc. + Copyright (C) 1995 Board of Trustees, University of Illinois. + Copyright (C) 1995 Tinker Systems. + Copyright (C) 1995, 1996, 2002 Ben Wing. + Copyright (C) 1995 Sun Microsystems, Inc. + +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 3 of the License, 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. If not, see . */ + +/* Synched up with: Not in FSF. */ + +/* Authors: Jamie Zawinski, Chuck Thompson, Ben Wing */ +/* Gtk version by William Perry */ + +#include +#include "lisp.h" + +#include "buffer.h" +#include "charset.h" +#include "device-impl.h" +#include "insdel.h" + +#include "console-gtk-impl.h" +#include "fontcolor-gtk-impl.h" + +/* sigh */ +#include "sysgdkx.h" + +/* XListFonts doesn't allocate memory unconditionally based on this. (For + XFree86 in 2005, at least. */ +#define MAX_FONT_COUNT INT_MAX + +#ifdef DEBUG_XEMACS +Fixnum debug_x_objects; +#endif /* DEBUG_XEMACS */ + + +/************************************************************************/ +/* color instances */ +/************************************************************************/ + +/* Replacement for XAllocColor() that tries to return the nearest + available color if the colormap is full. Original was from FSFmacs, + but rewritten by Jareth Hein 97/11/25 + Modified by Lee Kindness 31/08/99 to handle previous + total failure which was due to a read/write colorcell being the nearest + match - tries the next nearest... + + Gdk takes care of all this behind the scenes, so we don't need to + worry about it. + + Return value is 1 for normal success, 2 for nearest color success, + 3 for Non-deallocable success. */ +int +allocate_nearest_color (GdkColormap *colormap, GdkVisual *UNUSED (visual), + GdkColor *color_def) +{ + int rc; + + rc = gdk_colormap_alloc_color (colormap, color_def, FALSE, TRUE); + + if (rc == TRUE) + return (1); + + return (0); +} + +int +gtk_parse_nearest_color (struct device *d, GdkColor *color, Ibyte *name, + Bytecount len, Error_Behavior errb) +{ + GdkColormap *cmap; + GdkVisual *visual; + int result; + + cmap = DEVICE_GTK_COLORMAP(d); + visual = DEVICE_GTK_VISUAL (d); + + xzero (*color); + { + const Extbyte *extname; + Bytecount extnamelen; + + TO_EXTERNAL_FORMAT (DATA, (name, len), ALLOCA, (extname, extnamelen), Qbinary); + + result = gdk_color_parse (extname, color); + } + + if (result == FALSE) + { + maybe_invalid_argument ("unrecognized color", make_string (name, len), + Qcolor, errb); + return 0; + } + result = allocate_nearest_color (cmap, visual, color); + if (!result) + { + maybe_signal_error (Qgui_error, "couldn't allocate color", + make_string (name, len), Qcolor, errb); + return 0; + } + + return result; +} + +static int +gtk_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name, + Lisp_Object device, Error_Behavior errb) +{ + GdkColor color; + int result; + + result = gtk_parse_nearest_color (XDEVICE (device), &color, + XSTRING_DATA (name), + XSTRING_LENGTH (name), + errb); + + if (!result) + return 0; + + /* Don't allocate the data until we're sure that we will succeed, + or the finalize method may get fucked. */ + c->data = xnew (struct gtk_color_instance_data); + if (result == 3) + COLOR_INSTANCE_GTK_DEALLOC (c) = 0; + else + COLOR_INSTANCE_GTK_DEALLOC (c) = 1; + COLOR_INSTANCE_GTK_COLOR (c) = gdk_color_copy (&color); + return 1; +} + +static void +gtk_print_color_instance (struct Lisp_Color_Instance *c, + Lisp_Object printcharfun, + int UNUSED (escapeflag)) +{ + GdkColor *color = COLOR_INSTANCE_GTK_COLOR (c); + write_fmt_string (printcharfun, " %ld=(%X,%X,%X)", + color->pixel, color->red, color->green, color->blue); +} + +static void +gtk_finalize_color_instance (struct Lisp_Color_Instance *c) +{ + if (c->data) + { + if (DEVICE_LIVE_P (XDEVICE (c->device))) + { + if (COLOR_INSTANCE_GTK_DEALLOC (c)) + { + gdk_colormap_free_colors (DEVICE_GTK_COLORMAP (XDEVICE (c->device)), + COLOR_INSTANCE_GTK_COLOR (c), 1); + } + gdk_color_free (COLOR_INSTANCE_GTK_COLOR (c)); + } + xfree (c->data); + c->data = 0; + } +} + +/* Color instances are equal if they resolve to the same color on the + screen (have the same RGB values). I imagine that + "same RGB values" == "same cell in the colormap." Arguably we should + be comparing their names or pixel values instead. */ + +static int +gtk_color_instance_equal (struct Lisp_Color_Instance *c1, + struct Lisp_Color_Instance *c2, + int UNUSED (depth)) +{ + return (gdk_color_equal (COLOR_INSTANCE_GTK_COLOR (c1), + COLOR_INSTANCE_GTK_COLOR (c2))); +} + +static Hashcode +gtk_color_instance_hash (struct Lisp_Color_Instance *c, int UNUSED (depth), + Boolint UNUSED (equalp)) +{ + return (gdk_color_hash (COLOR_INSTANCE_GTK_COLOR (c), NULL)); +} + +static Lisp_Object +gtk_color_instance_rgb_components (struct Lisp_Color_Instance *c) +{ + GdkColor *color = COLOR_INSTANCE_GTK_COLOR (c); + return (list3 (make_int (color->red), + make_int (color->green), + make_int (color->blue))); +} + +static int +gtk_valid_color_name_p (struct device *UNUSED (d), Lisp_Object color) +{ + GdkColor c; + const char *extname; + + extname = LISP_STRING_TO_EXTERNAL (color, Qctext); + + if (gdk_color_parse (extname, &c) != TRUE) + return(0); + return (1); +} + +static Lisp_Object +gtk_color_list (void) +{ + /* #### BILL!!! + Is this correct? */ + return call0 (intern ("x-color-list-internal")); +} + + +/************************************************************************/ +/* font instances */ +/************************************************************************/ + +static int +gtk_initialize_font_instance (struct Lisp_Font_Instance *f, + Lisp_Object UNUSED (name), + Lisp_Object UNUSED (device), Error_Behavior errb) +{ + GdkFont *gf; + XFontStruct *xf; + const char *extname; + + extname = LISP_STRING_TO_EXTERNAL (f->name, Qctext); + + gf = gdk_font_load (extname); + + if (!gf) + { + maybe_signal_error (Qgui_error, "couldn't load font", f->name, + Qfont, errb); + return 0; + } + + xf = (XFontStruct*) GDK_FONT_XFONT (gf); + + /* Don't allocate the data until we're sure that we will succeed, + or the finalize method may get fucked. */ + f->data = xnew (struct gtk_font_instance_data); + FONT_INSTANCE_GTK_FONT (f) = gf; + f->ascent = gf->ascent; + f->descent = gf->descent; + f->height = gf->ascent + gf->descent; + + /* Now lets figure out the width of the font */ + { + /* following change suggested by Ted Phelps */ + unsigned int def_char = 'n'; /*xf->default_char;*/ + unsigned int byte1, byte2; + + once_more: + byte1 = def_char >> 8; + byte2 = def_char & 0xFF; + + if (xf->per_char) + { + /* Old versions of the R5 font server have garbage (>63k) as + def_char. 'n' might not be a valid character. */ + if (byte1 < xf->min_byte1 || + byte1 > xf->max_byte1 || + byte2 < xf->min_char_or_byte2 || + byte2 > xf->max_char_or_byte2) + f->width = 0; + else + f->width = xf->per_char[(byte1 - xf->min_byte1) * + (xf->max_char_or_byte2 - + xf->min_char_or_byte2 + 1) + + (byte2 - xf->min_char_or_byte2)].width; + } + else + f->width = xf->max_bounds.width; + + /* Some fonts have a default char whose width is 0. This is no good. + If that's the case, first try 'n' as the default char, and if n has + 0 width too (unlikely) then just use the max width. */ + if (f->width == 0) + { + if (def_char == xf->default_char) + f->width = xf->max_bounds.width; + else + { + def_char = xf->default_char; + goto once_more; + } + } + } + + /* If all characters don't exist then there could potentially be + 0-width characters lurking out there. Not setting this flag + trips an optimization that would make them appear to have width + to redisplay. This is bad. So we set it if not all characters + have the same width or if not all characters are defined. + */ + /* #### This sucks. There is a measurable performance increase + when using proportional width fonts if this flag is not set. + Unfortunately so many of the fucking X fonts are not fully + defined that we could almost just get rid of this damn flag and + make it an assertion. */ + f->proportional_p = (xf->min_bounds.width != xf->max_bounds.width || + (/* x_handle_non_fully_specified_fonts */ 0 && + !xf->all_chars_exist)); +#if 0 + f->width = gdk_char_width (gf, 'n'); + f->proportional_p = (gdk_char_width (gf, '|') != gdk_char_width (gf, 'W')) ? 1 : 0; +#endif + return 1; +} + +static void +gtk_print_font_instance (struct Lisp_Font_Instance *f, + Lisp_Object printcharfun, + int UNUSED (escapeflag)) +{ + write_fmt_string (printcharfun, " 0x%lx", + (unsigned long) gdk_font_id (FONT_INSTANCE_GTK_FONT (f))); +} + +static void +gtk_finalize_font_instance (struct Lisp_Font_Instance *f) +{ + if (f->data) + { + if (DEVICE_LIVE_P (XDEVICE (f->device))) + { + gdk_font_unref (FONT_INSTANCE_GTK_FONT (f)); + } + xfree (f->data); + f->data = 0; + } +} + +/* Forward declarations for X specific functions at the end of the file */ +Lisp_Object __get_gtk_font_truename (GdkFont *gdk_font, int expandp); +static Lisp_Object __gtk_font_list_internal (const char *pattern); + +static Lisp_Object +gtk_font_instance_truename (struct Lisp_Font_Instance *f, + Error_Behavior UNUSED (errb)) +{ + if (NILP (FONT_INSTANCE_TRUENAME (f))) + { + FONT_INSTANCE_TRUENAME (f) = __get_gtk_font_truename (FONT_INSTANCE_GTK_FONT (f), 1); + + if (NILP (FONT_INSTANCE_TRUENAME (f))) + { + /* Ok, just this once, return the font name as the truename. + (This is only used by Fequal() right now.) */ + return f->name; + } + } + return (FONT_INSTANCE_TRUENAME (f)); +} + +static Lisp_Object +gtk_font_instance_properties (struct Lisp_Font_Instance *UNUSED (f)) +{ + Lisp_Object result = Qnil; + + /* #### BILL!!! */ + /* There seems to be no way to get this information under Gtk */ + return result; +} + +static Lisp_Object +gtk_font_list (Lisp_Object pattern, Lisp_Object UNUSED (device), + Lisp_Object UNUSED (maxnumber)) +{ + const char *patternext; + + patternext = LISP_STRING_TO_EXTERNAL (pattern, Qbinary); + + return (__gtk_font_list_internal (patternext)); +} + +/* Include the charset support, shared, for the moment, with X11. */ +#define THIS_IS_GTK +#include "fontcolor-xlike-inc.c" + + +/************************************************************************/ +/* initialization */ +/************************************************************************/ + +void +syms_of_fontcolor_gtk (void) +{ +} + +void +console_type_create_fontcolor_gtk (void) +{ + /* object methods */ + + CONSOLE_HAS_METHOD (gtk, initialize_color_instance); + CONSOLE_HAS_METHOD (gtk, print_color_instance); + CONSOLE_HAS_METHOD (gtk, finalize_color_instance); + CONSOLE_HAS_METHOD (gtk, color_instance_equal); + CONSOLE_HAS_METHOD (gtk, color_instance_hash); + CONSOLE_HAS_METHOD (gtk, color_instance_rgb_components); + CONSOLE_HAS_METHOD (gtk, valid_color_name_p); + CONSOLE_HAS_METHOD (gtk, color_list); + + CONSOLE_HAS_METHOD (gtk, initialize_font_instance); + CONSOLE_HAS_METHOD (gtk, print_font_instance); + CONSOLE_HAS_METHOD (gtk, finalize_font_instance); + CONSOLE_HAS_METHOD (gtk, font_instance_truename); + CONSOLE_HAS_METHOD (gtk, font_instance_properties); + CONSOLE_HAS_METHOD (gtk, font_list); +#ifdef MULE + CONSOLE_HAS_METHOD (gtk, find_charset_font); + CONSOLE_HAS_METHOD (gtk, font_spec_matches_charset); +#endif +} + +void +vars_of_fontcolor_gtk (void) +{ +#ifdef DEBUG_XEMACS + DEFVAR_INT ("debug-x-objects", &debug_x_objects /* +If non-zero, display debug information about X objects +*/ ); + debug_x_objects = 0; +#endif +} + +static int +valid_font_name_p (Display *dpy, char *name) +{ + /* Maybe this should be implemented by callign XLoadFont and trapping + the error. That would be a lot of work, and wasteful as hell, but + might be more correct. + */ + int nnames = 0; + char **names = 0; + if (! name) + return 0; + names = XListFonts (dpy, name, 1, &nnames); + if (names) + XFreeFontNames (names); + return (nnames != 0); +} + +Lisp_Object +__get_gtk_font_truename (GdkFont *gdk_font, int expandp) +{ + Display *dpy = GDK_FONT_XDISPLAY (gdk_font); + GSList *names = ((GdkFontPrivate *) gdk_font)->names; + Lisp_Object font_name = Qnil; + + while (names) + { + if (names->data) + { + if (valid_font_name_p (dpy, (char*) names->data)) + { + if (!expandp) + { + /* They want the wildcarded version */ + font_name = build_cistring ((char*) names->data); + } + else + { + /* Need to expand out */ + int nnames = 0; + char **x_font_names = 0; + + x_font_names = XListFonts (dpy, (char*) names->data, 1, &nnames); + if (x_font_names) + { + font_name = build_cistring (x_font_names[0]); + XFreeFontNames (x_font_names); + } + } + break; + } + } + names = names->next; + } + return (font_name); +} + +static Lisp_Object __gtk_font_list_internal (const char *pattern) +{ + char **names; + int count = 0; + Lisp_Object result = Qnil; + + names = XListFonts (GDK_DISPLAY (), pattern, MAX_FONT_COUNT, &count); + while (count--) + result = Fcons (build_extstring (names [count], Qbinary), result); + if (names) + XFreeFontNames (names); + + return result; +} diff -r 861f2601a38b -r 1f0b15040456 src/fontcolor-gtk.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/fontcolor-gtk.h Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,45 @@ +/* Gtk-specific Lisp objects. + Copyright (C) 1993, 1994 Free Software Foundation, Inc. + Copyright (C) 1995 Board of Trustees, University of Illinois. + Copyright (C) 1995, 1996 Ben Wing. + +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 3 of the License, 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. If not, see . */ + +/* Synched up with: Not in FSF. */ +/* Gtk version by William Perry */ + +#ifndef _XEMACS_OBJECTS_GTK_H_ +#define _XEMACS_OBJECTS_GTK_H_ + +#include "fontcolor.h" + +#ifdef HAVE_GTK + +/***************************************************************************** + Color-Instance + ****************************************************************************/ + +int allocate_nearest_color (GdkColormap *screen_colormap, GdkVisual *visual, + GdkColor *color_def); +int gtk_parse_nearest_color (struct device *d, GdkColor *color, Ibyte *name, + Bytecount len, Error_Behavior errb); + +/***************************************************************************** + Font-Instance + ****************************************************************************/ + +#endif /* HAVE_GTK */ +#endif /* _XEMACS_OBJECTS_GTK_H_ */ diff -r 861f2601a38b -r 1f0b15040456 src/fontcolor-impl.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/fontcolor-impl.h Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,191 @@ +/* Generic object functions -- header implementation. + Copyright (C) 1995 Board of Trustees, University of Illinois. + Copyright (C) 1995, 1996, 2002 Ben Wing. + Copyright (C) 2010 Didier Verna + +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 3 of the License, 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. If not, see . */ + +/* Synched up with: Not in FSF. */ + +#ifndef INCLUDED_fontcolor_impl_h_ +#define INCLUDED_fontcolor_impl_h_ + +#include "specifier.h" +#include "fontcolor.h" + +/***************************************************************************** + * Color Specifier Object * + *****************************************************************************/ + +struct color_specifier +{ + Lisp_Object face; /* face this is attached to, or nil */ + Lisp_Object face_property; /* property of that face */ +}; + +#define COLOR_SPECIFIER_DATA(g) SPECIFIER_TYPE_DATA (g, color) +#define COLOR_SPECIFIER_FACE(g) (COLOR_SPECIFIER_DATA (g)->face) +#define COLOR_SPECIFIER_FACE_PROPERTY(g) \ + (COLOR_SPECIFIER_DATA (g)->face_property) + +DECLARE_SPECIFIER_TYPE (color); +#define XCOLOR_SPECIFIER(x) XSPECIFIER_TYPE (x, color) +#define COLOR_SPECIFIERP(x) SPECIFIER_TYPEP (x, color) +#define CHECK_COLOR_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, color) +#define CONCHECK_COLOR_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, color) + +/***************************************************************************** + * Font Specifier Object * + *****************************************************************************/ + +struct font_specifier +{ + Lisp_Object face; /* face this is attached to, or nil */ + Lisp_Object face_property; /* property of that face */ +}; + +#define FONT_SPECIFIER_DATA(g) SPECIFIER_TYPE_DATA (g, font) +#define FONT_SPECIFIER_FACE(g) (FONT_SPECIFIER_DATA (g)->face) +#define FONT_SPECIFIER_FACE_PROPERTY(g) \ + (FONT_SPECIFIER_DATA (g)->face_property) + +DECLARE_SPECIFIER_TYPE (font); +#define XFONT_SPECIFIER(x) XSPECIFIER_TYPE (x, font) +#define FONT_SPECIFIERP(x) SPECIFIER_TYPEP (x, font) +#define CHECK_FONT_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, font) +#define CONCHECK_FONT_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, font) + +/***************************************************************************** + * Face Boolean Specifier Object * + *****************************************************************************/ + +struct face_boolean_specifier +{ + Lisp_Object face; /* face this is attached to, or nil */ + Lisp_Object face_property; /* property of that face */ +}; + +#define FACE_BOOLEAN_SPECIFIER_DATA(g) SPECIFIER_TYPE_DATA (g, face_boolean) +#define FACE_BOOLEAN_SPECIFIER_FACE(g) (FACE_BOOLEAN_SPECIFIER_DATA (g)->face) +#define FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY(g) \ + (FACE_BOOLEAN_SPECIFIER_DATA (g)->face_property) + +DECLARE_SPECIFIER_TYPE (face_boolean); +extern Lisp_Object Qface_boolean; +#define XFACE_BOOLEAN_SPECIFIER(x) XSPECIFIER_TYPE (x, face_boolean) +#define FACE_BOOLEAN_SPECIFIERP(x) SPECIFIER_TYPEP (x, face_boolean) +#define CHECK_FACE_BOOLEAN_SPECIFIER(x) \ + CHECK_SPECIFIER_TYPE (x, face_boolean) +#define CONCHECK_FACE_BOOLEAN_SPECIFIER(x) \ + CONCHECK_SPECIFIER_TYPE (x, face_boolean) + +/***************************************************************************** + * Background Placement Specifier Object * + *****************************************************************************/ + +struct face_background_placement_specifier +{ + Lisp_Object face; /* face this is attached to, or nil */ +}; + +#define FACE_BACKGROUND_PLACEMENT_SPECIFIER_DATA(g) \ + SPECIFIER_TYPE_DATA (g, face_background_placement) +#define FACE_BACKGROUND_PLACEMENT_SPECIFIER_FACE(g) \ + (FACE_BACKGROUND_PLACEMENT_SPECIFIER_DATA (g)->face) + +DECLARE_SPECIFIER_TYPE (face_background_placement); +extern Lisp_Object Qface_background_placement, Qabsolute, Qrelative; +#define XFACE_BACKGROUND_PLACEMENT_SPECIFIER(x) \ + XSPECIFIER_TYPE (x, face_background_placement) +#define FACE_BACKGROUND_PLACEMENT_SPECIFIERP(x) \ + SPECIFIER_TYPEP (x, face_background_placement) +#define CHECK_FACE_BACKGROUND_PLACEMENT_SPECIFIER(x) \ + CHECK_SPECIFIER_TYPE (x, face_background_placement) +#define CONCHECK_FACE_BACKGROUND_PLACEMENT_SPECIFIER(x) \ + CONCHECK_SPECIFIER_TYPE (x, face_background_placement) + +/**************************************************************************** + * Color Instance Object * + ****************************************************************************/ + +struct Lisp_Color_Instance +{ + NORMAL_LISP_OBJECT_HEADER header; + Lisp_Object name; + Lisp_Object device; + + /* See comment in struct console about console variants. */ + enum console_variant color_instance_type; + + /* console-type-specific data */ + void *data; +}; + +#define COLOR_INSTANCE_NAME(c) ((c)->name) +#define COLOR_INSTANCE_DEVICE(c) ((c)->device) + +/**************************************************************************** + * Font Instance Object * + ****************************************************************************/ + +struct Lisp_Font_Instance +{ + NORMAL_LISP_OBJECT_HEADER header; + Lisp_Object name; /* the instantiator used to create the font instance */ + Lisp_Object truename; /* used by the device-specific methods; we need to + call them to get the truename (#### in reality, + they all probably just store the truename here + if they know it, and nil otherwise; we should + check this and enforce it as a general policy + X and GTK do this, except that when they don't + know they return NAME and don't update TRUENAME. + MS Windows initializes TRUENAME when the font is + initialized. TTY doesn't do truename.) */ + Lisp_Object device; + Lisp_Object charset; /* Mule charset, or whatever */ + + /* See comment in struct console about console variants. */ + enum console_variant font_instance_type; + + unsigned short ascent; /* extracted from `font', or made up */ + unsigned short descent; + unsigned short width; + unsigned short height; + int proportional_p; + + /* console-type-specific data */ + void *data; +}; + +#define FONT_INSTANCE_NAME(f) ((f)->name) +#define FONT_INSTANCE_TRUENAME(f) ((f)->truename) +#define FONT_INSTANCE_CHARSET(f) ((f)->charset) +#define FONT_INSTANCE_DEVICE(f) ((f)->device) +#define FONT_INSTANCE_ASCENT(f) ((f)->ascent) +#define FONT_INSTANCE_DESCENT(f) ((f)->descent) +#define FONT_INSTANCE_WIDTH(f) ((f)->width) +#define FONT_INSTANCE_HEIGHT(f) ((f)->height) + +#define XFONT_INSTANCE_NAME(f) FONT_INSTANCE_NAME (XFONT_INSTANCE (f)) +#define XFONT_INSTANCE_TRUENAME(f) FONT_INSTANCE_TRUENAME (XFONT_INSTANCE (f)) +#define XFONT_INSTANCE_CHARSET(f) FONT_INSTANCE_CHARSET (XFONT_INSTANCE (f)) +#define XFONT_INSTANCE_DEVICE(f) FONT_INSTANCE_DEVICE (XFONT_INSTANCE (f)) +#define XFONT_INSTANCE_ASCENT(f) FONT_INSTANCE_ASCENT (XFONT_INSTANCE (f)) +#define XFONT_INSTANCE_DESCENT(f) FONT_INSTANCE_DESCENT (XFONT_INSTANCE (f)) +#define XFONT_INSTANCE_WIDTH(f) FONT_INSTANCE_WIDTH (XFONT_INSTANCE (f)) +#define XFONT_INSTANCE_HEIGHT(f) FONT_INSTANCE_HEIGHT (XFONT_INSTANCE (f)) + +#endif /* INCLUDED_fontcolor_impl_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/fontcolor-msw-impl.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/fontcolor-msw-impl.h Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,73 @@ +/* mswindows-specific Lisp objects -- header implementation. + Copyright (C) 1993, 1994 Free Software Foundation, Inc. + Copyright (C) 1995 Board of Trustees, University of Illinois. + Copyright (C) 1995, 1996, 2002 Ben Wing. + Copyright (C) 1997, Jonathan Harris. + +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 3 of the License, 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. If not, see . */ + +/* Synched up with: Not in FSF. */ + +/* Authorship: + + Ultimately based on FSF. + Rewritten by Ben Wing. + Rewritten for mswindows by Jonathan Harris, November 1997 for 21.0. + */ + + +#ifndef INCLUDED_fontcolor_msw_impl_h_ +#define INCLUDED_fontcolor_msw_impl_h_ + +#include "fontcolor-impl.h" +#include "fontcolor-msw.h" + +struct mswindows_color_instance_data +{ + COLORREF color; +}; + +#define MSWINDOWS_COLOR_INSTANCE_DATA(c) \ + ((struct mswindows_color_instance_data *) (c)->data) +#define COLOR_INSTANCE_MSWINDOWS_COLOR(c) \ + (MSWINDOWS_COLOR_INSTANCE_DATA (c)->color) + +/* The four HFONTS are for the 4 (underlined, strikethrough) + combinations. Only the one at index 0, neither underlined nor + struk through is created with the font instance. Other fonts are + created as necessary during redisplay, using the one at index 0 + as prototype */ +#define MSWINDOWS_NUM_FONT_VARIANTS 4 +struct mswindows_font_instance_data +{ + HFONT hfont [MSWINDOWS_NUM_FONT_VARIANTS]; +}; + +#define MSWINDOWS_FONT_INSTANCE_DATA(c) \ + ((struct mswindows_font_instance_data *) (c)->data) + +#define FONT_INSTANCE_MSWINDOWS_HFONT_I(c,i) \ + (MSWINDOWS_FONT_INSTANCE_DATA(c)->hfont[(i)]) + +#define FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT(c,under,strike) \ + FONT_INSTANCE_MSWINDOWS_HFONT_I (c, (!!(strike)<<1)|!!(under)) + +/* If font creation during redisplay fails, then the following + value is used to prevent future attempts to create this font. + Redisplay uses the "main" font when encounters this value */ +#define MSWINDOWS_BAD_HFONT ((HFONT)INVALID_HANDLE_VALUE) + +#endif /* INCLUDED_fontcolor_msw_impl_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/fontcolor-msw.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/fontcolor-msw.c Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,2365 @@ +/* mswindows-specific Lisp objects. + Copyright (C) 1993, 1994 Free Software Foundation, Inc. + Copyright (C) 1995 Board of Trustees, University of Illinois. + Copyright (C) 1995 Tinker Systems. + Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004, 2005, 2010 Ben Wing. + Copyright (C) 1995 Sun Microsystems, Inc. + Copyright (C) 1997 Jonathan Harris. + +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 3 of the License, 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. If not, see . */ + +/* Synched up with: Not in FSF. */ + +/* Authorship: + + This file created by Jonathan Harris, November 1997 for 21.0; based + heavily on fontcolor-x.c (see authorship there). Much further work + by Ben Wing. + */ + +/* This function Mule-ized by Ben Wing, 3-24-02. */ + +/* TODO: palette handling */ + +#include +#include "lisp.h" + +#include "console-msw-impl.h" +#include "fontcolor-msw-impl.h" + +#include "buffer.h" +#include "charset.h" +#include "device-impl.h" +#include "elhash.h" +#include "insdel.h" +#include "opaque.h" + +typedef struct colormap_t +{ + const Ascbyte *name; + COLORREF colorref; +} colormap_t; + +/* Colors from X11R6 "XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp" */ +/* MSWindows tends to round up the numbers in its palette, ie where X uses + * 127, MSWindows uses 128. Colors commented as "Adjusted" are tweaked to + * match the Windows standard palette to increase the likelihood of + * mswindows_color_to_string() finding a named match. + +Sorted case-insensitively by the string name of the color. + + */ +static const colormap_t mswindows_X_color_map[] = +{ + {"AliceBlue" , PALETTERGB (240, 248, 255) }, + {"AntiqueWhite" , PALETTERGB (250, 235, 215) }, + {"AntiqueWhite1" , PALETTERGB (255, 239, 219) }, + {"AntiqueWhite2" , PALETTERGB (238, 223, 204) }, + {"AntiqueWhite3" , PALETTERGB (205, 192, 176) }, + {"AntiqueWhite4" , PALETTERGB (139, 131, 120) }, + {"aquamarine" , PALETTERGB (127, 255, 212) }, + {"aquamarine1" , PALETTERGB (127, 255, 212) }, + {"aquamarine2" , PALETTERGB (118, 238, 198) }, + {"aquamarine3" , PALETTERGB (102, 205, 170) }, + {"aquamarine4" , PALETTERGB (69, 139, 116) }, + {"azure" , PALETTERGB (240, 255, 255) }, + {"azure1" , PALETTERGB (240, 255, 255) }, + {"azure2" , PALETTERGB (224, 238, 238) }, + {"azure3" , PALETTERGB (193, 205, 205) }, + {"azure4" , PALETTERGB (131, 139, 139) }, + {"beige" , PALETTERGB (245, 245, 220) }, + {"bisque" , PALETTERGB (255, 228, 196) }, + {"bisque1" , PALETTERGB (255, 228, 196) }, + {"bisque2" , PALETTERGB (238, 213, 183) }, + {"bisque3" , PALETTERGB (205, 183, 158) }, + {"bisque4" , PALETTERGB (139, 125, 107) }, + {"black" , PALETTERGB (0, 0, 0) }, + {"BlanchedAlmond" , PALETTERGB (255, 235, 205) }, + {"blue" , PALETTERGB (0, 0, 255) }, + {"blue1" , PALETTERGB (0, 0, 255) }, + {"blue2" , PALETTERGB (0, 0, 238) }, + {"blue3" , PALETTERGB (0, 0, 205) }, + {"blue4" , PALETTERGB (0, 0, 139) }, + {"BlueViolet" , PALETTERGB (138, 43, 226) }, + {"brown" , PALETTERGB (165, 42, 42) }, + {"brown1" , PALETTERGB (255, 64, 64) }, + {"brown2" , PALETTERGB (238, 59, 59) }, + {"brown3" , PALETTERGB (205, 51, 51) }, + {"brown4" , PALETTERGB (139, 35, 35) }, + {"burlywood" , PALETTERGB (222, 184, 135) }, + {"burlywood1" , PALETTERGB (255, 211, 155) }, + {"burlywood2" , PALETTERGB (238, 197, 145) }, + {"burlywood3" , PALETTERGB (205, 170, 125) }, + {"burlywood4" , PALETTERGB (139, 115, 85) }, + {"CadetBlue" , PALETTERGB (95, 158, 160) }, + {"CadetBlue1" , PALETTERGB (152, 245, 255) }, + {"CadetBlue2" , PALETTERGB (144, 220, 240) }, /* Adjusted */ + {"CadetBlue3" , PALETTERGB (122, 197, 205) }, + {"CadetBlue4" , PALETTERGB (83, 134, 139) }, + {"chartreuse" , PALETTERGB (127, 255, 0) }, + {"chartreuse1" , PALETTERGB (127, 255, 0) }, + {"chartreuse2" , PALETTERGB (118, 238, 0) }, + {"chartreuse3" , PALETTERGB (102, 205, 0) }, + {"chartreuse4" , PALETTERGB (69, 139, 0) }, + {"chocolate" , PALETTERGB (210, 105, 30) }, + {"chocolate1" , PALETTERGB (255, 127, 36) }, + {"chocolate2" , PALETTERGB (238, 118, 33) }, + {"chocolate3" , PALETTERGB (205, 102, 29) }, + {"chocolate4" , PALETTERGB (139, 69, 19) }, + {"coral" , PALETTERGB (255, 127, 80) }, + {"coral1" , PALETTERGB (255, 114, 86) }, + {"coral2" , PALETTERGB (238, 106, 80) }, + {"coral3" , PALETTERGB (205, 91, 69) }, + {"coral4" , PALETTERGB (139, 62, 47) }, + {"CornflowerBlue" , PALETTERGB (100, 149, 237) }, + {"cornsilk" , PALETTERGB (255, 248, 220) }, + {"cornsilk1" , PALETTERGB (255, 248, 220) }, + {"cornsilk2" , PALETTERGB (238, 232, 205) }, + {"cornsilk3" , PALETTERGB (205, 200, 177) }, + {"cornsilk4" , PALETTERGB (139, 136, 120) }, + {"cyan" , PALETTERGB (0, 255, 255) }, + {"cyan1" , PALETTERGB (0, 255, 255) }, + {"cyan2" , PALETTERGB (0, 238, 238) }, + {"cyan3" , PALETTERGB (0, 205, 205) }, + {"cyan4" , PALETTERGB (0, 139, 139) }, + {"DarkBlue" , PALETTERGB (0, 0, 128) }, /* Adjusted == Navy */ + {"DarkCyan" , PALETTERGB (0, 128, 128) }, /* Adjusted */ + {"DarkGoldenrod" , PALETTERGB (184, 134, 11) }, + {"DarkGoldenrod1" , PALETTERGB (255, 185, 15) }, + {"DarkGoldenrod2" , PALETTERGB (238, 173, 14) }, + {"DarkGoldenrod3" , PALETTERGB (205, 149, 12) }, + {"DarkGoldenrod4" , PALETTERGB (139, 101, 8) }, + {"DarkGray" , PALETTERGB (169, 169, 169) }, + {"DarkGreen" , PALETTERGB (0, 128, 0) }, /* Adjusted */ + {"DarkGrey" , PALETTERGB (169, 169, 169) }, + {"DarkKhaki" , PALETTERGB (189, 183, 107) }, + {"DarkMagenta" , PALETTERGB (128, 0, 128) }, /* Adjusted */ + {"DarkOliveGreen" , PALETTERGB (85, 107, 47) }, + {"DarkOliveGreen1" , PALETTERGB (202, 255, 112) }, + {"DarkOliveGreen2" , PALETTERGB (188, 238, 104) }, + {"DarkOliveGreen3" , PALETTERGB (162, 205, 90) }, + {"DarkOliveGreen4" , PALETTERGB (110, 139, 61) }, + {"DarkOrange" , PALETTERGB (255, 140, 0) }, + {"DarkOrange1" , PALETTERGB (255, 127, 0) }, + {"DarkOrange2" , PALETTERGB (238, 118, 0) }, + {"DarkOrange3" , PALETTERGB (205, 102, 0) }, + {"DarkOrange4" , PALETTERGB (139, 69, 0) }, + {"DarkOrchid" , PALETTERGB (153, 50, 204) }, + {"DarkOrchid1" , PALETTERGB (191, 62, 255) }, + {"DarkOrchid2" , PALETTERGB (178, 58, 238) }, + {"DarkOrchid3" , PALETTERGB (154, 50, 205) }, + {"DarkOrchid4" , PALETTERGB (104, 34, 139) }, + {"DarkRed" , PALETTERGB (128, 0, 0) }, /* Adjusted */ + {"DarkSalmon" , PALETTERGB (233, 150, 122) }, + {"DarkSeaGreen" , PALETTERGB (143, 188, 143) }, + {"DarkSeaGreen1" , PALETTERGB (193, 255, 193) }, + {"DarkSeaGreen2" , PALETTERGB (180, 238, 180) }, + {"DarkSeaGreen3" , PALETTERGB (155, 205, 155) }, + {"DarkSeaGreen4" , PALETTERGB (105, 139, 105) }, + {"DarkSlateBlue" , PALETTERGB (72, 61, 139) }, + {"DarkSlateGray" , PALETTERGB (47, 79, 79) }, + {"DarkSlateGray1" , PALETTERGB (151, 255, 255) }, + {"DarkSlateGray2" , PALETTERGB (141, 238, 238) }, + {"DarkSlateGray3" , PALETTERGB (121, 205, 205) }, + {"DarkSlateGray4" , PALETTERGB (82, 139, 139) }, + {"DarkSlateGrey" , PALETTERGB (47, 79, 79) }, + {"DarkTurquoise" , PALETTERGB (0, 206, 209) }, + {"DarkViolet" , PALETTERGB (148, 0, 211) }, + {"DarkYellow" , PALETTERGB (128, 128, 0) }, + {"DeepPink" , PALETTERGB (255, 20, 147) }, + {"DeepPink1" , PALETTERGB (255, 20, 147) }, + {"DeepPink2" , PALETTERGB (238, 18, 137) }, + {"DeepPink3" , PALETTERGB (205, 16, 118) }, + {"DeepPink4" , PALETTERGB (139, 10, 80) }, + {"DeepSkyBlue" , PALETTERGB (0, 191, 255) }, + {"DeepSkyBlue1" , PALETTERGB (0, 191, 255) }, + {"DeepSkyBlue2" , PALETTERGB (0, 178, 238) }, + {"DeepSkyBlue3" , PALETTERGB (0, 154, 205) }, + {"DeepSkyBlue4" , PALETTERGB (0, 104, 139) }, + {"DimGray" , PALETTERGB (105, 105, 105) }, + {"DimGrey" , PALETTERGB (105, 105, 105) }, + {"DodgerBlue" , PALETTERGB (30, 144, 255) }, + {"DodgerBlue1" , PALETTERGB (30, 144, 255) }, + {"DodgerBlue2" , PALETTERGB (28, 134, 238) }, + {"DodgerBlue3" , PALETTERGB (24, 116, 205) }, + {"DodgerBlue4" , PALETTERGB (16, 78, 139) }, + {"firebrick" , PALETTERGB (178, 34, 34) }, + {"firebrick1" , PALETTERGB (255, 48, 48) }, + {"firebrick2" , PALETTERGB (238, 44, 44) }, + {"firebrick3" , PALETTERGB (205, 38, 38) }, + {"firebrick4" , PALETTERGB (139, 26, 26) }, + {"FloralWhite" , PALETTERGB (255, 250, 240) }, + {"ForestGreen" , PALETTERGB (34, 139, 34) }, + {"gainsboro" , PALETTERGB (220, 220, 220) }, + {"GhostWhite" , PALETTERGB (248, 248, 255) }, + {"gold" , PALETTERGB (255, 215, 0) }, + {"gold1" , PALETTERGB (255, 215, 0) }, + {"gold2" , PALETTERGB (238, 201, 0) }, + {"gold3" , PALETTERGB (205, 173, 0) }, + {"gold4" , PALETTERGB (139, 117, 0) }, + {"goldenrod" , PALETTERGB (218, 165, 32) }, + {"goldenrod1" , PALETTERGB (255, 193, 37) }, + {"goldenrod2" , PALETTERGB (238, 180, 34) }, + {"goldenrod3" , PALETTERGB (205, 155, 29) }, + {"goldenrod4" , PALETTERGB (139, 105, 20) }, + {"gray" , PALETTERGB (190, 190, 190) }, + {"gray0" , PALETTERGB (0, 0, 0) }, + {"gray1" , PALETTERGB (3, 3, 3) }, + {"gray10" , PALETTERGB (26, 26, 26) }, + {"gray100" , PALETTERGB (255, 255, 255) }, + {"gray11" , PALETTERGB (28, 28, 28) }, + {"gray12" , PALETTERGB (31, 31, 31) }, + {"gray13" , PALETTERGB (33, 33, 33) }, + {"gray14" , PALETTERGB (36, 36, 36) }, + {"gray15" , PALETTERGB (38, 38, 38) }, + {"gray16" , PALETTERGB (41, 41, 41) }, + {"gray17" , PALETTERGB (43, 43, 43) }, + {"gray18" , PALETTERGB (46, 46, 46) }, + {"gray19" , PALETTERGB (48, 48, 48) }, + {"gray2" , PALETTERGB (5, 5, 5) }, + {"gray20" , PALETTERGB (51, 51, 51) }, + {"gray21" , PALETTERGB (54, 54, 54) }, + {"gray22" , PALETTERGB (56, 56, 56) }, + {"gray23" , PALETTERGB (59, 59, 59) }, + {"gray24" , PALETTERGB (61, 61, 61) }, + {"gray25" , PALETTERGB (64, 64, 64) }, + {"gray26" , PALETTERGB (66, 66, 66) }, + {"gray27" , PALETTERGB (69, 69, 69) }, + {"gray28" , PALETTERGB (71, 71, 71) }, + {"gray29" , PALETTERGB (74, 74, 74) }, + {"gray3" , PALETTERGB (8, 8, 8) }, + {"gray30" , PALETTERGB (77, 77, 77) }, + {"gray31" , PALETTERGB (79, 79, 79) }, + {"gray32" , PALETTERGB (82, 82, 82) }, + {"gray33" , PALETTERGB (84, 84, 84) }, + {"gray34" , PALETTERGB (87, 87, 87) }, + {"gray35" , PALETTERGB (89, 89, 89) }, + {"gray36" , PALETTERGB (92, 92, 92) }, + {"gray37" , PALETTERGB (94, 94, 94) }, + {"gray38" , PALETTERGB (97, 97, 97) }, + {"gray39" , PALETTERGB (99, 99, 99) }, + {"gray4" , PALETTERGB (10, 10, 10) }, + {"gray40" , PALETTERGB (102, 102, 102) }, + {"gray41" , PALETTERGB (105, 105, 105) }, + {"gray42" , PALETTERGB (107, 107, 107) }, + {"gray43" , PALETTERGB (110, 110, 110) }, + {"gray44" , PALETTERGB (112, 112, 112) }, + {"gray45" , PALETTERGB (115, 115, 115) }, + {"gray46" , PALETTERGB (117, 117, 117) }, + {"gray47" , PALETTERGB (120, 120, 120) }, + {"gray48" , PALETTERGB (122, 122, 122) }, + {"gray49" , PALETTERGB (125, 125, 125) }, + {"gray5" , PALETTERGB (13, 13, 13) }, + {"gray50" , PALETTERGB (128, 128, 128) }, /* Adjusted */ + {"gray51" , PALETTERGB (130, 130, 130) }, + {"gray52" , PALETTERGB (133, 133, 133) }, + {"gray53" , PALETTERGB (135, 135, 135) }, + {"gray54" , PALETTERGB (138, 138, 138) }, + {"gray55" , PALETTERGB (140, 140, 140) }, + {"gray56" , PALETTERGB (143, 143, 143) }, + {"gray57" , PALETTERGB (145, 145, 145) }, + {"gray58" , PALETTERGB (148, 148, 148) }, + {"gray59" , PALETTERGB (150, 150, 150) }, + {"gray6" , PALETTERGB (15, 15, 15) }, + {"gray60" , PALETTERGB (153, 153, 153) }, + {"gray61" , PALETTERGB (156, 156, 156) }, + {"gray62" , PALETTERGB (158, 158, 158) }, + {"gray63" , PALETTERGB (161, 161, 161) }, + {"gray64" , PALETTERGB (163, 163, 163) }, + {"gray65" , PALETTERGB (166, 166, 166) }, + {"gray66" , PALETTERGB (168, 168, 168) }, + {"gray67" , PALETTERGB (171, 171, 171) }, + {"gray68" , PALETTERGB (173, 173, 173) }, + {"gray69" , PALETTERGB (176, 176, 176) }, + {"gray7" , PALETTERGB (18, 18, 18) }, + {"gray70" , PALETTERGB (179, 179, 179) }, + {"gray71" , PALETTERGB (181, 181, 181) }, + {"gray72" , PALETTERGB (184, 184, 184) }, + {"gray73" , PALETTERGB (186, 186, 186) }, + {"gray74" , PALETTERGB (189, 189, 189) }, + {"gray75" , PALETTERGB (192, 192, 192) }, /* Adjusted */ + {"gray76" , PALETTERGB (194, 194, 194) }, + {"gray77" , PALETTERGB (196, 196, 196) }, + {"gray78" , PALETTERGB (199, 199, 199) }, + {"gray79" , PALETTERGB (201, 201, 201) }, + {"gray8" , PALETTERGB (20, 20, 20) }, + {"gray80" , PALETTERGB (204, 204, 204) }, + {"gray81" , PALETTERGB (207, 207, 207) }, + {"gray82" , PALETTERGB (209, 209, 209) }, + {"gray83" , PALETTERGB (212, 212, 212) }, + {"gray84" , PALETTERGB (214, 214, 214) }, + {"gray85" , PALETTERGB (217, 217, 217) }, + {"gray86" , PALETTERGB (219, 219, 219) }, + {"gray87" , PALETTERGB (222, 222, 222) }, + {"gray88" , PALETTERGB (224, 224, 224) }, + {"gray89" , PALETTERGB (227, 227, 227) }, + {"gray9" , PALETTERGB (23, 23, 23) }, + {"gray90" , PALETTERGB (229, 229, 229) }, + {"gray91" , PALETTERGB (232, 232, 232) }, + {"gray92" , PALETTERGB (235, 235, 235) }, + {"gray93" , PALETTERGB (237, 237, 237) }, + {"gray94" , PALETTERGB (240, 240, 240) }, + {"gray95" , PALETTERGB (242, 242, 242) }, + {"gray96" , PALETTERGB (245, 245, 245) }, + {"gray97" , PALETTERGB (247, 247, 247) }, + {"gray98" , PALETTERGB (250, 250, 250) }, + {"gray99" , PALETTERGB (252, 252, 252) }, + {"green" , PALETTERGB (0, 255, 0) }, + {"green1" , PALETTERGB (0, 255, 0) }, + {"green2" , PALETTERGB (0, 238, 0) }, + {"green3" , PALETTERGB (0, 205, 0) }, + {"green4" , PALETTERGB (0, 139, 0) }, + {"GreenYellow" , PALETTERGB (173, 255, 47) }, + {"grey" , PALETTERGB (190, 190, 190) }, + {"grey0" , PALETTERGB (0, 0, 0) }, + {"grey1" , PALETTERGB (3, 3, 3) }, + {"grey10" , PALETTERGB (26, 26, 26) }, + {"grey100" , PALETTERGB (255, 255, 255) }, + {"grey11" , PALETTERGB (28, 28, 28) }, + {"grey12" , PALETTERGB (31, 31, 31) }, + {"grey13" , PALETTERGB (33, 33, 33) }, + {"grey14" , PALETTERGB (36, 36, 36) }, + {"grey15" , PALETTERGB (38, 38, 38) }, + {"grey16" , PALETTERGB (41, 41, 41) }, + {"grey17" , PALETTERGB (43, 43, 43) }, + {"grey18" , PALETTERGB (46, 46, 46) }, + {"grey19" , PALETTERGB (48, 48, 48) }, + {"grey2" , PALETTERGB (5, 5, 5) }, + {"grey20" , PALETTERGB (51, 51, 51) }, + {"grey21" , PALETTERGB (54, 54, 54) }, + {"grey22" , PALETTERGB (56, 56, 56) }, + {"grey23" , PALETTERGB (59, 59, 59) }, + {"grey24" , PALETTERGB (61, 61, 61) }, + {"grey25" , PALETTERGB (64, 64, 64) }, + {"grey26" , PALETTERGB (66, 66, 66) }, + {"grey27" , PALETTERGB (69, 69, 69) }, + {"grey28" , PALETTERGB (71, 71, 71) }, + {"grey29" , PALETTERGB (74, 74, 74) }, + {"grey3" , PALETTERGB (8, 8, 8) }, + {"grey30" , PALETTERGB (77, 77, 77) }, + {"grey31" , PALETTERGB (79, 79, 79) }, + {"grey32" , PALETTERGB (82, 82, 82) }, + {"grey33" , PALETTERGB (84, 84, 84) }, + {"grey34" , PALETTERGB (87, 87, 87) }, + {"grey35" , PALETTERGB (89, 89, 89) }, + {"grey36" , PALETTERGB (92, 92, 92) }, + {"grey37" , PALETTERGB (94, 94, 94) }, + {"grey38" , PALETTERGB (97, 97, 97) }, + {"grey39" , PALETTERGB (99, 99, 99) }, + {"grey4" , PALETTERGB (10, 10, 10) }, + {"grey40" , PALETTERGB (102, 102, 102) }, + {"grey41" , PALETTERGB (105, 105, 105) }, + {"grey42" , PALETTERGB (107, 107, 107) }, + {"grey43" , PALETTERGB (110, 110, 110) }, + {"grey44" , PALETTERGB (112, 112, 112) }, + {"grey45" , PALETTERGB (115, 115, 115) }, + {"grey46" , PALETTERGB (117, 117, 117) }, + {"grey47" , PALETTERGB (120, 120, 120) }, + {"grey48" , PALETTERGB (122, 122, 122) }, + {"grey49" , PALETTERGB (125, 125, 125) }, + {"grey5" , PALETTERGB (13, 13, 13) }, + {"grey50" , PALETTERGB (128, 128, 128) }, /* Adjusted */ + {"grey51" , PALETTERGB (130, 130, 130) }, + {"grey52" , PALETTERGB (133, 133, 133) }, + {"grey53" , PALETTERGB (135, 135, 135) }, + {"grey54" , PALETTERGB (138, 138, 138) }, + {"grey55" , PALETTERGB (140, 140, 140) }, + {"grey56" , PALETTERGB (143, 143, 143) }, + {"grey57" , PALETTERGB (145, 145, 145) }, + {"grey58" , PALETTERGB (148, 148, 148) }, + {"grey59" , PALETTERGB (150, 150, 150) }, + {"grey6" , PALETTERGB (15, 15, 15) }, + {"grey60" , PALETTERGB (153, 153, 153) }, + {"grey61" , PALETTERGB (156, 156, 156) }, + {"grey62" , PALETTERGB (158, 158, 158) }, + {"grey63" , PALETTERGB (161, 161, 161) }, + {"grey64" , PALETTERGB (163, 163, 163) }, + {"grey65" , PALETTERGB (166, 166, 166) }, + {"grey66" , PALETTERGB (168, 168, 168) }, + {"grey67" , PALETTERGB (171, 171, 171) }, + {"grey68" , PALETTERGB (173, 173, 173) }, + {"grey69" , PALETTERGB (176, 176, 176) }, + {"grey7" , PALETTERGB (18, 18, 18) }, + {"grey70" , PALETTERGB (179, 179, 179) }, + {"grey71" , PALETTERGB (181, 181, 181) }, + {"grey72" , PALETTERGB (184, 184, 184) }, + {"grey73" , PALETTERGB (186, 186, 186) }, + {"grey74" , PALETTERGB (189, 189, 189) }, + {"grey75" , PALETTERGB (192, 192, 192) }, /* Adjusted */ + {"grey76" , PALETTERGB (194, 194, 194) }, + {"grey77" , PALETTERGB (196, 196, 196) }, + {"grey78" , PALETTERGB (199, 199, 199) }, + {"grey79" , PALETTERGB (201, 201, 201) }, + {"grey8" , PALETTERGB (20, 20, 20) }, + {"grey80" , PALETTERGB (204, 204, 204) }, + {"grey81" , PALETTERGB (207, 207, 207) }, + {"grey82" , PALETTERGB (209, 209, 209) }, + {"grey83" , PALETTERGB (212, 212, 212) }, + {"grey84" , PALETTERGB (214, 214, 214) }, + {"grey85" , PALETTERGB (217, 217, 217) }, + {"grey86" , PALETTERGB (219, 219, 219) }, + {"grey87" , PALETTERGB (222, 222, 222) }, + {"grey88" , PALETTERGB (224, 224, 224) }, + {"grey89" , PALETTERGB (227, 227, 227) }, + {"grey9" , PALETTERGB (23, 23, 23) }, + {"grey90" , PALETTERGB (229, 229, 229) }, + {"grey91" , PALETTERGB (232, 232, 232) }, + {"grey92" , PALETTERGB (235, 235, 235) }, + {"grey93" , PALETTERGB (237, 237, 237) }, + {"grey94" , PALETTERGB (240, 240, 240) }, + {"grey95" , PALETTERGB (242, 242, 242) }, + {"grey96" , PALETTERGB (245, 245, 245) }, + {"grey97" , PALETTERGB (247, 247, 247) }, + {"grey98" , PALETTERGB (250, 250, 250) }, + {"grey99" , PALETTERGB (252, 252, 252) }, + {"honeydew" , PALETTERGB (240, 255, 240) }, + {"honeydew1" , PALETTERGB (240, 255, 240) }, + {"honeydew2" , PALETTERGB (224, 238, 224) }, + {"honeydew3" , PALETTERGB (193, 205, 193) }, + {"honeydew4" , PALETTERGB (131, 139, 131) }, + {"HotPink" , PALETTERGB (255, 105, 180) }, + {"HotPink1" , PALETTERGB (255, 110, 180) }, + {"HotPink2" , PALETTERGB (238, 106, 167) }, + {"HotPink3" , PALETTERGB (205, 96, 144) }, + {"HotPink4" , PALETTERGB (139, 58, 98) }, + {"IndianRed" , PALETTERGB (205, 92, 92) }, + {"IndianRed1" , PALETTERGB (255, 106, 106) }, + {"IndianRed2" , PALETTERGB (238, 99, 99) }, + {"IndianRed3" , PALETTERGB (205, 85, 85) }, + {"IndianRed4" , PALETTERGB (139, 58, 58) }, + {"ivory" , PALETTERGB (255, 255, 240) }, + {"ivory1" , PALETTERGB (255, 255, 240) }, + {"ivory2" , PALETTERGB (240, 240, 208) }, /* Adjusted */ + {"ivory3" , PALETTERGB (205, 205, 193) }, + {"ivory4" , PALETTERGB (139, 139, 131) }, + {"khaki" , PALETTERGB (240, 230, 140) }, + {"khaki1" , PALETTERGB (255, 246, 143) }, + {"khaki2" , PALETTERGB (238, 230, 133) }, + {"khaki3" , PALETTERGB (205, 198, 115) }, + {"khaki4" , PALETTERGB (139, 134, 78) }, + {"lavender" , PALETTERGB (230, 230, 250) }, + {"LavenderBlush" , PALETTERGB (255, 240, 245) }, + {"LavenderBlush1" , PALETTERGB (255, 240, 245) }, + {"LavenderBlush2" , PALETTERGB (238, 224, 229) }, + {"LavenderBlush3" , PALETTERGB (205, 193, 197) }, + {"LavenderBlush4" , PALETTERGB (139, 131, 134) }, + {"LawnGreen" , PALETTERGB (124, 252, 0) }, + {"LemonChiffon" , PALETTERGB (255, 250, 205) }, + {"LemonChiffon1" , PALETTERGB (255, 250, 205) }, + {"LemonChiffon2" , PALETTERGB (238, 233, 191) }, + {"LemonChiffon3" , PALETTERGB (205, 201, 165) }, + {"LemonChiffon4" , PALETTERGB (139, 137, 112) }, + {"LightBlue" , PALETTERGB (173, 216, 230) }, + {"LightBlue1" , PALETTERGB (191, 239, 255) }, + {"LightBlue2" , PALETTERGB (178, 223, 238) }, + {"LightBlue3" , PALETTERGB (154, 192, 205) }, + {"LightBlue4" , PALETTERGB (104, 131, 139) }, + {"LightCoral" , PALETTERGB (240, 128, 128) }, + {"LightCyan" , PALETTERGB (224, 255, 255) }, + {"LightCyan1" , PALETTERGB (224, 255, 255) }, + {"LightCyan2" , PALETTERGB (209, 238, 238) }, + {"LightCyan3" , PALETTERGB (180, 205, 205) }, + {"LightCyan4" , PALETTERGB (122, 139, 139) }, + {"LightGoldenrod" , PALETTERGB (238, 221, 130) }, + {"LightGoldenrod1" , PALETTERGB (255, 236, 139) }, + {"LightGoldenrod2" , PALETTERGB (238, 220, 130) }, + {"LightGoldenrod3" , PALETTERGB (205, 190, 112) }, + {"LightGoldenrod4" , PALETTERGB (139, 129, 76) }, + {"LightGoldenrodYellow", PALETTERGB (250, 250, 210) }, + {"LightGray" , PALETTERGB (211, 211, 211) }, + {"LightGreen" , PALETTERGB (144, 238, 144) }, + {"LightGrey" , PALETTERGB (211, 211, 211) }, + {"LightPink" , PALETTERGB (255, 182, 193) }, + {"LightPink1" , PALETTERGB (255, 174, 185) }, + {"LightPink2" , PALETTERGB (238, 162, 173) }, + {"LightPink3" , PALETTERGB (205, 140, 149) }, + {"LightPink4" , PALETTERGB (139, 95, 101) }, + {"LightSalmon" , PALETTERGB (255, 160, 122) }, + {"LightSalmon1" , PALETTERGB (255, 160, 122) }, + {"LightSalmon2" , PALETTERGB (238, 149, 114) }, + {"LightSalmon3" , PALETTERGB (205, 129, 98) }, + {"LightSalmon4" , PALETTERGB (139, 87, 66) }, + {"LightSeaGreen" , PALETTERGB (32, 178, 170) }, + {"LightSkyBlue" , PALETTERGB (135, 206, 250) }, + {"LightSkyBlue1" , PALETTERGB (176, 226, 255) }, + {"LightSkyBlue2" , PALETTERGB (164, 211, 238) }, + {"LightSkyBlue3" , PALETTERGB (141, 182, 205) }, + {"LightSkyBlue4" , PALETTERGB (96, 123, 139) }, + {"LightSlateBlue" , PALETTERGB (132, 112, 255) }, + {"LightSlateGray" , PALETTERGB (119, 136, 153) }, + {"LightSlateGrey" , PALETTERGB (119, 136, 153) }, + {"LightSteelBlue" , PALETTERGB (176, 196, 222) }, + {"LightSteelBlue1" , PALETTERGB (202, 225, 255) }, + {"LightSteelBlue2" , PALETTERGB (188, 210, 238) }, + {"LightSteelBlue3" , PALETTERGB (162, 181, 205) }, + {"LightSteelBlue4" , PALETTERGB (110, 123, 139) }, + {"LightYellow" , PALETTERGB (255, 255, 224) }, + {"LightYellow" , PALETTERGB (255, 255, 225) }, /* Adjusted */ + {"LightYellow1" , PALETTERGB (255, 255, 224) }, + {"LightYellow2" , PALETTERGB (238, 238, 209) }, + {"LightYellow3" , PALETTERGB (205, 205, 180) }, + {"LightYellow4" , PALETTERGB (139, 139, 122) }, + {"LimeGreen" , PALETTERGB (50, 205, 50) }, + {"linen" , PALETTERGB (250, 240, 230) }, + {"magenta" , PALETTERGB (255, 0, 255) }, + {"magenta1" , PALETTERGB (255, 0, 255) }, + {"magenta2" , PALETTERGB (238, 0, 238) }, + {"magenta3" , PALETTERGB (205, 0, 205) }, + {"magenta4" , PALETTERGB (139, 0, 139) }, + {"maroon" , PALETTERGB (176, 48, 96) }, + {"maroon1" , PALETTERGB (255, 52, 179) }, + {"maroon2" , PALETTERGB (238, 48, 167) }, + {"maroon3" , PALETTERGB (205, 41, 144) }, + {"maroon4" , PALETTERGB (139, 28, 98) }, + {"MediumAquamarine" , PALETTERGB (102, 205, 170) }, + {"MediumBlue" , PALETTERGB (0, 0, 205) }, + {"MediumOrchid" , PALETTERGB (186, 85, 211) }, + {"MediumOrchid1" , PALETTERGB (224, 102, 255) }, + {"MediumOrchid2" , PALETTERGB (209, 95, 238) }, + {"MediumOrchid3" , PALETTERGB (180, 82, 205) }, + {"MediumOrchid4" , PALETTERGB (122, 55, 139) }, + {"MediumPurple" , PALETTERGB (147, 112, 219) }, + {"MediumPurple1" , PALETTERGB (171, 130, 255) }, + {"MediumPurple2" , PALETTERGB (159, 121, 238) }, + {"MediumPurple3" , PALETTERGB (137, 104, 205) }, + {"MediumPurple4" , PALETTERGB (93, 71, 139) }, + {"MediumSeaGreen" , PALETTERGB (60, 179, 113) }, + {"MediumSlateBlue" , PALETTERGB (123, 104, 238) }, + {"MediumSpringGreen" , PALETTERGB (0, 250, 154) }, + {"MediumTurquoise" , PALETTERGB (72, 209, 204) }, + {"MediumVioletRed" , PALETTERGB (199, 21, 133) }, + {"MidnightBlue" , PALETTERGB (25, 25, 112) }, + {"MintCream" , PALETTERGB (245, 255, 250) }, + {"MistyRose" , PALETTERGB (255, 228, 225) }, + {"MistyRose1" , PALETTERGB (255, 228, 225) }, + {"MistyRose2" , PALETTERGB (238, 213, 210) }, + {"MistyRose3" , PALETTERGB (205, 183, 181) }, + {"MistyRose4" , PALETTERGB (139, 125, 123) }, + {"moccasin" , PALETTERGB (255, 228, 181) }, + {"NavajoWhite" , PALETTERGB (255, 222, 173) }, + {"NavajoWhite1" , PALETTERGB (255, 222, 173) }, + {"NavajoWhite2" , PALETTERGB (238, 207, 161) }, + {"NavajoWhite3" , PALETTERGB (205, 179, 139) }, + {"NavajoWhite4" , PALETTERGB (139, 121, 94) }, + {"navy" , PALETTERGB (0, 0, 128) }, + {"NavyBlue" , PALETTERGB (0, 0, 128) }, + {"OldLace" , PALETTERGB (253, 245, 230) }, + {"OliveDrab" , PALETTERGB (107, 142, 35) }, + {"OliveDrab1" , PALETTERGB (192, 255, 62) }, + {"OliveDrab2" , PALETTERGB (179, 238, 58) }, + {"OliveDrab3" , PALETTERGB (154, 205, 50) }, + {"OliveDrab4" , PALETTERGB (105, 139, 34) }, + {"orange" , PALETTERGB (255, 165, 0) }, + {"orange1" , PALETTERGB (255, 165, 0) }, + {"orange2" , PALETTERGB (238, 154, 0) }, + {"orange3" , PALETTERGB (205, 133, 0) }, + {"orange4" , PALETTERGB (139, 90, 0) }, + {"OrangeRed" , PALETTERGB (255, 69, 0) }, + {"OrangeRed1" , PALETTERGB (255, 69, 0) }, + {"OrangeRed2" , PALETTERGB (238, 64, 0) }, + {"OrangeRed3" , PALETTERGB (205, 55, 0) }, + {"OrangeRed4" , PALETTERGB (139, 37, 0) }, + {"orchid" , PALETTERGB (218, 112, 214) }, + {"orchid1" , PALETTERGB (255, 131, 250) }, + {"orchid2" , PALETTERGB (238, 122, 233) }, + {"orchid3" , PALETTERGB (205, 105, 201) }, + {"orchid4" , PALETTERGB (139, 71, 137) }, + {"PaleGoldenrod" , PALETTERGB (238, 232, 170) }, + {"PaleGreen" , PALETTERGB (152, 251, 152) }, + {"PaleGreen1" , PALETTERGB (154, 255, 154) }, + {"PaleGreen2" , PALETTERGB (144, 238, 144) }, + {"PaleGreen3" , PALETTERGB (124, 205, 124) }, + {"PaleGreen4" , PALETTERGB (84, 139, 84) }, + {"PaleTurquoise" , PALETTERGB (175, 238, 238) }, + {"PaleTurquoise1" , PALETTERGB (187, 255, 255) }, + {"PaleTurquoise2" , PALETTERGB (174, 238, 238) }, + {"PaleTurquoise3" , PALETTERGB (150, 205, 205) }, + {"PaleTurquoise4" , PALETTERGB (102, 139, 139) }, + {"PaleVioletRed" , PALETTERGB (219, 112, 147) }, + {"PaleVioletRed1" , PALETTERGB (255, 130, 171) }, + {"PaleVioletRed2" , PALETTERGB (238, 121, 159) }, + {"PaleVioletRed3" , PALETTERGB (205, 104, 137) }, + {"PaleVioletRed4" , PALETTERGB (139, 71, 93) }, + {"PaleYellow" , PALETTERGB (255, 255, 128) }, + {"PapayaWhip" , PALETTERGB (255, 239, 213) }, + {"PeachPuff" , PALETTERGB (255, 218, 185) }, + {"PeachPuff1" , PALETTERGB (255, 218, 185) }, + {"PeachPuff2" , PALETTERGB (238, 203, 173) }, + {"PeachPuff3" , PALETTERGB (205, 175, 149) }, + {"PeachPuff4" , PALETTERGB (139, 119, 101) }, + {"peru" , PALETTERGB (205, 133, 63) }, + {"pink" , PALETTERGB (255, 192, 203) }, + {"pink1" , PALETTERGB (255, 181, 197) }, + {"pink2" , PALETTERGB (238, 169, 184) }, + {"pink3" , PALETTERGB (205, 145, 158) }, + {"pink4" , PALETTERGB (139, 99, 108) }, + {"plum" , PALETTERGB (221, 160, 221) }, + {"plum1" , PALETTERGB (255, 187, 255) }, + {"plum2" , PALETTERGB (238, 174, 238) }, + {"plum3" , PALETTERGB (205, 150, 205) }, + {"plum4" , PALETTERGB (139, 102, 139) }, + {"PowderBlue" , PALETTERGB (176, 224, 230) }, + {"purple" , PALETTERGB (160, 32, 240) }, + {"purple1" , PALETTERGB (155, 48, 255) }, + {"purple2" , PALETTERGB (145, 44, 238) }, + {"purple3" , PALETTERGB (125, 38, 205) }, + {"purple4" , PALETTERGB (85, 26, 139) }, + {"red" , PALETTERGB (255, 0, 0) }, + {"red1" , PALETTERGB (255, 0, 0) }, + {"red2" , PALETTERGB (238, 0, 0) }, + {"red3" , PALETTERGB (205, 0, 0) }, + {"red4" , PALETTERGB (139, 0, 0) }, + {"RosyBrown" , PALETTERGB (188, 143, 143) }, + {"RosyBrown1" , PALETTERGB (255, 193, 193) }, + {"RosyBrown2" , PALETTERGB (238, 180, 180) }, + {"RosyBrown3" , PALETTERGB (205, 155, 155) }, + {"RosyBrown4" , PALETTERGB (139, 105, 105) }, + {"RoyalBlue" , PALETTERGB (65, 105, 225) }, + {"RoyalBlue1" , PALETTERGB (72, 118, 255) }, + {"RoyalBlue2" , PALETTERGB (67, 110, 238) }, + {"RoyalBlue3" , PALETTERGB (58, 95, 205) }, + {"RoyalBlue4" , PALETTERGB (39, 64, 139) }, + {"SaddleBrown" , PALETTERGB (139, 69, 19) }, + {"salmon" , PALETTERGB (250, 128, 114) }, + {"salmon1" , PALETTERGB (255, 140, 105) }, + {"salmon2" , PALETTERGB (238, 130, 98) }, + {"salmon3" , PALETTERGB (205, 112, 84) }, + {"salmon4" , PALETTERGB (139, 76, 57) }, + {"SandyBrown" , PALETTERGB (244, 164, 96) }, + {"SeaGreen" , PALETTERGB (46, 139, 87) }, + {"SeaGreen1" , PALETTERGB (84, 255, 159) }, + {"SeaGreen2" , PALETTERGB (78, 238, 148) }, + {"SeaGreen3" , PALETTERGB (67, 205, 128) }, + {"SeaGreen4" , PALETTERGB (46, 139, 87) }, + {"seashell" , PALETTERGB (255, 245, 238) }, + {"seashell1" , PALETTERGB (255, 245, 238) }, + {"seashell2" , PALETTERGB (238, 229, 222) }, + {"seashell3" , PALETTERGB (205, 197, 191) }, + {"seashell4" , PALETTERGB (139, 134, 130) }, + {"sienna" , PALETTERGB (160, 82, 45) }, + {"sienna1" , PALETTERGB (255, 130, 71) }, + {"sienna2" , PALETTERGB (238, 121, 66) }, + {"sienna3" , PALETTERGB (205, 104, 57) }, + {"sienna4" , PALETTERGB (139, 71, 38) }, + {"SkyBlue" , PALETTERGB (135, 206, 235) }, + {"SkyBlue1" , PALETTERGB (135, 206, 255) }, + {"SkyBlue2" , PALETTERGB (126, 192, 238) }, + {"SkyBlue3" , PALETTERGB (108, 166, 205) }, + {"SkyBlue4" , PALETTERGB (74, 112, 139) }, + {"SlateBlue" , PALETTERGB (106, 90, 205) }, + {"SlateBlue1" , PALETTERGB (131, 111, 255) }, + {"SlateBlue2" , PALETTERGB (122, 103, 238) }, + {"SlateBlue3" , PALETTERGB (105, 89, 205) }, + {"SlateBlue4" , PALETTERGB (71, 60, 139) }, + {"SlateGray" , PALETTERGB (112, 128, 144) }, + {"SlateGray1" , PALETTERGB (198, 226, 255) }, + {"SlateGray2" , PALETTERGB (185, 211, 238) }, + {"SlateGray3" , PALETTERGB (159, 182, 205) }, + {"SlateGray4" , PALETTERGB (108, 123, 139) }, + {"SlateGrey" , PALETTERGB (112, 128, 144) }, + {"snow" , PALETTERGB (255, 250, 250) }, + {"snow1" , PALETTERGB (255, 250, 250) }, + {"snow2" , PALETTERGB (238, 233, 233) }, + {"snow3" , PALETTERGB (205, 201, 201) }, + {"snow4" , PALETTERGB (139, 137, 137) }, + {"SpringGreen" , PALETTERGB (0, 255, 127) }, + {"SpringGreen1" , PALETTERGB (0, 255, 127) }, + {"SpringGreen2" , PALETTERGB (0, 238, 118) }, + {"SpringGreen3" , PALETTERGB (0, 205, 102) }, + {"SpringGreen4" , PALETTERGB (0, 139, 69) }, + {"SteelBlue" , PALETTERGB (70, 130, 180) }, + {"SteelBlue1" , PALETTERGB (99, 184, 255) }, + {"SteelBlue2" , PALETTERGB (92, 172, 238) }, + {"SteelBlue3" , PALETTERGB (79, 148, 205) }, + {"SteelBlue4" , PALETTERGB (54, 100, 139) }, + {"tan" , PALETTERGB (210, 180, 140) }, + {"tan1" , PALETTERGB (255, 165, 79) }, + {"tan2" , PALETTERGB (238, 154, 73) }, + {"tan3" , PALETTERGB (205, 133, 63) }, + {"tan4" , PALETTERGB (139, 90, 43) }, + {"thistle" , PALETTERGB (216, 191, 216) }, + {"thistle1" , PALETTERGB (255, 225, 255) }, + {"thistle2" , PALETTERGB (238, 210, 238) }, + {"thistle3" , PALETTERGB (205, 181, 205) }, + {"thistle4" , PALETTERGB (139, 123, 139) }, + {"tomato" , PALETTERGB (255, 99, 71) }, + {"tomato1" , PALETTERGB (255, 99, 71) }, + {"tomato2" , PALETTERGB (238, 92, 66) }, + {"tomato3" , PALETTERGB (205, 79, 57) }, + {"tomato4" , PALETTERGB (139, 54, 38) }, + {"turquoise" , PALETTERGB (64, 224, 208) }, + {"turquoise1" , PALETTERGB (0, 245, 255) }, + {"turquoise2" , PALETTERGB (0, 229, 238) }, + {"turquoise3" , PALETTERGB (0, 197, 205) }, + {"turquoise4" , PALETTERGB (0, 134, 139) }, + {"violet" , PALETTERGB (238, 130, 238) }, + {"VioletRed" , PALETTERGB (208, 32, 144) }, + {"VioletRed1" , PALETTERGB (255, 62, 150) }, + {"VioletRed2" , PALETTERGB (238, 58, 140) }, + {"VioletRed3" , PALETTERGB (205, 50, 120) }, + {"VioletRed4" , PALETTERGB (139, 34, 82) }, + {"wheat" , PALETTERGB (245, 222, 179) }, + {"wheat1" , PALETTERGB (255, 231, 186) }, + {"wheat2" , PALETTERGB (238, 216, 174) }, + {"wheat3" , PALETTERGB (205, 186, 150) }, + {"wheat4" , PALETTERGB (139, 126, 102) }, + {"white" , PALETTERGB (255, 255, 255) }, + {"WhiteSmoke" , PALETTERGB (245, 245, 245) }, + {"yellow" , PALETTERGB (255, 255, 0) }, + {"yellow1" , PALETTERGB (255, 255, 0) }, + {"yellow2" , PALETTERGB (238, 238, 0) }, + {"yellow3" , PALETTERGB (205, 205, 0) }, + {"yellow4" , PALETTERGB (139, 139, 0) }, + {"YellowGreen" , PALETTERGB (154, 205, 50) } +}; + + +typedef struct fontmap_t +{ + const Ascbyte *name; + int value; +} fontmap_t; + +/* Default weight first, preferred names listed before synonyms */ +static const fontmap_t fontweight_map[] = +{ + {"Regular" , FW_REGULAR}, /* The standard font weight */ + {"Thin" , FW_THIN}, + {"Extra Light" , FW_EXTRALIGHT}, + {"Ultra Light" , FW_ULTRALIGHT}, + {"Light" , FW_LIGHT}, + {"Normal" , FW_NORMAL}, + {"Medium" , FW_MEDIUM}, + {"Semi Bold" , FW_SEMIBOLD}, + {"Demi Bold" , FW_DEMIBOLD}, + {"Bold" , FW_BOLD}, /* The standard bold font weight */ + {"Extra Bold" , FW_EXTRABOLD}, + {"Ultra Bold" , FW_ULTRABOLD}, + {"Heavy" , FW_HEAVY}, + {"Black" , FW_BLACK} +}; + +/* Default charset must be listed first, no synonyms allowed because these + * names are matched against the names reported by win32 by match_font() */ +static const fontmap_t charset_map[] = +{ + {"Western" , ANSI_CHARSET}, /* Latin 1 */ + {"Central European" , EASTEUROPE_CHARSET}, + {"Cyrillic" , RUSSIAN_CHARSET}, + {"Greek" , GREEK_CHARSET}, + {"Turkish" , TURKISH_CHARSET}, + {"Hebrew" , HEBREW_CHARSET}, + {"Arabic" , ARABIC_CHARSET}, + {"Baltic" , BALTIC_CHARSET}, + {"Viet Nam" , VIETNAMESE_CHARSET}, + {"Thai" , THAI_CHARSET}, + {"Japanese" , SHIFTJIS_CHARSET}, + {"Korean" , HANGEUL_CHARSET}, + {"Simplified Chinese" , GB2312_CHARSET}, + {"Traditional Chinese", CHINESEBIG5_CHARSET}, + + {"Symbol" , SYMBOL_CHARSET}, + {"Mac" , MAC_CHARSET}, + {"Korean Johab" , JOHAB_CHARSET}, + {"OEM/DOS" , OEM_CHARSET} +}; + +#ifdef MULE + +typedef struct unicode_subrange_raw_t +{ + int subrange_bit; + int start; /* first Unicode codepoint */ + int end; /* last Unicode codepoint */ +} unicode_subrange_raw_t; + +/* This table comes from MSDN, Unicode Subset Bitfields [Platform SDK + Documentation, Base Services, International Features, Unicode and + Character Sets, Unicode and Character Set Reference, Unicode and + Character Set Constants]. We preprocess it at startup time into an + array of unicode_subrange_t. + */ + +static const unicode_subrange_raw_t unicode_subrange_raw_map[] = +{ + {0, 0x0020, 0x007e}, /* Basic Latin */ + {1, 0x00a0, 0x00ff}, /* Latin-1 Supplement */ + {2, 0x0100, 0x017f}, /* Latin Extended-A */ + {3, 0x0180, 0x024f}, /* Latin Extended-B */ + {4, 0x0250, 0x02af}, /* IPA Extensions */ + {5, 0x02b0, 0x02ff}, /* Spacing Modifier Letters */ + {6, 0x0300, 0x036f}, /* Combining Diacritical Marks */ + {7, 0x0370, 0x03ff}, /* Basic Greek */ + /* 8 Reserved */ + {9, 0x0400, 0x04ff}, /* Cyrillic */ + {10, 0x0530, 0x058f}, /* Armenian */ + {11, 0x0590, 0x05ff}, /* Basic Hebrew */ + /* 12 Reserved */ + {13, 0x0600, 0x06ff}, /* Basic Arabic */ + /* 14 Reserved */ + {15, 0x0900, 0x097f}, /* Devanagari */ + {16, 0x0980, 0x09ff}, /* Bengali */ + {17, 0x0a00, 0x0a7f}, /* Gurmukhi */ + {18, 0x0a80, 0x0aff}, /* Gujarati */ + {19, 0x0b00, 0x0b7f}, /* Oriya */ + {20, 0x0b80, 0x0bff}, /* Tamil */ + {21, 0x0c00, 0x0c7f}, /* Telugu */ + {22, 0x0c80, 0x0cff}, /* Kannada */ + {23, 0x0d00, 0x0d7f}, /* Malayalam */ + {24, 0x0e00, 0x0e7f}, /* Thai */ + {25, 0x0e80, 0x0eff}, /* Lao */ + {26, 0x10a0, 0x10ff}, /* Basic Georgian */ + /* 27 Reserved */ + {28, 0x1100, 0x11ff}, /* Hangul Jamo */ + {29, 0x1e00, 0x1eff}, /* Latin Extended Additional */ + {30, 0x1f00, 0x1fff}, /* Greek Extended */ + {31, 0x2000, 0x206f}, /* General Punctuation */ + {32, 0x2070, 0x209f}, /* Subscripts and Superscripts */ + {33, 0x20a0, 0x20cf}, /* Currency Symbols */ + {34, 0x20d0, 0x20ff}, /* Combining Diacritical Marks for Symbols */ + {35, 0x2100, 0x214f}, /* Letter-like Symbols */ + {36, 0x2150, 0x218f}, /* Number Forms */ + {37, 0x2190, 0x21ff}, /* Arrows */ + {38, 0x2200, 0x22ff}, /* Mathematical Operators */ + {39, 0x2300, 0x23ff}, /* Miscellaneous Technical */ + {40, 0x2400, 0x243f}, /* Control Pictures */ + {41, 0x2440, 0x245f}, /* Optical Character Recognition */ + {42, 0x2460, 0x24ff}, /* Enclosed Alphanumerics */ + {43, 0x2500, 0x257f}, /* Box Drawing */ + {44, 0x2580, 0x259f}, /* Block Elements */ + {45, 0x25a0, 0x25ff}, /* Geometric Shapes */ + {46, 0x2600, 0x26ff}, /* Miscellaneous Symbols */ + {47, 0x2700, 0x27bf}, /* Dingbats */ + {48, 0x3000, 0x303f}, /* Chinese, Japanese, and Korean (CJK) Symbols and Punctuation */ + {49, 0x3040, 0x309f}, /* Hiragana */ + {50, 0x30a0, 0x30ff}, /* Katakana */ + {51, 0x3100, 0x312f}, /* Bopomofo */ + {51, 0x31a0, 0x31bf}, /* Extended Bopomofo */ + {52, 0x3130, 0x318f}, /* Hangul Compatibility Jamo */ + {53, 0x3190, 0x319f}, /* CJK Miscellaneous */ + {54, 0x3200, 0x32ff}, /* Enclosed CJK Letters and Months */ + {55, 0x3300, 0x33ff}, /* CJK Compatibility */ + {56, 0xac00, 0xd7a3}, /* Hangul */ + {57, 0xd800, 0xdfff}, /* Surrogates. Note that setting this bit implies that there is at least one codepoint beyond the Basic Multilingual Plane that is supported by this font. */ + /* 58 Reserved */ + {59, 0x4e00, 0x9fff}, /* CJK Unified Ideographs */ + {59, 0x2e80, 0x2eff}, /* CJK Radicals Supplement */ + {59, 0x2f00, 0x2fdf}, /* Kangxi Radicals */ + {59, 0x2ff0, 0x2fff}, /* Ideographic Description */ + {59, 0x3400, 0x4dbf}, /* CJK Unified Ideograph Extension A */ + {60, 0xe000, 0xf8ff}, /* Private Use Area */ + {61, 0xf900, 0xfaff}, /* CJK Compatibility Ideographs */ + {62, 0xfb00, 0xfb4f}, /* Alphabetic Presentation Forms */ + {63, 0xfb50, 0xfdff}, /* Arabic Presentation Forms-A */ + {64, 0xfe20, 0xfe2f}, /* Combining Half Marks */ + {65, 0xfe30, 0xfe4f}, /* CJK Compatibility Forms */ + {66, 0xfe50, 0xfe6f}, /* Small Form Variants */ + {67, 0xfe70, 0xfefe}, /* Arabic Presentation Forms-B */ + {68, 0xff00, 0xffef}, /* Halfwidth and Fullwidth Forms */ + {69, 0xfff0, 0xfffd}, /* Specials */ + {70, 0x0f00, 0x0fcf}, /* Tibetan */ + {71, 0x0700, 0x074f}, /* Syriac */ + {72, 0x0780, 0x07bf}, /* Thaana */ + {73, 0x0d80, 0x0dff}, /* Sinhala */ + {74, 0x1000, 0x109f}, /* Myanmar */ + {75, 0x1200, 0x12bf}, /* Ethiopic */ + {76, 0x13a0, 0x13ff}, /* Cherokee */ + {77, 0x1400, 0x14df}, /* Canadian Aboriginal Syllabics */ + {78, 0x1680, 0x169f}, /* Ogham */ + {79, 0x16a0, 0x16ff}, /* Runic */ + {80, 0x1780, 0x17ff}, /* Khmer */ + {81, 0x1800, 0x18af}, /* Mongolian */ + {82, 0x2800, 0x28ff}, /* Braille */ + {83, 0xa000, 0xa48c}, /* Yi, Yi Radicals */ + /* 84-122 Reserved */ + /* 123 Windows 2000/XP: Layout progress: horizontal from right to left */ + /* 124 Windows 2000/XP: Layout progress: vertical before horizontal */ + /* 125 Windows 2000/XP: Layout progress: vertical bottom to top */ + /* 126 Reserved; must be 0 */ + /* 127 Reserved; must be 1 */ +}; + +typedef struct unicode_subrange_t +{ + int no_subranges; + const unicode_subrange_raw_t *subranges; +} unicode_subrange_t; + +unicode_subrange_t *unicode_subrange_table; + +/* Hash table mapping font specs (strings) to font signature data + (FONTSIGNATURE structures stored in opaques), as determined by + GetTextCharsetInfo(). I presume this is somewhat expensive because it + involves creating a font object. At the very least, with no hashing, it + definitely took awhile (a few seconds) when encountering characters from + charsets needing stage 2 processing. */ +Lisp_Object Vfont_signature_data; + +#endif /* MULE */ + + +/************************************************************************/ +/* helpers */ +/************************************************************************/ + +static int +hexval (Ibyte c) +{ + /* assumes ASCII and isxdigit (c) */ + if (c >= 'a') + return c - 'a' + 10; + else if (c >= 'A') + return c - 'A' + 10; + else + return c - '0'; +} + +static int +colormap_t_compare (const void *a, const void *b) +{ + return ascii_strcasecmp (((colormap_t *)a)->name, + ((colormap_t *)b)->name); +} + +COLORREF +mswindows_string_to_color (const Ibyte *name) +{ + int i; + + if (*name == '#') + { + /* numeric names look like "#RRGGBB", "#RRRGGGBBB" or "#RRRRGGGGBBBB" + or "rgb:rrrr/gggg/bbbb" */ + unsigned int r, g, b; + + for (i = 1; i < qxestrlen (name); i++) + { + if (!byte_ascii_p (name[i]) || !isxdigit ((int) name[i])) + return (COLORREF) -1; + } + if (qxestrlen (name) == 7) + { + r = hexval (name[1]) * 16 + hexval (name[2]); + g = hexval (name[3]) * 16 + hexval (name[4]); + b = hexval (name[5]) * 16 + hexval (name[6]); + return (PALETTERGB (r, g, b)); + } + else if (qxestrlen (name) == 10) + { + r = hexval (name[1]) * 16 + hexval (name[2]); + g = hexval (name[4]) * 16 + hexval (name[5]); + b = hexval (name[7]) * 16 + hexval (name[8]); + return (PALETTERGB (r, g, b)); + } + else if (qxestrlen (name) == 13) + { + r = hexval (name[1]) * 16 + hexval (name[2]); + g = hexval (name[5]) * 16 + hexval (name[6]); + b = hexval (name[9]) * 16 + hexval (name[10]); + return (PALETTERGB (r, g, b)); + } + } + else if (!qxestrncmp_ascii (name, "rgb:", 4)) + { + unsigned int r, g, b; + + if (sscanf ((CIbyte *) name, "rgb:%04x/%04x/%04x", &r, &g, &b) == 3) + { + int len = qxestrlen (name); + if (len == 18) + { + r /= 257; + g /= 257; + b /= 257; + } + else if (len == 15) + { + r /= 17; + g /= 17; + b /= 17; + } + return (PALETTERGB (r, g, b)); + } + else + return (COLORREF) -1; + } + else if (*name) /* Can't be an empty string */ + { + colormap_t key = { alloca_ascbytes (qxestrlen (name) + 1), + PALETTERGB (255, 255, 255) }, *res; + Ascbyte *c = (Ascbyte *)(key.name); + + while (*name) + { + if (*name != ' ') + { + if (!byte_ascii_p (*name)) + { + return (COLORREF) -1; + } + + *c++ = *name++; + } + else + { + name++; + } + } + *c = '\0'; + + if ((res = (colormap_t *) bsearch (&key, mswindows_X_color_map, + countof (mswindows_X_color_map), + sizeof (mswindows_X_color_map[0]), + colormap_t_compare)) != NULL) + { + return res->colorref; + } + } + return (COLORREF) -1; +} + +Lisp_Object +mswindows_color_to_string (COLORREF color) +{ + int i; + Ascbyte buf[8]; + COLORREF pcolor = PALETTERGB (GetRValue (color), GetGValue (color), + GetBValue (color)); + + for (i = 0; i < countof (mswindows_X_color_map); i++) + if (pcolor == (mswindows_X_color_map[i].colorref)) + return build_ascstring (mswindows_X_color_map[i].name); + + sprintf (buf, "#%02X%02X%02X", + GetRValue (color), GetGValue (color), GetBValue (color)); + return build_ascstring (buf); +} + +/* + * Returns non-zero if the two supplied font patterns match. + * If they match and fontname is not NULL, copies the logical OR of the + * patterns to fontname (which is assumed to be at least MSW_FONTSIZE in size). + * + * The patterns 'match' iff for each field that is not blank in either pattern, + * the corresponding field in the other pattern is either identical or blank. + */ +static int +match_font (Ibyte *pattern1, Ibyte *pattern2, + Ibyte *fontname) +{ + Ibyte *c1 = pattern1, *c2 = pattern2, *e1 = 0, *e2 = 0; + int i; + + if (fontname) + fontname[0] = '\0'; + + for (i = 0; i < 5; i++) + { + if (c1 && (e1 = qxestrchr (c1, ':'))) + *(e1) = '\0'; + if (c2 && (e2 = qxestrchr (c2, ':'))) + *(e2) = '\0'; + + if (c1 && c1[0] != '\0') + { + if (c2 && c2[0] != '\0' && qxestrcasecmp (c1, c2)) + { + if (e1) *e1 = ':'; + if (e2) *e2 = ':'; + return 0; + } + else if (fontname) + qxestrcat_ascii (qxestrcat (fontname, c1), ":"); + } + else if (fontname) + { + if (c2 && c2[0] != '\0') + qxestrcat_ascii (qxestrcat (fontname, c2), ":"); + else + qxestrcat_ascii (fontname, ":"); + } + + if (e1) *(e1++) = ':'; + if (e2) *(e2++) = ':'; + c1 = e1; + c2 = e2; + } + + if (fontname) + fontname[qxestrlen (fontname) - 1] = '\0'; /* Trim trailing ':' */ + return 1; +} + + +/************************************************************************/ +/* exports */ +/************************************************************************/ + +struct font_enum_t +{ + HDC hdc; + Lisp_Object list; +}; + +static int CALLBACK +font_enum_callback_2 (ENUMLOGFONTEXW *lpelfe, NEWTEXTMETRICEXW *lpntme, + int FontType, struct font_enum_t *font_enum) +{ + Ibyte fontname[MSW_FONTSIZE * 2 * MAX_ICHAR_LEN]; /* should be enough :)*/ + Lisp_Object fontname_lispstr; + int i; + Ibyte *facename; + + /* + * The enumerated font weights are not to be trusted because: + * a) lpelfe->elfStyle is only filled in for TrueType fonts. + * b) Not all Bold and Italic styles of all fonts (including some Vector, + * Truetype and Raster fonts) are enumerated. + * I guess that fonts for which Bold and Italic styles are generated + * 'on-the-fly' are not enumerated. It would be overly restrictive to + * disallow Bold And Italic weights for these fonts, so we just leave + * weights unspecified. This means that we have to weed out duplicates of + * those fonts that do get enumerated with different weights. + */ + facename = TSTR_TO_ITEXT (lpelfe->elfLogFont.lfFaceName); + if (itext_ichar (facename) == '@') + /* This is a font for writing vertically. We ignore it. */ + return 1; + + if (FontType == 0 /*vector*/ || FontType & TRUETYPE_FONTTYPE) + /* Scalable, so leave pointsize blank */ + qxesprintf (fontname, "%s::::", facename); + else + /* Formula for pointsize->height from LOGFONT docs in Platform SDK */ + qxesprintf (fontname, "%s::%d::", facename, + MulDiv (lpntme->ntmTm.tmHeight - + lpntme->ntmTm.tmInternalLeading, + 72, GetDeviceCaps (font_enum->hdc, LOGPIXELSY))); + + /* + * The enumerated font character set strings are not to be trusted because + * lpelfe->elfScript is returned in the host language and not in English. + * We can't know a priori the translations of "Western", "Central European" + * etc into the host language, so we must use English. The same argument + * applies to the font weight string when matching fonts. + */ + for (i = 0; i < countof (charset_map); i++) + if (lpelfe->elfLogFont.lfCharSet == charset_map[i].value) + { + qxestrcat_ascii (fontname, charset_map[i].name); + break; + } + if (i == countof (charset_map)) + return 1; + + /* Add the font name to the list if not already there */ + fontname_lispstr = build_istring (fontname); + if (NILP (Fassoc (fontname_lispstr, font_enum->list))) + font_enum->list = + Fcons (Fcons (fontname_lispstr, + /* TMPF_FIXED_PITCH is backwards from what you expect! + If set, it means NOT fixed pitch. */ + (lpntme->ntmTm.tmPitchAndFamily & TMPF_FIXED_PITCH) ? + Qnil : Qt), + font_enum->list); + + return 1; +} + +static int CALLBACK +font_enum_callback_1 (ENUMLOGFONTEXW *lpelfe, + NEWTEXTMETRICEXW *UNUSED (lpntme), + int UNUSED (FontType), struct font_enum_t *font_enum) +{ + /* This function gets called once per facename per character set. + * We call a second callback to enumerate the fonts in each facename */ + return qxeEnumFontFamiliesEx (font_enum->hdc, &lpelfe->elfLogFont, + (FONTENUMPROCW) font_enum_callback_2, + (LPARAM) font_enum, 0); +} + +/* Function for sorting lists of fonts as obtained from + mswindows_enumerate_fonts(). These come in a known format: + "family::::charset" for TrueType fonts, "family::size::charset" + otherwise. */ + +static Boolint +sort_font_list_function (Lisp_Object UNUSED (pred), Lisp_Object UNUSED (key), + Lisp_Object obj1, Lisp_Object obj2) +{ + Ibyte *font1, *font2; + Ibyte *c1, *c2; + int t1, t2; + + /* + 1. fixed over proportional. + 2. Western over other charsets. + 3. TrueType over non-TrueType. + 4. Within non-TrueType, sizes closer to 10pt over sizes farther from 10pt. + 5. Courier New over other families. + */ + + /* The sort function should return non-zero if OBJ1 < OBJ2, zero + otherwise. */ + + t1 = !NILP (XCDR (obj1)); + t2 = !NILP (XCDR (obj2)); + + if (t1 && !t2) + return 1; + if (t2 && !t1) + return 0; + + font1 = XSTRING_DATA (XCAR (obj1)); + font2 = XSTRING_DATA (XCAR (obj2)); + + c1 = qxestrrchr (font1, ':'); + c2 = qxestrrchr (font2, ':'); + + t1 = !qxestrcasecmp_ascii (c1 + 1, "western"); + t2 = !qxestrcasecmp_ascii (c2 + 1, "western"); + + if (t1 && !t2) + return 1; + if (t2 && !t1) + return 0; + + c1 -= 2; + c2 -= 2; + t1 = *c1 == ':'; + t2 = *c2 == ':'; + + if (t1 && !t2) + return 1; + if (t2 && !t1) + return 0; + + if (!t1 && !t2) + { + while (isdigit (*c1)) + c1--; + while (isdigit (*c2)) + c2--; + + t1 = qxeatoi (c1 + 1) - 10; + t2 = qxeatoi (c2 + 1) - 10; + + if (abs (t1) < abs (t2)) + return 1; + else if (abs (t2) < abs (t1)) + return 0; + else if (t1 < t2) + /* Prefer a smaller font over a larger one just as far away + because the smaller one won't upset the total line height if it's + just a few chars. */ + return 1; + } + + t1 = !qxestrncasecmp_ascii (font1, "courier new:", 12); + t2 = !qxestrncasecmp_ascii (font2, "courier new:", 12); + + if (t1 && !t2) + return 1; + if (t2 && !t1) + return 0; + + return 0; +} + +/* + * Enumerate the available on the HDC fonts and return a list of string + * font names. + */ +Lisp_Object +mswindows_enumerate_fonts (HDC hdc) +{ + /* This cannot GC */ + LOGFONTW logfont; + struct font_enum_t font_enum; + + assert (hdc != NULL); + logfont.lfCharSet = DEFAULT_CHARSET; + logfont.lfFaceName[0] = '\0'; + logfont.lfPitchAndFamily = DEFAULT_PITCH; + font_enum.hdc = hdc; + font_enum.list = Qnil; + /* EnumFontFamilies seems to enumerate only one charset per font, which + is not what we want. We aren't supporting NT 3.5x, so no need to + worry about this not existing. */ + qxeEnumFontFamiliesEx (hdc, &logfont, (FONTENUMPROCW) font_enum_callback_1, + (LPARAM) (&font_enum), 0); + + return list_sort (font_enum.list, sort_font_list_function, Qnil, Qidentity); +} + +static HFONT +mswindows_create_font_variant (Lisp_Font_Instance *f, + int under, int strike) +{ + /* Cannot GC */ + LOGFONTW lf; + HFONT hfont; + + assert (FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, under, strike) == NULL); + + if (qxeGetObject (FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, 0, 0), + sizeof (lf), (void *) &lf) == 0) + { + hfont = MSWINDOWS_BAD_HFONT; + } + else + { + lf.lfUnderline = under; + lf.lfStrikeOut = strike; + + hfont = qxeCreateFontIndirect (&lf); + if (hfont == NULL) + hfont = MSWINDOWS_BAD_HFONT; + } + + FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, under, strike) = hfont; + return hfont; +} + +HFONT +mswindows_get_hfont (Lisp_Font_Instance *f, + int under, int strike) +{ + /* Cannot GC */ + HFONT hfont = FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, under, strike); + + if (hfont == NULL) + hfont = mswindows_create_font_variant (f, under, strike); + + /* If strikeout/underline variant of the font could not be + created, then use the base version of the font */ + if (hfont == MSWINDOWS_BAD_HFONT) + hfont = FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, 0, 0); + + assert (hfont != NULL && hfont != MSWINDOWS_BAD_HFONT); + + return hfont; +} + +/************************************************************************/ +/* methods */ +/************************************************************************/ + +static int +mswindows_initialize_color_instance (Lisp_Color_Instance *c, Lisp_Object name, + Lisp_Object UNUSED (device), + Error_Behavior errb) +{ + COLORREF color; + + color = mswindows_string_to_color (XSTRING_DATA (name)); + if (color != (COLORREF) -1) + { + c->data = xnew (struct mswindows_color_instance_data); + COLOR_INSTANCE_MSWINDOWS_COLOR (c) = color; + return 1; + } + maybe_signal_error (Qinvalid_constant, + "Unrecognized color", name, Qcolor, errb); + return(0); +} + +#if 0 +static void +mswindows_mark_color_instance (Lisp_Color_Instance *c) +{ +} +#endif + +static void +mswindows_print_color_instance (Lisp_Color_Instance *c, + Lisp_Object printcharfun, + int UNUSED (escapeflag)) +{ + COLORREF color = COLOR_INSTANCE_MSWINDOWS_COLOR (c); + write_fmt_string (printcharfun, + " %06ld=(%04X,%04X,%04X)", color & 0xffffff, + GetRValue (color) * 257, GetGValue (color) * 257, + GetBValue (color) * 257); +} + +static void +mswindows_finalize_color_instance (Lisp_Color_Instance *c) +{ + if (c->data) + { + xfree (c->data); + c->data = 0; + } +} + +static int +mswindows_color_instance_equal (Lisp_Color_Instance *c1, + Lisp_Color_Instance *c2, + int UNUSED (depth)) +{ + return (COLOR_INSTANCE_MSWINDOWS_COLOR (c1) == + COLOR_INSTANCE_MSWINDOWS_COLOR (c2)); +} + +static Hashcode +mswindows_color_instance_hash (Lisp_Color_Instance *c, int UNUSED (depth)) +{ + return (unsigned long) COLOR_INSTANCE_MSWINDOWS_COLOR (c); +} + +static Lisp_Object +mswindows_color_instance_rgb_components (Lisp_Color_Instance *c) +{ + COLORREF color = COLOR_INSTANCE_MSWINDOWS_COLOR (c); + return list3 (make_int (GetRValue (color) * 257), + make_int (GetGValue (color) * 257), + make_int (GetBValue (color) * 257)); +} + +static int +mswindows_valid_color_name_p (struct device *UNUSED (d), Lisp_Object color) +{ + return (mswindows_string_to_color (XSTRING_DATA (color)) != (COLORREF) -1); +} + + + +static void +mswindows_finalize_font_instance (Lisp_Font_Instance *f); + +/* Parse the font spec in NAMESTR. Maybe issue errors, according to ERRB; + NAME_FOR_ERRORS is the Lisp string to use when issuing errors. Store + the five parts of the font spec into the given strings, which should be + declared as + + Ibyte fontname[LF_FACESIZE], weight[LF_FACESIZE], points[8]; + Ibyte effects[LF_FACESIZE], charset[LF_FACESIZE]; + + If LOGFONT is given, store the necessary information in LOGFONT to + create a font object. If LOGFONT is given, HDC must also be given; + else, NULL can be given for both. + + Return 1 if ok, 0 if error. + */ +static int +parse_font_spec (const Ibyte *namestr, + HDC hdc, + Lisp_Object name_for_errors, + Error_Behavior errb, + LOGFONTW *logfont, + Ibyte *fontname, + Ibyte *weight, + Ibyte *points, + Ibyte *effects, + Ibyte *charset) +{ + int fields, i; + int pt; + Ibyte *style; + Ibyte *c; + + /* + * mswindows fonts look like: + * fontname[:[weight ][style][:pointsize[:effects]]][:charset] + * The font name field shouldn't be empty. + * + * ie: + * Lucida Console:Regular:10 + * minimal: + * Courier New + * maximal: + * Courier New:Bold Italic:10:underline strikeout:western + */ + + fontname[0] = 0; + weight[0] = 0; + points[0] = 0; + effects[0] = 0; + charset[0] = 0; + + if (logfont) + xzero (*logfont); + + fields = sscanf ((CIbyte *) namestr, "%31[^:]:%31[^:]:%7[^:]:%31[^:]:%31s", + fontname, weight, points, effects, charset); + + /* This function is implemented in a fairly ad-hoc manner. + * The general idea is to validate and canonicalize each of the above fields + * at the same time as we build up the win32 LOGFONT structure. This enables + * us to use match_font() on a canonicalized font string to check the + * availability of the requested font */ + + if (fields < 0) + { + maybe_signal_error (Qinvalid_argument, "Invalid font", name_for_errors, + Qfont, errb); + return 0; + } + + if (fields > 0 && qxestrlen (fontname)) + { + Extbyte *extfontname; + + extfontname = ITEXT_TO_TSTR (fontname); + if (logfont) + { + qxetcsncpy ((Extbyte *) logfont->lfFaceName, extfontname, + LF_FACESIZE - 1); + logfont->lfFaceName[LF_FACESIZE - 1] = 0; + } + } + + /* weight */ + if (fields < 2) + qxestrcpy_ascii (weight, fontweight_map[0].name); + + /* Maybe split weight into weight and style */ + if ((c = qxestrchr (weight, ' '))) + { + *c = '\0'; + style = c + 1; + } + else + style = NULL; + + for (i = 0; i < countof (fontweight_map); i++) + if (!qxestrcasecmp_ascii (weight, fontweight_map[i].name)) + { + if (logfont) + logfont->lfWeight = fontweight_map[i].value; + break; + } + if (i == countof (fontweight_map)) /* No matching weight */ + { + if (!style) + { + if (logfont) + logfont->lfWeight = FW_REGULAR; + style = weight; /* May have specified style without weight */ + } + else + { + maybe_signal_error (Qinvalid_constant, "Invalid font weight", + name_for_errors, Qfont, errb); + return 0; + } + } + + if (style) + { + /* #### what about oblique? */ + if (qxestrcasecmp_ascii (style, "italic") == 0) + { + if (logfont) + logfont->lfItalic = TRUE; + } + else + { + maybe_signal_error (Qinvalid_constant, + "Invalid font weight or style", + name_for_errors, Qfont, errb); + return 0; + } + + /* Glue weight and style together again */ + if (weight != style) + *c = ' '; + } + else if (logfont) + logfont->lfItalic = FALSE; + + if (fields < 3 || !qxestrcmp_ascii (points, "")) + ; + else if (points[0] == '0' || + qxestrspn (points, "0123456789") < qxestrlen (points)) + { + maybe_signal_error (Qinvalid_argument, "Invalid font pointsize", + name_for_errors, Qfont, errb); + return 0; + } + else + { + pt = qxeatoi (points); + + if (logfont) + { + /* Formula for pointsize->height from LOGFONT docs in MSVC5 Platform + SDK */ + logfont->lfHeight = -MulDiv (pt, GetDeviceCaps (hdc, LOGPIXELSY), + 72); + logfont->lfWidth = 0; + } + } + + /* Effects */ + if (logfont) + { + logfont->lfUnderline = FALSE; + logfont->lfStrikeOut = FALSE; + } + + if (fields >= 4 && effects[0] != '\0') + { + Ibyte *effects2; + int underline = FALSE, strikeout = FALSE; + + /* Maybe split effects into effects and effects2 */ + if ((c = qxestrchr (effects, ' '))) + { + *c = '\0'; + effects2 = c + 1; + } + else + effects2 = NULL; + + if (qxestrcasecmp_ascii (effects, "underline") == 0) + underline = TRUE; + else if (qxestrcasecmp_ascii (effects, "strikeout") == 0) + strikeout = TRUE; + else + { + maybe_signal_error (Qinvalid_constant, "Invalid font effect", + name_for_errors, Qfont, errb); + return 0; + } + + if (effects2 && effects2[0] != '\0') + { + if (qxestrcasecmp_ascii (effects2, "underline") == 0) + underline = TRUE; + else if (qxestrcasecmp_ascii (effects2, "strikeout") == 0) + strikeout = TRUE; + else + { + maybe_signal_error (Qinvalid_constant, "Invalid font effect", + name_for_errors, Qfont, errb); + return 0; + } + } + + /* Regenerate sanitized effects string */ + if (underline) + { + if (strikeout) + qxestrcpy_ascii (effects, "underline strikeout"); + else + qxestrcpy_ascii (effects, "underline"); + } + else if (strikeout) + qxestrcpy_ascii (effects, "strikeout"); + + if (logfont) + { + logfont->lfUnderline = underline; + logfont->lfStrikeOut = strikeout; + } + } + + /* Charset */ + /* charset can be specified even if earlier fields haven't been */ + if (fields < 5) + { + if ((c = qxestrchr (namestr, ':')) && (c = qxestrchr (c + 1, ':')) && + (c = qxestrchr (c + 1, ':')) && (c = qxestrchr (c + 1, ':'))) + { + qxestrncpy (charset, c + 1, LF_FACESIZE); + charset[LF_FACESIZE - 1] = '\0'; + } + } + + /* NOTE: If you give a blank charset spec, we will normally not get here + under Mule unless we explicitly call `make-font-instance'! This is + because the C code instantiates fonts using particular charsets, by + way of specifier_matching_instance(). Before instantiating the font, + font_instantiate() calls the devmeth find_matching_font(), which gets + a truename font spec with the registry (i.e. the charset spec) filled + in appropriately to the charset. */ + if (!qxestrcmp_ascii (charset, "")) + ; + else + { + for (i = 0; i < countof (charset_map); i++) + if (!qxestrcasecmp_ascii (charset, charset_map[i].name)) + { + if (logfont) + logfont->lfCharSet = charset_map[i].value; + break; + } + + if (i == countof (charset_map)) /* No matching charset */ + { + maybe_signal_error (Qinvalid_argument, "Invalid charset", + name_for_errors, Qfont, errb); + return 0; + } + } + + if (logfont) + { + /* Misc crud */ +#if 1 + logfont->lfOutPrecision = OUT_DEFAULT_PRECIS; + logfont->lfClipPrecision = CLIP_DEFAULT_PRECIS; + logfont->lfQuality = DEFAULT_QUALITY; +#else + logfont->lfOutPrecision = OUT_STROKE_PRECIS; + logfont->lfClipPrecision = CLIP_STROKE_PRECIS; + logfont->lfQuality = PROOF_QUALITY; +#endif + /* Default to monospaced if the specified fontname doesn't exist. */ + logfont->lfPitchAndFamily = FF_MODERN; + } + + return 1; +} + +/* + mswindows fonts look like: + [fontname[:style[:pointsize[:effects]]]][:charset] + A maximal mswindows font spec looks like: + Courier New:Bold Italic:10:underline strikeout:Western + + A missing weight/style field is the same as Regular, and a missing + effects field is left alone, and means no effects; but a missing + fontname, pointsize or charset field means any will do. We prefer + Courier New, 10, Western. See sort function above. */ + +static HFONT +create_hfont_from_font_spec (const Ibyte *namestr, + HDC hdc, + Lisp_Object name_for_errors, + Lisp_Object device_font_list, + Error_Behavior errb, + Lisp_Object *truename_ret) +{ + LOGFONTW logfont; + HFONT hfont; + Ibyte fontname[LF_FACESIZE], weight[LF_FACESIZE], points[8]; + Ibyte effects[LF_FACESIZE], charset[LF_FACESIZE]; + Ibyte truename[MSW_FONTSIZE]; + Ibyte truername[MSW_FONTSIZE]; + + /* Windows will silently substitute a default font if the fontname + specifies a non-existent font. This is bad for screen fonts because + it doesn't allow higher-level code to see the error and to act + appropriately. For instance complex_vars_of_faces() sets up a + fallback list of fonts for the default face. Instead, we look at all + the possibilities and pick one that works, handling missing pointsize + and charset fields appropriately. + + For printer fonts, we used to go ahead and let Windows choose the + font, and for those devices, then, DEVICE_FONT_LIST would be nil. + However, this causes problems with the font-matching code below, which + needs a list of fonts so it can pick the right one for Mule. + + Thus, the code below to handle a nil DEVICE_FONT_LIST is not currently + used. */ + + if (!NILP (device_font_list)) + { + Lisp_Object fonttail = Qnil; + + if (!parse_font_spec (namestr, 0, name_for_errors, + errb, 0, fontname, weight, points, + effects, charset)) + return 0; + + /* The fonts in the device font list always specify fontname and + charset, but often times not the size; so if we don't have the + size specified either, do a round with size 10 so we'll always end + up with a size in the truename (if we fail this one but succeed + the next one, we'll have chosen a non-TrueType font, and in those + cases the size is specified in the font list item. */ + + if (!points[0]) + { + qxesprintf (truename, "%s:%s:10:%s:%s", + fontname, weight, effects, charset); + + LIST_LOOP (fonttail, device_font_list) + { + if (match_font (XSTRING_DATA (XCAR (XCAR (fonttail))), + truename, truername)) + break; + } + } + + if (NILP (fonttail)) + { + qxesprintf (truename, "%s:%s:%s:%s:%s", + fontname, weight, points, effects, charset); + + LIST_LOOP (fonttail, device_font_list) + { + if (match_font (XSTRING_DATA (XCAR (XCAR (fonttail))), + truename, truername)) + break; + } + } + + if (NILP (fonttail)) + { + maybe_signal_error (Qinvalid_argument, "No matching font", + name_for_errors, Qfont, errb); + return 0; + } + + if (!parse_font_spec (truername, hdc, name_for_errors, + ERROR_ME_DEBUG_WARN, &logfont, fontname, weight, + points, effects, charset)) + signal_error (Qinternal_error, "Bad value in device font list?", + build_istring (truername)); + } + else if (!parse_font_spec (namestr, hdc, name_for_errors, + errb, &logfont, fontname, weight, points, + effects, charset)) + return 0; + + if ((hfont = qxeCreateFontIndirect (&logfont)) == NULL) + { + maybe_signal_error (Qgui_error, "Couldn't create font", + name_for_errors, Qfont, errb); + return 0; + } + + /* #### Truename will not have all its fields filled in when we have no + list of fonts. Doesn't really matter now, since we always have one. + See above. */ + qxesprintf (truename, "%s:%s:%s:%s:%s", fontname, weight, + points, effects, charset); + + *truename_ret = build_istring (truename); + return hfont; +} + +/* + * This is a work horse for both mswindows_initialize_font_instance and + * msprinter_initialize_font_instance. + */ +static int +initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name, + Lisp_Object device_font_list, HDC hdc, + Error_Behavior errb) +{ + HFONT hfont, hfont2; + TEXTMETRICW metrics; + Ibyte *namestr = XSTRING_DATA (name); + Lisp_Object truename; + + hfont = create_hfont_from_font_spec (namestr, hdc, name, device_font_list, + errb, &truename); + if (!hfont) + return 0; + f->truename = truename; + f->data = xnew_and_zero (struct mswindows_font_instance_data); + FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, 0, 0) = hfont; + + /* Some underlined fonts have the descent of one pixel more than their + non-underlined counterparts. Font variants though are assumed to have + identical metrics. So get the font metrics from the underlined variant + of the font */ + hfont2 = mswindows_create_font_variant (f, 1, 0); + if (hfont2 != MSWINDOWS_BAD_HFONT) + hfont = hfont2; + + hfont2 = (HFONT) SelectObject (hdc, hfont); + if (!hfont2) + { + mswindows_finalize_font_instance (f); + maybe_signal_error (Qgui_error, "Couldn't map font", name, Qfont, errb); + return 0; + } + qxeGetTextMetrics (hdc, &metrics); + SelectObject (hdc, hfont2); + + f->width = (unsigned short) metrics.tmAveCharWidth; + f->height = (unsigned short) metrics.tmHeight; + f->ascent = (unsigned short) metrics.tmAscent; + f->descent = (unsigned short) metrics.tmDescent; + f->proportional_p = (metrics.tmPitchAndFamily & TMPF_FIXED_PITCH); + + return 1; +} + +static int +mswindows_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name, + Lisp_Object device, Error_Behavior errb) +{ + HDC hdc = CreateCompatibleDC (NULL); + Lisp_Object font_list = DEVICE_MSWINDOWS_FONTLIST (XDEVICE (device)); + int res = initialize_font_instance (f, name, font_list, hdc, errb); + DeleteDC (hdc); + return res; +} + +static int +msprinter_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name, + Lisp_Object device, Error_Behavior errb) +{ + HDC hdc = DEVICE_MSPRINTER_HDC (XDEVICE (device)); + Lisp_Object font_list = DEVICE_MSPRINTER_FONTLIST (XDEVICE (device)); + return initialize_font_instance (f, name, font_list, hdc, errb); +} + +static void +mswindows_finalize_font_instance (Lisp_Font_Instance *f) +{ + int i; + + if (f->data) + { + for (i = 0; i < MSWINDOWS_NUM_FONT_VARIANTS; i++) + { + if (FONT_INSTANCE_MSWINDOWS_HFONT_I (f, i) != NULL + && FONT_INSTANCE_MSWINDOWS_HFONT_I (f, i) != MSWINDOWS_BAD_HFONT) + DeleteObject (FONT_INSTANCE_MSWINDOWS_HFONT_I (f, i)); + } + + xfree (f->data); + f->data = 0; + } +} + +#if 0 +static void +mswindows_mark_font_instance (Lisp_Font_Instance *f) +{ +} +#endif + +static void +mswindows_print_font_instance (Lisp_Font_Instance *f, + Lisp_Object printcharfun, + int UNUSED (escapeflag)) +{ + write_fmt_string (printcharfun, " 0x%lx", + (unsigned long) + FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, 0, 0)); + +} + +static Lisp_Object +mswindows_font_list (Lisp_Object pattern, Lisp_Object device, + Lisp_Object UNUSED (maxnumber)) +{ + struct device *d = XDEVICE (device); + Lisp_Object font_list = Qnil, fonttail, result = Qnil; + + if (DEVICE_MSWINDOWS_P (d)) + font_list = DEVICE_MSWINDOWS_FONTLIST (d); + else if (DEVICE_MSPRINTER_P (d)) + font_list = DEVICE_MSPRINTER_FONTLIST (d); + else + ABORT (); + + LIST_LOOP (fonttail, font_list) + { + Ibyte fontname[MSW_FONTSIZE]; + + if (match_font (XSTRING_DATA (XCAR (XCAR (fonttail))), + XSTRING_DATA (pattern), + fontname)) + result = Fcons (build_istring (fontname), result); + } + + return Fnreverse (result); +} + +static Lisp_Object +mswindows_font_instance_truename (Lisp_Font_Instance *f, + Error_Behavior UNUSED (errb)) +{ + return f->truename; +} + +#ifdef MULE + +static int +mswindows_font_spec_matches_charset_stage_1 (struct device *UNUSED (d), + Lisp_Object charset, + const Ibyte *nonreloc, + Lisp_Object reloc, + Bytecount offset, + Bytecount length) +{ + int i; + Lisp_Object charset_registry; + const Ibyte *font_charset; + const Ibyte *the_nonreloc = nonreloc; + const Ibyte *c; + Bytecount the_length = length; + + if (NILP (charset)) + return 1; + + if (!the_nonreloc) + the_nonreloc = XSTRING_DATA (reloc); + fixup_internal_substring (nonreloc, reloc, offset, &the_length); + the_nonreloc += offset; + + c = the_nonreloc; + for (i = 0; i < 4; i++) + { + Ibyte *newc = (Ibyte *) memchr (c, ':', the_length); + if (!newc) + break; + newc++; + the_length -= (newc - c); + c = newc; + } + + if (i < 4) + return 0; + + font_charset = c; + + /* For border-glyph use */ + if (!qxestrcasecmp_ascii (font_charset, "symbol")) + font_charset = (const Ibyte *) "western"; + + /* Get code page for the charset */ + charset_registry = Fmswindows_charset_registry (charset); + if (!STRINGP (charset_registry)) + return 0; + + return !qxestrcasecmp (XSTRING_DATA (charset_registry), font_charset); +} + +/* + +#### The following comment is old and probably not applicable any longer. + +1. handle standard mapping and inheritance vectors properly in Face-frob-property. +2. finish impl of mswindows-charset-registry. +3. see if everything works under fixup, now that i copied the stuff over. +4. consider generalizing Face-frob-property to frob-specifier. +5. maybe extract some of the flets out of Face-frob-property as useful specifier frobbing. +6. eventually this stuff's got to be checked in!!!! +*/ + +static int +mswindows_font_spec_matches_charset_stage_2 (struct device *d, + Lisp_Object charset, + const Ibyte *nonreloc, + Lisp_Object reloc, + Bytecount offset, + Bytecount length) +{ + const Ibyte *the_nonreloc = nonreloc; + FONTSIGNATURE fs; + FONTSIGNATURE *fsp = &fs; + struct gcpro gcpro1; + Lisp_Object fontsig; + Bytecount the_length = length; + int i; + + if (NILP (charset)) + return 1; + + if (!the_nonreloc) + the_nonreloc = XSTRING_DATA (reloc); + fixup_internal_substring (nonreloc, reloc, offset, &the_length); + the_nonreloc += offset; + + /* Get the list of Unicode subranges corresponding to the font. This + is contained inside of FONTSIGNATURE data, obtained by calling + GetTextCharsetInfo on a font object, which we need to create from the + spec. See if the FONTSIGNATURE data is already cached. If not, get + it and cache it. */ + if (!STRINGP (reloc) || the_nonreloc != XSTRING_DATA (reloc)) + reloc = build_istring (the_nonreloc); + GCPRO1 (reloc); + fontsig = Fgethash (reloc, Vfont_signature_data, Qunbound); + + if (!UNBOUNDP (fontsig)) + { + fsp = (FONTSIGNATURE *) XOPAQUE_DATA (fontsig); + UNGCPRO; + } + else + { + HDC hdc = CreateCompatibleDC (NULL); + Lisp_Object font_list = Qnil, truename; + HFONT hfont; + + if (DEVICE_TYPE_P (d, mswindows)) + { + font_list = DEVICE_MSWINDOWS_FONTLIST (d); + } + else if (DEVICE_TYPE_P (d, msprinter)) + { + font_list = DEVICE_MSPRINTER_FONTLIST (d); + } + else + { + assert(0); + } + + hfont = create_hfont_from_font_spec (the_nonreloc, hdc, Qnil, + font_list, + ERROR_ME_DEBUG_WARN, + &truename); + + if (!hfont || !(hfont = (HFONT) SelectObject (hdc, hfont))) + { + nope: + DeleteDC (hdc); + UNGCPRO; + return 0; + } + + if (GetTextCharsetInfo (hdc, &fs, 0) == DEFAULT_CHARSET) + { + SelectObject (hdc, hfont); + goto nope; + } + SelectObject (hdc, hfont); + DeleteDC (hdc); + Fputhash (reloc, make_opaque (&fs, sizeof (fs)), Vfont_signature_data); + UNGCPRO; + } + + { + int lowlim, highlim; + int dim, j, cp = -1; + + /* Try to find a Unicode char in the charset. #### This is somewhat + bogus. See below. + + #### Cache me baby!!!!!!!!!!!!! + */ + get_charset_limits (charset, &lowlim, &highlim); + dim = XCHARSET_DIMENSION (charset); + + if (dim == 1) + { + for (i = lowlim; i <= highlim; i++) + if ((cp = ichar_to_unicode (make_ichar (charset, i, 0))) >= 0) + break; + } + else + { + for (i = lowlim; i <= highlim; i++) + for (j = lowlim; j <= highlim; j++) + if ((cp = ichar_to_unicode (make_ichar (charset, i, j))) >= 0) + break; + } + + if (cp < 0) + return 0; + + /* Check to see, for each subrange supported by the font, + whether the Unicode char is within that subrange. If any match, + the font supports the char (whereby, the charset, bogusly). */ + + for (i = 0; i < 128; i++) + { + if (fsp->fsUsb[i >> 5] & (1 << (i & 32))) + { + for (j = 0; j < unicode_subrange_table[i].no_subranges; j++) + if (cp >= unicode_subrange_table[i].subranges[j].start && + cp <= unicode_subrange_table[i].subranges[j].end) + return 1; + } + } + + return 0; + } +} + +/* + Given a truename font spec, does it match CHARSET? + + We try two stages: + + -- First see if the charset corresponds to one of the predefined Windows + charsets; if so, we see if the registry (that's the last element of the + font spec) is that same charset. If so, this means that the font is + specifically designed for the charset, and we prefer it. + + -- However, there are only a limited number of defined Windows charsets, + and new ones aren't being defined; so if we fail the first stage, we find + a character from the charset with a Unicode equivalent, and see if the + font can display this character. we do that by retrieving the Unicode + ranges that the font supports, to see if the character comes from that + subrange. + + #### Note: We really want to be doing all these checks at the character + level, not the charset level. There's no guarantee that a charset covers + a single Unicode range. Furthermore, this is extremely wasteful. We + should be doing this when we're about to redisplay and already have the + Unicode codepoints in hand. +*/ + +static int +mswindows_font_spec_matches_charset (struct device *d, Lisp_Object charset, + const Ibyte *nonreloc, + Lisp_Object reloc, + Bytecount offset, Bytecount length, + enum font_specifier_matchspec_stages stage) +{ + return stage == STAGE_FINAL ? + mswindows_font_spec_matches_charset_stage_2 (d, charset, nonreloc, + reloc, offset, length) + : mswindows_font_spec_matches_charset_stage_1 (d, charset, nonreloc, + reloc, offset, length); +} + + +/* Find a font spec that matches font spec FONT and also matches + (the registry of) CHARSET. */ + +static Lisp_Object +mswindows_find_charset_font (Lisp_Object device, Lisp_Object font, + Lisp_Object charset, + enum font_specifier_matchspec_stages stage) +{ + Lisp_Object fontlist, fonttail; + + /* If FONT specifies a particular charset, this will only list fonts with + that charset; otherwise, it will list fonts with all charsets. */ + fontlist = mswindows_font_list (font, device, Qnil); + + if (stage == STAGE_INITIAL) + { + LIST_LOOP (fonttail, fontlist) + { + if (mswindows_font_spec_matches_charset_stage_1 + (XDEVICE (device), charset, 0, XCAR (fonttail), 0, -1)) + return XCAR (fonttail); + } + } + else + { + LIST_LOOP (fonttail, fontlist) + { + if (mswindows_font_spec_matches_charset_stage_2 + (XDEVICE (device), charset, 0, XCAR (fonttail), 0, -1)) + return XCAR (fonttail); + } + } + + return Qnil; +} + +#endif /* MULE */ + + +/************************************************************************/ +/* non-methods */ +/************************************************************************/ + +static Lisp_Object +mswindows_color_list (void) +{ + Lisp_Object result = Qnil; + int i; + + for (i = countof (mswindows_X_color_map); i != 0;) + result = Fcons (build_ascstring (mswindows_X_color_map[--i].name), result); + + return result; +} + + +/************************************************************************/ +/* initialization */ +/************************************************************************/ + +void +syms_of_fontcolor_mswindows (void) +{ +} + +void +console_type_create_fontcolor_mswindows (void) +{ + /* object methods */ + CONSOLE_HAS_METHOD (mswindows, initialize_color_instance); +/* CONSOLE_HAS_METHOD (mswindows, mark_color_instance); */ + CONSOLE_HAS_METHOD (mswindows, print_color_instance); + CONSOLE_HAS_METHOD (mswindows, finalize_color_instance); + CONSOLE_HAS_METHOD (mswindows, color_instance_equal); + CONSOLE_HAS_METHOD (mswindows, color_instance_hash); + CONSOLE_HAS_METHOD (mswindows, color_instance_rgb_components); + CONSOLE_HAS_METHOD (mswindows, valid_color_name_p); + CONSOLE_HAS_METHOD (mswindows, color_list); + + CONSOLE_HAS_METHOD (mswindows, initialize_font_instance); +/* CONSOLE_HAS_METHOD (mswindows, mark_font_instance); */ + CONSOLE_HAS_METHOD (mswindows, print_font_instance); + CONSOLE_HAS_METHOD (mswindows, finalize_font_instance); + CONSOLE_HAS_METHOD (mswindows, font_instance_truename); + CONSOLE_HAS_METHOD (mswindows, font_list); +#ifdef MULE + CONSOLE_HAS_METHOD (mswindows, font_spec_matches_charset); + CONSOLE_HAS_METHOD (mswindows, find_charset_font); +#endif + + /* Printer methods - delegate most to windows methods, + since graphical objects behave the same way. */ + + CONSOLE_INHERITS_METHOD (msprinter, mswindows, initialize_color_instance); +/* CONSOLE_INHERITS_METHOD (msprinter, mswindows, mark_color_instance); */ + CONSOLE_INHERITS_METHOD (msprinter, mswindows, print_color_instance); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, finalize_color_instance); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, color_instance_equal); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, color_instance_hash); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, color_instance_rgb_components); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, valid_color_name_p); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, color_list); + + CONSOLE_HAS_METHOD (msprinter, initialize_font_instance); +/* CONSOLE_INHERITS_METHOD (msprinter, mswindows, mark_font_instance); */ + CONSOLE_INHERITS_METHOD (msprinter, mswindows, print_font_instance); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, finalize_font_instance); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, font_instance_truename); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, font_list); +#ifdef MULE + CONSOLE_INHERITS_METHOD (msprinter, mswindows, font_spec_matches_charset); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, find_charset_font); +#endif +} + +void +reinit_vars_of_fontcolor_mswindows (void) +{ +#ifdef MULE + int i; + + unicode_subrange_table = xnew_array_and_zero (unicode_subrange_t, 128); + for (i = 0; i < countof (unicode_subrange_raw_map); i++) + { + const unicode_subrange_raw_t *el = &unicode_subrange_raw_map[i]; + if (unicode_subrange_table[el->subrange_bit].subranges == 0) + unicode_subrange_table[el->subrange_bit].subranges = el; + unicode_subrange_table[el->subrange_bit].no_subranges++; + } + + Fclrhash (Vfont_signature_data); +#endif /* MULE */ +} + +void +vars_of_fontcolor_mswindows (void) +{ +#ifdef MULE + Vfont_signature_data = + make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, Qequal); + staticpro (&Vfont_signature_data); +#endif /* MULE */ +} diff -r 861f2601a38b -r 1f0b15040456 src/fontcolor-msw.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/fontcolor-msw.h Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,40 @@ +/* mswindows-specific Lisp objects. + Copyright (C) 1993, 1994 Free Software Foundation, Inc. + Copyright (C) 1995 Board of Trustees, University of Illinois. + Copyright (C) 1995, 1996, 2002 Ben Wing. + Copyright (C) 1997, Jonathan Harris. + +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 3 of the License, 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. If not, see . */ + +/* Synched up with: Not in FSF. */ + +/* Authorship: + + Ultimately based on FSF. + Rewritten by Ben Wing. + Rewritten for mswindows by Jonathan Harris, November 1997 for 21.0. + */ + + +#ifndef INCLUDED_fontcolor_msw_h_ +#define INCLUDED_fontcolor_msw_h_ + +#include "fontcolor.h" + +HFONT mswindows_get_hfont (Lisp_Font_Instance *f, int under, int strike); +Lisp_Object mswindows_color_to_string (COLORREF color); + +#endif /* INCLUDED_fontcolor_msw_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/fontcolor-tty-impl.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/fontcolor-tty-impl.h Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,80 @@ +/* TTY-specific Lisp objects. + Copyright (C) 1995 Board of Trustees, University of Illinois. + Copyright (C) 1995 Ben Wing + +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 3 of the License, 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. If not, see . */ + +/* Synched up with: Not in FSF. */ + +#ifndef INCLUDED_fontcolor_tty_impl_h_ +#define INCLUDED_fontcolor_tty_impl_h_ + +#include "fontcolor-impl.h" +#include "fontcolor-tty.h" + +struct tty_color_instance_data +{ +#ifdef NEW_GC + NORMAL_LISP_OBJECT_HEADER header; +#endif /* NEW_GC */ + Lisp_Object symbol; /* so we don't have to constantly call Fintern() */ +}; + +#ifdef NEW_GC +DECLARE_LISP_OBJECT (tty_color_instance_data, struct tty_color_instance_data); +#define XTTY_COLOR_INSTANCE_DATA(x) \ + XRECORD (x, tty_color_instance_data, struct tty_color_instance_data) +#define wrap_tty_color_instance_data(p) \ + wrap_record (p, tty_color_instance_data) +#define TTY_COLOR_INSTANCE_DATAP(x) RECORDP (x, tty_color_instance_data) +#define CHECK_TTY_COLOR_INSTANCE_DATA(x) \ + CHECK_RECORD (x, tty_color_instance_data) +#define CONCHECK_TTY_COLOR_INSTANCE_DATA(x) \ + CONCHECK_RECORD (x, tty_color_instance_data) +#endif /* NEW_GC */ + +#define TTY_COLOR_INSTANCE_DATA(c) \ + ((struct tty_color_instance_data *) (c)->data) + +#define COLOR_INSTANCE_TTY_SYMBOL(c) (TTY_COLOR_INSTANCE_DATA (c)->symbol) + +struct tty_font_instance_data +{ +#ifdef NEW_GC + NORMAL_LISP_OBJECT_HEADER header; +#endif /* NEW_GC */ + Lisp_Object charset; +}; + +#ifdef NEW_GC +DECLARE_LISP_OBJECT (tty_font_instance_data, struct tty_font_instance_data); +#define XTTY_FONT_INSTANCE_DATA(x) \ + XRECORD (x, tty_font_instance_data, struct tty_font_instance_data) +#define wrap_tty_font_instance_data(p) \ + wrap_record (p, tty_font_instance_data) +#define TTY_FONT_INSTANCE_DATAP(x) RECORDP (x, tty_font_instance_data) +#define CHECK_TTY_FONT_INSTANCE_DATA(x) \ + CHECK_RECORD (x, tty_font_instance_data) +#define CONCHECK_TTY_FONT_INSTANCE_DATA(x) \ + CONCHECK_RECORD (x, tty_font_instance_data) +#endif /* NEW_GC */ + +#define TTY_FONT_INSTANCE_DATA(c) \ + ((struct tty_font_instance_data *) (c)->data) + +#define FONT_INSTANCE_TTY_CHARSET(c) (TTY_FONT_INSTANCE_DATA (c)->charset) + +#endif /* INCLUDED_fontcolor_tty_impl_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/fontcolor-tty.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/fontcolor-tty.c Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,450 @@ +/* TTY-specific Lisp objects. + Copyright (C) 1995 Board of Trustees, University of Illinois. + Copyright (C) 1995, 1996, 2001, 2002, 2010 Ben Wing. + +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 3 of the License, 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. If not, see . */ + +/* Synched up with: Not in FSF. */ + +#include +#include "lisp.h" + +#include "console-tty-impl.h" +#include "insdel.h" +#include "fontcolor-tty-impl.h" +#include "device.h" +#include "charset.h" + +/* An alist mapping from color names to a cons of (FG-STRING, BG-STRING). */ +Lisp_Object Vtty_color_alist; +#if 0 /* This stuff doesn't quite work yet */ +Lisp_Object Vtty_dynamic_color_fg; +Lisp_Object Vtty_dynamic_color_bg; +#endif + +static const struct memory_description tty_color_instance_data_description_1 [] = { + { XD_LISP_OBJECT, offsetof (struct tty_color_instance_data, symbol) }, + { XD_END } +}; + +#ifdef NEW_GC +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("tty-color-instance-data", + tty_color_instance_data, + 0, tty_color_instance_data_description_1, + struct tty_color_instance_data); +#else /* not NEW_GC */ +const struct sized_memory_description tty_color_instance_data_description = { + sizeof (struct tty_color_instance_data), tty_color_instance_data_description_1 +}; +#endif /* not NEW_GC */ + +static const struct memory_description tty_font_instance_data_description_1 [] = { + { XD_LISP_OBJECT, offsetof (struct tty_font_instance_data, charset) }, + { XD_END } +}; + +#ifdef NEW_GC +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("tty-font-instance-data", + tty_font_instance_data, 0, + tty_font_instance_data_description_1, + struct tty_font_instance_data); +#else /* not NEW_GC */ +const struct sized_memory_description tty_font_instance_data_description = { + sizeof (struct tty_font_instance_data), tty_font_instance_data_description_1 +}; +#endif /* not NEW_GC */ + +DEFUN ("register-tty-color", Fregister_tty_color, 3, 3, 0, /* +Register COLOR as a recognized TTY color. +COLOR should be a string. +Strings FG-STRING and BG-STRING should specify the escape sequences to + set the foreground and background to the given color, respectively. +*/ + (color, fg_string, bg_string)) +{ + CHECK_STRING (color); + CHECK_STRING (fg_string); + CHECK_STRING (bg_string); + + color = Fintern (color, Qnil); + Vtty_color_alist = Fremassq (color, Vtty_color_alist); + Vtty_color_alist = Fcons (Fcons (color, Fcons (fg_string, bg_string)), + Vtty_color_alist); + + return Qnil; +} + +DEFUN ("unregister-tty-color", Funregister_tty_color, 1, 1, 0, /* +Unregister COLOR as a recognized TTY color. +*/ + (color)) +{ + CHECK_STRING (color); + + color = Fintern (color, Qnil); + Vtty_color_alist = Fremassq (color, Vtty_color_alist); + return Qnil; +} + +DEFUN ("find-tty-color", Ffind_tty_color, 1, 1, 0, /* +Look up COLOR in the list of registered TTY colors. +If it is found, return a list (FG-STRING BG-STRING) of the escape +sequences used to set the foreground and background to the color, respectively. +If it is not found, return nil. +*/ + (color)) +{ + Lisp_Object result; + + CHECK_STRING (color); + + result = Fassq (Fintern (color, Qnil), Vtty_color_alist); + if (!NILP (result)) + return list2 (Fcar (Fcdr (result)), Fcdr (Fcdr (result))); + else + return Qnil; +} + +static Lisp_Object +tty_color_list (void) +{ + Lisp_Object result = Qnil; + Lisp_Object rest; + + LIST_LOOP (rest, Vtty_color_alist) + { + result = Fcons (Fsymbol_name (XCAR (XCAR (rest))), result); + } + + return Fnreverse (result); +} + +#if 0 + +/* This approach is too simplistic. The problem is that the + dynamic color settings apply to *all* text in the default color, + not just the text output after the escape sequence has been given. */ + +DEFUN ("set-tty-dynamic-color-specs", Fset_tty_dynamic_color_specs, 2, 2, 0, /* +Set the dynamic color specifications for TTY's. +FG and BG should be either nil or vaguely printf-like strings, +where each occurrence of %s is replaced with the color name and each +occurrence of %% is replaced with a single % character. +*/ + (fg, bg)) +{ + if (!NILP (fg)) + CHECK_STRING (fg); + if (!NILP (bg)) + CHECK_STRING (bg); + + Vtty_dynamic_color_fg = fg; + Vtty_dynamic_color_bg = bg; + + return Qnil; +} + +DEFUN ("tty-dynamic-color-specs", Ftty_dynamic_color_specs, 0, 0, 0, /* +Return the dynamic color specifications for TTY's as a list of (FG BG). +See `set-tty-dynamic-color-specs'. +*/ + ()) +{ + return list2 (Vtty_dynamic_color_fg, Vtty_dynamic_color_bg); +} + +#endif /* 0 */ + +static int +tty_initialize_color_instance (Lisp_Color_Instance *c, Lisp_Object name, + Lisp_Object UNUSED (device), + Error_Behavior UNUSED (errb)) +{ + Lisp_Object result; + + name = Fintern (name, Qnil); + result = assq_no_quit (name, Vtty_color_alist); + + if (NILP (result)) + { +#if 0 + if (!STRINGP (Vtty_dynamic_color_fg) + && !STRINGP (Vtty_dynamic_color_bg)) +#endif + return 0; + } + + /* Don't allocate the data until we're sure that we will succeed. */ +#ifdef NEW_GC + c->data = + XTTY_COLOR_INSTANCE_DATA (ALLOC_NORMAL_LISP_OBJECT (tty_color_instance_data)); +#else /* not NEW_GC */ + c->data = xnew (struct tty_color_instance_data); +#endif /* not NEW_GC */ + COLOR_INSTANCE_TTY_SYMBOL (c) = name; + + return 1; +} + +static void +tty_mark_color_instance (Lisp_Color_Instance *c) +{ + mark_object (COLOR_INSTANCE_TTY_SYMBOL (c)); +} + +static void +tty_print_color_instance (Lisp_Color_Instance *UNUSED (c), + Lisp_Object UNUSED (printcharfun), + int UNUSED (escapeflag)) +{ +} + +static void +tty_finalize_color_instance (Lisp_Color_Instance *UNUSED_IF_NEW_GC (c)) +{ +#ifndef NEW_GC + if (c->data) + { + xfree (c->data); + c->data = 0; + } +#endif /* not NEW_GC */ +} + +static int +tty_color_instance_equal (Lisp_Color_Instance *c1, + Lisp_Color_Instance *c2, + int UNUSED (depth)) +{ + return (EQ (COLOR_INSTANCE_TTY_SYMBOL (c1), + COLOR_INSTANCE_TTY_SYMBOL (c2))); +} + +static Hashcode +tty_color_instance_hash (Lisp_Color_Instance *c, int UNUSED (depth)) +{ + return LISP_HASH (COLOR_INSTANCE_TTY_SYMBOL (c)); +} + +static int +tty_valid_color_name_p (struct device *UNUSED (d), Lisp_Object color) +{ + return (!NILP (assoc_no_quit (Fintern (color, Qnil), Vtty_color_alist))); +#if 0 + || STRINGP (Vtty_dynamic_color_fg) + || STRINGP (Vtty_dynamic_color_bg) +#endif +} + + +static int +tty_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name, + Lisp_Object UNUSED (device), + Error_Behavior UNUSED (errb)) +{ + Ibyte *str = XSTRING_DATA (name); + Lisp_Object charset = Qnil; + + if (qxestrncmp_ascii (str, "normal", 6)) + return 0; + str += 6; + if (*str) + { +#ifdef MULE + if (*str != '/') + return 0; + str++; + charset = Ffind_charset (intern_istring (str)); + if (NILP (charset)) + return 0; +#else + return 0; +#endif + } + + /* Don't allocate the data until we're sure that we will succeed. */ +#ifdef NEW_GC + f->data = + XTTY_FONT_INSTANCE_DATA (ALLOC_NORMAL_LISP_OBJECT (tty_font_instance_data)); +#else /* not NEW_GC */ + f->data = xnew (struct tty_font_instance_data); +#endif /* not NEW_GC */ + FONT_INSTANCE_TTY_CHARSET (f) = charset; +#ifdef MULE + if (CHARSETP (charset)) + f->width = XCHARSET_COLUMNS (charset); + else +#endif + f->width = 1; + + f->proportional_p = 0; + f->ascent = f->height = 1; + f->descent = 0; + + return 1; +} + +static void +tty_mark_font_instance (Lisp_Font_Instance *f) +{ + mark_object (FONT_INSTANCE_TTY_CHARSET (f)); +} + +static void +tty_print_font_instance (Lisp_Font_Instance *UNUSED (f), + Lisp_Object UNUSED (printcharfun), + int UNUSED (escapeflag)) +{ +} + +static void +tty_finalize_font_instance (Lisp_Font_Instance *UNUSED_IF_NEW_GC (f)) +{ +#ifndef NEW_GC + if (f->data) + { + xfree (f->data); + f->data = 0; + } +#endif /* not NEW_GC */ +} + +static Lisp_Object +tty_font_list (Lisp_Object UNUSED (pattern), Lisp_Object UNUSED (device), + Lisp_Object UNUSED (maxnumber)) +{ + return list1 (build_ascstring ("normal")); +} + +#ifdef MULE + +static int +tty_font_spec_matches_charset (struct device *UNUSED (d), Lisp_Object charset, + const Ibyte *nonreloc, Lisp_Object reloc, + Bytecount offset, Bytecount length, + enum font_specifier_matchspec_stages stage) +{ + const Ibyte *the_nonreloc = nonreloc; + + if (stage == STAGE_FINAL) + return 0; + + if (!the_nonreloc) + the_nonreloc = XSTRING_DATA (reloc); + fixup_internal_substring (nonreloc, reloc, offset, &length); + the_nonreloc += offset; + + if (NILP (charset)) + return !memchr (the_nonreloc, '/', length); + the_nonreloc = (const Ibyte *) memchr (the_nonreloc, '/', length); + if (!the_nonreloc) + return 0; + the_nonreloc++; + { + Lisp_Object s = symbol_name (XSYMBOL (XCHARSET_NAME (charset))); + return !qxestrcmp (the_nonreloc, XSTRING_DATA (s)); + } +} + +/* find a font spec that matches font spec FONT and also matches + (the registry of) CHARSET. */ +static Lisp_Object +tty_find_charset_font (Lisp_Object device, Lisp_Object font, + Lisp_Object charset, + enum font_specifier_matchspec_stages stage) +{ + Ibyte *fontname = XSTRING_DATA (font); + + if (stage == STAGE_FINAL) + return Qnil; + + if (strchr ((const char *) fontname, '/')) + { + if (tty_font_spec_matches_charset (XDEVICE (device), charset, 0, + font, 0, -1, STAGE_INITIAL)) + return font; + return Qnil; + } + + if (NILP (charset)) + return font; + + return concat3 (font, build_ascstring ("/"), + Fsymbol_name (XCHARSET_NAME (charset))); +} + +#endif /* MULE */ + + +/************************************************************************/ +/* initialization */ +/************************************************************************/ + +void +syms_of_fontcolor_tty (void) +{ +#ifdef NEW_GC + INIT_LISP_OBJECT (tty_color_instance_data); + INIT_LISP_OBJECT (tty_font_instance_data); +#endif /* NEW_GC */ + + DEFSUBR (Fregister_tty_color); + DEFSUBR (Funregister_tty_color); + DEFSUBR (Ffind_tty_color); +#if 0 + DEFSUBR (Fset_tty_dynamic_color_specs); + DEFSUBR (Ftty_dynamic_color_specs); +#endif +} + +void +console_type_create_fontcolor_tty (void) +{ + /* object methods */ + CONSOLE_HAS_METHOD (tty, initialize_color_instance); + CONSOLE_HAS_METHOD (tty, mark_color_instance); + CONSOLE_HAS_METHOD (tty, print_color_instance); + CONSOLE_HAS_METHOD (tty, finalize_color_instance); + CONSOLE_HAS_METHOD (tty, color_instance_equal); + CONSOLE_HAS_METHOD (tty, color_instance_hash); + CONSOLE_HAS_METHOD (tty, valid_color_name_p); + CONSOLE_HAS_METHOD (tty, color_list); + + CONSOLE_HAS_METHOD (tty, initialize_font_instance); + CONSOLE_HAS_METHOD (tty, mark_font_instance); + CONSOLE_HAS_METHOD (tty, print_font_instance); + CONSOLE_HAS_METHOD (tty, finalize_font_instance); + CONSOLE_HAS_METHOD (tty, font_list); +#ifdef MULE + CONSOLE_HAS_METHOD (tty, font_spec_matches_charset); + CONSOLE_HAS_METHOD (tty, find_charset_font); +#endif +} + +void +vars_of_fontcolor_tty (void) +{ + staticpro (&Vtty_color_alist); + Vtty_color_alist = Qnil; + +#if 0 + staticpro (&Vtty_dynamic_color_fg); + Vtty_dynamic_color_fg = Qnil; + + staticpro (&Vtty_dynamic_color_bg); + Vtty_dynamic_color_bg = Qnil; +#endif +} diff -r 861f2601a38b -r 1f0b15040456 src/fontcolor-tty.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/fontcolor-tty.h Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,30 @@ +/* TTY-specific Lisp objects. + Copyright (C) 1995 Board of Trustees, University of Illinois. + Copyright (C) 1995 Ben Wing + +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 3 of the License, 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. If not, see . */ + +/* Synched up with: Not in FSF. */ + +#ifndef INCLUDED_fontcolor_tty_h_ +#define INCLUDED_fontcolor_tty_h_ + +#include "fontcolor.h" + +extern Lisp_Object Vtty_color_alist, Vtty_dynamic_color_bg; +extern Lisp_Object Vtty_dynamic_color_fg; + +#endif /* INCLUDED_fontcolor_tty_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/fontcolor-x-impl.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/fontcolor-x-impl.h Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,86 @@ +/* X-specific Lisp objects. + Copyright (C) 1993, 1994 Free Software Foundation, Inc. + Copyright (C) 1995 Board of Trustees, University of Illinois. + Copyright (C) 1995, 1996, 2002 Ben Wing. + +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 3 of the License, 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. If not, see . */ + +/* Synched up with: Not in FSF. */ + +/* This file Mule-ized (more like Mule-verified) by Ben Wing, 7-10-00. */ + +#ifndef INCLUDED_fontcolor_x_impl_h_ +#define INCLUDED_fontcolor_x_impl_h_ + +#include "fontcolor-impl.h" +#include "fontcolor-x.h" +#ifdef HAVE_XFT +/* for resource name definitions, etc */ +#include "../lwlib/lwlib-fonts.h" +#endif + +#ifdef HAVE_X_WINDOWS + +/***************************************************************************** + Color-Instance + ****************************************************************************/ + +struct x_color_instance_data +{ + XColor color; + /* Yes, it looks crazy to have both the XColor and the XftColor, but + pragmatically both are used. */ +#ifdef HAVE_XFT + XftColor xftColor; +#endif + char dealloc_on_gc; +}; + +#define X_COLOR_INSTANCE_DATA(c) ((struct x_color_instance_data *) (c)->data) +#define COLOR_INSTANCE_X_COLOR(c) (X_COLOR_INSTANCE_DATA (c)->color) +#define XCOLOR_INSTANCE_X_COLOR(c) COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (c)) +#ifdef HAVE_XFT +#define COLOR_INSTANCE_X_XFTCOLOR(c) (X_COLOR_INSTANCE_DATA (c)->xftColor) +#endif +#define COLOR_INSTANCE_X_DEALLOC(c) (X_COLOR_INSTANCE_DATA (c)->dealloc_on_gc) + +/***************************************************************************** + Font-Instance + ****************************************************************************/ + +struct x_font_instance_data +{ + /* X-specific information */ + /* Yes, it looks crazy to have both the XFontStruct and the XftFont, but + pragmatically both are used (lwlib delegates labels to the widget sets, + which internally use XFontStructs). */ + XFontStruct * font; +#ifdef HAVE_XFT + XftFont *xftFont; +#endif + +}; + +#define X_FONT_INSTANCE_DATA(f) ((struct x_font_instance_data *) (f)->data) +#define FONT_INSTANCE_X_FONT(f) (X_FONT_INSTANCE_DATA (f)->font) +#define XFONT_INSTANCE_X_FONT(c) FONT_INSTANCE_X_FONT (XFONT_INSTANCE (c)) +#ifdef HAVE_XFT +#define FONT_INSTANCE_X_XFTFONT(f) (X_FONT_INSTANCE_DATA (f)->xftFont) +#endif + +#endif /* HAVE_X_WINDOWS */ + +#endif /* INCLUDED_fontcolor_x_impl_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/fontcolor-x.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/fontcolor-x.c Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,986 @@ +/* X-specific fonts and colors. + Copyright (C) 1993, 1994 Free Software Foundation, Inc. + Copyright (C) 1995 Board of Trustees, University of Illinois. + Copyright (C) 1995 Tinker Systems. + Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004, 2010 Ben Wing. + Copyright (C) 1995 Sun Microsystems, Inc. + +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 3 of the License, 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. If not, see . */ + +/* Synched up with: Not in FSF. */ + +/* Authors: Jamie Zawinski, Chuck Thompson, Ben Wing */ + +/* This file Mule-ized by Ben Wing, 7-10-00. */ + +#include +#include "lisp.h" + +#include "charset.h" +#include "device-impl.h" +#include "insdel.h" + +#include "console-x-impl.h" +#include "fontcolor-x-impl.h" +#include "elhash.h" + +#ifdef HAVE_XFT +#include "font-mgr.h" +#endif + +int x_handle_non_fully_specified_fonts; + +#ifdef DEBUG_XEMACS +Fixnum debug_x_fonts; +#endif /* DEBUG_XEMACS */ + + +/************************************************************************/ +/* color instances */ +/************************************************************************/ + +static int +x_parse_nearest_color (struct device *d, XColor *color, Lisp_Object name, + Error_Behavior errb) +{ + Display *dpy = DEVICE_X_DISPLAY (d); + Colormap cmap = DEVICE_X_COLORMAP (d); + Visual *visual = DEVICE_X_VISUAL (d); + int result; + + xzero (*color); + { + const Extbyte *extname; + + extname = LISP_STRING_TO_EXTERNAL (name, Qx_color_name_encoding); + result = XParseColor (dpy, cmap, extname, color); + } + if (!result) + { + maybe_signal_error (Qgui_error, "Unrecognized color", + name, Qcolor, errb); + return 0; + } + result = x_allocate_nearest_color (dpy, cmap, visual, color); + if (!result) + { + maybe_signal_error (Qgui_error, "Couldn't allocate color", + name, Qcolor, errb); + return 0; + } + + return result; +} + +static int +x_initialize_color_instance (Lisp_Color_Instance *c, Lisp_Object name, + Lisp_Object device, Error_Behavior errb) +{ + XColor color; +#ifdef HAVE_XFT + XftColor xftColor; +#endif + int result; + + result = x_parse_nearest_color (XDEVICE (device), &color, name, errb); + + if (!result) + return 0; + + /* Don't allocate the data until we're sure that we will succeed, + or the finalize method may get fucked. */ + c->data = xnew (struct x_color_instance_data); + if (result == 3) + COLOR_INSTANCE_X_DEALLOC (c) = 0; + else + COLOR_INSTANCE_X_DEALLOC (c) = 1; + COLOR_INSTANCE_X_COLOR (c) = color; + +#ifdef HAVE_XFT + xftColor.pixel = color.pixel; + xftColor.color.red = color.red; + xftColor.color.green = color.green; + xftColor.color.blue = color.blue; + xftColor.color.alpha = 0xffff; + + COLOR_INSTANCE_X_XFTCOLOR (c) = xftColor; +#endif + + return 1; +} + +static void +x_print_color_instance (Lisp_Color_Instance *c, + Lisp_Object printcharfun, + int UNUSED (escapeflag)) +{ + XColor color = COLOR_INSTANCE_X_COLOR (c); + write_fmt_string (printcharfun, " %ld=(%X,%X,%X)", + color.pixel, color.red, color.green, color.blue); +} + +static void +x_finalize_color_instance (Lisp_Color_Instance *c) +{ + if (c->data) + { + if (DEVICE_LIVE_P (XDEVICE (c->device))) + { + if (COLOR_INSTANCE_X_DEALLOC (c)) + { + XFreeColors (DEVICE_X_DISPLAY (XDEVICE (c->device)), + DEVICE_X_COLORMAP (XDEVICE (c->device)), + &COLOR_INSTANCE_X_COLOR (c).pixel, 1, 0); + } + } + xfree (c->data); + c->data = 0; + } +} + +/* Color instances are equal if they resolve to the same color on the + screen (have the same RGB values). I imagine that + "same RGB values" == "same cell in the colormap." Arguably we should + be comparing their names or pixel values instead. */ + +static int +x_color_instance_equal (Lisp_Color_Instance *c1, + Lisp_Color_Instance *c2, + int UNUSED (depth)) +{ + XColor color1 = COLOR_INSTANCE_X_COLOR (c1); + XColor color2 = COLOR_INSTANCE_X_COLOR (c2); + return ((color1.red == color2.red) && + (color1.green == color2.green) && + (color1.blue == color2.blue)); +} + +static Hashcode +x_color_instance_hash (Lisp_Color_Instance *c, int UNUSED (depth)) +{ + XColor color = COLOR_INSTANCE_X_COLOR (c); + return HASH3 (color.red, color.green, color.blue); +} + +static Lisp_Object +x_color_instance_rgb_components (Lisp_Color_Instance *c) +{ + XColor color = COLOR_INSTANCE_X_COLOR (c); + return (list3 (make_int (color.red), + make_int (color.green), + make_int (color.blue))); +} + +static int +x_valid_color_name_p (struct device *d, Lisp_Object color) +{ + XColor c; + Display *dpy = DEVICE_X_DISPLAY (d); + Colormap cmap = DEVICE_X_COLORMAP (d); + const Extbyte *extname; + + extname = LISP_STRING_TO_EXTERNAL (color, Qx_color_name_encoding); + + return XParseColor (dpy, cmap, extname, &c); +} + +static Lisp_Object +x_color_list (void) +{ + return call0 (intern ("x-color-list-internal")); +} + + +/************************************************************************/ +/* font instances */ +/************************************************************************/ + + +static int +x_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object UNUSED (name), + Lisp_Object device, Error_Behavior errb) +{ + Display *dpy = DEVICE_X_DISPLAY (XDEVICE (device)); + Extbyte *extname; + XFontStruct *fs = NULL; /* _F_ont _S_truct */ +#ifdef HAVE_XFT + XftFont *rf = NULL; /* _R_ender _F_ont (X Render extension) */ +#else +#define rf (0) +#endif + +#ifdef HAVE_XFT + DEBUG_XFT1 (2, "attempting to initialize font spec %s\n", + XSTRING_DATA(f->name)); + /* #### serialize (optimize) these later... */ + /* #### This function really needs to go away. + The problem is that the fontconfig/Xft functions work much too hard + to ensure that something is returned; but that something need not be + at all close to what we asked for. */ + extname = LISP_STRING_TO_EXTERNAL (f->name, Qfc_font_name_encoding); + rf = xft_open_font_by_name (dpy, extname); +#endif + extname = LISP_STRING_TO_EXTERNAL (f->name, Qx_font_name_encoding); + /* With XFree86 4.0's fonts, XListFonts returns an entry for + -isas-fangsong ti-medium-r-normal--16-160-72-72-c-160-gb2312.1980-0 but + an XLoadQueryFont on the corresponding XLFD returns NULL. + + XListFonts is not trustworthy (of course, this is news to exactly + no-one used to reading XEmacs source.) */ + fs = XLoadQueryFont (dpy, extname); + + if (!fs && !rf) + { + /* #### should this refer to X and/or Xft? */ + maybe_signal_error (Qgui_error, "Couldn't load font", f->name, + Qfont, errb); + return 0; + } + + if (rf && fs) + { + XFreeFont (dpy, fs); + fs = NULL; /* we don' need no steenkin' X font */ + } + + if (fs && !fs->max_bounds.width) + { + /* yes, this has been known to happen. */ + XFreeFont (dpy, fs); + fs = NULL; + maybe_signal_error (Qgui_error, "X font is too small", f->name, Qfont, + errb); + return 0; + } + + /* Now that we're sure that we will succeed, we can allocate data without + fear that the finalize method may get fucked. */ + f->data = xnew (struct x_font_instance_data); + +#ifdef HAVE_XFT + FONT_INSTANCE_X_XFTFONT (f) = rf; + if (rf) + /* Have an Xft font, initialize font info from it. */ + { + DEBUG_XFT4 (2, "pre-initial ascent %d descent %d width %d height %d\n", + f->ascent, f->descent, f->width, f->height); + + /* #### This shit is just plain wrong unless we have a character cell + font. It really hoses us on large repertoire Unicode fonts with + "double-width" characters. */ + f->ascent = rf->ascent; + f->descent = rf->descent; + { + /* This is an approximation that AFAIK only gets used to compute + cell size for estimating window dimensions. The test_string8 + is an ASCII string whose characters should approximate the + distribution of widths expected in real text. */ + static const FcChar8 test_string8[] = "Mmneei"; + static const int len = sizeof (test_string8) - 1; + XGlyphInfo glyphinfo; + + XftTextExtents8 (dpy, rf, test_string8, len, &glyphinfo); + /* #### maybe should be glyphinfo.xOff - glyphinfo.x? */ + f->width = (2*glyphinfo.width + len)/(2*len); + } + f->height = rf->height; + f->proportional_p = 1; /* we can't recognize monospaced fonts! */ + + /* #### This message appears wa-a-ay too often! + We probably need to cache truenames or something? + Even if Xft does it for us, we cons too many font instances. */ + DEBUG_XFT4 (0, + "initialized metrics ascent %d descent %d width %d height %d\n", + f->ascent, f->descent, f->width, f->height); + } + else + { + DEBUG_XFT1 (0, "couldn't initialize Xft font %s\n", + XSTRING_DATA(f->name)); + } +#endif + + FONT_INSTANCE_X_FONT (f) = fs; + if (fs) + /* Have to use a core font, initialize font info from it. */ + { + f->ascent = fs->ascent; + f->descent = fs->descent; + f->height = fs->ascent + fs->descent; + { + /* following change suggested by Ted Phelps */ + int def_char = 'n'; /*fs->default_char;*/ + int byte1, byte2; + + once_more: + byte1 = def_char >> 8; + byte2 = def_char & 0xFF; + + if (fs->per_char) + { + /* Old versions of the R5 font server have garbage (>63k) as + def_char. 'n' might not be a valid character. */ + if (byte1 < (int) fs->min_byte1 || + byte1 > (int) fs->max_byte1 || + byte2 < (int) fs->min_char_or_byte2 || + byte2 > (int) fs->max_char_or_byte2) + f->width = 0; + else + f->width = fs->per_char[(byte1 - fs->min_byte1) * + (fs->max_char_or_byte2 - + fs->min_char_or_byte2 + 1) + + (byte2 - fs->min_char_or_byte2)].width; + } + else + f->width = fs->max_bounds.width; + + /* Some fonts have a default char whose width is 0. This is no good. + If that's the case, first try 'n' as the default char, and if n has + 0 width too (unlikely) then just use the max width. */ + if (f->width == 0) + { + if (def_char == (int) fs->default_char) + f->width = fs->max_bounds.width; + else + { + def_char = fs->default_char; + goto once_more; + } + } + } + + /* If all characters don't exist then there could potentially be + 0-width characters lurking out there. Not setting this flag + trips an optimization that would make them appear to have width + to redisplay. This is bad. So we set it if not all characters + have the same width or if not all characters are defined. */ + /* #### This sucks. There is a measurable performance increase + when using proportional width fonts if this flag is not set. + Unfortunately so many of the fucking X fonts are not fully + defined that we could almost just get rid of this damn flag and + make it an assertion. */ + f->proportional_p = (fs->min_bounds.width != fs->max_bounds.width || + (x_handle_non_fully_specified_fonts && + !fs->all_chars_exist)); + } + +#ifdef HAVE_XFT + if (debug_xft > 0) + { + int n = 3, d = 5; + /* check for weirdness */ + if (n * f->height < d * f->width) + stderr_out ("font %s: width:height is %d:%d, larger than %d:%d\n", + XSTRING_DATA(f->name), f->width, f->height, n, d); + if (f->height <= 0 || f->width <= 0) + stderr_out ("bogus dimensions of font %s: width = %d, height = %d\n", + XSTRING_DATA(f->name), f->width, f->height); + stderr_out ("initialized font %s\n", XSTRING_DATA(f->name)); + } +#else +#undef rf +#endif + + return 1; +} + +static void +x_print_font_instance (Lisp_Font_Instance *f, + Lisp_Object printcharfun, + int UNUSED (escapeflag)) +{ + /* We should print information here about initial vs. final stages; we + can't rely on the device charset stage cache for that, + unfortunately. */ + if (FONT_INSTANCE_X_FONT (f)) + write_fmt_string (printcharfun, " font id: 0x%lx,", + (unsigned long) FONT_INSTANCE_X_FONT (f)->fid); + +#ifdef HAVE_XFT + /* #### What should we do here? For now, print the address. */ + if (FONT_INSTANCE_X_XFTFONT (f)) + write_fmt_string (printcharfun, " xft font: 0x%lx", + (unsigned long) FONT_INSTANCE_X_XFTFONT (f)); +#endif +} + +static void +x_finalize_font_instance (Lisp_Font_Instance *f) +{ + +#ifdef HAVE_XFT + DEBUG_XFT1 (0, "finalizing %s\n", (STRINGP (f->name) + ? (char *) XSTRING_DATA (f->name) + : "(unnamed font)")); +#endif + + if (f->data) + { + if (DEVICE_LIVE_P (XDEVICE (f->device))) + { + Display *dpy = DEVICE_X_DISPLAY (XDEVICE (f->device)); + + if (FONT_INSTANCE_X_FONT (f)) + XFreeFont (dpy, FONT_INSTANCE_X_FONT (f)); +#ifdef HAVE_XFT + if (FONT_INSTANCE_X_XFTFONT (f)) + XftFontClose (dpy, FONT_INSTANCE_X_XFTFONT (f)); +#endif + } + xfree (f->data); + f->data = 0; + } +} + +/* Determining the truename of a font is hard. (Big surprise.) + + This is not true for fontconfig. Each font has a (nearly) canonical + representation up to permutation of the order of properties. It is + possible to construct a name which exactly identifies the properties of + the current font. However, it is theoretically possible that there exists + another font with a super set of those properties that would happen to get + selected. -- sjt + + By "truename" we mean an XLFD-form name which contains no wildcards, yet + which resolves to *exactly* the same font as the one which we already have + the (probably wildcarded) name and `XFontStruct' of. + + One might think that the first font returned by XListFonts would be the one + that XOpenFont would pick. Apparently this is the case on some servers, + but not on others. It would seem not to be specified. + + The MIT R5 server sometimes appears to be picking the lexicographically + smallest font which matches the name (thus picking "adobe" fonts before + "bitstream" fonts even if the bitstream fonts are earlier in the path, and + also picking 100dpi adobe fonts over 75dpi adobe fonts even though the + 75dpi are in the path earlier) but sometimes appears to be doing something + else entirely (for example, removing the bitstream fonts from the path will + cause the 75dpi adobe fonts to be used instead of the 100dpi, even though + their relative positions in the path (and their names!) have not changed). + + The documentation for XSetFontPath() seems to indicate that the order of + entries in the font path means something, but it's pretty noncommittal about + it, and the spirit of the law is apparently not being obeyed... + + All the fonts I've seen have a property named `FONT' which contains the + truename of the font. However, there are two problems with using this: the + first is that the X Protocol Document is quite explicit that all properties + are optional, so we can't depend on it being there. The second is that + it's conceivable that this alleged truename isn't actually accessible as a + font, due to some difference of opinion between the font designers and + whoever installed the font on the system. + + So, our first attempt is to look for a FONT property, and then verify that + the name there is a valid name by running XListFonts on it. There's still + the potential that this could be true but we could still be being lied to, + but that seems pretty remote. + + Late breaking news: I've gotten reports that SunOS 4.1.3U1 + with OpenWound 3.0 has a font whose truename is really + "-Adobe-Courier-Medium-R-Normal--12-120-75-75-M-70-ISO8859-1" + but whose FONT property contains "Courier". + + So we disbelieve the FONT property unless it begins with a dash and + is more than 30 characters long. X Windows: The defacto substandard. + X Windows: Complex nonsolutions to simple nonproblems. X Windows: + Live the nightmare. + + If the FONT property doesn't exist, then we try and construct an XLFD name + out of the other font properties (FOUNDRY, FAMILY_NAME, WEIGHT_NAME, etc). + This is necessary at least for some versions of OpenWound. But who knows + what the future will bring. + + If that doesn't work, then we use XListFonts and either take the first font + (which I think is the most sensible thing) or we find the lexicographically + least, depending on whether the preprocessor constant `XOPENFONT_SORTS' is + defined. This sucks because the two behaviors are a property of the server + being used, not the architecture on which emacs has been compiled. Also, + as I described above, sorting isn't ALWAYS what the server does. Really it + does something seemingly random. There is no reliable way to win if the + FONT property isn't present. + + Another possibility which I haven't bothered to implement would be to map + over all of the matching fonts and find the first one that has the same + character metrics as the font we already have loaded. Even if this didn't + return exactly the same font, it would at least return one whose characters + were the same sizes, which would probably be good enough. + + More late-breaking news: on RS/6000 AIX 3.2.4, the expression + XLoadQueryFont (dpy, "-*-Fixed-Medium-R-*-*-*-130-75-75-*-*-ISO8859-1") + actually returns the font + -Misc-Fixed-Medium-R-Normal--13-120-75-75-C-80-ISO8859-1 + which is crazy, because that font doesn't even match that pattern! It is + also not included in the output produced by `xlsfonts' with that pattern. + + So this is yet another example of XListFonts() and XOpenFont() using + completely different algorithms. This, however, is a goofier example of + this bug, because in this case, it's not just the search order that is + different -- the sets don't even intersect. + + If anyone has any better ideas how to do this, or any insights on what it is + that the various servers are actually doing, please let me know! -- jwz. */ + +static int +valid_x_font_name_p (Display *dpy, Extbyte *name) +{ + /* Maybe this should be implemented by calling XLoadFont and trapping + the error. That would be a lot of work, and wasteful as hell, but + might be more correct. + */ + int nnames = 0; + Extbyte **names = 0; + if (! name) + return 0; + names = XListFonts (dpy, name, 1, &nnames); + if (names) + XFreeFontNames (names); + return (nnames != 0); +} + +static Extbyte * +truename_via_FONT_prop (Display *dpy, XFontStruct *font) +{ + unsigned long value = 0; + Extbyte *result = 0; + if (XGetFontProperty (font, XA_FONT, &value)) + result = XGetAtomName (dpy, value); + /* result is now 0, or the string value of the FONT property. */ + if (result) + { + /* Verify that result is an XLFD name (roughly...) */ + if (result [0] != '-' || strlen (result) < 30) + { + XFree (result); + result = 0; + } + } + return result; /* this must be freed by caller if non-0 */ +} + +static Extbyte * +truename_via_random_props (Display *dpy, XFontStruct *font) +{ + struct device *d = get_device_from_display (dpy); + unsigned long value = 0; + Extbyte *foundry, *family, *weight, *slant, *setwidth, *add_style; + unsigned long pixel, point, res_x, res_y; + Extbyte *spacing; + unsigned long avg_width; + Extbyte *registry, *encoding; + Extbyte composed_name [2048]; + int ok = 0; + Extbyte *result; + +#define get_string(atom,var) \ + if (XGetFontProperty (font, (atom), &value)) \ + var = XGetAtomName (dpy, value); \ + else { \ + var = 0; \ + goto FAIL; } +#define get_number(atom,var) \ + if (!XGetFontProperty (font, (atom), &var) || \ + var > 999) \ + goto FAIL; + + foundry = family = weight = slant = setwidth = 0; + add_style = spacing = registry = encoding = 0; + + get_string (DEVICE_XATOM_FOUNDRY (d), foundry); + get_string (DEVICE_XATOM_FAMILY_NAME (d), family); + get_string (DEVICE_XATOM_WEIGHT_NAME (d), weight); + get_string (DEVICE_XATOM_SLANT (d), slant); + get_string (DEVICE_XATOM_SETWIDTH_NAME (d), setwidth); + get_string (DEVICE_XATOM_ADD_STYLE_NAME (d), add_style); + get_number (DEVICE_XATOM_PIXEL_SIZE (d), pixel); + get_number (DEVICE_XATOM_POINT_SIZE (d), point); + get_number (DEVICE_XATOM_RESOLUTION_X (d), res_x); + get_number (DEVICE_XATOM_RESOLUTION_Y (d), res_y); + get_string (DEVICE_XATOM_SPACING (d), spacing); + get_number (DEVICE_XATOM_AVERAGE_WIDTH (d), avg_width); + get_string (DEVICE_XATOM_CHARSET_REGISTRY (d), registry); + get_string (DEVICE_XATOM_CHARSET_ENCODING (d), encoding); +#undef get_number +#undef get_string + + sprintf (composed_name, + "-%s-%s-%s-%s-%s-%s-%ld-%ld-%ld-%ld-%s-%ld-%s-%s", + foundry, family, weight, slant, setwidth, add_style, pixel, + point, res_x, res_y, spacing, avg_width, registry, encoding); + ok = 1; + + FAIL: + if (ok) + { + int L = strlen (composed_name) + 1; + result = xnew_extbytes (L); + strncpy (result, composed_name, L); + } + else + result = 0; + + if (foundry) XFree (foundry); + if (family) XFree (family); + if (weight) XFree (weight); + if (slant) XFree (slant); + if (setwidth) XFree (setwidth); + if (add_style) XFree (add_style); + if (spacing) XFree (spacing); + if (registry) XFree (registry); + if (encoding) XFree (encoding); + + return result; +} + +/* XListFonts doesn't allocate memory unconditionally based on this. (For + XFree86 in 2005, at least. */ +#define MAX_FONT_COUNT INT_MAX + +static Extbyte * +truename_via_XListFonts (Display *dpy, Extbyte *font_name) +{ + Extbyte *result = 0; + Extbyte **names; + int count = 0; + +#ifndef XOPENFONT_SORTS + /* In a sensible world, the first font returned by XListFonts() + would be the font that XOpenFont() would use. */ + names = XListFonts (dpy, font_name, 1, &count); + if (count) result = names [0]; +#else + /* But the world I live in is much more perverse. */ + names = XListFonts (dpy, font_name, MAX_FONT_COUNT, &count); + /* Find the lexicographic minimum of names[]. + (#### Should we be comparing case-insensitively?) */ + while (count--) + /* [[ !!#### Not Mule-friendly ]] + Doesn't matter, XLFDs are HPC (old) or Latin1 (modern). If they + aren't, who knows what they are? -- sjt */ + if (result == 0 || (strcmp (result, names [count]) < 0)) + result = names [count]; +#endif + + if (result) + result = xstrdup (result); + if (names) + XFreeFontNames (names); + + return result; /* this must be freed by caller if non-0 */ +} + +static Lisp_Object +x_font_truename (Display *dpy, Extbyte *name, XFontStruct *font) +{ + Extbyte *truename_FONT = 0; + Extbyte *truename_random = 0; + Extbyte *truename = 0; + + /* The search order is: + - if FONT property exists, and is a valid name, return it. + - if the other props exist, and add up to a valid name, return it. + - if we find a matching name with XListFonts, return it. + - if FONT property exists, return it regardless. + - if other props exist, return the resultant name regardless. + - else return 0. + */ + + truename = truename_FONT = truename_via_FONT_prop (dpy, font); + if (truename && !valid_x_font_name_p (dpy, truename)) + truename = 0; + if (!truename) + truename = truename_random = truename_via_random_props (dpy, font); + if (truename && !valid_x_font_name_p (dpy, truename)) + truename = 0; + if (!truename && name) + truename = truename_via_XListFonts (dpy, name); + + if (!truename) + { + /* Gag - we weren't able to find a seemingly-valid truename. + Well, maybe we're on one of those braindead systems where + XListFonts() and XLoadFont() are in violent disagreement. + If we were able to compute a truename, try using that even + if evidence suggests that it's not a valid name - because + maybe it is, really, and that's better than nothing. + X Windows: You'll envy the dead. + */ + if (truename_FONT) + truename = truename_FONT; + else if (truename_random) + truename = truename_random; + } + + /* One or both of these are not being used - free them. */ + if (truename_FONT && truename_FONT != truename) + XFree (truename_FONT); + if (truename_random && truename_random != truename) + XFree (truename_random); + + if (truename) + { + Lisp_Object result = build_extstring (truename, Qx_font_name_encoding); + XFree (truename); + return result; + } + else + return Qnil; +} + +static Lisp_Object +x_font_instance_truename (Lisp_Font_Instance *f, Error_Behavior errb) +{ + struct device *d = XDEVICE (f->device); + Display *dpy = DEVICE_X_DISPLAY (d); + Extbyte *nameext; + + /* #### restructure this so that we return a valid truename at the end, + and otherwise only return when we return something desperate that + doesn't get stored for future use. */ + +#ifdef HAVE_XFT + /* First, try an Xft font. */ + if (NILP (FONT_INSTANCE_TRUENAME (f)) && FONT_INSTANCE_X_XFTFONT (f)) + { + /* The font is already open, we just unparse. */ + FcChar8 *res = FcNameUnparse (FONT_INSTANCE_X_XFTFONT (f)->pattern); + if (! FONT_INSTANCE_X_XFTFONT (f)->pattern) + { + maybe_signal_error (Qgui_error, + "Xft font present but lacks pattern", + wrap_font_instance(f), Qfont, errb); + } + if (res) + { + FONT_INSTANCE_TRUENAME (f) = + build_extstring ((Extbyte *) res, Qfc_font_name_encoding); + free (res); + return FONT_INSTANCE_TRUENAME (f); + } + else + { + maybe_signal_error (Qgui_error, + "Couldn't unparse Xft font to truename", + wrap_font_instance(f), Qfont, errb); + /* used to return Qnil here */ + } + } +#endif /* HAVE_XFT */ + + /* OK, fall back to core font. */ + if (NILP (FONT_INSTANCE_TRUENAME (f)) + && FONT_INSTANCE_X_FONT (f)) + { + nameext = LISP_STRING_TO_EXTERNAL (f->name, Qx_font_name_encoding); + FONT_INSTANCE_TRUENAME (f) = + x_font_truename (dpy, nameext, FONT_INSTANCE_X_FONT (f)); + } + + if (NILP (FONT_INSTANCE_TRUENAME (f))) + { + /* Urk, no luck. Whine about our bad luck and exit. */ + Lisp_Object font_instance = wrap_font_instance (f); + + + maybe_signal_error (Qgui_error, "Couldn't determine font truename", + font_instance, Qfont, errb); + /* Ok, just this once, return the font name as the truename. + (This is only used by Fequal() right now.) */ + return f->name; + } + + /* Return what we found. */ + return FONT_INSTANCE_TRUENAME (f); +} + +static Lisp_Object +x_font_instance_properties (Lisp_Font_Instance *f) +{ + struct device *d = XDEVICE (f->device); + int i; + Lisp_Object result = Qnil; + Display *dpy = DEVICE_X_DISPLAY (d); + XFontProp *props = NULL; + + /* #### really should hack Xft fonts, too + Strategy: fontconfig must have an iterator for this purpose. */ + if (! FONT_INSTANCE_X_FONT (f)) return result; + + props = FONT_INSTANCE_X_FONT (f)->properties; + for (i = FONT_INSTANCE_X_FONT (f)->n_properties - 1; i >= 0; i--) + { + Lisp_Object name, value; + Atom atom = props [i].name; + Ibyte *name_str = 0; + Bytecount name_len; + Extbyte *namestrext = XGetAtomName (dpy, atom); + + if (namestrext) + TO_INTERNAL_FORMAT (C_STRING, namestrext, + ALLOCA, (name_str, name_len), + Qx_atom_name_encoding); + + name = (name_str ? intern_istring (name_str) : Qnil); + if (name_str && + (atom == XA_FONT || + atom == DEVICE_XATOM_FOUNDRY (d) || + atom == DEVICE_XATOM_FAMILY_NAME (d) || + atom == DEVICE_XATOM_WEIGHT_NAME (d) || + atom == DEVICE_XATOM_SLANT (d) || + atom == DEVICE_XATOM_SETWIDTH_NAME (d) || + atom == DEVICE_XATOM_ADD_STYLE_NAME (d) || + atom == DEVICE_XATOM_SPACING (d) || + atom == DEVICE_XATOM_CHARSET_REGISTRY (d) || + atom == DEVICE_XATOM_CHARSET_ENCODING (d) || + !qxestrcmp_ascii (name_str, "CHARSET_COLLECTIONS") || + !qxestrcmp_ascii (name_str, "FONTNAME_REGISTRY") || + !qxestrcmp_ascii (name_str, "CLASSIFICATION") || + !qxestrcmp_ascii (name_str, "COPYRIGHT") || + !qxestrcmp_ascii (name_str, "DEVICE_FONT_NAME") || + !qxestrcmp_ascii (name_str, "FULL_NAME") || + !qxestrcmp_ascii (name_str, "MONOSPACED") || + !qxestrcmp_ascii (name_str, "QUALITY") || + !qxestrcmp_ascii (name_str, "RELATIVE_SET") || + !qxestrcmp_ascii (name_str, "RELATIVE_WEIGHT") || + !qxestrcmp_ascii (name_str, "STYLE"))) + { + Extbyte *val_str = XGetAtomName (dpy, props [i].card32); + + value = (val_str ? build_extstring (val_str, Qx_atom_name_encoding) + : Qnil); + } + else + value = make_int (props [i].card32); + if (namestrext) XFree (namestrext); + result = Fcons (Fcons (name, value), result); + } + return result; +} + +static Lisp_Object +x_font_list (Lisp_Object pattern, Lisp_Object device, Lisp_Object maxnumber) +{ + Extbyte **names; + int count = 0; + int max_number = MAX_FONT_COUNT; + Lisp_Object result = Qnil; + const Extbyte *patternext; + + patternext = LISP_STRING_TO_EXTERNAL (pattern, Qx_font_name_encoding); + + if (!NILP(maxnumber) && INTP(maxnumber)) + { + max_number = XINT(maxnumber); + } + + names = XListFonts (DEVICE_X_DISPLAY (XDEVICE (device)), + patternext, max_number, &count); + while (count--) + result = Fcons (build_extstring (names[count], Qx_font_name_encoding), + result); + if (names) + XFreeFontNames (names); + return result; +} + +/* Include the charset support, shared, for the moment, with GTK. */ +#define THIS_IS_X +#include "fontcolor-xlike-inc.c" + + +/************************************************************************/ +/* initialization */ +/************************************************************************/ + +void +syms_of_fontcolor_x (void) +{ +} + +void +console_type_create_fontcolor_x (void) +{ + /* object methods */ + + CONSOLE_HAS_METHOD (x, initialize_color_instance); + CONSOLE_HAS_METHOD (x, print_color_instance); + CONSOLE_HAS_METHOD (x, finalize_color_instance); + CONSOLE_HAS_METHOD (x, color_instance_equal); + CONSOLE_HAS_METHOD (x, color_instance_hash); + CONSOLE_HAS_METHOD (x, color_instance_rgb_components); + CONSOLE_HAS_METHOD (x, valid_color_name_p); + CONSOLE_HAS_METHOD (x, color_list); + + CONSOLE_HAS_METHOD (x, initialize_font_instance); + CONSOLE_HAS_METHOD (x, print_font_instance); + CONSOLE_HAS_METHOD (x, finalize_font_instance); + CONSOLE_HAS_METHOD (x, font_instance_truename); + CONSOLE_HAS_METHOD (x, font_instance_properties); + CONSOLE_HAS_METHOD (x, font_list); +#ifdef MULE + CONSOLE_HAS_METHOD (x, find_charset_font); + CONSOLE_HAS_METHOD (x, font_spec_matches_charset); +#endif +} + +void +vars_of_fontcolor_x (void) +{ +#ifdef DEBUG_XEMACS + DEFVAR_INT ("debug-x-fonts", &debug_x_fonts /* +If non-zero, display debug information about X fonts +*/ ); + debug_x_fonts = 0; +#endif + + DEFVAR_BOOL ("x-handle-non-fully-specified-fonts", + &x_handle_non_fully_specified_fonts /* +If this is true then fonts which do not have all characters specified +will be considered to be proportional width even if they are actually +fixed-width. If this is not done then characters which are supposed to +have 0 width may appear to actually have some width. + +Note: While setting this to t guarantees correct output in all +circumstances, it also causes a noticeable performance hit when using +fixed-width fonts. Since most people don't use characters which could +cause problems this is set to nil by default. +*/ ); + x_handle_non_fully_specified_fonts = 0; + +#ifdef HAVE_XFT + Fprovide (intern ("xft-fonts")); +#endif +} + +void +Xatoms_of_fontcolor_x (struct device *d) +{ + Display *D = DEVICE_X_DISPLAY (d); + + DEVICE_XATOM_FOUNDRY (d) = XInternAtom (D, "FOUNDRY", False); + DEVICE_XATOM_FAMILY_NAME (d) = XInternAtom (D, "FAMILY_NAME", False); + DEVICE_XATOM_WEIGHT_NAME (d) = XInternAtom (D, "WEIGHT_NAME", False); + DEVICE_XATOM_SLANT (d) = XInternAtom (D, "SLANT", False); + DEVICE_XATOM_SETWIDTH_NAME (d) = XInternAtom (D, "SETWIDTH_NAME", False); + DEVICE_XATOM_ADD_STYLE_NAME (d) = XInternAtom (D, "ADD_STYLE_NAME", False); + DEVICE_XATOM_PIXEL_SIZE (d) = XInternAtom (D, "PIXEL_SIZE", False); + DEVICE_XATOM_POINT_SIZE (d) = XInternAtom (D, "POINT_SIZE", False); + DEVICE_XATOM_RESOLUTION_X (d) = XInternAtom (D, "RESOLUTION_X", False); + DEVICE_XATOM_RESOLUTION_Y (d) = XInternAtom (D, "RESOLUTION_Y", False); + DEVICE_XATOM_SPACING (d) = XInternAtom (D, "SPACING", False); + DEVICE_XATOM_AVERAGE_WIDTH (d) = XInternAtom (D, "AVERAGE_WIDTH", False); + DEVICE_XATOM_CHARSET_REGISTRY(d) = XInternAtom (D, "CHARSET_REGISTRY",False); + DEVICE_XATOM_CHARSET_ENCODING(d) = XInternAtom (D, "CHARSET_ENCODING",False); +} diff -r 861f2601a38b -r 1f0b15040456 src/fontcolor-x.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/fontcolor-x.h Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,41 @@ +/* X-specific Lisp objects. + Copyright (C) 1993, 1994 Free Software Foundation, Inc. + Copyright (C) 1995 Board of Trustees, University of Illinois. + Copyright (C) 1995, 1996, 2002 Ben Wing. + +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 3 of the License, 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. If not, see . */ + +/* Synched up with: Not in FSF. */ + +/* This file Mule-ized (more like Mule-verified) by Ben Wing, 7-10-00. */ + +#ifndef INCLUDED_fontcolor_x_h_ +#define INCLUDED_fontcolor_x_h_ + +#include "fontcolor.h" +#include "../lwlib/lwlib-colors.h" /* for x_allocate_nearest_color */ + +#ifdef HAVE_X_WINDOWS + +#ifdef HAVE_XFT +EXFUN (Ffc_font_real_pattern, 2); +#endif + +/* Lisp_Object Fxlfd_font_name_p; */ + +#endif /* HAVE_X_WINDOWS */ + +#endif /* INCLUDED_fontcolor_x_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/fontcolor-xlike-inc.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/fontcolor-xlike-inc.c Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,909 @@ +/* Common code between X and GTK -- fonts and colors. + Copyright (C) 1991-5, 1997 Free Software Foundation, Inc. + Copyright (C) 1995 Sun Microsystems, Inc. + Copyright (C) 1996, 2001, 2002, 2003, 2010 Ben Wing. + +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 3 of the License, 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. If not, see . */ + +/* Synched up with: Not in FSF. */ + +/* Before including this file, you need to define either THIS_IS_X or + THIS_IS_GTK. */ + +/* See comment at top of console-xlike-inc.h for an explanation of + how this file works. */ + +/* Pango is ready for prime-time now, as far as I understand it. The GTK + people should be using that. Oh well. (Aidan Kehoe, Sat Nov 4 12:41:12 + CET 2006) */ + +#include "console-xlike-inc.h" + +#ifdef DEBUG_XEMACS +# define DEBUG_FONTS1(format, arg) \ +do { \ + if (debug_x_fonts) \ + debug_out (format, arg); \ +} while (0) + +# define DEBUG_FONTS2(format, arg1, arg2) \ +do { \ + if (debug_x_fonts) \ + debug_out (format, arg1, arg2); \ +} while (0) + +# define DEBUG_FONTS3(format, arg1, arg2, arg3) \ +do { \ + if (debug_x_fonts) \ + debug_out (format, arg1, arg2, arg3); \ +} while (0) + +# define DEBUG_FONTS4(format, arg1, arg2, arg3, arg4) \ +do { \ + if (debug_x_fonts) \ + debug_out (format, arg1, arg2, arg3, arg4); \ +} while (0) + +# define DEBUG_FONTS_LISP1(format, arg) \ +do { \ + if (debug_x_fonts) \ + debug_out_lisp (format, 1, arg); \ +} while (0) + +# define DEBUG_FONTS_LISP2(format, arg1, arg2) \ +do { \ + if (debug_x_fonts) \ + debug_out_lisp (format, 2, arg1, arg2); \ +} while (0) + +# define DEBUG_FONTS_LISP3(format, arg1, arg2, arg3) \ +do { \ + if (debug_x_fonts) \ + debug_out_lisp (format, 3, arg1, arg2, arg3); \ +} while (0) + +# define DEBUG_FONTS_LISP4(format, arg1, arg2, arg3, arg4) \ +do { \ + if (debug_x_fonts) \ + debug_out_lisp (format, 4, arg1, arg2, arg3, arg4); \ +} while (0) +#else /* not DEBUG_XEMACS */ +# define DEBUG_FONTS1(format, arg) +# define DEBUG_FONTS2(format, arg1, arg2) +# define DEBUG_FONTS3(format, arg1, arg2, arg3) +# define DEBUG_FONTS4(format, arg1, arg2, arg3, arg4) +# define DEBUG_FONTS_LISP1(format, arg) +# define DEBUG_FONTS_LISP2(format, arg1, arg2) +# define DEBUG_FONTS_LISP3(format, arg1, arg2, arg3) +# define DEBUG_FONTS_LISP4(format, arg1, arg2, arg3, arg4) +#endif + +#ifdef MULE + +/* For some code it's reasonable to have only one copy and conditionalize + at run-time. For other code it isn't. */ + +static int +count_hyphens (const Ibyte *str, Bytecount length, Ibyte **last_hyphen) +{ + int hyphen_count = 0; + const Ibyte *hyphening = str; + const Ibyte *new_hyphening; + + for (hyphen_count = 0; + NULL != (new_hyphening = (Ibyte *) memchr ((const void *)hyphening, '-', length)); + hyphen_count++) + { + ++new_hyphening; + length -= new_hyphening - hyphening; + hyphening = new_hyphening; + } + + if (NULL != last_hyphen) + { + *last_hyphen = (Ibyte *)hyphening; + } + + return hyphen_count; +} + +static int +XFUN (font_spec_matches_charset) (struct device * USED_IF_XFT (d), + Lisp_Object charset, + const Ibyte *nonreloc, Lisp_Object reloc, + Bytecount offset, Bytecount length, + enum font_specifier_matchspec_stages stage) +{ + Lisp_Object registries = Qnil; + long i, registries_len; + const Ibyte *the_nonreloc; + Bytecount the_length; + + the_nonreloc = nonreloc; + the_length = length; + + if (!the_nonreloc) + the_nonreloc = XSTRING_DATA (reloc); + fixup_internal_substring (nonreloc, reloc, offset, &the_length); + the_nonreloc += offset; + +#ifdef USE_XFT + if (stage == STAGE_FINAL) + { + Display *dpy = DEVICE_X_DISPLAY (d); + Extbyte *extname; + XftFont *rf; + + if (!NILP (reloc)) + { + the_nonreloc = XSTRING_DATA (reloc); + extname = LISP_STRING_TO_EXTERNAL (reloc, Qx_font_name_encoding); + rf = xft_open_font_by_name (dpy, extname); + return 0; /* #### maybe this will compile and run ;) */ + /* Jesus, Stephen, what the fuck? */ + } + } +#endif + + /* Hmm, this smells bad. */ + if (NILP (charset)) + return 1; + + /* Hack! Short font names don't have the registry in them, + so we just assume the user knows what they're doing in the + case of ASCII. For other charsets, you gotta give the + long form; sorry buster. + #### FMH: this screws fontconfig/Xft? + STRATEGY: use fontconfig's ability to hack languages and character + sets (lang and charset properties). + #### Maybe we can use the fontconfig model to eliminate the difference + between faces and fonts? No - it looks like that would be an abuse + (fontconfig doesn't know about colors, although Xft does). + */ + if (EQ (charset, Vcharset_ascii) && + (!memchr (the_nonreloc, '*', the_length)) + && (5 > (count_hyphens (the_nonreloc, the_length, NULL)))) + { + return 1; + } + + if (STAGE_FINAL == stage) + { + registries = Qunicode_registries; + } + else if (STAGE_INITIAL == stage) + { + registries = XCHARSET_REGISTRIES (charset); + if (NILP (registries)) + { + return 0; + } + } + else assert (0); + + CHECK_VECTOR (registries); + registries_len = XVECTOR_LENGTH (registries); + + for (i = 0; i < registries_len; ++i) + { + if (!(STRINGP (XVECTOR_DATA (registries)[i])) + || (XSTRING_LENGTH (XVECTOR_DATA (registries)[i]) > the_length)) + { + continue; + } + + /* Check if the font spec ends in the registry specified. X11 says + this comparison is case insensitive: XLFD, section 3.11: + + "Alphabetic case distinctions are allowed but are for human + readability concerns only. Conforming X servers will perform + matching on font name query or open requests independent of case." */ + if (0 == qxestrcasecmp (XSTRING_DATA (XVECTOR_DATA (registries)[i]), + the_nonreloc + (the_length - + XSTRING_LENGTH + (XVECTOR_DATA (registries)[i])))) + { + return 1; + } + } + return 0; +} + +static Lisp_Object +xlistfonts_checking_charset (Lisp_Object device, const Ibyte *xlfd, + Lisp_Object charset, + enum font_specifier_matchspec_stages stage) +{ + Extbyte **names; + Lisp_Object result = Qnil; + int count = 0, i; + DECLARE_EISTRING (ei_single_result); + Extbyte *fontext; + + DEBUG_FONTS2 ("xlistfonts_checking_charset called, XLFD %s stage %s", + xlfd, stage == STAGE_INITIAL ? "initial" : "final"); + DEBUG_FONTS_LISP1 (" charset %s\n", charset); + fontext = ITEXT_TO_EXTERNAL (xlfd, Qx_font_name_encoding); + names = XListFonts (GET_XLIKE_DISPLAY (XDEVICE (device)), + fontext, MAX_FONT_COUNT, &count); + + for (i = 0; i < count; ++i) + { + eireset (ei_single_result); + eicpy_ext (ei_single_result, names[i], Qx_font_name_encoding); + + if (DEVMETH_OR_GIVEN (XDEVICE (device), font_spec_matches_charset, + (XDEVICE (device), charset, + eidata (ei_single_result), Qnil, 0, + -1, stage), 0)) + { + result = eimake_string (ei_single_result); + break; + } + } + + if (names) + { + XFreeFontNames (names); + } + + DEBUG_FONTS_LISP1 ("xlistfonts_checking_charset returns %s\n", result); + return result; +} + +#ifdef USE_XFT +/* #### debug functions: find a better place for us */ +const char *FcResultToString (FcResult r); +const char * +FcResultToString (FcResult r) +{ + static char buffer[256]; + switch (r) + { + case FcResultMatch: + return "FcResultMatch"; + case FcResultNoMatch: + return "FcResultNoMatch"; + case FcResultTypeMismatch: + return "FcResultTypeMismatch"; + case FcResultNoId: + return "FcResultNoId"; + default: + snprintf (buffer, 255, "FcResultUndocumentedValue (%d)", r); + return buffer; + } +} + +const char *FcTypeOfValueToString (FcValue v); +const char * +FcTypeOfValueToString (FcValue v) +{ + static char buffer[256]; + switch (v.type) + { + case FcTypeMatrix: + return "FcTypeMatrix"; + case FcTypeString: + return "FcTypeString"; + case FcTypeVoid: + return "FcTypeVoid"; + case FcTypeDouble: + return "FcTypeDouble"; + case FcTypeInteger: + return "FcTypeInteger"; + case FcTypeBool: + return "FcTypeBool"; + case FcTypeCharSet: + return "FcTypeCharSet"; + case FcTypeLangSet: + return "FcTypeLangSet"; + /* #### There is no union member of this type, but there are void* and + FcPattern* members, as of fontconfig.h FC_VERSION 10002 */ + case FcTypeFTFace: + return "FcTypeFTFace"; + default: + snprintf (buffer, 255, "FcTypeUndocumentedType (%d)", v.type); + return buffer; + } +} + +static FcCharSet * +mule_to_fc_charset (Lisp_Object cs) +{ + int ucode, i, j; + FcCharSet *fccs; + + CHECK_CHARSET (cs); + fccs = FcCharSetCreate (); + /* #### do we also need to deal with 94 vs. 96 charsets? + ie, how are SP and DEL treated in ASCII? non-graphic should return -1 */ + if (1 == XCHARSET_DIMENSION (cs)) + /* Unicode tables are indexed by offsets from ASCII SP, not by ASCII */ + for (i = 0; i < 96; i++) + { + ucode = ((int *) XCHARSET_TO_UNICODE_TABLE (cs))[i]; + if (ucode >= 0) + /* #### should check for allocation failure */ + FcCharSetAddChar (fccs, (FcChar32) ucode); + } + else if (2 == XCHARSET_DIMENSION (cs)) + /* Unicode tables are indexed by offsets from ASCII SP, not by ASCII */ + for (i = 0; i < 96; i++) + for (j = 0; j < 96; j++) + { + ucode = ((int **) XCHARSET_TO_UNICODE_TABLE (cs))[i][j]; + if (ucode >= 0) + /* #### should check for allocation failure */ + FcCharSetAddChar (fccs, (FcChar32) ucode); + } + else + { + FcCharSetDestroy (fccs); + fccs = NULL; + } + return fccs; +} + +struct charset_reporter { + Lisp_Object *charset; + /* This is a debug facility, require ASCII. */ + const Ascbyte *language; /* ASCII, please */ + /* Technically this is FcChar8, but fsckin' GCC 4 bitches. + RFC 3066 is a combination of ISO 639 and ISO 3166. */ + const Ascbyte *rfc3066; /* ASCII, please */ +}; + +static struct charset_reporter charset_table[] = + { + /* #### It's my branch, my favorite charsets get checked first! + That's a joke, Son. + Ie, I don't know what I'm doing, so my charsets first is as good as + any other arbitrary order. If you have a better idea, speak up! */ + { &Vcharset_ascii, "English", "en" }, + { &Vcharset_japanese_jisx0208, "Japanese", "ja" }, + { &Vcharset_japanese_jisx0212, "Japanese", "ja" }, + { &Vcharset_katakana_jisx0201, "Japanese", "ja" }, + { &Vcharset_latin_jisx0201, "Japanese", "ja" }, + { &Vcharset_japanese_jisx0208_1978, "Japanese", "ja" }, + { &Vcharset_greek_iso8859_7, "Greek", "el" }, + /* #### all the Chinese need checking + Damn the blood-sucking ISO anyway. */ + { &Vcharset_chinese_gb2312, "simplified Chinese", "zh-cn" }, + { &Vcharset_korean_ksc5601, "Korean", "ko" }, + { &Vcharset_chinese_cns11643_1, "traditional Chinese", "zh-tw" }, + { &Vcharset_chinese_cns11643_2, "traditional Chinese", "zh-tw" }, + /* #### not obvious how to handle these + We could (for experimental purposes) make the last element into + an array of ISO 639 codes, and check for all of them. If a font + provides some but not others, warn. */ + { &Vcharset_latin_iso8859_1, NULL, NULL }, + { &Vcharset_latin_iso8859_2, NULL, NULL }, + { &Vcharset_latin_iso8859_3, NULL, NULL }, + { &Vcharset_latin_iso8859_4, NULL, NULL }, + { &Vcharset_latin_iso8859_9, NULL, NULL }, + { &Vcharset_latin_iso8859_15, NULL, NULL }, + { &Vcharset_thai_tis620, "Thai", "th" }, + /* We don't have an arabic charset. bidi issues, I guess? */ + /* { &Vcharset_arabic_iso8859_6, "Arabic", "ar" }, */ + { &Vcharset_hebrew_iso8859_8, "Hebrew", "he" }, + /* #### probably close enough for Ukraine? */ + { &Vcharset_cyrillic_iso8859_5, "Russian", "ru" }, + /* #### these probably are not quite right */ + { &Vcharset_chinese_big5_1, "traditional Chinese", "zh-tw" }, + { &Vcharset_chinese_big5_2, "traditional Chinese", "zh-tw" }, + { NULL, NULL, NULL } + }; + +/* Choose appropriate font name for debug messages. + Use only in the top half of next function (enforced with #undef). */ +#define DECLARE_DEBUG_FONTNAME(__xemacs_name) \ + Eistring *__xemacs_name; \ + do \ + { \ + __xemacs_name = debug_xft > 2 ? eistr_fullname \ + : debug_xft > 1 ? eistr_longname \ + : eistr_shortname; \ + } while (0) + +static Lisp_Object +xft_find_charset_font (Lisp_Object font, Lisp_Object charset, + enum font_specifier_matchspec_stages stage) +{ + const Extbyte *patternext; + Lisp_Object result = Qnil; + + /* #### with Xft need to handle second stage here -- sjt + Hm. Or maybe not. That would be cool. :-) */ + if (stage == STAGE_FINAL) + return Qnil; + + /* Fontconfig converts all FreeType names to UTF-8 before passing them + back to callers---see fcfreetype.c (FcFreeTypeQuery). + I don't believe this is documented. */ + + DEBUG_XFT1 (1, "confirming charset for font instance %s\n", + XSTRING_DATA (font)); + + /* #### this looks like a fair amount of work, but the basic design + has never been rethought, and it should be + + what really should happen here is that we use FcFontSort (FcFontList?) + to get a list of matching fonts, then pick the first (best) one that + gives language or repertoire coverage. + */ + + FcInit (); /* No-op if already initialized. + In fontconfig 2.3.2, this cannot return + failure, but that looks like a bug. We + check for it with FcGetCurrentConfig(), + which *can* fail. */ + if (!FcConfigGetCurrent()) + stderr_out ("Failed fontconfig initialization\n"); + else + { + FcPattern *fontxft; /* long-lived, freed at end of this block */ + FcResult fcresult; + FcConfig *fcc; + const Ascbyte *lang = "en"; + FcCharSet *fccs = NULL; + DECLARE_EISTRING (eistr_shortname); /* user-friendly nickname */ + DECLARE_EISTRING (eistr_longname); /* omit FC_LANG and FC_CHARSET */ + DECLARE_EISTRING (eistr_fullname); /* everything */ + + patternext = LISP_STRING_TO_EXTERNAL (font, Qfc_font_name_encoding); + fcc = FcConfigGetCurrent (); + + /* parse the name, do the substitutions, and match the font */ + + { + FcPattern *p = FcNameParse ((FcChar8 *) patternext); + PRINT_XFT_PATTERN (3, "FcNameParse'ed name is %s\n", p); + /* #### Next two return FcBool, but what does the return mean? */ + /* The order is correct according the fontconfig docs. */ + FcConfigSubstitute (fcc, p, FcMatchPattern); + PRINT_XFT_PATTERN (2, "FcConfigSubstitute'ed name is %s\n", p); + FcDefaultSubstitute (p); + PRINT_XFT_PATTERN (3, "FcDefaultSubstitute'ed name is %s\n", p); + /* #### check fcresult of following match? */ + fcresult = FcResultMatch; + fontxft = FcFontMatch (fcc, p, &fcresult); + switch (fcresult) + { + /* case FcResultOutOfMemory: */ + case FcResultNoMatch: + case FcResultTypeMismatch: + case FcResultNoId: + break; + case FcResultMatch: + /* this prints the long fontconfig name */ + PRINT_XFT_PATTERN (1, "FcFontMatch'ed name is %s\n", fontxft); + break; + } + FcPatternDestroy (p); + } + + /* heuristic to give reasonable-length names for debug reports + + I considered #ifdef SUPPORT_FULL_FONTCONFIG_NAME etc but that's + pointless. We're just going to remove this code once the font/ + face refactoring is done, but until then it could be very useful. + */ + { + FcPattern *p = FcFontRenderPrepare (fcc, fontxft, fontxft); + Extbyte *name; + + /* full name, including language coverage and repertoire */ + name = (Extbyte *) FcNameUnparse (p); + eicpy_ext (eistr_fullname, + (name ? name : "NOT FOUND"), + Qfc_font_name_encoding); + if (name) free (name); + + /* long name, omitting coverage and repertoire, plus a number + of rarely useful properties */ + FcPatternDel (p, FC_CHARSET); + FcPatternDel (p, FC_LANG); +#ifdef FC_WIDTH + FcPatternDel (p, FC_WIDTH); +#endif + FcPatternDel (p, FC_SPACING); + FcPatternDel (p, FC_HINTING); + FcPatternDel (p, FC_VERTICAL_LAYOUT); + FcPatternDel (p, FC_AUTOHINT); + FcPatternDel (p, FC_GLOBAL_ADVANCE); + FcPatternDel (p, FC_INDEX); + FcPatternDel (p, FC_SCALE); + FcPatternDel (p, FC_FONTVERSION); + name = (Extbyte *) FcNameUnparse (p); + eicpy_ext (eistr_longname, + (name ? name : "NOT FOUND"), + Qfc_font_name_encoding); + if (name) free (name); + + /* nickname, just family and size, but + "family" names usually have style, slant, and weight */ + FcPatternDel (p, FC_FOUNDRY); + FcPatternDel (p, FC_STYLE); + FcPatternDel (p, FC_SLANT); + FcPatternDel (p, FC_WEIGHT); + FcPatternDel (p, FC_PIXEL_SIZE); + FcPatternDel (p, FC_OUTLINE); + FcPatternDel (p, FC_SCALABLE); + FcPatternDel (p, FC_DPI); + name = (Extbyte *) FcNameUnparse (p); + eicpy_ext (eistr_shortname, + (name ? name : "NOT FOUND"), + Qfc_font_name_encoding); + if (name) free (name); + + FcPatternDestroy (p); + } + + /* The language approach may better in the long run, but we can't use + it based on Mule charsets; fontconfig doesn't provide a way to test + for unions of languages, etc. That will require support from the + text module. + + Optimization: cache the generated FcCharSet in the Mule charset. + Don't forget to destroy it if the Mule charset gets deallocated. */ + + { + /* This block possibly should be a function, but it generates + multiple values. I find the "pass an address to return the + value in" idiom opaque, so prefer a block. */ + struct charset_reporter *cr; + for (cr = charset_table; + cr->charset && !EQ (*(cr->charset), charset); + cr++) + ; + + if (cr->rfc3066) + { + DECLARE_DEBUG_FONTNAME (name); + CHECKING_LANG (0, eidata (name), cr->language); + lang = cr->rfc3066; + } + else if (cr->charset) + { + /* what the hey, build 'em on the fly */ + /* #### in the case of error this could return NULL! */ + fccs = mule_to_fc_charset (charset); + /* #### Bad idea here */ + lang = (const Ascbyte *) XSTRING_DATA (XSYMBOL (XCHARSET_NAME + (charset))->name); + } + else + { + /* OK, we fell off the end of the table */ + warn_when_safe_lispobj (intern ("xft"), intern ("alert"), + list2 (build_ascstring ("unchecked charset"), + charset)); + /* default to "en" + #### THIS IS WRONG, WRONG, WRONG!! + It is why we never fall through to XLFD-checking. */ + } + + ASSERT_ASCTEXT_ASCII (lang); + + if (fccs) + { + /* check for character set coverage */ + int i = 0; + FcCharSet *v; + FcResult r = FcPatternGetCharSet (fontxft, FC_CHARSET, i, &v); + + if (r == FcResultTypeMismatch) + { + DEBUG_XFT0 (0, "Unexpected type return in charset value\n"); + result = Qnil; + } + else if (r == FcResultMatch && FcCharSetIsSubset (fccs, v)) + { + /* The full pattern with the bitmap coverage is massively + unwieldy, but the shorter names are just *wrong*. We + should have the full thing internally as truename, and + filter stuff the client doesn't want to see on output. + Should we just store it into the truename right here? */ + DECLARE_DEBUG_FONTNAME (name); + DEBUG_XFT2 (0, "Xft font %s supports %s\n", + eidata (name), lang); +#ifdef RETURN_LONG_FONTCONFIG_NAMES + result = eimake_string (eistr_fullname); +#else + result = eimake_string (eistr_longname); +#endif + } + else + { + DECLARE_DEBUG_FONTNAME (name); + DEBUG_XFT2 (0, "Xft font %s doesn't support %s\n", + eidata (name), lang); + result = Qnil; + } + + /* clean up */ + FcCharSetDestroy (fccs); + } + else + { + /* check for language coverage */ + int i = 0; + FcValue v; + /* the main event */ + FcResult r = FcPatternGet (fontxft, FC_LANG, i, &v); + + if (r == FcResultMatch) + { + if (v.type != FcTypeLangSet) /* excessive paranoia */ + { + ASSERT_ASCTEXT_ASCII (FcTypeOfValueToString (v)); + /* Urk! Fall back and punt to core font. */ + DEBUG_XFT1 (0, "Unexpected type of lang value (%s)\n", + FcTypeOfValueToString (v)); + result = Qnil; + } + else if (FcLangSetHasLang (v.u.l, (FcChar8 *) lang) + != FcLangDifferentLang) + { + DECLARE_DEBUG_FONTNAME (name); + DEBUG_XFT2 (0, "Xft font %s supports %s\n", + eidata (name), lang); +#ifdef RETURN_LONG_FONTCONFIG_NAMES + result = eimake_string (eistr_fullname); +#else + result = eimake_string (eistr_longname); +#endif + } + else + { + DECLARE_DEBUG_FONTNAME (name); + DEBUG_XFT2 (0, "Xft font %s doesn't support %s\n", + eidata (name), lang); + result = Qnil; + } + } + else + { + ASSERT_ASCTEXT_ASCII (FcResultToString (r)); + DEBUG_XFT1 (0, "Getting lang: unexpected result=%s\n", + FcResultToString (r)); + result = Qnil; + } + } + + /* clean up and maybe return */ + FcPatternDestroy (fontxft); + if (!UNBOUNDP (result)) + return result; + } + } + return Qnil; +} +#undef DECLARE_DEBUG_FONTNAME + +#endif /* USE_XFT */ + +/* find a font spec that matches font spec FONT and also matches + (the registry of) CHARSET. */ +static Lisp_Object +XFUN (find_charset_font) (Lisp_Object device, Lisp_Object font, + Lisp_Object charset, + enum font_specifier_matchspec_stages stage) +{ + Lisp_Object result = Qnil, registries = Qnil; + int j, hyphen_count, registries_len = 0; + Ibyte *hyphening, *new_hyphening; + Bytecount xlfd_length; + + DECLARE_EISTRING (ei_xlfd_without_registry); + DECLARE_EISTRING (ei_xlfd); + +#ifdef USE_XFT + result = xft_find_charset_font (font, charset, stage); + if (!NILP (result)) + { + return result; + } +#endif + + switch (stage) + { + case STAGE_INITIAL: + { + if (!(NILP (XCHARSET_REGISTRIES (charset))) + && VECTORP (XCHARSET_REGISTRIES (charset))) + { + registries_len = XVECTOR_LENGTH (XCHARSET_REGISTRIES (charset)); + registries = XCHARSET_REGISTRIES (charset); + } + break; + } + case STAGE_FINAL: + { + registries_len = 1; + registries = Qunicode_registries; + break; + } + default: + { + assert (0); + break; + } + } + + eicpy_lstr (ei_xlfd, font); + hyphening = eidata (ei_xlfd); + xlfd_length = eilen (ei_xlfd); + + /* Count the hyphens in the string, moving new_hyphening to just after the + last one. */ + hyphen_count = count_hyphens (hyphening, xlfd_length, &new_hyphening); + + if (0 == registries_len || (5 > hyphen_count && + !(1 == xlfd_length && '*' == *hyphening))) + { + /* No proper XLFD specified, or we can't modify the pattern to change + the registry and encoding to match what we want, or we have no + information on the registry needed. */ + result = xlistfonts_checking_charset (device, eidata (ei_xlfd), + charset, stage); + /* No need to loop through the available registries; return + immediately. */ + return result; + } + else if (1 == xlfd_length && '*' == *hyphening) + { + /* It's a single asterisk. We can add the registry directly to the + end. */ + eicpy_ch (ei_xlfd_without_registry, '*'); + } + else + { + /* It's a fully-specified XLFD. Work out where the registry and + encoding are, and initialise ei_xlfd_without_registry to the string + without them. */ + + /* count_hyphens has set new_hyphening to just after the last + hyphen. Move back to just after the hyphen before it. */ + + for (new_hyphening -= 2; new_hyphening > hyphening + && '-' != *new_hyphening; --new_hyphening) + ; + ++new_hyphening; + + eicpy_ei (ei_xlfd_without_registry, ei_xlfd); + + /* Manipulate ei_xlfd_without_registry, using the information about + ei_xlfd, to which it's identical. */ + eidel (ei_xlfd_without_registry, new_hyphening - hyphening, -1, + eilen (ei_xlfd) - (new_hyphening - hyphening), -1); + + } + + /* Now, loop through the registries and encodings defined for this + charset, doing an XListFonts each time with the pattern modified to + specify the regisry and encoding. This avoids huge amounts of IPC and + duplicated searching; now we use the searching the X server was doing + anyway, where before the X server did its search, transferred huge + amounts of data, and then we proceeded to do a regexp search on that + data. */ + for (j = 0; j < registries_len && NILP (result); ++j) + { + eireset (ei_xlfd); + eicpy_ei (ei_xlfd, ei_xlfd_without_registry); + + eicat_lstr (ei_xlfd, XVECTOR_DATA (registries)[j]); + + result = xlistfonts_checking_charset (device, eidata (ei_xlfd), + charset, stage); + } + + /* In the event that the charset is ASCII and we haven't matched + anything up to now, even with a pattern of "*", add "iso8859-1" + to the charset's registry and try again. Not returning a result + for ASCII means our frame geometry calculations are + inconsistent, and that we may crash. */ + + if (1 == xlfd_length && EQ (charset, Vcharset_ascii) && NILP (result) + && ('*' == eigetch (ei_xlfd_without_registry, 0))) + + { + int have_latin1 = 0; + + /* Set this to, for example, is08859-1 if you want to see the + error behaviour. */ + +#define FALLBACK_ASCII_REGISTRY "iso8859-1" + + for (j = 0; j < registries_len; ++j) + { + if (0 == qxestrcasecmp (XSTRING_DATA (XVECTOR_DATA (registries)[j]), + (Ibyte *) FALLBACK_ASCII_REGISTRY)) + { + have_latin1 = 1; + break; + } + } + + if (!have_latin1) + { + Lisp_Object new_registries = make_vector (registries_len + 1, Qnil); + + XVECTOR_DATA (new_registries)[0] + = build_ascstring (FALLBACK_ASCII_REGISTRY); + + memcpy (XVECTOR_DATA (new_registries) + 1, + XVECTOR_DATA (registries), + sizeof XVECTOR_DATA (registries)[0] * + XVECTOR_LENGTH (registries)); + + /* Calling set_charset_registries instead of overwriting the + value directly, to allow the charset font caches to be + invalidated and a change to the default face to be + noted. */ + set_charset_registries (charset, new_registries); + + warn_when_safe (Qface, Qwarning, + "Your ASCII charset registries contain nothing " + "sensible. Adding `" FALLBACK_ASCII_REGISTRY "'."); + + /* And recurse. */ + result = + DEVMETH_OR_GIVEN (XDEVICE (device), find_charset_font, + (device, font, charset, stage), + result); + } + else + { + DECLARE_EISTRING (ei_connection_name); + + /* We preserve a copy of the connection name for the error message + after the device is deleted. */ + eicpy_lstr (ei_connection_name, + DEVICE_CONNECTION (XDEVICE (device))); + + stderr_out ("Cannot find a font for ASCII, deleting device on %s\n", + eidata (ei_connection_name)); + + io_error_delete_device (device); + + /* Do a normal warning in the event that we have other, non-X + frames available. (If we don't, io_error_delete_device will + have exited.) */ + warn_when_safe + (Qface, Qerror, + "Cannot find a font for ASCII, deleting device on %s.\n" + "\n" + "Your X server fonts appear to be inconsistent; fix them, or\n" + "the next frame you create on that DISPLAY will crash this\n" + "XEmacs. At a minimum, provide one font with an XLFD ending\n" + "in `" FALLBACK_ASCII_REGISTRY "', so we can work out what size\n" + "a frame should be. ", + eidata (ei_connection_name)); + } + + } + + /* This function used to return the font spec, in the case where a font + didn't exist on the X server but it did match the charset. We're not + doing that any more, because none of the other platform code does, and + the old behaviour was badly-judged in other respects, so I don't trust + the original author to have had a good reason for it. */ + + return result; +} + +#endif /* MULE */ diff -r 861f2601a38b -r 1f0b15040456 src/fontcolor.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/fontcolor.c Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,1466 @@ +/* Generic Objects and Functions. + Copyright (C) 1995 Free Software Foundation, Inc. + Copyright (C) 1995 Board of Trustees, University of Illinois. + Copyright (C) 1995, 1996, 2002, 2004, 2005, 2010 Ben Wing. + Copyright (C) 2010 Didier Verna + +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 3 of the License, 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. If not, see . */ + +/* Synched up with: Not in FSF. */ + +#include +#include "lisp.h" + +#include "buffer.h" +#include "device-impl.h" +#include "elhash.h" +#include "faces.h" +#include "frame.h" +#include "glyphs.h" +#include "fontcolor-impl.h" +#include "specifier.h" +#include "window.h" + +#ifdef HAVE_TTY +#include "console-tty.h" +#endif + +/* Objects that are substituted when an instantiation fails. + If we leave in the Qunbound value, we will probably get crashes. */ +Lisp_Object Vthe_null_color_instance, Vthe_null_font_instance; + +/* Author: Ben Wing; some earlier code from Chuck Thompson, Jamie + Zawinski. */ + +DOESNT_RETURN +finalose (void *ptr) +{ + Lisp_Object obj = wrap_pointer_1 (ptr); + + invalid_operation + ("Can't dump an emacs containing window system objects", obj); +} + + +/**************************************************************************** + * Color-Instance Object * + ****************************************************************************/ + +Lisp_Object Qcolor_instancep; + +static const struct memory_description color_instance_data_description_1 []= { +#ifdef HAVE_TTY +#ifdef NEW_GC + { XD_LISP_OBJECT, tty_console }, +#else /* not NEW_GC */ + { XD_BLOCK_PTR, tty_console, 1, { &tty_color_instance_data_description } }, +#endif /* not NEW_GC */ +#endif + { XD_END } +}; + +static const struct sized_memory_description color_instance_data_description = { + sizeof (void *), color_instance_data_description_1 +}; + +static const struct memory_description color_instance_description[] = { + { XD_INT, offsetof (Lisp_Color_Instance, color_instance_type) }, + { XD_LISP_OBJECT, offsetof (Lisp_Color_Instance, name)}, + { XD_LISP_OBJECT, offsetof (Lisp_Color_Instance, device)}, + { XD_UNION, offsetof (Lisp_Color_Instance, data), + XD_INDIRECT (0, 0), { &color_instance_data_description } }, + {XD_END} +}; + +static Lisp_Object +mark_color_instance (Lisp_Object obj) +{ + Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); + mark_object (c->name); + if (!NILP (c->device)) /* Vthe_null_color_instance */ + MAYBE_DEVMETH (XDEVICE (c->device), mark_color_instance, (c)); + + return c->device; +} + +static void +print_color_instance (Lisp_Object obj, Lisp_Object printcharfun, + int escapeflag) +{ + Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); + if (print_readably) + printing_unreadable_lisp_object (obj, 0); + write_fmt_string_lisp (printcharfun, "#name); + write_fmt_string_lisp (printcharfun, " on %s", 1, c->device); + if (!NILP (c->device)) /* Vthe_null_color_instance */ + MAYBE_DEVMETH (XDEVICE (c->device), print_color_instance, + (c, printcharfun, escapeflag)); + write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); +} + +static void +finalize_color_instance (Lisp_Object obj) +{ + Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); + + if (!NILP (c->device)) + MAYBE_DEVMETH (XDEVICE (c->device), finalize_color_instance, (c)); +} + +static int +color_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, + int UNUSED (foldcase)) +{ + Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1); + Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (obj2); + + return (c1 == c2) || + (EQ (c1->device, c2->device) && + DEVICEP (c1->device) && + HAS_DEVMETH_P (XDEVICE (c1->device), color_instance_equal) && + DEVMETH (XDEVICE (c1->device), color_instance_equal, (c1, c2, depth))); +} + +static Hashcode +color_instance_hash (Lisp_Object obj, int depth, Boolint UNUSED (equalp)) +{ + Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); + struct device *d = DEVICEP (c->device) ? XDEVICE (c->device) : 0; + + return HASH2 ((Hashcode) d, + !d ? LISP_HASH (obj) + : DEVMETH_OR_GIVEN (d, color_instance_hash, (c, depth), + LISP_HASH (obj))); +} + +DEFINE_NODUMP_LISP_OBJECT ("color-instance", color_instance, + mark_color_instance, print_color_instance, + finalize_color_instance, color_instance_equal, + color_instance_hash, + color_instance_description, + Lisp_Color_Instance); + +DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /* +Return a new `color-instance' object named NAME (a string). + +Optional argument DEVICE specifies the device this object applies to +and defaults to the selected device. + +An error is signaled if the color is unknown or cannot be allocated; +however, if optional argument NOERROR is non-nil, nil is simply +returned in this case. (And if NOERROR is other than t, a warning may +be issued.) + +The returned object is a normal, first-class lisp object. The way you +`deallocate' the color is the way you deallocate any other lisp object: +you drop all pointers to it and allow it to be garbage collected. When +these objects are GCed, the underlying window-system data (e.g. X object) +is deallocated as well. +*/ + (name, device, noerror)) +{ + Lisp_Object obj; + Lisp_Color_Instance *c; + int retval; + + CHECK_STRING (name); + device = wrap_device (decode_device (device)); + + obj = ALLOC_NORMAL_LISP_OBJECT (color_instance); + c = XCOLOR_INSTANCE (obj); + c->name = name; + c->device = device; + c->data = 0; + c->color_instance_type = get_console_variant (XDEVICE_TYPE (c->device)); + + retval = MAYBE_INT_DEVMETH (XDEVICE (device), initialize_color_instance, + (c, name, device, + decode_error_behavior_flag (noerror))); + if (!retval) + return Qnil; + + return obj; +} + +DEFUN ("color-instance-p", Fcolor_instance_p, 1, 1, 0, /* +Return non-nil if OBJECT is a color instance. +*/ + (object)) +{ + return COLOR_INSTANCEP (object) ? Qt : Qnil; +} + +DEFUN ("color-instance-name", Fcolor_instance_name, 1, 1, 0, /* +Return the name used to allocate COLOR-INSTANCE. +*/ + (color_instance)) +{ + CHECK_COLOR_INSTANCE (color_instance); + return XCOLOR_INSTANCE (color_instance)->name; +} + +DEFUN ("color-instance-rgb-components", Fcolor_instance_rgb_components, 1, 1, 0, /* +Return a three element list containing the red, green, and blue +color components of COLOR-INSTANCE, or nil if unknown. +Component values range from 0 to 65535. +*/ + (color_instance)) +{ + Lisp_Color_Instance *c; + + CHECK_COLOR_INSTANCE (color_instance); + c = XCOLOR_INSTANCE (color_instance); + + if (NILP (c->device)) + return Qnil; + + return MAYBE_LISP_DEVMETH (XDEVICE (c->device), + color_instance_rgb_components, + (c)); +} + +DEFUN ("valid-color-name-p", Fvalid_color_name_p, 1, 2, 0, /* +Return true if COLOR names a valid color for the current device. + +Valid color names for X are listed in the file /usr/lib/X11/rgb.txt, or +whatever the equivalent is on your system. + +Valid color names for TTY are those which have an ISO 6429 (ANSI) sequence. +In addition to being a color this may be one of a number of attributes +such as `blink'. +*/ + (color, device)) +{ + struct device *d = decode_device (device); + + CHECK_STRING (color); + return MAYBE_INT_DEVMETH (d, valid_color_name_p, (d, color)) ? Qt : Qnil; +} + +DEFUN ("color-list", Fcolor_list, 0, 1, 0, /* +Return a list of color names. +DEVICE specifies which device to return names for, and defaults to the +currently selected device. +*/ + (device)) +{ + device = wrap_device (decode_device (device)); + + return MAYBE_LISP_DEVMETH (XDEVICE (device), color_list, ()); +} + + +/*************************************************************************** + * Font-Instance Object * + ***************************************************************************/ + +Lisp_Object Qfont_instancep; + +static Lisp_Object font_instance_truename_internal (Lisp_Object xfont, + Error_Behavior errb); + +static const struct memory_description font_instance_data_description_1 []= { +#ifdef HAVE_TTY +#ifdef NEW_GC + { XD_LISP_OBJECT, tty_console }, +#else /* not NEW_GC */ + { XD_BLOCK_PTR, tty_console, 1, { &tty_font_instance_data_description } }, +#endif /* not NEW_GC */ +#endif + { XD_END } +}; + +static const struct sized_memory_description font_instance_data_description = { + sizeof (void *), font_instance_data_description_1 +}; + +static const struct memory_description font_instance_description[] = { + { XD_INT, offsetof (Lisp_Font_Instance, font_instance_type) }, + { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, name)}, + { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, truename)}, + { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, device)}, + { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, charset)}, + { XD_UNION, offsetof (Lisp_Font_Instance, data), + XD_INDIRECT (0, 0), { &font_instance_data_description } }, + { XD_END } +}; + + +static Lisp_Object +mark_font_instance (Lisp_Object obj) +{ + Lisp_Font_Instance *f = XFONT_INSTANCE (obj); + + mark_object (f->name); + mark_object (f->truename); + if (!NILP (f->device)) /* Vthe_null_font_instance */ + MAYBE_DEVMETH (XDEVICE (f->device), mark_font_instance, (f)); + + return f->device; +} + +static void +print_font_instance (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) +{ + Lisp_Font_Instance *f = XFONT_INSTANCE (obj); + if (print_readably) + printing_unreadable_lisp_object (obj, 0); + write_fmt_string_lisp (printcharfun, "#name); + write_fmt_string_lisp (printcharfun, " on %s", 1, f->device); + if (!NILP (f->device)) + { + MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance, + (f, printcharfun, escapeflag)); + + } + write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); +} + +static void +finalize_font_instance (Lisp_Object obj) +{ + Lisp_Font_Instance *f = XFONT_INSTANCE (obj); + + if (!NILP (f->device)) + { + MAYBE_DEVMETH (XDEVICE (f->device), finalize_font_instance, (f)); + } +} + +/* Fonts are equal if they resolve to the same name. + Since we call `font-truename' to do this, and since font-truename is lazy, + this means the `equal' could cause XListFonts to be run the first time. + */ +static int +font_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, + int UNUSED (foldcase)) +{ + /* #### should this be moved into a device method? */ + return internal_equal (font_instance_truename_internal + (obj1, ERROR_ME_DEBUG_WARN), + font_instance_truename_internal + (obj2, ERROR_ME_DEBUG_WARN), + depth + 1); +} + +static Hashcode +font_instance_hash (Lisp_Object obj, int depth, Boolint UNUSED (equalp)) +{ + return internal_hash (font_instance_truename_internal + (obj, ERROR_ME_DEBUG_WARN), + depth + 1, 0); +} + +DEFINE_NODUMP_LISP_OBJECT ("font-instance", font_instance, + mark_font_instance, print_font_instance, + finalize_font_instance, font_instance_equal, + font_instance_hash, font_instance_description, + Lisp_Font_Instance); + + +/* #### Why is this exposed to Lisp? Used in: +x-frob-font-size, gtk-font-menu-load-font, x-font-menu-load-font-xft, +x-font-menu-load-font-core, mswindows-font-menu-load-font, +mswindows-frob-font-style-and-sizify, mswindows-frob-font-size. */ +DEFUN ("make-font-instance", Fmake_font_instance, 1, 4, 0, /* +Return a new `font-instance' object named NAME. +DEVICE specifies the device this object applies to and defaults to the +selected device. An error is signalled if the font is unknown or cannot +be allocated; however, if NOERROR is non-nil, nil is simply returned in +this case. CHARSET is used internally. #### make helper function? + +The returned object is a normal, first-class lisp object. The way you +`deallocate' the font is the way you deallocate any other lisp object: +you drop all pointers to it and allow it to be garbage collected. When +these objects are GCed, the underlying GUI data is deallocated as well. +*/ + (name, device, noerror, charset)) +{ + Lisp_Object obj; + Lisp_Font_Instance *f; + int retval = 0; + Error_Behavior errb = decode_error_behavior_flag (noerror); + + if (ERRB_EQ (errb, ERROR_ME)) + CHECK_STRING (name); + else if (!STRINGP (name)) + return Qnil; + + device = wrap_device (decode_device (device)); + + obj = ALLOC_NORMAL_LISP_OBJECT (font_instance); + f = XFONT_INSTANCE (obj); + f->name = name; + f->truename = Qnil; + f->device = device; + + f->data = 0; + f->font_instance_type = get_console_variant (XDEVICE_TYPE (f->device)); + + /* Stick some default values here ... */ + f->ascent = f->height = 1; + f->descent = 0; + f->width = 1; + f->charset = charset; + f->proportional_p = 0; + + retval = MAYBE_INT_DEVMETH (XDEVICE (device), initialize_font_instance, + (f, name, device, errb)); + + if (!retval) + return Qnil; + + return obj; +} + +DEFUN ("font-instance-p", Ffont_instance_p, 1, 1, 0, /* +Return non-nil if OBJECT is a font instance. +*/ + (object)) +{ + return FONT_INSTANCEP (object) ? Qt : Qnil; +} + +DEFUN ("font-instance-name", Ffont_instance_name, 1, 1, 0, /* +Return the name used to allocate FONT-INSTANCE. +*/ + (font_instance)) +{ + CHECK_FONT_INSTANCE (font_instance); + return XFONT_INSTANCE (font_instance)->name; +} + +DEFUN ("font-instance-ascent", Ffont_instance_ascent, 1, 1, 0, /* +Return the ascent in pixels of FONT-INSTANCE. +The returned value is the maximum ascent for all characters in the font, +where a character's ascent is the number of pixels above (and including) +the baseline. +*/ + (font_instance)) +{ + CHECK_FONT_INSTANCE (font_instance); + return make_int (XFONT_INSTANCE (font_instance)->ascent); +} + +DEFUN ("font-instance-descent", Ffont_instance_descent, 1, 1, 0, /* +Return the descent in pixels of FONT-INSTANCE. +The returned value is the maximum descent for all characters in the font, +where a character's descent is the number of pixels below the baseline. +\(Many characters to do not have any descent. Typical characters with a +descent are lowercase p and lowercase g.) +*/ + (font_instance)) +{ + CHECK_FONT_INSTANCE (font_instance); + return make_int (XFONT_INSTANCE (font_instance)->descent); +} + +DEFUN ("font-instance-width", Ffont_instance_width, 1, 1, 0, /* +Return the width in pixels of FONT-INSTANCE. +The returned value is the average width for all characters in the font. +*/ + (font_instance)) +{ + CHECK_FONT_INSTANCE (font_instance); + return make_int (XFONT_INSTANCE (font_instance)->width); +} + +DEFUN ("font-instance-proportional-p", Ffont_instance_proportional_p, 1, 1, 0, /* +Return whether FONT-INSTANCE is proportional. +This means that different characters in the font have different widths. +*/ + (font_instance)) +{ + CHECK_FONT_INSTANCE (font_instance); + return XFONT_INSTANCE (font_instance)->proportional_p ? Qt : Qnil; +} + +static Lisp_Object +font_instance_truename_internal (Lisp_Object font_instance, + Error_Behavior errb) +{ + Lisp_Font_Instance *f = XFONT_INSTANCE (font_instance); + + if (NILP (f->device)) + { + maybe_signal_error (Qgui_error, + "can't determine truename: " + "no device for font instance", + font_instance, Qfont, errb); + return Qnil; + } + + return DEVMETH_OR_GIVEN (XDEVICE (f->device), + font_instance_truename, (f, errb), f->name); +} + +DEFUN ("font-instance-truename", Ffont_instance_truename, 1, 1, 0, /* +Return the canonical name of FONT-INSTANCE. +Font names are patterns which may match any number of fonts, of which +the first found is used. This returns an unambiguous name for that font +\(but not necessarily its only unambiguous name). +*/ + (font_instance)) +{ + CHECK_FONT_INSTANCE (font_instance); + return font_instance_truename_internal (font_instance, ERROR_ME); +} + +DEFUN ("font-instance-charset", Ffont_instance_charset, 1, 1, 0, /* +Return the Mule charset that FONT-INSTANCE was allocated to handle. +*/ + (font_instance)) +{ + CHECK_FONT_INSTANCE (font_instance); + return XFONT_INSTANCE (font_instance)->charset; +} + +DEFUN ("font-instance-properties", Ffont_instance_properties, 1, 1, 0, /* +Return the properties (an alist or nil) of FONT-INSTANCE. +*/ + (font_instance)) +{ + Lisp_Font_Instance *f; + + CHECK_FONT_INSTANCE (font_instance); + f = XFONT_INSTANCE (font_instance); + + if (NILP (f->device)) + return Qnil; + + return MAYBE_LISP_DEVMETH (XDEVICE (f->device), + font_instance_properties, (f)); +} + +DEFUN ("font-list", Ffont_list, 1, 3, 0, /* +Return a list of font names matching the given pattern. +DEVICE specifies which device to search for names, and defaults to the +currently selected device. +*/ + (pattern, device, maxnumber)) +{ + CHECK_STRING (pattern); + device = wrap_device (decode_device (device)); + + return MAYBE_LISP_DEVMETH (XDEVICE (device), font_list, (pattern, device, + maxnumber)); +} + + +/**************************************************************************** + Color Object + ***************************************************************************/ + +static const struct memory_description color_specifier_description[] = { + { XD_LISP_OBJECT, offsetof (struct color_specifier, face) }, + { XD_LISP_OBJECT, offsetof (struct color_specifier, face_property) }, + { XD_END } +}; + +DEFINE_SPECIFIER_TYPE_WITH_DATA (color); +/* Qcolor defined in general.c */ + +static void +color_create (Lisp_Object obj) +{ + Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); + + COLOR_SPECIFIER_FACE (color) = Qnil; + COLOR_SPECIFIER_FACE_PROPERTY (color) = Qnil; +} + +static void +color_mark (Lisp_Object obj) +{ + Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); + + mark_object (COLOR_SPECIFIER_FACE (color)); + mark_object (COLOR_SPECIFIER_FACE_PROPERTY (color)); +} + +/* No equal or hash methods; ignore the face the color is based off + of for `equal' */ + +static Lisp_Object +color_instantiate (Lisp_Object specifier, Lisp_Object UNUSED (matchspec), + Lisp_Object domain, Lisp_Object instantiator, + Lisp_Object depth, int no_fallback) +{ + /* When called, we're inside of call_with_suspended_errors(), + so we can freely error. */ + Lisp_Object device = DOMAIN_DEVICE (domain); + struct device *d = XDEVICE (device); + + if (COLOR_INSTANCEP (instantiator)) + { + /* If we are on the same device then we're done. Otherwise change + the instantiator to the name used to generate the pixel and let the + STRINGP case deal with it. */ + if (NILP (device) /* Vthe_null_color_instance */ + || EQ (device, XCOLOR_INSTANCE (instantiator)->device)) + return instantiator; + else + instantiator = Fcolor_instance_name (instantiator); + } + + if (STRINGP (instantiator)) + { + /* First, look to see if we can retrieve a cached value. */ + Lisp_Object instance = + Fgethash (instantiator, d->color_instance_cache, Qunbound); + /* Otherwise, make a new one. */ + if (UNBOUNDP (instance)) + { + /* make sure we cache the failures, too. */ + instance = Fmake_color_instance (instantiator, device, Qt); + Fputhash (instantiator, instance, d->color_instance_cache); + } + + return NILP (instance) ? Qunbound : instance; + } + else if (VECTORP (instantiator)) + { + switch (XVECTOR_LENGTH (instantiator)) + { + case 0: + if (DEVICE_TTY_P (d)) + return Vthe_null_color_instance; + else + gui_error ("Color instantiator [] only valid on TTY's", + device); + + case 1: + if (NILP (COLOR_SPECIFIER_FACE (XCOLOR_SPECIFIER (specifier)))) + gui_error ("Color specifier not attached to a face", + instantiator); + return (FACE_PROPERTY_INSTANCE_1 + (Fget_face (XVECTOR_DATA (instantiator)[0]), + COLOR_SPECIFIER_FACE_PROPERTY + (XCOLOR_SPECIFIER (specifier)), + domain, ERROR_ME, no_fallback, depth)); + + case 2: + return (FACE_PROPERTY_INSTANCE_1 + (Fget_face (XVECTOR_DATA (instantiator)[0]), + XVECTOR_DATA (instantiator)[1], domain, ERROR_ME, + no_fallback, depth)); + + default: + ABORT (); + } + } + else if (NILP (instantiator)) + { + if (DEVICE_TTY_P (d)) + return Vthe_null_color_instance; + else + gui_error ("Color instantiator [] only valid on TTY's", + device); + } + else + ABORT (); /* The spec validation routines are screwed up. */ + + return Qunbound; +} + +static void +color_validate (Lisp_Object instantiator) +{ + if (COLOR_INSTANCEP (instantiator) || STRINGP (instantiator)) + return; + if (VECTORP (instantiator)) + { + if (XVECTOR_LENGTH (instantiator) > 2) + sferror ("Inheritance vector must be of size 0 - 2", + instantiator); + else if (XVECTOR_LENGTH (instantiator) > 0) + { + Lisp_Object face = XVECTOR_DATA (instantiator)[0]; + + Fget_face (face); + if (XVECTOR_LENGTH (instantiator) == 2) + { + Lisp_Object field = XVECTOR_DATA (instantiator)[1]; + if (!EQ (field, Qforeground) && !EQ (field, Qbackground)) + invalid_constant + ("Inheritance field must be `foreground' or `background'", + field); + } + } + } + else + invalid_argument ("Invalid color instantiator", instantiator); +} + +static void +color_after_change (Lisp_Object specifier, Lisp_Object locale) +{ + Lisp_Object face = COLOR_SPECIFIER_FACE (XCOLOR_SPECIFIER (specifier)); + Lisp_Object property = + COLOR_SPECIFIER_FACE_PROPERTY (XCOLOR_SPECIFIER (specifier)); + if (!NILP (face)) + { + face_property_was_changed (face, property, locale); + if (BUFFERP (locale)) + XBUFFER (locale)->buffer_local_face_property = 1; + } +} + +void +set_color_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property) +{ + Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); + + COLOR_SPECIFIER_FACE (color) = face; + COLOR_SPECIFIER_FACE_PROPERTY (color) = property; +} + +DEFUN ("color-specifier-p", Fcolor_specifier_p, 1, 1, 0, /* +Return t if OBJECT is a color specifier. + +See `make-color-specifier' for a description of possible color instantiators. +*/ + (object)) +{ + return COLOR_SPECIFIERP (object) ? Qt : Qnil; +} + + +/**************************************************************************** + Font Object + ***************************************************************************/ + +static const struct memory_description font_specifier_description[] = { + { XD_LISP_OBJECT, offsetof (struct font_specifier, face) }, + { XD_LISP_OBJECT, offsetof (struct font_specifier, face_property) }, + { XD_END } +}; + +DEFINE_SPECIFIER_TYPE_WITH_DATA (font); +/* Qfont defined in general.c */ + +static void +font_create (Lisp_Object obj) +{ + Lisp_Specifier *font = XFONT_SPECIFIER (obj); + + FONT_SPECIFIER_FACE (font) = Qnil; + FONT_SPECIFIER_FACE_PROPERTY (font) = Qnil; +} + +static void +font_mark (Lisp_Object obj) +{ + Lisp_Specifier *font = XFONT_SPECIFIER (obj); + + mark_object (FONT_SPECIFIER_FACE (font)); + mark_object (FONT_SPECIFIER_FACE_PROPERTY (font)); +} + +/* No equal or hash methods; ignore the face the font is based off + of for `equal' */ + +#ifdef MULE + +/* Given a truename font spec (i.e. the font spec should have its registry + field filled in), does it support displaying characters from CHARSET? */ + +static int +font_spec_matches_charset (struct device *d, Lisp_Object charset, + const Ibyte *nonreloc, Lisp_Object reloc, + Bytecount offset, Bytecount length, + enum font_specifier_matchspec_stages stage) +{ + return DEVMETH_OR_GIVEN (d, font_spec_matches_charset, + (d, charset, nonreloc, reloc, offset, length, + stage), + 1); +} + +static void +font_validate_matchspec (Lisp_Object matchspec) +{ + CHECK_CONS (matchspec); + Fget_charset (XCAR (matchspec)); + + do + { + if (EQ(XCDR(matchspec), Qinitial)) + { + break; + } + if (EQ(XCDR(matchspec), Qfinal)) + { + break; + } + + invalid_argument("Invalid font matchspec stage", + XCDR(matchspec)); + } while (0); +} + +void +initialize_charset_font_caches (struct device *d) +{ + /* Note that the following tables are bi-level. */ + d->charset_font_cache_stage_1 = + make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, Qeq); + d->charset_font_cache_stage_2 = + make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, Qeq); +} + +void +invalidate_charset_font_caches (Lisp_Object charset) +{ + /* Invalidate font cache entries for charset on all devices. */ + Lisp_Object devcons, concons, hash_table; + DEVICE_LOOP_NO_BREAK (devcons, concons) + { + struct device *d = XDEVICE (XCAR (devcons)); + hash_table = Fgethash (charset, d->charset_font_cache_stage_1, + Qunbound); + if (!UNBOUNDP (hash_table)) + Fclrhash (hash_table); + hash_table = Fgethash (charset, d->charset_font_cache_stage_2, + Qunbound); + if (!UNBOUNDP (hash_table)) + Fclrhash (hash_table); + } +} + +#endif /* MULE */ + +/* It's a little non-obvious what's going on here. Specifically: + + MATCHSPEC is a somewhat bogus way in the specifier mechanism of passing + in additional information needed to instantiate some object. For fonts, + it's a cons of (CHARSET . SECOND-STAGE-P). SECOND-STAGE-P, if set, + means "try harder to find an appropriate font" and is a very bogus way + of dealing with the fact that it may not be possible to may a charset + directly onto a font; it's used esp. under Windows. @@#### We need to + change this so that MATCHSPEC is just a character. + + When redisplay is building up its structure, and needs font info, it + calls functions in faces.c such as ensure_face_cachel_complete() (map + fonts needed for a string of text) or + ensure_face_cachel_contains_charset() (map fonts needed for a charset + derived from a single character). The former function calls the latter; + the latter calls face_property_matching_instance(); this constructs the + MATCHSPEC and calls specifier_instance_no_quit() twice (first stage and + second stage, updating MATCHSPEC appropriately). That function, in + turn, looks up the appropriate specifier method to do the instantiation, + which, lo and behold, is this function here (because we set it in + initialization using `SPECIFIER_HAS_METHOD (font, instantiate);'). We + in turn call the device method `find_charset_font', which maps to + mswindows_find_charset_font(), x_find_charset_font(), or similar, in + fontcolor-msw.c or the like. + + --ben */ + +static Lisp_Object +font_instantiate (Lisp_Object UNUSED (specifier), + Lisp_Object USED_IF_MULE (matchspec), + Lisp_Object domain, Lisp_Object instantiator, + Lisp_Object depth, int no_fallback) +{ + /* When called, we're inside of call_with_suspended_errors(), + so we can freely error. */ + Lisp_Object device = DOMAIN_DEVICE (domain); + struct device *d = XDEVICE (device); + Lisp_Object instance; + Lisp_Object charset = Qnil; +#ifdef MULE + enum font_specifier_matchspec_stages stage = STAGE_INITIAL; + + if (!UNBOUNDP (matchspec)) + { + charset = Fget_charset (XCAR (matchspec)); + +#define FROB(new_stage, enumstage) \ + if (EQ(Q##new_stage, XCDR(matchspec))) \ + { \ + stage = enumstage; \ + } + + FROB (initial, STAGE_INITIAL) + else FROB (final, STAGE_FINAL) + else assert(0); + +#undef FROB + + } +#endif + + if (FONT_INSTANCEP (instantiator)) + { + if (NILP (device) + || EQ (device, XFONT_INSTANCE (instantiator)->device)) + { +#ifdef MULE + if (font_spec_matches_charset (d, charset, 0, + Ffont_instance_truename + (instantiator), + 0, -1, stage)) +#endif + return instantiator; + } + instantiator = Ffont_instance_name (instantiator); + } + + if (STRINGP (instantiator)) + { +#ifdef MULE + /* #### rename these caches. */ + Lisp_Object cache = stage == STAGE_FINAL ? + d->charset_font_cache_stage_2 : + d->charset_font_cache_stage_1; +#else + Lisp_Object cache = d->font_instance_cache; +#endif + +#ifdef MULE + if (!NILP (charset)) + { + /* The instantiator is a font spec that could match many + different fonts. We need to find one of those fonts + whose registry matches the registry of the charset in + MATCHSPEC. This is potentially a very slow operation, + as it involves doing an XListFonts() or equivalent to + iterate over all possible fonts, and a regexp match + on each one. So we cache the results. */ + Lisp_Object matching_font = Qunbound; + Lisp_Object hash_table = Fgethash (charset, cache, Qunbound); + if (UNBOUNDP (hash_table)) + { + /* need to make a sub hash table. */ + hash_table = make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, + Qequal); + Fputhash (charset, hash_table, cache); + } + else + matching_font = Fgethash (instantiator, hash_table, Qunbound); + + if (UNBOUNDP (matching_font)) + { + /* make sure we cache the failures, too. */ + matching_font = + DEVMETH_OR_GIVEN (d, find_charset_font, + (device, instantiator, charset, stage), + instantiator); + Fputhash (instantiator, matching_font, hash_table); + } + if (NILP (matching_font)) + return Qunbound; + instantiator = matching_font; + } +#endif /* MULE */ + + /* First, look to see if we can retrieve a cached value. */ + instance = Fgethash (instantiator, cache, Qunbound); + /* Otherwise, make a new one. */ + if (UNBOUNDP (instance)) + { + /* make sure we cache the failures, too. */ + instance = Fmake_font_instance (instantiator, device, Qt, charset); + Fputhash (instantiator, instance, cache); + } + + return NILP (instance) ? Qunbound : instance; + } + else if (VECTORP (instantiator)) + { + Lisp_Object match_inst = Qunbound; + assert (XVECTOR_LENGTH (instantiator) == 1); + + match_inst = face_property_matching_instance + (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont, + charset, domain, ERROR_ME, no_fallback, depth, STAGE_INITIAL); + + if (UNBOUNDP(match_inst)) + { + match_inst = face_property_matching_instance + (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont, + charset, domain, ERROR_ME, no_fallback, depth, STAGE_FINAL); + } + + return match_inst; + + } + else if (NILP (instantiator)) + return Qunbound; + else + ABORT (); /* Eh? */ + + return Qunbound; +} + +static void +font_validate (Lisp_Object instantiator) +{ + if (FONT_INSTANCEP (instantiator) || STRINGP (instantiator)) + return; + if (VECTORP (instantiator)) + { + if (XVECTOR_LENGTH (instantiator) != 1) + { + sferror + ("Vector length must be one for font inheritance", instantiator); + } + Fget_face (XVECTOR_DATA (instantiator)[0]); + } + else + invalid_argument ("Must be string, vector, or font-instance", + instantiator); +} + +static void +font_after_change (Lisp_Object specifier, Lisp_Object locale) +{ + Lisp_Object face = FONT_SPECIFIER_FACE (XFONT_SPECIFIER (specifier)); + Lisp_Object property = + FONT_SPECIFIER_FACE_PROPERTY (XFONT_SPECIFIER (specifier)); + if (!NILP (face)) + { + face_property_was_changed (face, property, locale); + if (BUFFERP (locale)) + XBUFFER (locale)->buffer_local_face_property = 1; + } +} + +void +set_font_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property) +{ + Lisp_Specifier *font = XFONT_SPECIFIER (obj); + + FONT_SPECIFIER_FACE (font) = face; + FONT_SPECIFIER_FACE_PROPERTY (font) = property; +} + +DEFUN ("font-specifier-p", Ffont_specifier_p, 1, 1, 0, /* +Return non-nil if OBJECT is a font specifier. + +See `make-font-specifier' for a description of possible font instantiators. +*/ + (object)) +{ + return FONT_SPECIFIERP (object) ? Qt : Qnil; +} + + +/***************************************************************************** + Face Boolean Object + ****************************************************************************/ + +static const struct memory_description face_boolean_specifier_description[] = { + { XD_LISP_OBJECT, offsetof (struct face_boolean_specifier, face) }, + { XD_LISP_OBJECT, offsetof (struct face_boolean_specifier, face_property) }, + { XD_END } +}; + +DEFINE_SPECIFIER_TYPE_WITH_DATA (face_boolean); +Lisp_Object Qface_boolean; + +static void +face_boolean_create (Lisp_Object obj) +{ + Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); + + FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = Qnil; + FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = Qnil; +} + +static void +face_boolean_mark (Lisp_Object obj) +{ + Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); + + mark_object (FACE_BOOLEAN_SPECIFIER_FACE (face_boolean)); + mark_object (FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean)); +} + +/* No equal or hash methods; ignore the face the face-boolean is based off + of for `equal' */ + +static Lisp_Object +face_boolean_instantiate (Lisp_Object specifier, + Lisp_Object UNUSED (matchspec), + Lisp_Object domain, Lisp_Object instantiator, + Lisp_Object depth, int no_fallback) +{ + /* When called, we're inside of call_with_suspended_errors(), + so we can freely error. */ + if (NILP (instantiator) || EQ (instantiator, Qt)) + return instantiator; + else if (VECTORP (instantiator)) + { + Lisp_Object retval; + Lisp_Object prop; + int instantiator_len = XVECTOR_LENGTH (instantiator); + + assert (instantiator_len >= 1 && instantiator_len <= 3); + if (instantiator_len > 1) + prop = XVECTOR_DATA (instantiator)[1]; + else + { + if (NILP (FACE_BOOLEAN_SPECIFIER_FACE + (XFACE_BOOLEAN_SPECIFIER (specifier)))) + gui_error + ("Face-boolean specifier not attached to a face", instantiator); + prop = FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY + (XFACE_BOOLEAN_SPECIFIER (specifier)); + } + + retval = (FACE_PROPERTY_INSTANCE_1 + (Fget_face (XVECTOR_DATA (instantiator)[0]), + prop, domain, ERROR_ME, no_fallback, depth)); + + if (instantiator_len == 3 && !NILP (XVECTOR_DATA (instantiator)[2])) + retval = NILP (retval) ? Qt : Qnil; + + return retval; + } + else + ABORT (); /* Eh? */ + + return Qunbound; +} + +static void +face_boolean_validate (Lisp_Object instantiator) +{ + if (NILP (instantiator) || EQ (instantiator, Qt)) + return; + else if (VECTORP (instantiator) && + (XVECTOR_LENGTH (instantiator) >= 1 && + XVECTOR_LENGTH (instantiator) <= 3)) + { + Lisp_Object face = XVECTOR_DATA (instantiator)[0]; + + Fget_face (face); + + if (XVECTOR_LENGTH (instantiator) > 1) + { + Lisp_Object field = XVECTOR_DATA (instantiator)[1]; + if (!EQ (field, Qunderline) + && !EQ (field, Qstrikethru) + && !EQ (field, Qhighlight) + && !EQ (field, Qdim) + && !EQ (field, Qblinking) + && !EQ (field, Qreverse)) + invalid_constant ("Invalid face-boolean inheritance field", + field); + } + } + else if (VECTORP (instantiator)) + sferror ("Wrong length for face-boolean inheritance spec", + instantiator); + else + invalid_argument ("Face-boolean instantiator must be nil, t, or vector", + instantiator); +} + +static void +face_boolean_after_change (Lisp_Object specifier, Lisp_Object locale) +{ + Lisp_Object face = + FACE_BOOLEAN_SPECIFIER_FACE (XFACE_BOOLEAN_SPECIFIER (specifier)); + Lisp_Object property = + FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (XFACE_BOOLEAN_SPECIFIER (specifier)); + if (!NILP (face)) + { + face_property_was_changed (face, property, locale); + if (BUFFERP (locale)) + XBUFFER (locale)->buffer_local_face_property = 1; + } +} + +void +set_face_boolean_attached_to (Lisp_Object obj, Lisp_Object face, + Lisp_Object property) +{ + Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); + + FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = face; + FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = property; +} + +DEFUN ("face-boolean-specifier-p", Fface_boolean_specifier_p, 1, 1, 0, /* +Return non-nil if OBJECT is a face-boolean specifier. + +See `make-face-boolean-specifier' for a description of possible +face-boolean instantiators. +*/ + (object)) +{ + return FACE_BOOLEAN_SPECIFIERP (object) ? Qt : Qnil; +} + + +/***************************************************************************** + Face Background Placement Object + ****************************************************************************/ +Lisp_Object Qabsolute, Qrelative; + +static const struct memory_description +face_background_placement_specifier_description[] = { + { XD_LISP_OBJECT, offsetof (struct face_background_placement_specifier, + face) }, + { XD_END } +}; + +DEFINE_SPECIFIER_TYPE_WITH_DATA (face_background_placement); +Lisp_Object Qface_background_placement; + +static void +face_background_placement_create (Lisp_Object obj) +{ + Lisp_Specifier *face_background_placement + = XFACE_BACKGROUND_PLACEMENT_SPECIFIER (obj); + + FACE_BACKGROUND_PLACEMENT_SPECIFIER_FACE (face_background_placement) = Qnil; +} + +static void +face_background_placement_mark (Lisp_Object obj) +{ + Lisp_Specifier *face_background_placement + = XFACE_BACKGROUND_PLACEMENT_SPECIFIER (obj); + + mark_object + (FACE_BACKGROUND_PLACEMENT_SPECIFIER_FACE (face_background_placement)); +} + +/* No equal or hash methods; ignore the face the background-placement is based + off of for `equal' */ + +extern Lisp_Object Qbackground_placement; + +static Lisp_Object +face_background_placement_instantiate (Lisp_Object UNUSED (specifier), + Lisp_Object UNUSED (matchspec), + Lisp_Object domain, + Lisp_Object instantiator, + Lisp_Object depth, + int no_fallback) +{ + /* When called, we're inside of call_with_suspended_errors(), + so we can freely error. */ + if (EQ (instantiator, Qabsolute) || EQ (instantiator, Qrelative)) + return instantiator; + else if (VECTORP (instantiator)) + { + assert (XVECTOR_LENGTH (instantiator) == 1); + + return FACE_PROPERTY_INSTANCE_1 + (Fget_face (XVECTOR_DATA (instantiator)[0]), + Qbackground_placement, domain, ERROR_ME, no_fallback, depth); + } + else + ABORT (); /* Eh? */ + + return Qunbound; +} + +static void +face_background_placement_validate (Lisp_Object instantiator) +{ + if (EQ (instantiator, Qabsolute) || EQ (instantiator, Qrelative)) + return; + else if (VECTORP (instantiator) && + (XVECTOR_LENGTH (instantiator) == 1)) + { + Lisp_Object face = XVECTOR_DATA (instantiator)[0]; + + Fget_face (face); /* just to check that the face exists -- dvl */ + } + else if (VECTORP (instantiator)) + sferror ("Wrong length for background-placement inheritance spec", + instantiator); + else + invalid_argument + ("\ +Background-placement instantiator must be absolute, relative or vector", + instantiator); +} + +static void +face_background_placement_after_change (Lisp_Object specifier, + Lisp_Object locale) +{ + Lisp_Object face + = FACE_BACKGROUND_PLACEMENT_SPECIFIER_FACE + (XFACE_BACKGROUND_PLACEMENT_SPECIFIER (specifier)); + + if (!NILP (face)) + { + face_property_was_changed (face, Qbackground_placement, locale); + if (BUFFERP (locale)) + XBUFFER (locale)->buffer_local_face_property = 1; + } +} + +void +set_face_background_placement_attached_to (Lisp_Object obj, Lisp_Object face) +{ + Lisp_Specifier *face_background_placement + = XFACE_BACKGROUND_PLACEMENT_SPECIFIER (obj); + + FACE_BACKGROUND_PLACEMENT_SPECIFIER_FACE (face_background_placement) = face; +} + +DEFUN ("face-background-placement-specifier-p", Fface_background_placement_specifier_p, 1, 1, 0, /* +Return non-nil if OBJECT is a face-background-placement specifier. + +See `make-face-background-placement-specifier' for a description of possible +face-background-placement instantiators. +*/ + (object)) +{ + return FACE_BACKGROUND_PLACEMENT_SPECIFIERP (object) ? Qt : Qnil; +} + + +/************************************************************************/ +/* initialization */ +/************************************************************************/ + +void +syms_of_fontcolor (void) +{ + INIT_LISP_OBJECT (color_instance); + INIT_LISP_OBJECT (font_instance); + + DEFSUBR (Fcolor_specifier_p); + DEFSUBR (Ffont_specifier_p); + DEFSUBR (Fface_boolean_specifier_p); + DEFSUBR (Fface_background_placement_specifier_p); + + DEFSYMBOL_MULTIWORD_PREDICATE (Qcolor_instancep); + DEFSUBR (Fmake_color_instance); + DEFSUBR (Fcolor_instance_p); + DEFSUBR (Fcolor_instance_name); + DEFSUBR (Fcolor_instance_rgb_components); + DEFSUBR (Fvalid_color_name_p); + DEFSUBR (Fcolor_list); + + DEFSYMBOL_MULTIWORD_PREDICATE (Qfont_instancep); + DEFSUBR (Fmake_font_instance); + DEFSUBR (Ffont_instance_p); + DEFSUBR (Ffont_instance_name); + DEFSUBR (Ffont_instance_ascent); + DEFSUBR (Ffont_instance_descent); + DEFSUBR (Ffont_instance_width); + DEFSUBR (Ffont_instance_charset); + DEFSUBR (Ffont_instance_proportional_p); + DEFSUBR (Ffont_instance_truename); + DEFSUBR (Ffont_instance_properties); + DEFSUBR (Ffont_list); + + /* Qcolor, Qfont defined in general.c */ + DEFSYMBOL (Qface_boolean); + + DEFSYMBOL (Qface_background_placement); + DEFSYMBOL (Qabsolute); + DEFSYMBOL (Qrelative); +} + +void +specifier_type_create_fontcolor (void) +{ + INITIALIZE_SPECIFIER_TYPE_WITH_DATA (color, "color", "color-specifier-p"); + INITIALIZE_SPECIFIER_TYPE_WITH_DATA (font, "font", "font-specifier-p"); + INITIALIZE_SPECIFIER_TYPE_WITH_DATA (face_boolean, "face-boolean", + "face-boolean-specifier-p"); + INITIALIZE_SPECIFIER_TYPE_WITH_DATA (face_background_placement, + "face-background-placement", + "\ +face-background-placement-specifier-p"); + + SPECIFIER_HAS_METHOD (color, instantiate); + SPECIFIER_HAS_METHOD (font, instantiate); + SPECIFIER_HAS_METHOD (face_boolean, instantiate); + SPECIFIER_HAS_METHOD (face_background_placement, instantiate); + + SPECIFIER_HAS_METHOD (color, validate); + SPECIFIER_HAS_METHOD (font, validate); + SPECIFIER_HAS_METHOD (face_boolean, validate); + SPECIFIER_HAS_METHOD (face_background_placement, validate); + + SPECIFIER_HAS_METHOD (color, create); + SPECIFIER_HAS_METHOD (font, create); + SPECIFIER_HAS_METHOD (face_boolean, create); + SPECIFIER_HAS_METHOD (face_background_placement, create); + + SPECIFIER_HAS_METHOD (color, mark); + SPECIFIER_HAS_METHOD (font, mark); + SPECIFIER_HAS_METHOD (face_boolean, mark); + SPECIFIER_HAS_METHOD (face_background_placement, mark); + + SPECIFIER_HAS_METHOD (color, after_change); + SPECIFIER_HAS_METHOD (font, after_change); + SPECIFIER_HAS_METHOD (face_boolean, after_change); + SPECIFIER_HAS_METHOD (face_background_placement, after_change); + +#ifdef MULE + SPECIFIER_HAS_METHOD (font, validate_matchspec); +#endif +} + +void +reinit_specifier_type_create_fontcolor (void) +{ + REINITIALIZE_SPECIFIER_TYPE (color); + REINITIALIZE_SPECIFIER_TYPE (font); + REINITIALIZE_SPECIFIER_TYPE (face_boolean); + REINITIALIZE_SPECIFIER_TYPE (face_background_placement); +} + +void +reinit_vars_of_fontcolor (void) +{ + { + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (color_instance); + Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); + c->name = Qnil; + c->device = Qnil; + c->data = 0; + + Vthe_null_color_instance = obj; + staticpro_nodump (&Vthe_null_color_instance); + } + + { + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (font_instance); + Lisp_Font_Instance *f = XFONT_INSTANCE (obj); + f->name = Qnil; + f->truename = Qnil; + f->device = Qnil; + f->data = 0; + + f->ascent = f->height = 0; + f->descent = 0; + f->width = 0; + f->proportional_p = 0; + + Vthe_null_font_instance = obj; + staticpro_nodump (&Vthe_null_font_instance); + } +} + +void +vars_of_fontcolor (void) +{ +} diff -r 861f2601a38b -r 1f0b15040456 src/fontcolor.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/fontcolor.h Sun May 01 18:44:03 2011 +0100 @@ -0,0 +1,85 @@ +/* Generic object functions -- interface. + Copyright (C) 1995 Board of Trustees, University of Illinois. + Copyright (C) 1995, 1996, 2002, 2010 Ben Wing. + +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 3 of the License, 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. If not, see . */ + +/* Synched up with: Not in FSF. */ + +#ifndef INCLUDED_fontcolor_h_ +#define INCLUDED_fontcolor_h_ + +DECLARE_DOESNT_RETURN (finalose (void *ptr)); + +/**************************************************************************** + * Color Instance Object * + ****************************************************************************/ + +DECLARE_LISP_OBJECT (color_instance, Lisp_Color_Instance); +#define XCOLOR_INSTANCE(x) XRECORD (x, color_instance, Lisp_Color_Instance) +#define wrap_color_instance(p) wrap_record (p, color_instance) +#define COLOR_INSTANCEP(x) RECORDP (x, color_instance) +#define CHECK_COLOR_INSTANCE(x) CHECK_RECORD (x, color_instance) +#define CONCHECK_COLOR_INSTANCE(x) CONCHECK_RECORD (x, color_instance) + +EXFUN (Fmake_color_instance, 3); + +extern Lisp_Object Vthe_null_color_instance; + +void set_color_attached_to (Lisp_Object obj, Lisp_Object face, + Lisp_Object property); + +/**************************************************************************** + * Font Instance Object * + ****************************************************************************/ + +void initialize_charset_font_caches (struct device *d); +void invalidate_charset_font_caches (Lisp_Object charset); + +DECLARE_LISP_OBJECT (font_instance, Lisp_Font_Instance); +#define XFONT_INSTANCE(x) XRECORD (x, font_instance, Lisp_Font_Instance) +#define wrap_font_instance(p) wrap_record (p, font_instance) +#define FONT_INSTANCEP(x) RECORDP (x, font_instance) +#define CHECK_FONT_INSTANCE(x) CHECK_RECORD (x, font_instance) +#define CONCHECK_FONT_INSTANCE(x) CONCHECK_RECORD (x, font_instance) + +EXFUN (Fmake_font_instance, 4); +EXFUN (Ffont_instance_name, 1); +EXFUN (Ffont_instance_p, 1); +EXFUN (Ffont_instance_truename, 1); +EXFUN (Ffont_instance_charset, 1); + +extern Lisp_Object Vthe_null_font_instance; + +void set_font_attached_to (Lisp_Object obj, Lisp_Object face, + Lisp_Object property); + +/***************************************************************************** + * Face Boolean Specifier Object * + *****************************************************************************/ + +void set_face_boolean_attached_to (Lisp_Object obj, Lisp_Object face, + Lisp_Object property); + +/***************************************************************************** + * Face Background Placement Specifier Object * + *****************************************************************************/ + +void set_face_background_placement_attached_to (Lisp_Object obj, + Lisp_Object face); + + +#endif /* INCLUDED_fontcolor_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/frame-gtk.c --- a/src/frame-gtk.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/frame-gtk.c Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,13 @@ /* Functions for the GTK toolkit. Copyright (C) 1989, 1992-5, 1997 Free Software Foundation, Inc. - Copyright (C) 1995, 1996, 2002, 2003 Ben Wing. + Copyright (C) 1995, 1996, 2002, 2003, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not synched with FSF. */ @@ -42,7 +40,7 @@ #include "elhash.h" #include "console-gtk-impl.h" #include "glyphs-gtk.h" -#include "objects-gtk-impl.h" +#include "fontcolor-gtk-impl.h" #include "scrollbar-gtk.h" #include "ui-gtk.h" @@ -103,11 +101,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("gtk-frame", gtk_frame, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - gtk_frame_data_description_1, - Lisp_Gtk_Frame); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("gtk-frame", gtk_frame, + 0, gtk_frame_data_description_1, + Lisp_Gtk_Frame); #else /* not NEW_GC */ extern const struct sized_memory_description gtk_frame_data_description; @@ -373,7 +369,7 @@ { GdkWindowHints geometry_mask = GDK_HINT_RESIZE_INC; /* Deal with the cell size */ - default_face_height_and_width (wrap_frame (f), &geometry.height_inc, &geometry.width_inc); + default_face_width_and_height (wrap_frame (f), &geometry.width_inc, &geometry.height_inc); gtk_window_set_geometry_hints (GTK_WINDOW (shell), FRAME_GTK_TEXT_WIDGET (f), &geometry, geometry_mask); @@ -384,7 +380,7 @@ FRAME_HEIGHT (f) = h; FRAME_WIDTH (f) = w; - change_frame_size (f, h, w, 0); + change_frame_size (f, w, h, 0); { GtkRequisition req; @@ -635,13 +631,13 @@ { struct window *win = XWINDOW (f->root_window); - WINDOW_LEFT (win) = FRAME_LEFT_BORDER_END (f); - WINDOW_TOP (win) = FRAME_TOP_BORDER_END (f); + WINDOW_LEFT (win) = FRAME_PANED_LEFT_EDGE (f); + WINDOW_TOP (win) = FRAME_PANED_TOP_EDGE (f); if (!NILP (f->minibuffer_window)) { win = XWINDOW (f->minibuffer_window); - WINDOW_LEFT (win) = FRAME_LEFT_BORDER_END (f); + WINDOW_LEFT (win) = FRAME_PANED_LEFT_EDGE (f); } } @@ -974,7 +970,7 @@ /* zero out all slots. */ #ifdef NEW_GC - f->frame_data = alloc_lrecord_type (struct gtk_frame, &lrecord_gtk_frame); + f->frame_data = XGTK_FRAME (ALLOC_NORMAL_LISP_OBJECT (gtk_frame)); #else /* not NEW_GC */ f->frame_data = xnew_and_zero (struct gtk_frame); #endif /* not NEW_GC */ @@ -994,11 +990,11 @@ now that we have internal_equal_trapping_problems(). --ben */ FRAME_GTK_WIDGET_INSTANCE_HASH_TABLE (f) = - make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, Qeq); FRAME_GTK_WIDGET_CALLBACK_HASH_TABLE (f) = - make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, Qeq); FRAME_GTK_WIDGET_CALLBACK_EX_HASH_TABLE (f) = - make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, Qeq); } @@ -1065,7 +1061,7 @@ * will update the frame title anyway, so nothing is lost. * JV: * It turns out it gives problems with FVWMs name based mapping. - * We'll just need to be carefull in the modeline specs. + * We'll just need to be careful in the modeline specs. */ update_frame_title (f); } @@ -1191,13 +1187,14 @@ GdkWindowHints geometry_mask = GDK_HINT_RESIZE_INC; /* Update the cell size */ - default_face_height_and_width (wrap_frame (f), &geometry.height_inc, &geometry.width_inc); + default_face_width_and_height (wrap_frame (f), &geometry.width_inc, + &geometry.height_inc); gtk_window_set_geometry_hints (GTK_WINDOW (shell), FRAME_GTK_TEXT_WIDGET (f), &geometry, geometry_mask); } - change_frame_size (f, rows, cols, 0); + change_frame_size (f, cols, rows, 0); { GtkRequisition req; @@ -1372,7 +1369,7 @@ gint width_inc = 10; gint height_inc = 10; - default_face_height_and_width (wrap_frame (frm), &height_inc, &width_inc); + default_face_width_and_height (wrap_frame (frm), &width_inc, &height_inc); geometry_mask = GDK_HINT_RESIZE_INC; geometry.width_inc = width_inc; geometry.height_inc = height_inc; @@ -1474,7 +1471,7 @@ syms_of_frame_gtk (void) { #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (gtk_frame); + INIT_LISP_OBJECT (gtk_frame); #endif /* NEW_GC */ DEFSYMBOL (Qtext_widget); diff -r 861f2601a38b -r 1f0b15040456 src/frame-impl.h --- a/src/frame-impl.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/frame-impl.h Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,13 @@ /* Define frame-object for XEmacs. Copyright (C) 1988, 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Ben Wing. + Copyright (C) 1995, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ @@ -41,7 +39,7 @@ struct frame { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; /* Methods for this frame's console. This can also be retrieved through frame->device->console, but it's faster this way. */ @@ -100,17 +98,23 @@ /* Size of toolbars as seen by redisplay. This is used to determine whether to re-layout windows by a call to change_frame_size early in redisplay_frame. */ - int current_toolbar_size[4]; + int current_toolbar_size[NUM_EDGES]; #endif /* Size of gutters as seen by redisplay. This is used to determine whether to re-layout windows by a call to change_frame_size early in redisplay_frame. */ - int current_gutter_bounds[4]; + int current_gutter_bounds[NUM_EDGES]; + + /* Toolbar visibility */ + int toolbar_was_visible[NUM_EDGES]; + + /* gutter visibility */ + int gutter_was_visible[NUM_EDGES]; /* Dynamic arrays of display lines for gutters */ - display_line_dynarr *current_display_lines[4]; - display_line_dynarr *desired_display_lines[4]; + display_line_dynarr *current_display_lines[NUM_EDGES]; + display_line_dynarr *desired_display_lines[NUM_EDGES]; /* A structure of auxiliary data specific to the device type. For example, struct x_frame is for X window frames; defined in @@ -160,16 +164,6 @@ /* True if frame's root window can't be split. */ unsigned int no_split :1; - unsigned int top_toolbar_was_visible :1; - unsigned int bottom_toolbar_was_visible :1; - unsigned int left_toolbar_was_visible :1; - unsigned int right_toolbar_was_visible :1; - /* gutter visibility */ - unsigned int top_gutter_was_visible :1; - unsigned int bottom_gutter_was_visible :1; - unsigned int left_gutter_was_visible :1; - unsigned int right_gutter_was_visible :1; - /* redisplay flags */ unsigned int buffers_changed :1; unsigned int clip_changed :1; @@ -543,8 +537,16 @@ #endif /* FSFmacs */ -#define FRAME_BORDER_WIDTH(f) ((f)->internal_border_width) -#define FRAME_BORDER_HEIGHT(f) ((f)->internal_border_width) +#define FRAME_INTERNAL_BORDER_WIDTH(f) ((f)->internal_border_width) +#define FRAME_INTERNAL_BORDER_HEIGHT(f) ((f)->internal_border_width) +#define FRAME_INTERNAL_BORDER_SIZE(f, pos) ((f)->internal_border_width) + +/************************************************************************/ +/* toolbars */ +/************************************************************************/ + +/*---------------- Theoretical and real toolbar values ----------------*/ + /* This returns the frame-local value; that tells you what you should use when computing the frame size. It is *not* the actual toolbar @@ -573,13 +575,13 @@ : 0) #define FRAME_THEORETICAL_TOP_TOOLBAR_HEIGHT(f) \ - FRAME_THEORETICAL_TOOLBAR_SIZE (f, TOP_TOOLBAR) + FRAME_THEORETICAL_TOOLBAR_SIZE (f, TOP_EDGE) #define FRAME_THEORETICAL_BOTTOM_TOOLBAR_HEIGHT(f) \ - FRAME_THEORETICAL_TOOLBAR_SIZE (f, BOTTOM_TOOLBAR) + FRAME_THEORETICAL_TOOLBAR_SIZE (f, BOTTOM_EDGE) #define FRAME_THEORETICAL_LEFT_TOOLBAR_WIDTH(f) \ - FRAME_THEORETICAL_TOOLBAR_SIZE (f, LEFT_TOOLBAR) + FRAME_THEORETICAL_TOOLBAR_SIZE (f, LEFT_EDGE) #define FRAME_THEORETICAL_RIGHT_TOOLBAR_WIDTH(f) \ - FRAME_THEORETICAL_TOOLBAR_SIZE (f, RIGHT_TOOLBAR) + FRAME_THEORETICAL_TOOLBAR_SIZE (f, RIGHT_EDGE) #define FRAME_THEORETICAL_TOOLBAR_BORDER_WIDTH(f, pos) \ (FRAME_RAW_THEORETICAL_TOOLBAR_VISIBLE (f, pos) \ @@ -587,13 +589,13 @@ : 0) #define FRAME_THEORETICAL_TOP_TOOLBAR_BORDER_WIDTH(f) \ - FRAME_THEORETICAL_TOOLBAR_BORDER_WIDTH (f, TOP_TOOLBAR) + FRAME_THEORETICAL_TOOLBAR_BORDER_WIDTH (f, TOP_EDGE) #define FRAME_THEORETICAL_BOTTOM_TOOLBAR_BORDER_WIDTH(f) \ - FRAME_THEORETICAL_TOOLBAR_BORDER_WIDTH (f, BOTTOM_TOOLBAR) + FRAME_THEORETICAL_TOOLBAR_BORDER_WIDTH (f, BOTTOM_EDGE) #define FRAME_THEORETICAL_LEFT_TOOLBAR_BORDER_WIDTH(f) \ - FRAME_THEORETICAL_TOOLBAR_BORDER_WIDTH (f, LEFT_TOOLBAR) + FRAME_THEORETICAL_TOOLBAR_BORDER_WIDTH (f, LEFT_EDGE) #define FRAME_THEORETICAL_RIGHT_TOOLBAR_BORDER_WIDTH(f) \ - FRAME_THEORETICAL_TOOLBAR_BORDER_WIDTH (f, RIGHT_TOOLBAR) + FRAME_THEORETICAL_TOOLBAR_BORDER_WIDTH (f, RIGHT_EDGE) /* This returns the window-local value rather than the frame-local value; that tells you about what's actually visible rather than what should @@ -657,59 +659,127 @@ ? FRAME_RAW_REAL_TOOLBAR_BORDER_WIDTH (f, pos) \ : 0) +#define FRAME_REAL_TOOLBAR_BOUNDS(f, pos) \ + (FRAME_REAL_TOOLBAR_SIZE (f, pos) + \ + 2 * FRAME_REAL_TOOLBAR_BORDER_WIDTH (f, pos)) + #define FRAME_REAL_TOP_TOOLBAR_HEIGHT(f) \ - FRAME_REAL_TOOLBAR_SIZE (f, TOP_TOOLBAR) + FRAME_REAL_TOOLBAR_SIZE (f, TOP_EDGE) #define FRAME_REAL_BOTTOM_TOOLBAR_HEIGHT(f) \ - FRAME_REAL_TOOLBAR_SIZE (f, BOTTOM_TOOLBAR) + FRAME_REAL_TOOLBAR_SIZE (f, BOTTOM_EDGE) #define FRAME_REAL_LEFT_TOOLBAR_WIDTH(f) \ - FRAME_REAL_TOOLBAR_SIZE (f, LEFT_TOOLBAR) + FRAME_REAL_TOOLBAR_SIZE (f, LEFT_EDGE) #define FRAME_REAL_RIGHT_TOOLBAR_WIDTH(f) \ - FRAME_REAL_TOOLBAR_SIZE (f, RIGHT_TOOLBAR) + FRAME_REAL_TOOLBAR_SIZE (f, RIGHT_EDGE) #define FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH(f) \ - FRAME_REAL_TOOLBAR_BORDER_WIDTH (f, TOP_TOOLBAR) + FRAME_REAL_TOOLBAR_BORDER_WIDTH (f, TOP_EDGE) #define FRAME_REAL_BOTTOM_TOOLBAR_BORDER_WIDTH(f) \ - FRAME_REAL_TOOLBAR_BORDER_WIDTH (f, BOTTOM_TOOLBAR) + FRAME_REAL_TOOLBAR_BORDER_WIDTH (f, BOTTOM_EDGE) #define FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH(f) \ - FRAME_REAL_TOOLBAR_BORDER_WIDTH (f, LEFT_TOOLBAR) + FRAME_REAL_TOOLBAR_BORDER_WIDTH (f, LEFT_EDGE) #define FRAME_REAL_RIGHT_TOOLBAR_BORDER_WIDTH(f) \ - FRAME_REAL_TOOLBAR_BORDER_WIDTH (f, RIGHT_TOOLBAR) + FRAME_REAL_TOOLBAR_BORDER_WIDTH (f, RIGHT_EDGE) #define FRAME_REAL_TOP_TOOLBAR_VISIBLE(f) \ - FRAME_REAL_TOOLBAR_VISIBLE (f, TOP_TOOLBAR) + FRAME_REAL_TOOLBAR_VISIBLE (f, TOP_EDGE) #define FRAME_REAL_BOTTOM_TOOLBAR_VISIBLE(f) \ - FRAME_REAL_TOOLBAR_VISIBLE (f, BOTTOM_TOOLBAR) + FRAME_REAL_TOOLBAR_VISIBLE (f, BOTTOM_EDGE) #define FRAME_REAL_LEFT_TOOLBAR_VISIBLE(f) \ - FRAME_REAL_TOOLBAR_VISIBLE (f, LEFT_TOOLBAR) + FRAME_REAL_TOOLBAR_VISIBLE (f, LEFT_EDGE) #define FRAME_REAL_RIGHT_TOOLBAR_VISIBLE(f) \ - FRAME_REAL_TOOLBAR_VISIBLE (f, RIGHT_TOOLBAR) + FRAME_REAL_TOOLBAR_VISIBLE (f, RIGHT_EDGE) + +#define FRAME_REAL_TOP_TOOLBAR_BOUNDS(f) \ + FRAME_REAL_TOOLBAR_BOUNDS (f, TOP_EDGE) +#define FRAME_REAL_BOTTOM_TOOLBAR_BOUNDS(f) \ + FRAME_REAL_TOOLBAR_BOUNDS (f, BOTTOM_EDGE) +#define FRAME_REAL_LEFT_TOOLBAR_BOUNDS(f) \ + FRAME_REAL_TOOLBAR_BOUNDS (f, LEFT_EDGE) +#define FRAME_REAL_RIGHT_TOOLBAR_BOUNDS(f) \ + FRAME_REAL_TOOLBAR_BOUNDS (f, RIGHT_EDGE) + +/************************************************************************/ +/* frame dimensions defined using toolbars and gutters */ +/************************************************************************/ + +/* Bounds of the area framed by the toolbars is the client area -- + (0, 0) - (FRAME_PIXWIDTH, FRAME_PIXHEIGHT). */ + +/* Bounds of the area framed by the internal border width -- inside of the + toolbars, outside of everything else. */ -#define FRAME_TOP_BORDER_START(f) \ - (FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) + \ - 2 * FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f)) -#define FRAME_TOP_BORDER_END(f) \ - (FRAME_TOP_BORDER_START (f) + FRAME_BORDER_HEIGHT (f)) +#define FRAME_TOP_INTERNAL_BORDER_START(f) \ + FRAME_REAL_TOP_TOOLBAR_BOUNDS (f) +#define FRAME_TOP_INTERNAL_BORDER_END(f) \ + (FRAME_TOP_INTERNAL_BORDER_START (f) + FRAME_INTERNAL_BORDER_HEIGHT (f)) + +#define FRAME_BOTTOM_INTERNAL_BORDER_START(f) \ + (FRAME_BOTTOM_INTERNAL_BORDER_END (f) - FRAME_INTERNAL_BORDER_HEIGHT (f)) +#define FRAME_BOTTOM_INTERNAL_BORDER_END(f) \ + (FRAME_PIXHEIGHT (f) - FRAME_REAL_BOTTOM_TOOLBAR_BOUNDS (f)) + +#define FRAME_LEFT_INTERNAL_BORDER_START(f) \ + FRAME_REAL_LEFT_TOOLBAR_BOUNDS (f) +#define FRAME_LEFT_INTERNAL_BORDER_END(f) \ + (FRAME_LEFT_INTERNAL_BORDER_START (f) + FRAME_INTERNAL_BORDER_WIDTH (f)) + +#define FRAME_RIGHT_INTERNAL_BORDER_START(f) \ + (FRAME_RIGHT_INTERNAL_BORDER_END (f) - FRAME_INTERNAL_BORDER_WIDTH (f)) +#define FRAME_RIGHT_INTERNAL_BORDER_END(f) \ + (FRAME_PIXWIDTH (f) - FRAME_REAL_RIGHT_TOOLBAR_BOUNDS (f)) + +/* Bounds of the area framed by the gutter -- inside of the + toolbars and internal border width. */ -#define FRAME_BOTTOM_BORDER_START(f) \ - (FRAME_PIXHEIGHT (f) - FRAME_BORDER_HEIGHT (f) - \ - FRAME_REAL_BOTTOM_TOOLBAR_HEIGHT (f) - \ - 2 * FRAME_REAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f)) -#define FRAME_BOTTOM_BORDER_END(f) \ - (FRAME_PIXHEIGHT (f) - FRAME_REAL_BOTTOM_TOOLBAR_HEIGHT (f) - \ - 2 * FRAME_REAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f)) +#define FRAME_TOP_GUTTER_START(f) \ + FRAME_TOP_INTERNAL_BORDER_END (f) +#define FRAME_TOP_GUTTER_END(f) \ + (FRAME_TOP_GUTTER_START (f) + FRAME_TOP_GUTTER_BOUNDS (f)) + +#ifdef BOTTOM_GUTTER_IS_OUTSIDE_MINIBUFFER +#define FRAME_BOTTOM_GUTTER_START(f) \ + (FRAME_BOTTOM_GUTTER_END (f) - FRAME_BOTTOM_GUTTER_BOUNDS (f)) +#define FRAME_BOTTOM_GUTTER_END(f) \ + FRAME_BOTTOM_INTERNAL_BORDER_START (f) +#endif /* BOTTOM_GUTTER_IS_OUTSIDE_MINIBUFFER */ + +#define FRAME_LEFT_GUTTER_START(f) \ + FRAME_LEFT_INTERNAL_BORDER_END (f) +#define FRAME_LEFT_GUTTER_END(f) \ + (FRAME_LEFT_GUTTER_START (f) + FRAME_LEFT_GUTTER_BOUNDS (f)) + +#define FRAME_RIGHT_GUTTER_START(f) \ + (FRAME_RIGHT_GUTTER_END (f) - FRAME_RIGHT_GUTTER_BOUNDS (f)) +#define FRAME_RIGHT_GUTTER_END(f) \ + FRAME_RIGHT_INTERNAL_BORDER_START (f) -#define FRAME_LEFT_BORDER_START(f) \ - (FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) + \ - 2 * FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f)) -#define FRAME_LEFT_BORDER_END(f) \ - (FRAME_LEFT_BORDER_START (f) + FRAME_BORDER_WIDTH (f)) +/* These are the bounds of the paned area -- inside of the toolbars, + gutters, and internal border width. The paned area is the same as the + area occupied by windows, including the minibuffer. See long comment in + frame.c. */ + +#define FRAME_PANED_TOP_EDGE(f) FRAME_TOP_GUTTER_END (f) +#ifdef BOTTOM_GUTTER_IS_OUTSIDE_MINIBUFFER +#define FRAME_PANED_BOTTOM_EDGE(f) FRAME_BOTTOM_GUTTER_START (f) +#endif /* BOTTOM_GUTTER_IS_OUTSIDE_MINIBUFFER */ +#define FRAME_PANED_LEFT_EDGE(f) FRAME_LEFT_GUTTER_END (f) +#define FRAME_PANED_RIGHT_EDGE(f) FRAME_RIGHT_GUTTER_START (f) -#define FRAME_RIGHT_BORDER_START(f) \ - (FRAME_PIXWIDTH (f) - FRAME_BORDER_WIDTH (f) - \ - FRAME_REAL_RIGHT_TOOLBAR_WIDTH(f) - \ - 2 * FRAME_REAL_RIGHT_TOOLBAR_BORDER_WIDTH (f)) -#define FRAME_RIGHT_BORDER_END(f) \ - (FRAME_PIXWIDTH (f) - FRAME_REAL_RIGHT_TOOLBAR_WIDTH (f) - \ - 2 * FRAME_REAL_RIGHT_TOOLBAR_BORDER_WIDTH(f)) +/* Thickness of non-paned area at edge of frame; + + FRAME_PANED_TOP_EDGE (f) == FRAME_NONPANED_SIZE (f, TOP_EDGE) + FRAME_PANED_LEFT_EDGE (f) == FRAME_NONPANED_SIZE (f, LEFT_EDGE) + FRAME_PANED_BOTTOM_EDGE (f) == + FRAME_PIXHEIGHT (f) - FRAME_NONPANED_SIZE (f, BOTTOM_EDGE) + FRAME_PANED_RIGHT_EDGE (f) == + FRAME_PIXWIDTH (f) - FRAME_NONPANED_SIZE (f, RIGHT_EDGE) + +*/ +#define FRAME_NONPANED_SIZE(f, pos) \ + (FRAME_REAL_TOOLBAR_BOUNDS (f, pos) + FRAME_INTERNAL_BORDER_SIZE (f, pos) + \ + FRAME_GUTTER_BOUNDS (f, pos)) + + #endif /* INCLUDED_frame_impl_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/frame-msw.c --- a/src/frame-msw.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/frame-msw.c Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,13 @@ /* Functions for the mswindows window system. Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1995, 1996, 2001, 2002 Ben Wing. + Copyright (C) 1995, 1996, 2001, 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not synched with FSF. */ @@ -93,11 +91,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("mswindows-frame", mswindows_frame, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - mswindows_frame_data_description_1, - Lisp_Mswindows_Frame); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("mswindows-frame", mswindows_frame, + 0, mswindows_frame_data_description_1, + Lisp_Mswindows_Frame); #else /* not NEW_GC */ extern const struct sized_memory_description mswindows_frame_data_description; @@ -174,8 +170,7 @@ CHECK_INT (height); #ifdef NEW_GC - f->frame_data = alloc_lrecord_type (struct mswindows_frame, - &lrecord_mswindows_frame); + f->frame_data = XMSWINDOWS_FRAME (ALLOC_NORMAL_LISP_OBJECT (mswindows_frame)); #else /* not NEW_GC */ f->frame_data = xnew_and_zero (struct mswindows_frame); #endif /* not NEW_GC */ @@ -193,7 +188,7 @@ #ifdef HAVE_TOOLBARS /* EQ not EQUAL or we will get QUIT crashes, see below. */ FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE (f) = - make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, Qeq); #endif /* hashtable of instantiated glyphs on the frame. [[ Make them EQ because we only use ints as keys. Otherwise we run into stickiness in @@ -201,11 +196,11 @@ enter_redisplay_critical_section(). ]] -- probably not true any more, now that we have internal_equal_trapping_problems(). --ben */ FRAME_MSWINDOWS_WIDGET_HASH_TABLE1 (f) = - make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, Qeq); FRAME_MSWINDOWS_WIDGET_HASH_TABLE2 (f) = - make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, Qeq); FRAME_MSWINDOWS_WIDGET_HASH_TABLE3 (f) = - make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, Qeq); /* Will initialize these in WM_SIZE handler. We cannot do it now, because we do not know what is CW_USEDEFAULT height and width */ FRAME_WIDTH (f) = 0; @@ -238,7 +233,7 @@ GetWindowRect (hwnd_parent, &rect); rect_default.left = rect.left + POPUP_OFFSET; rect_default.top = rect.top + POPUP_OFFSET; - char_to_real_pixel_size (f, POPUP_WIDTH, POPUP_HEIGHT, + char_to_pixel_size (f, POPUP_WIDTH, POPUP_HEIGHT, &rect_default.width, &rect_default.height); FRAME_MSWINDOWS_POPUP (f) = 1; } @@ -375,14 +370,14 @@ mswindows_set_frame_size (struct frame *f, int width, int height) { RECT rect; - int columns, rows; + int pwidth, pheight; + + change_frame_size (f, width, height, 0); + frame_unit_to_pixel_size (f, width, height, &pwidth, &pheight); rect.left = rect.top = 0; - rect.right = width; - rect.bottom = height; - - pixel_to_char_size (f, rect.right, rect.bottom, &columns, &rows); - change_frame_size (f, rows, columns, 0); + rect.right = pwidth; + rect.bottom = pheight; /* This can call Lisp, because it runs the window procedure, which can call redisplay() */ @@ -741,7 +736,7 @@ int pixel_width, pixel_height; int size_p = (dest->width >=0 || dest->height >=0); int move_p = (dest->top >=0 || dest->left >=0); - char_to_real_pixel_size (f, dest->width, dest->height, &pixel_width, + char_to_pixel_size (f, dest->width, dest->height, &pixel_width, &pixel_height); if (dest->width < 0) @@ -940,7 +935,7 @@ if (FRAME_MSPRINTER_CHARWIDTH (f) > 0) { - char_to_real_pixel_size (f, FRAME_MSPRINTER_CHARWIDTH (f), 0, + char_to_pixel_size (f, FRAME_MSPRINTER_CHARWIDTH (f), 0, &frame_width, NULL); FRAME_MSPRINTER_RIGHT_MARGIN(f) = MulDiv (physicalwidth - (frame_left + frame_width), 1440, @@ -956,7 +951,7 @@ if (FRAME_MSPRINTER_CHARHEIGHT (f) > 0) { - char_to_real_pixel_size (f, 0, FRAME_MSPRINTER_CHARHEIGHT (f), + char_to_pixel_size (f, 0, FRAME_MSPRINTER_CHARHEIGHT (f), NULL, &frame_height); FRAME_MSPRINTER_BOTTOM_MARGIN(f) = @@ -986,8 +981,8 @@ int rows, columns; FRAME_PIXWIDTH (f) = frame_width; FRAME_PIXHEIGHT (f) = frame_height; - pixel_to_char_size (f, frame_width, frame_height, &columns, &rows); - change_frame_size (f, rows, columns, 0); + pixel_to_frame_unit_size (f, frame_width, frame_height, &columns, &rows); + change_frame_size (f, columns, rows, 0); } FRAME_MSPRINTER_PIXLEFT(f) = frame_left; @@ -1096,8 +1091,15 @@ maybe_error_if_job_active (f); if (!NILP (val)) { - CHECK_NATNUM (val); - FRAME_MSPRINTER_CHARWIDTH (f) = XINT (val); +#ifdef HAVE_BIGNUM + check_integer_range (val, Qzero, make_integer (INT_MAX)); + FRAME_MSPRINTER_CHARWIDTH (f) = + BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) : + XINT (val); +#else + CHECK_NATNUM (val); + FRAME_MSPRINTER_CHARWIDTH (f) = XINT (val); +#endif } } if (EQ (prop, Qheight)) @@ -1105,33 +1107,68 @@ maybe_error_if_job_active (f); if (!NILP (val)) { +#ifdef HAVE_BIGNUM + check_integer_range (val, Qzero, make_integer (INT_MAX)); + FRAME_MSPRINTER_CHARHEIGHT (f) = + BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) : + XINT (val); +#else CHECK_NATNUM (val); FRAME_MSPRINTER_CHARHEIGHT (f) = XINT (val); +#endif } } else if (EQ (prop, Qleft_margin)) { maybe_error_if_job_active (f); +#ifdef HAVE_BIGNUM + check_integer_range (val, Qzero, make_integer (INT_MAX)); + FRAME_MSPRINTER_LEFT_MARGIN (f) = + BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) : + XINT (val); +#else CHECK_NATNUM (val); FRAME_MSPRINTER_LEFT_MARGIN (f) = XINT (val); +#endif } else if (EQ (prop, Qtop_margin)) { maybe_error_if_job_active (f); +#ifdef HAVE_BIGNUM + check_integer_range (val, Qzero, make_integer (INT_MAX)); + FRAME_MSPRINTER_TOP_MARGIN (f) = + BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) : + XINT (val); +#else CHECK_NATNUM (val); FRAME_MSPRINTER_TOP_MARGIN (f) = XINT (val); +#endif } else if (EQ (prop, Qright_margin)) { maybe_error_if_job_active (f); +#ifdef HAVE_BIGNUM + check_integer_range (val, Qzero, make_integer (INT_MAX)); + FRAME_MSPRINTER_RIGHT_MARGIN (f) = + BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) : + XINT (val); +#else CHECK_NATNUM (val); FRAME_MSPRINTER_RIGHT_MARGIN (f) = XINT (val); +#endif } else if (EQ (prop, Qbottom_margin)) { maybe_error_if_job_active (f); +#ifdef HAVE_BIGNUM + check_integer_range (val, Qzero, make_integer (INT_MAX)); + FRAME_MSPRINTER_BOTTOM_MARGIN (f) = + BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) : + XINT (val); +#else CHECK_NATNUM (val); FRAME_MSPRINTER_BOTTOM_MARGIN (f) = XINT (val); +#endif } } } @@ -1212,7 +1249,7 @@ syms_of_frame_mswindows (void) { #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (mswindows_frame); + INIT_LISP_OBJECT (mswindows_frame); #endif /* NEW_GC */ } diff -r 861f2601a38b -r 1f0b15040456 src/frame-tty.c --- a/src/frame-tty.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/frame-tty.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/frame-x.c --- a/src/frame-x.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/frame-x.c Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,14 @@ /* Functions for the X window system. Copyright (C) 1989, 1992-5, 1997 Free Software Foundation, Inc. - Copyright (C) 1995, 1996, 2001, 2002, 2004 Ben Wing. + Copyright (C) 1995, 1996, 2001, 2002, 2004, 2010 Ben Wing. + Copyright (C) 2010 Didier Verna This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not synched with FSF. */ @@ -39,7 +38,7 @@ #include "console-x-impl.h" #include "glyphs-x.h" -#include "objects-x-impl.h" +#include "fontcolor-x-impl.h" #include "scrollbar-x.h" #include "xintrinsicp.h" /* CoreP.h needs this */ @@ -74,11 +73,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("x-frame", x_frame, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - x_frame_data_description_1, - Lisp_X_Frame); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("x-frame", x_frame, + 0, x_frame_data_description_1, + Lisp_X_Frame); #else /* not NEW_GC */ extern const struct sized_memory_description x_frame_data_description; @@ -226,14 +223,14 @@ void x_wm_mark_shell_size_user_specified (Widget wmshell) { - if (! XtIsWMShell (wmshell)) ABORT (); + assert (XtIsWMShell (wmshell)); EmacsShellSetSizeUserSpecified (wmshell); } void x_wm_mark_shell_position_user_specified (Widget wmshell) { - if (! XtIsWMShell (wmshell)) ABORT (); + assert (XtIsWMShell (wmshell)); EmacsShellSetPositionUserSpecified (wmshell); } @@ -242,7 +239,7 @@ void x_wm_set_shell_iconic_p (Widget shell, int iconic_p) { - if (! XtIsWMShell (shell)) ABORT (); + assert (XtIsWMShell (shell)); /* Because of questionable logic in Shell.c, this sequence can't work: @@ -271,10 +268,8 @@ { Arg al [2]; - if (!XtIsWMShell (wmshell)) - ABORT (); - if (cw <= 0 || ch <= 0) - ABORT (); + assert (XtIsWMShell (wmshell)); + assert (cw > 0 && ch > 0); Xt_SET_ARG (al[0], XtNwidthInc, cw); Xt_SET_ARG (al[1], XtNheightInc, ch); @@ -286,8 +281,7 @@ { Arg al [2]; - if (!XtIsWMShell (wmshell)) - ABORT (); + assert (XtIsWMShell (wmshell)); #ifdef DEBUG_GEOMETRY_MANAGEMENT /* See comment in EmacsShell.c */ printf ("x_wm_set_variable_size: %d %d\n", width, height); @@ -355,8 +349,7 @@ Extbyte *app_name, *app_class; XClassHint classhint; - if (!XtIsWMShell (shell)) - ABORT (); + assert (XtIsWMShell (shell)); XtGetApplicationNameAndClass (dpy, &app_name, &app_class); classhint.res_name = frame_name; @@ -372,8 +365,7 @@ Widget w = FRAME_X_SHELL_WIDGET (f); struct device *d = XDEVICE (FRAME_DEVICE (f)); - if (!XtIsWMShell (w)) - ABORT (); + assert (XtIsWMShell (w)); if (NILP (DEVICE_X_WM_COMMAND_FRAME (d))) { @@ -542,6 +534,23 @@ *y = xwa.y; } +void x_get_frame_text_position (struct frame *f) +{ + Display *dpy = DEVICE_X_DISPLAY (XDEVICE (FRAME_DEVICE (f))); + Window window = XtWindow (FRAME_X_TEXT_WIDGET (f)); + Window root, child; + int x, y; + unsigned int width, height, border_width; + unsigned int depth; + + XGetGeometry (dpy, window, &root, &x, &y, &width, &height, &border_width, + &depth); + XTranslateCoordinates (dpy, window, root, 0, 0, &x, &y, &child); + + FRAME_X_X (f) = x; + FRAME_X_Y (f) = y; +} + #if 0 static void x_smash_bastardly_shell_position (Widget shell) @@ -1439,16 +1448,13 @@ { struct window *win = XWINDOW (f->root_window); - WINDOW_LEFT (win) = FRAME_LEFT_BORDER_END (f) - + FRAME_LEFT_GUTTER_BOUNDS (f); - WINDOW_TOP (win) = FRAME_TOP_BORDER_END (f) - + FRAME_TOP_GUTTER_BOUNDS (f); + WINDOW_LEFT (win) = FRAME_PANED_LEFT_EDGE (f); + WINDOW_TOP (win) = FRAME_PANED_TOP_EDGE (f); if (!NILP (f->minibuffer_window)) { win = XWINDOW (f->minibuffer_window); - WINDOW_LEFT (win) = FRAME_LEFT_BORDER_END (f) - + FRAME_LEFT_GUTTER_BOUNDS (f); + WINDOW_LEFT (win) = FRAME_PANED_LEFT_EDGE (f); } } @@ -1526,8 +1532,7 @@ /* OK, we're a top-level shell. */ - if (!XtIsWMShell (wmshell)) - ABORT (); + assert (XtIsWMShell (wmshell)); /* If the EmacsFrame doesn't have a geometry but the shell does, treat that as the geometry of the frame. @@ -2041,7 +2046,7 @@ { /* zero out all slots. */ #ifdef NEW_GC - f->frame_data = alloc_lrecord_type (struct x_frame, &lrecord_x_frame); + f->frame_data = XX_FRAME (ALLOC_NORMAL_LISP_OBJECT (x_frame)); #else /* not NEW_GC */ f->frame_data = xnew_and_zero (struct x_frame); #endif /* not NEW_GC */ @@ -2125,9 +2130,13 @@ static void x_init_frame_3 (struct frame *f) { - /* Pop up the frame. */ - + /* #### NOTE: This whole business of splitting frame initialization into + #### different functions is somewhat messy. The latest one seems a good + #### place to initialize the edit widget's position because we're sure + #### that the frame is now relalized. -- dvl */ + x_popup_frame (f); + x_get_frame_text_position (f); } static void @@ -2754,7 +2763,7 @@ syms_of_frame_x (void) { #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (x_frame); + INIT_LISP_OBJECT (x_frame); #endif /* NEW_GC */ DEFSYMBOL (Qoverride_redirect); diff -r 861f2601a38b -r 1f0b15040456 src/frame.c --- a/src/frame.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/frame.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* Generic frame functions. Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1995, 1996, 2002, 2003, 2005 Ben Wing. + Copyright (C) 1995, 1996, 2002, 2003, 2005, 2010 Ben Wing. Copyright (C) 1995 Sun Microsystems, Inc. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,14 +16,352 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ /* This file has been Mule-ized. */ +/* About window and frame geometry [ben]: + + Here is an ASCII diagram: + ++------------------------------------------------------------------------| +| window-manager decoration | +| +--------------------------------------------------------------------+ | +| | menubar | | +| ###################################################################### | +| # toolbar # | +| #--------------------------------------------------------------------# | +| # | internal border | # | +| # | +----------------------------------------------------------+ | # | +| # | | gutter | | # | +| # | |-********************************************************-| | # | +|w# | | *@| scrollbar |v* |s* | | #w| +|i# | | *-+-------------------------|e* |c* | | #i| +|n# | | *s| |r* |r* | | #n| +|d# | | *c| |t* |o* | | #d| +|o# | | *r| |.* text area |l* | | #o| +|w# |i| *o| | * |l* |i| #w| +|-# |n| *l| text area |d* |b* |n| #-| +|m# |t| *l| |i* |a* |t| #m| +|a# |e| *b| |v* |r* |e| #a| +|n# t|r| *a| |i*----------------------+-* |r|t #n| +|a# o|n|g*r| |d* scrollbar |@*g|n|o #a| +|g# o|a|u*-+-------------------------|e*----------------------+-*u|a|o #g| +|e# l|l|t* modeline |r* modeline *t|l|l #e| +|r# b| |t********************************************************t| |b #r| +| # a|b|e* =..texttexttex....= |s|v* |s*e|b|a # | +|d# r|o|r*o m=..texttexttextt..=o m|c|e* |c*r|o|r #d| +|e# |r| *u a=.exttexttextte...=u a|r|r* |r* |r| #e| +|c# |d| *t r=....texttexttex..=t r|o|t* |o* |d| #c| +|o# |e| *s g= etc. =s g|l|.* text area |l* |e| #o| +|r# |r| *i i= =i i|l| * |l* |r| #r| +|a# | | *d n= =d n|b|d* |b* | | #a| +|t# | | *e = inner text area =e |a|i* |a* | | #t| +|i# | | * = = |r|v* |r* | | #i| +|o# | | *---===================---+-|i*----------------------+-* | | #o| +|n# | | * scrollbar |@|d* scrollbar |@* | | #n| +| # | | *-------------------------+-|e*----------------------+-* | | # | +| # | | * modeline |r* modeline * | | # | +| # | |-********************************************************-| | # | +| # | | gutter | | # | +| # | |-********************************************************-| | # | +| # | |@* minibuffer *@| | # | +| # | +-********************************************************-+ | # | +| # | internal border | # | +| #--------------------------------------------------------------------# | +| # toolbar # | +| ###################################################################### | +| window manager decoration | ++------------------------------------------------------------------------+ + + # = boundary of client area; * = window boundaries, boundary of paned area + = = boundary of inner text area; . = inside margin area; @ = dead boxes + + Note in particular what happens at the corners, where a "corner box" + occurs. Top and bottom toolbars take precedence over left and right + toolbars, extending out horizontally into the corner boxes. Gutters + work the same way. The corner box where the scrollbars meet, however, + is assigned to neither scrollbar, and is known as the "dead box"; it is + an area that must be cleared specially. There are similar dead boxes at + the bottom-right and bottom-left corners where the minibuffer and + left/right gutters meet, but there is currently a bug in that these dead + boxes are not explicitly cleared and may contain junk. + + THE FRAME + --------- + + The "top-level window area" is the entire area of a top-level window (or + "frame"). The "client area" (a term from MS Windows) is the area of a + top-level window that XEmacs draws into and manages with redisplay. + This includes the toolbar, scrollbars, gutters, dividers, text area, + modeline and minibuffer. It does not include the menubar, title or + outer borders. The "non-client area" is the area of a top-level window + outside of the client area and includes the menubar, title and outer + borders. Internally, all frame coordinates are relative to the client + area. + + + THE NON-CLIENT AREA + ------------------- + + Under X, the non-client area is split into two parts: + + (1) The outer layer is the window-manager decorations: The title and + borders. These are controlled by the window manager, a separate process + that controls the desktop, the location of icons, etc. When a process + tries to create a window, the window manager intercepts this action and + "reparents" the window, placing another window around it which contains + the window decorations, including the title bar, outer borders used for + resizing, etc. The window manager also implements any actions involving + the decorations, such as the ability to resize a window by dragging its + borders, move a window by dragging its title bar, etc. If there is no + window manager or you kill it, windows will have no decorations (and + will lose them if they previously had any) and you will not be able to + move or resize them. + + (2) Inside of the window-manager decorations is the "shell", which is + managed by the toolkit and widget libraries your program is linked with. + The code in *-x.c uses the Xt toolkit and various possible widget + libraries built on top of Xt, such as Motif, Athena, the "Lucid" + widgets, etc. Another possibility is GTK (*-gtk.c), which implements + both the toolkit and widgets. Under Xt, the "shell" window is an + EmacsShell widget, containing an EmacsManager widget of the same size, + which in turn contains a menubar widget and an EmacsFrame widget, inside + of which is the client area. (The division into EmacsShell and + EmacsManager is due to the complex and screwy geometry-management system + in Xt [and X more generally]. The EmacsShell handles negotiation with + the window manager; the place of the EmacsManager widget is normally + assumed by a widget that manages the geometry of its child widgets, but + the EmacsManager widget just lets the XEmacs redisplay mechanism do the + positioning.) + + Under Windows, the non-client area is managed by the window system. + There is no division such as under X. Part of the window-system API + (USER.DLL) of Win32 includes functions to control the menubars, title, + etc. and implements the move and resize behavior. There *is* an + equivalent of the window manager, called the "shell", but it manages + only the desktop, not the windows themselves. The normal shell under + Windows is EXPLORER.EXE; if you kill this, you will lose the bar + containing the "Start" menu and tray and such, but the windows + themselves will not be affected or lose their decorations. + + + THE CLIENT AREA + --------------- + + Inside of the client area is the toolbars, the gutters (where the buffer + tabs are displayed), the minibuffer, the internal border width, and one + or more non-overlapping "windows" (this is old Emacs terminology, from + before the time when frames existed at all; the standard terminology for + this would be "pane"). Each window can contain a modeline, horizontal + and/or vertical scrollbars, and (for non-rightmost windows) a vertical + divider, surrounding a text area. + + The dimensions of the toolbars and gutters are determined by the formula + (THICKNESS + 2 * BORDER-THICKNESS), where "thickness" is a cover term + for height or width, as appropriate. The height and width come from + `default-toolbar-height' and `default-toolbar-width' and the specific + versions of these (`top-toolbar-height', `left-toolbar-width', etc.). + The border thickness comes from `default-toolbar-border-height' and + `default-toolbar-border-width', and the specific versions of these. The + gutter works exactly equivalently. + + Note that for any particular toolbar or gutter, it will only be + displayed if [a] its visibility specifier (`default-toolbar-visible-p' + etc.) is non-nil; [b] its thickness (`default-toolbar-height' etc.) is + greater than 0; [c] its contents (`default-toolbar' etc.) are non-nil. + + The position-specific toolbars interact with the default specifications + as follows: If the value for a position-specific specifier is not + defined in a particular domain (usually a window), and the position of + that specifier is set as the default position (using + `default-toolbar-position'), then the value from the corresponding + default specifier in that domain will be used. The gutters work the + same. + + + THE PANED AREA + -------------- + + The area occupied by the "windows" is called the paned area. Unfortunately, + because of the presence of the gutter *between* the minibuffer and other + windows, the bottom of the paned area is not well-defined -- does it + include the minibuffer (in which case it also includes the bottom gutter, + but none others) or does it not include the minibuffer? (In which case + not all windows are included.) #### GEOM! It would be cleaner to put the + bottom gutter *below* the minibuffer instead of above it. + + Each window can include a horizontal and/or vertical scrollbar, a + modeline and a vertical divider to its right, as well as the text area. + Only non-rightmost windows can include a vertical divider. (The + minibuffer normally does not include either modeline or scrollbars.) + + Note that, because the toolbars and gutters are controlled by + specifiers, and specifiers can have window-specific and buffer-specific + values, the size of the paned area can change depending on which window + is selected: In other words, if the selected window or buffer changes, + the entire paned area for the frame may change. + + + TEXT AREAS, FRINGES, MARGINS + ---------------------------- + + The space occupied by a window can be divided into the text area and the + fringes. The fringes include the modeline, scrollbars and vertical + divider on the right side (if any); inside of this is the text area, + where the text actually occurs. Note that a window may or may not + contain any of the elements that are part of the fringe -- this is + controlled by specifiers, e.g. `has-modeline-p', + `horizontal-scrollbar-visible-p', `vertical-scrollbar-visible-p', + `vertical-divider-always-visible-p', etc. + + In addition, it is possible to set margins in the text area using the + specifiers `left-margin-width' and `right-margin-width'. When this is + done, only the "inner text area" (the area inside of the margins) will + be used for normal display of text; the margins will be used for glyphs + with a layout policy of `outside-margin' (as set on an extent containing + the glyph by `set-extent-begin-glyph-layout' or + `set-extent-end-glyph-layout'). However, the calculation of the text + area size (e.g. in the function `window-text-area-width') includes the + margins. Which margin is used depends on whether a glyph has been set + as the begin-glyph or end-glyph of an extent (`set-extent-begin-glyph' + etc.), using the left and right margins, respectively. + + Technically, the margins outside of the inner text area are known as the + "outside margins". The "inside margins" are in the inner text area and + constitute the whitespace between the outside margins and the first or + last non-whitespace character in a line; their width can vary from line + to line. Glyphs will be placed in the inside margin if their layout + policy is `inside-margin' or `whitespace', with `whitespace' glyphs on + the inside and `inside-margin' glyphs on the outside. Inside-margin + glyphs can spill over into the outside margin if `use-left-overflow' or + `use-right-overflow', respectively, is non-nil. + + See the Lisp Reference manual, under Annotations, for more details. + + + THE DISPLAYABLE AREA + -------------------- + + The "displayable area" is not so much an actual area as a convenient + fiction. It is the area used to convert between pixel and character + dimensions for frames. The character dimensions for a frame (e.g. as + returned by `frame-width' and `frame-height' and set by + `set-frame-width' and `set-frame-height') are determined from the + displayable area by dividing by the pixel size of the default font as + instantiated in the frame. (For proportional fonts, the "average" width + is used. Under Windows, this is a built-in property of the fonts. + Under X, this is based on the width of the lowercase 'n', or if this is + zero then the width of the default character. [We prefer 'n' to the + specified default character because many X fonts have a default + character with a zero or otherwise non-representative width.]) + + The displayable area is essentially the "theoretical" gutter area of the + frame, excluding the rightmost and bottom-most scrollbars. That is, it + starts from the client (or "total") area and then excludes the + "theoretical" toolbars and bottom-most/rightmost scrollbars, and the + internal border width. In this context, "theoretical" means that all + calculations on based on frame-level values for toolbar and scrollbar + thicknesses. Because these thicknesses are controlled by specifiers, + and specifiers can have window-specific and buffer-specific values, + these calculations may or may not reflect the actual size of the paned + area or of the scrollbars when any particular window is selected. Note + also that the "displayable area" may not even be contiguous! In + particular, the gutters are included, but the bottom-most and rightmost + scrollbars are excluded even though they are inside of the gutters. + Furthermore, if the frame-level value of the horizontal scrollbar height + is non-zero, then the displayable area includes the paned area above and + below the bottom horizontal scrollbar (i.e. the modeline and minibuffer) + but not the scrollbar itself. + + As a further twist, the character-dimension calculations are adjusted so + that the truncation and continuation glyphs (see `truncation-glyph' and + `continuation-glyph') count as a single character even if they are wider + than the default font width. (Technically, the character width is + computed from the displayable-area width by subtracting the maximum of + the truncation-glyph width, continuation-glyph width and default-font + width before dividing by the default-font width, and then adding 1 to + the result.) (The ultimate motivation for this kludge as well as the + subtraction of the scrollbars, but not the minibuffer or bottom-most + modeline, is to maintain compatibility with TTY's.) + + Despite all these concerns and kludges, however, the "displayable area" + concept works well in practice and mostly ensures that by default the + frame will actually fit 79 characters + continuation/truncation glyph. + + + WHICH FUNCTIONS USE WHICH? + -------------------------- + + [1] Top-level window area: + + set-frame-position + `left' and `top' frame properties + + [2] Client area: + + frame-pixel-*, set-frame-pixel-* + + [3] Paned area: + + window-pixel-edges + event-x-pixel, event-y-pixel, event-properties, make-event + + [4] Displayable area: + + frame-width, frame-height and other all functions specifying frame size + in characters + frame-displayable-pixel-* + + --ben + +*/ + +/* + About different types of units: + + (1) "Total pixels" measure the pixel size of the client area of the + frame (everything except the menubars and window-manager decorations; + see comment at top of file). + + (2) "Displayable pixels" measure the pixel size of the "displayable area" + of the frame, a convenient fiction that specifies which portion of + the frame "counts" for the purposes of determining the size of the + frame in character cells. Approximately speaking, the difference + between the client area and displayable area is that toolbars, + gutters, internal border width and bottom-most/right-most scrollbars + are inside the client area but outside the displayable area. See + comment at top of file for more discussion. + + (3) "Character-cell units" measure the frame size in "character cells", + which are fixed rectangles of a size meant to correspond with the + height and (average) width of the bounding box of a single character + in the default font. The size of a frame in character cells is + determined by computing the size in "displayable pixels" and dividing + by the pixel size of the default font as instantiated in the frame. + See comment at top of file under "displayable area" for more info. + + (4) In window-system "frame units" -- pixels on MS Windows, character + cells on X and GTK (on TTY's, pixels and character cells are the + same). Note that on MS Windows the pixels measure the size of the + displayable area, not the entire client area. + + This bogosity exists because MS Windows always reports frame sizes + in pixels, whereas X-Windows has a scheme whereby character-cell + sizes and extra sizes (e.g. for toolbars, menubars, etc.) can be + reported to the window manager, and the window manager displays + character-cell units when resizing, only allows resizing to integral + character-cell sizes, and reports back the size in character cells. + As a result, someone thought it was a good idea to make the + fundamental units for measuring frame size correspond to what the + window system "reports" and hence vary between pixels and character + cells, as described above. + + --ben +*/ + #include #include "lisp.h" @@ -120,24 +458,50 @@ static void store_minibuf_frame_prop (struct frame *f, Lisp_Object val); -typedef enum { +typedef enum +{ DISPLAYABLE_PIXEL_TO_CHAR, + CHAR_TO_DISPLAYABLE_PIXEL, TOTAL_PIXEL_TO_CHAR, CHAR_TO_TOTAL_PIXEL, - CHAR_TO_DISPLAYABLE_PIXEL -} pixel_to_char_mode_t; + TOTAL_PIXEL_TO_DISPLAYABLE_PIXEL, + DISPLAYABLE_PIXEL_TO_TOTAL_PIXEL, +} +pixel_to_char_mode_t; + +enum frame_size_type +{ + SIZE_TOTAL_PIXEL, + SIZE_DISPLAYABLE_PIXEL, + SIZE_CHAR_CELL, + SIZE_FRAME_UNIT, +}; static void frame_conversion_internal (struct frame *f, - pixel_to_char_mode_t pixel_to_char, - int *pixel_width, int *pixel_height, - int *char_width, int *char_height, - int real_face); + enum frame_size_type source, + int source_width, int source_height, + enum frame_size_type dest, + int *dest_width, int *dest_height); +static void get_frame_char_size (struct frame *f, int *out_width, + int *out_height); +static void get_frame_new_displayable_pixel_size (struct frame *f, + int *out_width, + int *out_height); +static void get_frame_new_total_pixel_size (struct frame *f, + int *out_width, + int *out_height); + static struct display_line title_string_display_line; /* Used by generate_title_string. Global because they get used so much that the dynamic allocation time adds up. */ static Ichar_dynarr *title_string_ichar_dynarr; +/**************************************************************************/ +/* */ +/* frame object */ +/* */ +/**************************************************************************/ #ifndef NEW_GC extern const struct sized_memory_description gtk_frame_data_description; @@ -180,12 +544,9 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("expose-ignore", - expose_ignore, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - expose_ignore_description_1, - struct expose_ignore); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("expose-ignore", expose_ignore, + 0, expose_ignore_description_1, + struct expose_ignore); #else /* not NEW_GC */ extern const struct sized_memory_description expose_ignore_description; @@ -274,24 +635,31 @@ struct frame *frm = XFRAME (obj); if (print_readably) - printing_unreadable_lcrecord (obj, XSTRING_DATA (frm->name)); + printing_unreadable_lisp_object (obj, XSTRING_DATA (frm->name)); write_fmt_string (printcharfun, "#<%s-frame ", !FRAME_LIVE_P (frm) ? "dead" : FRAME_TYPE_NAME (frm)); print_internal (frm->name, printcharfun, 1); - write_fmt_string (printcharfun, " 0x%x>", frm->header.uid); + write_ascstring (printcharfun, " on "); + print_internal (frm->device, printcharfun, 0); + write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); } -DEFINE_LRECORD_IMPLEMENTATION ("frame", frame, - 0, /*dumpable-flag*/ - mark_frame, print_frame, 0, 0, 0, - frame_description, - struct frame); +DEFINE_NODUMP_LISP_OBJECT ("frame", frame, + mark_frame, print_frame, 0, 0, 0, + frame_description, + struct frame); +/**************************************************************************/ +/* */ +/* frame creation */ +/* */ +/**************************************************************************/ + static void nuke_all_frame_slots (struct frame *f) { - ZERO_LCRECORD (f); + zero_nonsized_lisp_object (wrap_frame (f)); #define MARKED_SLOT(x) f->x = Qnil; #include "frameslots.h" @@ -305,12 +673,11 @@ allocate_frame_core (Lisp_Object device) { /* This function can GC */ - Lisp_Object frame; Lisp_Object root_window; - struct frame *f = ALLOC_LCRECORD_TYPE (struct frame, &lrecord_frame); + Lisp_Object frame = ALLOC_NORMAL_LISP_OBJECT (frame); + struct frame *f = XFRAME (frame); nuke_all_frame_slots (f); - frame = wrap_frame (f); f->device = device; f->framemeths = XDEVICE (device)->devmeths; @@ -658,7 +1025,7 @@ reset_glyph_cachels (XWINDOW (f->minibuffer_window)); } - change_frame_size (f, f->height, f->width, 0); + change_frame_size (f, f->width, f->height, 0); } MAYBE_FRAMEMETH (f, init_frame_2, (f, props)); @@ -703,7 +1070,7 @@ earlier. */ init_frame_gutters (f); - change_frame_size (f, f->height, f->width, 0); + change_frame_size (f, f->width, f->height, 0); } if (first_frame_on_device) @@ -725,6 +1092,12 @@ } +/**************************************************************************/ +/* */ +/* validating a frame argument */ +/* */ +/**************************************************************************/ + /* this function should be used in most cases when a Lisp function is passed a FRAME argument. Use this unless you don't accept nil == current frame (in which case, do a CHECK_LIVE_FRAME() and then an XFRAME()) or you @@ -757,93 +1130,12 @@ return decode_frame (cdf); } -Lisp_Object -frame_device (struct frame *f) -{ - return FRAME_DEVICE (f); -} - int frame_live_p (struct frame *f) { return FRAME_LIVE_P (f); } - -void -invalidate_vertical_divider_cache_in_frame (struct frame *f) -{ - /* Invalidate cached value of needs_vertical_divider_p in - every and all windows */ - map_windows (f, invalidate_vertical_divider_cache_in_window, 0); -} - -/* - * Frame size may change due to changes in scrollbars, toolbars, - * default font etc. These changes are applied early in redisplay - * frame. - */ -void -adjust_frame_size (struct frame *f) -{ - /* This can call Lisp. */ - int keep_char_size = 0; - Lisp_Object frame = wrap_frame (f); - - if (!f->size_slipped) - return; - - /* Don't adjust tty frames. #### May break when TTY have menubars. - Then, write an Vadjust_frame_function which will return t for TTY - frames. Another solution is frame_size_fixed_p method for TTYs, - which always returned yes it's fixed. - */ - if (!FRAME_WIN_P (f)) - { - CLEAR_FRAME_SIZE_SLIPPED (f); - return; - } - - /* frame_size_fixed_p tells that frame size cannot currently - be changed change due to external conditions */ - if (!FRAMEMETH_OR_GIVEN (f, frame_size_fixed_p, (f), 0)) - { - if (NILP (Vadjust_frame_function)) - keep_char_size = 1; - else if (EQ (Vadjust_frame_function, Qt)) - keep_char_size = 0; - else - keep_char_size = - NILP (call1_trapping_problems ("Error in adjust-frame-function", - Vadjust_frame_function, frame, - 0)); - - if (keep_char_size) - Fset_frame_size (frame, make_int (FRAME_CHARWIDTH(f)), - make_int (FRAME_CHARHEIGHT(f)), Qnil); - } - - if (!keep_char_size) - { - int height, width; - pixel_to_char_size (f, FRAME_PIXWIDTH(f), FRAME_PIXHEIGHT(f), - &width, &height); - change_frame_size (f, height, width, 0); - CLEAR_FRAME_SIZE_SLIPPED (f); - } -} - -/* - * This is a "specifier changed in frame" handler for various specifiers - * changing which causes frame size adjustment - */ -void -frame_size_slipped (Lisp_Object UNUSED (specifier), struct frame *f, - Lisp_Object UNUSED (oldval)) -{ - MARK_FRAME_SIZE_SLIPPED(f); -} - DEFUN ("framep", Fframep, 1, 1, 0, /* Return non-nil if OBJECT is a frame. Also see `frame-live-p'. @@ -864,6 +1156,27 @@ } +/**************************************************************************/ +/* */ +/* frame focus/selection */ +/* */ +/**************************************************************************/ + +Lisp_Object +frame_device (struct frame *f) +{ + return FRAME_DEVICE (f); +} + +DEFUN ("frame-device", Fframe_device, 0, 1, 0, /* +Return the device that FRAME is on. +If omitted, FRAME defaults to the currently selected frame. +*/ + (frame)) +{ + return FRAME_DEVICE (decode_frame (frame)); +} + DEFUN ("focus-frame", Ffocus_frame, 1, 1, 0, /* Select FRAME and give it the window system focus. This function is not affected by the value of `focus-follows-mouse'. @@ -963,6 +1276,9 @@ #if 0 /* FSFmacs */ +/* Ben thinks there is no need for `redirect-frame-focus' or `frame-focus', + crockish FSFmacs functions. See summary on focus in event-stream.c. */ + DEFUN ("handle-switch-frame", Fhandle_switch_frame, 1, 2, "e", /* Handle a switch-frame event EVENT. Switch-frame events are usually bound to this function. @@ -1114,16 +1430,39 @@ return window; } - -DEFUN ("frame-device", Fframe_device, 0, 1, 0, /* -Return the device that FRAME is on. -If omitted, FRAME defaults to the currently selected frame. +DEFUN ("disable-frame", Fdisable_frame, 1, 1, 0, /* +Disable frame FRAME, so that it cannot have the focus or receive user input. +This is normally used during modal dialog boxes. +WARNING: Be very careful not to wedge XEmacs! +Use an `unwind-protect' that re-enables the frame to avoid this. */ (frame)) { - return FRAME_DEVICE (decode_frame (frame)); + struct frame *f = decode_frame (frame); + + f->disabled = 1; + MAYBE_FRAMEMETH (f, disable_frame, (f)); + return Qnil; } +DEFUN ("enable-frame", Fenable_frame, 1, 1, 0, /* +Enable frame FRAME, so that it can have the focus and receive user input. +Frames are normally enabled, unless explicitly disabled using `disable-frame'. +*/ + (frame)) +{ + struct frame *f = decode_frame (frame); + f->disabled = 0; + MAYBE_FRAMEMETH (f, enable_frame, (f)); + return Qnil; +} + +/**************************************************************************/ +/* */ +/* traversing the list of frames */ +/* */ +/**************************************************************************/ + int is_surrogate_for_selected_frame (struct frame *f) { @@ -1416,6 +1755,11 @@ } +/**************************************************************************/ +/* */ +/* frame deletion */ +/* */ +/**************************************************************************/ /* extern void free_line_insertion_deletion_costs (struct frame *f); */ @@ -1806,8 +2150,7 @@ point their minibuffer frames must have been deleted, but that is prohibited at the top; you can't delete surrogate minibuffer frames. */ - if (NILP (frame_with_minibuf)) - ABORT (); + assert (!NILP (frame_with_minibuf)); con->default_minibuffer_frame = frame_with_minibuf; } @@ -1869,6 +2212,12 @@ } +/**************************************************************************/ +/* */ +/* mouse position in frame */ +/* */ +/**************************************************************************/ + /* Return mouse position in character cell units. */ static int @@ -2056,6 +2405,12 @@ return Qnil; } +/**************************************************************************/ +/* */ +/* frame visibility */ +/* */ +/**************************************************************************/ + DEFUN ("make-frame-visible", Fmake_frame_visible, 0, 1, 0, /* Make the frame FRAME visible (assuming it is an X-window). If omitted, FRAME defaults to the currently selected frame. @@ -2218,7 +2573,6 @@ return value; } - DEFUN ("raise-frame", Fraise_frame, 0, 1, "", /* Bring FRAME to the front, so it occludes any frames it overlaps. If omitted, FRAME defaults to the currently selected frame. @@ -2251,36 +2605,12 @@ } -DEFUN ("disable-frame", Fdisable_frame, 1, 1, 0, /* -Disable frame FRAME, so that it cannot have the focus or receive user input. -This is normally used during modal dialog boxes. -WARNING: Be very careful not to wedge XEmacs! -Use an `unwind-protect' that re-enables the frame to avoid this. -*/ - (frame)) -{ - struct frame *f = decode_frame (frame); - - f->disabled = 1; - MAYBE_FRAMEMETH (f, disable_frame, (f)); - return Qnil; -} - -DEFUN ("enable-frame", Fenable_frame, 1, 1, 0, /* -Enable frame FRAME, so that it can have the focus and receive user input. -Frames are normally enabled, unless explicitly disabled using `disable-frame'. -*/ - (frame)) -{ - struct frame *f = decode_frame (frame); - f->disabled = 0; - MAYBE_FRAMEMETH (f, enable_frame, (f)); - return Qnil; -} - -/* Ben thinks there is no need for `redirect-frame-focus' or `frame-focus', - crockish FSFmacs functions. See summary on focus in event-stream.c. */ - +/***************************************************************************/ +/* */ +/* print-related functions */ +/* */ +/***************************************************************************/ + DEFUN ("print-job-page-number", Fprint_job_page_number, 1, 1, 0, /* Return current page number for the print job FRAME. */ @@ -2308,11 +2638,33 @@ /***************************************************************************/ +/* */ /* frame properties */ +/* */ /***************************************************************************/ -static void internal_set_frame_size (struct frame *f, int cols, int rows, - int pretend); +DEFUN ("frame-name", Fframe_name, 0, 1, 0, /* +Return the name of FRAME (defaulting to the selected frame). +This is not the same as the `title' of the frame. +*/ + (frame)) +{ + return decode_frame (frame)->name; +} + +DEFUN ("frame-modified-tick", Fframe_modified_tick, 0, 1, 0, /* +Return FRAME's tick counter, incremented for each change to the frame. +Each frame has a tick counter which is incremented each time the frame +is resized, a window is resized, added, or deleted, a face is changed, +`set-window-buffer' or `select-window' is called on a window in the +frame, the window-start of a window in the frame has changed, or +anything else interesting has happened. It wraps around occasionally. +No argument or nil as argument means use selected frame as FRAME. +*/ + (frame)) +{ + return make_int (decode_frame (frame)->modiff); +} static void store_minibuf_frame_prop (struct frame *f, Lisp_Object val) @@ -2608,17 +2960,9 @@ if (EQ (Qheight, property) || EQ (Qwidth, property)) { - if (window_system_pixelated_geometry (frame)) - { - int width, height; - pixel_to_real_char_size (f, FRAME_PIXWIDTH (f), FRAME_PIXHEIGHT (f), - &width, &height); - return make_int (EQ (Qheight, property) ? height: width); - } - else - return make_int (EQ (Qheight, property) ? - FRAME_HEIGHT (f) : - FRAME_WIDTH (f)); + int width, height; + get_frame_char_size (f, &width, &height); + return make_int (EQ (Qheight, property) ? height : width); } /* NOTE: FSF returns Qnil instead of Qt for FRAME_HAS_MINIBUF_P. @@ -2710,17 +3054,7 @@ result); { int width, height; - - if (window_system_pixelated_geometry (frame)) - { - pixel_to_real_char_size (f, FRAME_PIXWIDTH (f), FRAME_PIXHEIGHT (f), - &width, &height); - } - else - { - height = FRAME_HEIGHT (f); - width = FRAME_WIDTH (f); - } + get_frame_char_size (f, &width, &height); result = cons3 (Qwidth , make_int (width), result); result = cons3 (Qheight, make_int (height), result); } @@ -2732,12 +3066,22 @@ } +/**************************************************************************/ +/* */ +/* frame sizing (user functions) */ +/* */ +/**************************************************************************/ + DEFUN ("frame-pixel-height", Fframe_pixel_height, 0, 1, 0, /* Return the total height in pixels of FRAME. */ (frame)) { - return make_int (decode_frame (frame)->pixheight); + struct frame *f = decode_frame (frame); + int width, height; + + get_frame_new_total_pixel_size (f, &width, &height); + return make_int (height); } DEFUN ("frame-displayable-pixel-height", Fframe_displayable_pixel_height, 0, 1, 0, /* @@ -2746,20 +3090,10 @@ (frame)) { struct frame *f = decode_frame (frame); - int height, pheight; - frame = wrap_frame (f); - - if (!window_system_pixelated_geometry (frame)) - { - height = FRAME_HEIGHT (f); - - frame_conversion_internal (f, CHAR_TO_DISPLAYABLE_PIXEL, - 0, &pheight, 0, &height, 0); - } - else - pheight = FRAME_PIXHEIGHT (f); - - return make_int (pheight); + int width, height; + + get_frame_new_displayable_pixel_size (f, &width, &height); + return make_int (height); } DEFUN ("frame-pixel-width", Fframe_pixel_width, 0, 1, 0, /* @@ -2767,7 +3101,11 @@ */ (frame)) { - return make_int (decode_frame (frame)->pixwidth); + struct frame *f = decode_frame (frame); + int width, height; + + get_frame_new_total_pixel_size (f, &width, &height); + return make_int (width); } DEFUN ("frame-displayable-pixel-width", Fframe_displayable_pixel_width, 0, 1, 0, /* @@ -2776,56 +3114,10 @@ (frame)) { struct frame *f = decode_frame (frame); - int width, pwidth; - frame = wrap_frame (f); - - if (!window_system_pixelated_geometry (frame)) - { - width = FRAME_WIDTH (f); - - frame_conversion_internal (f, CHAR_TO_DISPLAYABLE_PIXEL, - &pwidth, 0, &width, 0, 0); - } - else - pwidth = FRAME_PIXWIDTH (f); - - return make_int (pwidth); -} - -DEFUN ("frame-name", Fframe_name, 0, 1, 0, /* -Return the name of FRAME (defaulting to the selected frame). -This is not the same as the `title' of the frame. -*/ - (frame)) -{ - return decode_frame (frame)->name; -} - -DEFUN ("frame-modified-tick", Fframe_modified_tick, 0, 1, 0, /* -Return FRAME's tick counter, incremented for each change to the frame. -Each frame has a tick counter which is incremented each time the frame -is resized, a window is resized, added, or deleted, a face is changed, -`set-window-buffer' or `select-window' is called on a window in the -frame, the window-start of a window in the frame has changed, or -anything else interesting has happened. It wraps around occasionally. -No argument or nil as argument means use selected frame as FRAME. -*/ - (frame)) -{ - return make_int (decode_frame (frame)->modiff); -} - -static void -internal_set_frame_size (struct frame *f, int cols, int rows, int pretend) -{ - /* This can call Lisp. See mswindows_set_frame_size(). */ - /* An explicit size change cancels any pending frame size adjustment */ - CLEAR_FRAME_SIZE_SLIPPED (f); - - if (pretend || !HAS_FRAMEMETH_P (f, set_frame_size)) - change_frame_size (f, rows, cols, 0); - else - FRAMEMETH (f, set_frame_size, (f, cols, rows)); + int width, height; + + get_frame_new_displayable_pixel_size (f, &width, &height); + return make_int (width); } DEFUN ("set-frame-height", Fset_frame_height, 2, 3, 0, /* @@ -2837,23 +3129,16 @@ { /* This can call Lisp. */ struct frame *f = decode_frame (frame); - int height, width; - frame = wrap_frame (f); + int cwidth, cheight; + int guwidth, guheight; + CHECK_INT (lines); - - if (window_system_pixelated_geometry (frame)) - { - char_to_real_pixel_size (f, 0, XINT (lines), 0, &height); - width = FRAME_PIXWIDTH (f); - } - else - { - height = XINT (lines); - width = FRAME_WIDTH (f); - } - - internal_set_frame_size (f, width, height, !NILP (pretend)); - return frame; + get_frame_char_size (f, &cwidth, &cheight); + cheight = XINT (lines); + frame_conversion_internal (f, SIZE_CHAR_CELL, cwidth, cheight, + SIZE_FRAME_UNIT, &guwidth, &guheight); + internal_set_frame_size (f, guwidth, guheight, !NILP (pretend)); + return wrap_frame (f); } DEFUN ("set-frame-pixel-height", Fset_frame_pixel_height, 2, 3, 0, /* @@ -2865,25 +3150,16 @@ { /* This can call Lisp. */ struct frame *f = decode_frame (frame); - int pheight, width; - frame = wrap_frame (f); + int pwidth, pheight; + int guwidth, guheight; + CHECK_INT (height); - - if (!window_system_pixelated_geometry (frame)) - { - int h = XINT (height); - width = FRAME_WIDTH (f); - - frame_conversion_internal (f, TOTAL_PIXEL_TO_CHAR, 0, &h, 0, &pheight, 0); - } - else - { - width = FRAME_PIXWIDTH (f); - pheight = XINT (height); - } - - internal_set_frame_size (f, width, pheight, !NILP (pretend)); - return frame; + get_frame_new_total_pixel_size (f, &pwidth, &pheight); + pheight = XINT (height); + frame_conversion_internal (f, SIZE_TOTAL_PIXEL, pwidth, pheight, + SIZE_FRAME_UNIT, &guwidth, &guheight); + internal_set_frame_size (f, guwidth, guheight, !NILP (pretend)); + return wrap_frame (f); } DEFUN ("set-frame-displayable-pixel-height", Fset_frame_displayable_pixel_height, 2, 3, 0, /* @@ -2895,24 +3171,16 @@ { /* This can call Lisp. */ struct frame *f = decode_frame (frame); - int pheight, width; - frame = wrap_frame (f); + int pwidth, pheight; + int guwidth, guheight; + CHECK_INT (height); - - if (!window_system_pixelated_geometry (frame)) - { - int h = XINT (height); - width = FRAME_WIDTH (f); - frame_conversion_internal (f, DISPLAYABLE_PIXEL_TO_CHAR, 0, &h, 0, &pheight, 0); - } - else - { - width = FRAME_PIXWIDTH (f); - pheight = XINT (height); - } - - internal_set_frame_size (f, width, pheight, !NILP (pretend)); - return frame; + get_frame_new_displayable_pixel_size (f, &pwidth, &pheight); + pheight = XINT (height); + frame_conversion_internal (f, SIZE_DISPLAYABLE_PIXEL, pwidth, pheight, + SIZE_FRAME_UNIT, &guwidth, &guheight); + internal_set_frame_size (f, guwidth, guheight, !NILP (pretend)); + return wrap_frame (f); } @@ -2925,23 +3193,16 @@ { /* This can call Lisp. */ struct frame *f = decode_frame (frame); - int width, height; - frame = wrap_frame (f); + int cwidth, cheight; + int guwidth, guheight; + CHECK_INT (cols); - - if (window_system_pixelated_geometry (frame)) - { - char_to_real_pixel_size (f, XINT (cols), 0, &width, 0); - height = FRAME_PIXHEIGHT (f); - } - else - { - width = XINT (cols); - height = FRAME_HEIGHT (f); - } - - internal_set_frame_size (f, width, height, !NILP (pretend)); - return frame; + get_frame_char_size (f, &cwidth, &cheight); + cwidth = XINT (cols); + frame_conversion_internal (f, SIZE_CHAR_CELL, cwidth, cheight, + SIZE_FRAME_UNIT, &guwidth, &guheight); + internal_set_frame_size (f, guwidth, guheight, !NILP (pretend)); + return wrap_frame (f); } DEFUN ("set-frame-pixel-width", Fset_frame_pixel_width, 2, 3, 0, /* @@ -2953,24 +3214,16 @@ { /* This can call Lisp. */ struct frame *f = decode_frame (frame); - int height, pwidth; - frame = wrap_frame (f); + int pwidth, pheight; + int guwidth, guheight; + CHECK_INT (width); - - if (!window_system_pixelated_geometry (frame)) - { - int w = XINT (width); - height = FRAME_HEIGHT (f); - frame_conversion_internal (f, TOTAL_PIXEL_TO_CHAR, &w, 0, &pwidth, 0, 0); - } - else - { - height = FRAME_PIXHEIGHT (f); - pwidth = XINT (width); - } - - internal_set_frame_size (f, pwidth, height, !NILP (pretend)); - return frame; + get_frame_new_total_pixel_size (f, &pwidth, &pheight); + pwidth = XINT (width); + frame_conversion_internal (f, SIZE_TOTAL_PIXEL, pwidth, pheight, + SIZE_FRAME_UNIT, &guwidth, &guheight); + internal_set_frame_size (f, guwidth, guheight, !NILP (pretend)); + return wrap_frame (f); } DEFUN ("set-frame-displayable-pixel-width", Fset_frame_displayable_pixel_width, 2, 3, 0, /* @@ -2982,24 +3235,16 @@ { /* This can call Lisp. */ struct frame *f = decode_frame (frame); - int height, pwidth; - frame = wrap_frame (f); + int pwidth, pheight; + int guwidth, guheight; + CHECK_INT (width); - - if (!window_system_pixelated_geometry (frame)) - { - int w = XINT (width); - height = FRAME_HEIGHT (f); - frame_conversion_internal (f, DISPLAYABLE_PIXEL_TO_CHAR, &w, 0, &pwidth, 0, 0); - } - else - { - height = FRAME_PIXHEIGHT (f); - pwidth = XINT (width); - } - - internal_set_frame_size (f, pwidth, height, !NILP (pretend)); - return frame; + get_frame_new_displayable_pixel_size (f, &pwidth, &pheight); + pwidth = XINT (width); + frame_conversion_internal (f, SIZE_DISPLAYABLE_PIXEL, pwidth, pheight, + SIZE_FRAME_UNIT, &guwidth, &guheight); + internal_set_frame_size (f, guwidth, guheight, !NILP (pretend)); + return wrap_frame (f); } DEFUN ("set-frame-size", Fset_frame_size, 3, 4, 0, /* @@ -3011,21 +3256,14 @@ { /* This can call Lisp. */ struct frame *f = decode_frame (frame); - int height, width; - frame = wrap_frame (f); + int guwidth, guheight; + CHECK_INT (cols); CHECK_INT (rows); - - if (window_system_pixelated_geometry (frame)) - char_to_real_pixel_size (f, XINT (cols), XINT (rows), &width, &height); - else - { - height = XINT (rows); - width = XINT (cols); - } - - internal_set_frame_size (f, width, height, !NILP (pretend)); - return frame; + frame_conversion_internal (f, SIZE_CHAR_CELL, XINT (cols), XINT (rows), + SIZE_FRAME_UNIT, &guwidth, &guheight); + internal_set_frame_size (f, guwidth, guheight, !NILP (pretend)); + return wrap_frame (f); } DEFUN ("set-frame-pixel-size", Fset_frame_pixel_size, 3, 4, 0, /* @@ -3037,25 +3275,14 @@ { /* This can call Lisp. */ struct frame *f = decode_frame (frame); - int pheight, pwidth; - frame = wrap_frame (f); + int guwidth, guheight; + CHECK_INT (width); CHECK_INT (height); - - if (!window_system_pixelated_geometry (frame)) - { - int w = XINT (width); - int h = XINT (height); - frame_conversion_internal (f, TOTAL_PIXEL_TO_CHAR, &w, &h, &pwidth, &pheight, 0); - } - else - { - pheight = XINT (height); - pwidth = XINT (width); - } - - internal_set_frame_size (f, pwidth, pheight, !NILP (pretend)); - return frame; + frame_conversion_internal (f, SIZE_TOTAL_PIXEL, XINT (width), XINT (height), + SIZE_FRAME_UNIT, &guwidth, &guheight); + internal_set_frame_size (f, guwidth, guheight, !NILP (pretend)); + return wrap_frame (f); } DEFUN ("set-frame-displayable-pixel-size", Fset_frame_displayable_pixel_size, 3, 4, 0, /* @@ -3067,25 +3294,15 @@ { /* This can call Lisp. */ struct frame *f = decode_frame (frame); - int pheight, pwidth; - frame = wrap_frame (f); + int guwidth, guheight; + CHECK_INT (width); CHECK_INT (height); - - if (!window_system_pixelated_geometry (frame)) - { - int w = XINT (width); - int h = XINT (height); - frame_conversion_internal (f, DISPLAYABLE_PIXEL_TO_CHAR, &w, &h, &pwidth, &pheight, 0); - } - else - { - pheight = XINT (height); - pwidth = XINT (width); - } - - internal_set_frame_size (f, pwidth, pheight, !NILP (pretend)); - return frame; + frame_conversion_internal (f, SIZE_DISPLAYABLE_PIXEL, + XINT (width), XINT (height), + SIZE_FRAME_UNIT, &guwidth, &guheight); + internal_set_frame_size (f, guwidth, guheight, !NILP (pretend)); + return wrap_frame (f); } DEFUN ("set-frame-position", Fset_frame_position, 3, 3, 0, /* @@ -3106,32 +3323,50 @@ } +/**************************************************************************/ +/* */ +/* various ways of measuring the frame size */ +/* */ +/**************************************************************************/ /* Frame size conversion functions moved here from EmacsFrame.c because they're generic and really don't belong in that file. Function get_default_char_pixel_size() removed because it's - exactly the same as default_face_height_and_width(). */ + exactly the same as default_face_width_and_height(). + + Convert between total pixel size, displayable pixel size and + character-cell size. Variables are either "in", "out" or unused, + depending on the value of PIXEL_TO_CHAR, which indicates which units the + source and destination values are measured in. + + See frame_conversion_internal() for a discussion of the different + types of units. */ + static void -frame_conversion_internal (struct frame *f, - pixel_to_char_mode_t pixel_to_char, - int *pixel_width, int *pixel_height, - int *char_width, int *char_height, - int real_face) +frame_conversion_internal_1 (struct frame *f, + pixel_to_char_mode_t pixel_to_char, + int *total_pixel_width, int *total_pixel_height, + int *disp_pixel_width, int *disp_pixel_height, + int *char_width, int *char_height) { - int cpw; - int cph; + int cpw, cph; int egw; int obw, obh, bdr; Lisp_Object frame, window; frame = wrap_frame (f); - if (real_face) - default_face_height_and_width (frame, &cph, &cpw); - else - default_face_height_and_width_1 (frame, &cph, &cpw); + default_face_width_and_height (frame, &cpw, &cph); window = FRAME_SELECTED_WINDOW (f); + /* #### It really seems like we should also be subtracting out the + theoretical gutter width and height, just like we do for toolbars. + There is currently a bug where if you call `set-frame-pixel-width' + on MS Windows (at least, possibly also X) things get confused and + the top of the root window overlaps the top gutter instead of being + below it. This gets fixed next time you resize the frame using the + mouse. Possibly this is caused by not handling the gutter height + here? */ egw = max (glyph_width (Vcontinuation_glyph, window), glyph_width (Vtruncation_glyph, window)); egw = max (egw, cpw); @@ -3154,34 +3389,118 @@ { case DISPLAYABLE_PIXEL_TO_CHAR: if (char_width) - *char_width = ROUND_UP (*pixel_width, cpw) / cpw; + *char_width = ROUND_UP (*disp_pixel_width, cpw) / cpw; if (char_height) - *char_height = ROUND_UP (*pixel_height, cph) / cph; + *char_height = ROUND_UP (*disp_pixel_height, cph) / cph; + break; + case CHAR_TO_DISPLAYABLE_PIXEL: + if (disp_pixel_width) + *disp_pixel_width = *char_width * cpw; + if (disp_pixel_height) + *disp_pixel_height = *char_height * cph; break; case TOTAL_PIXEL_TO_CHAR: /* Convert to chars so that the total frame size is pixel_width x pixel_height. */ if (char_width) - *char_width = 1 + ((*pixel_width - egw) - bdr - obw) / cpw; + *char_width = 1 + ((*total_pixel_width - egw) - bdr - obw) / cpw; if (char_height) - *char_height = (*pixel_height - bdr - obh) / cph; + *char_height = (*total_pixel_height - bdr - obh) / cph; break; case CHAR_TO_TOTAL_PIXEL: - if (pixel_width) - *pixel_width = (*char_width - 1) * cpw + egw + bdr + obw; - if (pixel_height) - *pixel_height = *char_height * cph + bdr + obh; + if (total_pixel_width) + *total_pixel_width = (*char_width - 1) * cpw + egw + bdr + obw; + if (total_pixel_height) + *total_pixel_height = *char_height * cph + bdr + obh; break; - case CHAR_TO_DISPLAYABLE_PIXEL: - if (pixel_width) - *pixel_width = *char_width * cpw; - if (pixel_height) - *pixel_height = *char_height * cph; + case TOTAL_PIXEL_TO_DISPLAYABLE_PIXEL: + /* Convert to chars so that the total frame size is pixel_width x + pixel_height. */ + if (disp_pixel_width) + *disp_pixel_width = cpw + (*total_pixel_width - egw) - bdr - obw; + if (disp_pixel_height) + *disp_pixel_height = *total_pixel_height - bdr - obh; + break; + case DISPLAYABLE_PIXEL_TO_TOTAL_PIXEL: + if (total_pixel_width) + *total_pixel_width = *disp_pixel_width - cpw + egw + bdr + obw; + if (total_pixel_height) + *total_pixel_height = *disp_pixel_height + bdr + obh; break; } } -/* This takes the size in pixels of the text area, and returns the number + +static enum frame_size_type +canonicalize_frame_size_type (enum frame_size_type type, int pixgeom) +{ + if (type == SIZE_FRAME_UNIT) + { + if (pixgeom) + type = SIZE_DISPLAYABLE_PIXEL; + else + type = SIZE_CHAR_CELL; + } + return type; +} + +/* Basic frame conversion function. Convert source size to destination + size, where either of them can be in total pixels, displayable pixels, + frame units or character-cell units. + + See comment at top of file for discussion about different types of + units. */ + +static void +frame_conversion_internal (struct frame *f, + enum frame_size_type source, + int source_width, int source_height, + enum frame_size_type dest, + int *dest_width, int *dest_height) +{ + int pixgeom = window_system_pixelated_geometry (wrap_frame (f)); + dest = canonicalize_frame_size_type (dest, pixgeom); + source = canonicalize_frame_size_type (source, pixgeom); + if (source == dest) + { + *dest_width = source_width; + *dest_height = source_height; + } + else if (source == SIZE_TOTAL_PIXEL && dest == SIZE_CHAR_CELL) + frame_conversion_internal_1 (f, TOTAL_PIXEL_TO_CHAR, + &source_width, &source_height, 0, 0, + dest_width, dest_height); + else if (source == SIZE_DISPLAYABLE_PIXEL && dest == SIZE_CHAR_CELL) + frame_conversion_internal_1 (f, DISPLAYABLE_PIXEL_TO_CHAR, 0, 0, + &source_width, &source_height, + dest_width, dest_height); + else if (source == SIZE_TOTAL_PIXEL && dest == SIZE_DISPLAYABLE_PIXEL) + frame_conversion_internal_1 (f, TOTAL_PIXEL_TO_DISPLAYABLE_PIXEL, + &source_width, &source_height, + dest_width, dest_height, 0, 0); + else if (dest == SIZE_TOTAL_PIXEL && source == SIZE_CHAR_CELL) + frame_conversion_internal_1 (f, CHAR_TO_TOTAL_PIXEL, + dest_width, dest_height, 0, 0, + &source_width, &source_height); + else if (dest == SIZE_DISPLAYABLE_PIXEL && source == SIZE_CHAR_CELL) + frame_conversion_internal_1 (f, CHAR_TO_DISPLAYABLE_PIXEL, 0, 0, + dest_width, dest_height, + &source_width, &source_height); + else if (dest == SIZE_TOTAL_PIXEL && source == SIZE_DISPLAYABLE_PIXEL) + frame_conversion_internal_1 (f, DISPLAYABLE_PIXEL_TO_TOTAL_PIXEL, + dest_width, dest_height, + &source_width, &source_height, 0, 0); + else + { + ABORT (); + if (dest_width) + *dest_width = 0; + if (dest_height) + *dest_height = 0; + } +} + +/* This takes the size in pixels of the client area, and returns the number of characters that will fit there, taking into account the internal border width, and the pixel width of the line terminator glyphs (which always count as one "character" wide, even if they are not the same size @@ -3192,35 +3511,56 @@ Therefore the result is not necessarily a multiple of anything in particular. */ + void pixel_to_char_size (struct frame *f, int pixel_width, int pixel_height, int *char_width, int *char_height) { - frame_conversion_internal (f, TOTAL_PIXEL_TO_CHAR, - &pixel_width, &pixel_height, char_width, - char_height, 0); + frame_conversion_internal (f, SIZE_TOTAL_PIXEL, pixel_width, pixel_height, + SIZE_CHAR_CELL, char_width, char_height); } -/* Given a character size, this returns the minimum number of pixels - necessary to display that many characters, taking into account the - internal border width, scrollbar height and width, toolbar heights and - widths and the size of the line terminator glyphs (assuming the line - terminators take up exactly one character position). +/* Given a character size, this returns the minimum pixel size of the + client area necessary to display that many characters, taking into + account the internal border width, scrollbar height and width, toolbar + heights and widths and the size of the line terminator glyphs (assuming + the line terminators take up exactly one character position). Therefore the result is not necessarily a multiple of anything in particular. */ + void char_to_pixel_size (struct frame *f, int char_width, int char_height, int *pixel_width, int *pixel_height) { - frame_conversion_internal (f, CHAR_TO_TOTAL_PIXEL, - pixel_width, pixel_height, &char_width, - &char_height, 0); + frame_conversion_internal (f, SIZE_CHAR_CELL, char_width, char_height, + SIZE_TOTAL_PIXEL, pixel_width, pixel_height); } -/* Given a pixel size, rounds DOWN to the smallest size in pixels necessary - to display the same number of characters as are displayable now. - */ +/* Versions of the above that operate in "frame units" instead of + characters. frame units are the same as characters except on + MS Windows and MS Printer frames, where they are displayable-area + pixels. */ + +void +pixel_to_frame_unit_size (struct frame *f, int pixel_width, int pixel_height, + int *frame_unit_width, int *frame_unit_height) +{ + frame_conversion_internal (f, SIZE_TOTAL_PIXEL, pixel_width, pixel_height, + SIZE_FRAME_UNIT, frame_unit_width, + frame_unit_height); +} + +void +frame_unit_to_pixel_size (struct frame *f, int frame_unit_width, + int frame_unit_height, + int *pixel_width, int *pixel_height) +{ + frame_conversion_internal (f, SIZE_FRAME_UNIT, frame_unit_width, + frame_unit_height, + SIZE_TOTAL_PIXEL, pixel_width, pixel_height); +} + void round_size_to_char (struct frame *f, int in_width, int in_height, int *out_width, int *out_height) @@ -3231,44 +3571,58 @@ char_to_pixel_size (f, char_width, char_height, out_width, out_height); } -/* Versions of the above which always account for real font metrics. - */ -void -pixel_to_real_char_size (struct frame *f, int pixel_width, int pixel_height, - int *char_width, int *char_height) +static void +get_frame_char_size (struct frame *f, int *out_width, int *out_height) { - frame_conversion_internal (f, TOTAL_PIXEL_TO_CHAR, - &pixel_width, &pixel_height, char_width, - char_height, 1); + *out_width = FRAME_CHARWIDTH (f); + *out_height = FRAME_CHARHEIGHT (f); } -void -char_to_real_pixel_size (struct frame *f, int char_width, int char_height, - int *pixel_width, int *pixel_height) +/* Return the "new" frame size in displayable pixels, which will be + accurate as of next redisplay. If we have changed the default font or + toolbar or scrollbar specifiers, the frame pixel size will change as of + next redisplay, but the frame character-cell size will remain the same. + So use those dimensions to compute the displayable-pixel size. */ + +static void +get_frame_new_displayable_pixel_size (struct frame *f, int *out_width, + int *out_height) { - frame_conversion_internal (f, CHAR_TO_TOTAL_PIXEL, - pixel_width, pixel_height, &char_width, - &char_height, 1); + frame_conversion_internal (f, SIZE_CHAR_CELL, FRAME_CHARWIDTH (f), + FRAME_CHARHEIGHT (f), SIZE_DISPLAYABLE_PIXEL, + out_width, out_height); } -void -round_size_to_real_char (struct frame *f, int in_width, int in_height, - int *out_width, int *out_height) +/* Return the "new" frame size in total pixels, which will be + accurate as of next redisplay. See get_frame_new_displayable_pixel_size(). +*/ + + +static void +get_frame_new_total_pixel_size (struct frame *f, int *out_width, + int *out_height) { - int char_width; - int char_height; - pixel_to_real_char_size (f, in_width, in_height, &char_width, &char_height); - char_to_real_pixel_size (f, char_width, char_height, out_width, out_height); + frame_conversion_internal (f, SIZE_CHAR_CELL, FRAME_CHARWIDTH (f), + FRAME_CHARHEIGHT (f), SIZE_TOTAL_PIXEL, + out_width, out_height); } -/* Change the frame height and/or width. Values may be given as zero to - indicate no change is to take place. */ + +/**************************************************************************/ +/* */ +/* frame resizing (implementation) */ +/* */ +/**************************************************************************/ + +/* Change the frame height and/or width. Values passed in are in + frame units (character cells on X/GTK, displayable-area pixels + on MS Windows or generally on pixelated-geometry window systems). */ static void -change_frame_size_1 (struct frame *f, int newheight, int newwidth) +change_frame_size_1 (struct frame *f, int newwidth, int newheight) { - Lisp_Object frame; int new_pixheight, new_pixwidth; - int font_height, real_font_height, font_width; + int paned_pixheight, paned_pixwidth; + int real_font_height, real_font_width; /* #### Chuck -- shouldn't we be checking to see if the frame is being "changed" to its existing size, and do nothing if so? */ @@ -3276,155 +3630,105 @@ update code relies on this function to cause window `top' and `left' coordinates to be recomputed even though no frame size change occurs. --kyle */ - if (in_display || hold_frame_size_changes) - ABORT (); - - frame = wrap_frame (f); - - default_face_height_and_width (frame, &real_font_height, 0); - default_face_height_and_width_1 (frame, &font_height, &font_width); + assert (!in_display && !hold_frame_size_changes); + + /* We no longer allow bogus values passed in. */ + assert (newheight && newwidth); + + default_face_width_and_height (wrap_frame (f), &real_font_width, + &real_font_height); + + frame_conversion_internal (f, SIZE_FRAME_UNIT, newwidth, newheight, + SIZE_TOTAL_PIXEL, &new_pixwidth, + &new_pixheight); /* This size-change overrides any pending one for this frame. */ f->size_change_pending = 0; FRAME_NEW_HEIGHT (f) = 0; FRAME_NEW_WIDTH (f) = 0; - new_pixheight = newheight * font_height; - new_pixwidth = (newwidth - 1) * font_width; - - /* #### dependency on FRAME_WIN_P should be removed. */ - if (FRAME_WIN_P (f)) - { - new_pixheight += FRAME_SCROLLBAR_HEIGHT (f); - new_pixwidth += FRAME_SCROLLBAR_WIDTH (f); - } - - /* when frame_conversion_internal() calculated the number of rows/cols - in the frame, the theoretical toolbar sizes were subtracted out. - The calculations below adjust for real toolbar height/width in - frame, which may be different from frame spec, taking the above - fact into account */ - new_pixheight += - + FRAME_THEORETICAL_TOP_TOOLBAR_HEIGHT (f) - + 2 * FRAME_THEORETICAL_TOP_TOOLBAR_BORDER_WIDTH (f) - - FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) - - 2 * FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f); - - new_pixheight += - + FRAME_THEORETICAL_BOTTOM_TOOLBAR_HEIGHT (f) - + 2 * FRAME_THEORETICAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f) - - FRAME_REAL_BOTTOM_TOOLBAR_HEIGHT (f) - - 2 * FRAME_REAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f); - - new_pixwidth += - + FRAME_THEORETICAL_LEFT_TOOLBAR_WIDTH (f) - + 2 * FRAME_THEORETICAL_LEFT_TOOLBAR_BORDER_WIDTH (f) - - FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) - - 2 * FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f); - - new_pixwidth += - + FRAME_THEORETICAL_RIGHT_TOOLBAR_WIDTH (f) - + 2 * FRAME_THEORETICAL_RIGHT_TOOLBAR_BORDER_WIDTH (f) - - FRAME_REAL_RIGHT_TOOLBAR_WIDTH (f) - - 2 * FRAME_REAL_RIGHT_TOOLBAR_BORDER_WIDTH (f); - - /* Adjust the width for the end glyph which may be a different width - than the default character width. */ - { - int adjustment, trunc_width, cont_width; - - trunc_width = glyph_width (Vtruncation_glyph, - FRAME_SELECTED_WINDOW (f)); - cont_width = glyph_width (Vcontinuation_glyph, - FRAME_SELECTED_WINDOW (f)); - adjustment = max (trunc_width, cont_width); - adjustment = max (adjustment, font_width); - - new_pixwidth += adjustment; - } - - /* If we don't have valid values, exit. */ - if (!new_pixheight && !new_pixwidth) - return; - - if (new_pixheight) + /* We need to remove the boundaries of the paned area (see top of file) + from the total-area pixel size, which is what we have now. + */ + paned_pixheight = new_pixheight - + (FRAME_NONPANED_SIZE (f, TOP_EDGE) + FRAME_NONPANED_SIZE (f, BOTTOM_EDGE)); + paned_pixwidth = new_pixwidth - + (FRAME_NONPANED_SIZE (f, LEFT_EDGE) + FRAME_NONPANED_SIZE (f, RIGHT_EDGE)); + + XWINDOW (FRAME_ROOT_WINDOW (f))->pixel_top = FRAME_PANED_TOP_EDGE (f); + + if (FRAME_HAS_MINIBUF_P (f) + && ! FRAME_MINIBUF_ONLY_P (f)) + /* Frame has both root and minibuffer. */ { - /* Adjust for gutters here so that we always get set - properly. */ - new_pixheight -= - (FRAME_TOP_GUTTER_BOUNDS (f) - + FRAME_BOTTOM_GUTTER_BOUNDS (f)); - - XWINDOW (FRAME_ROOT_WINDOW (f))->pixel_top - = FRAME_TOP_BORDER_END (f) + FRAME_TOP_GUTTER_BOUNDS (f); - - if (FRAME_HAS_MINIBUF_P (f) - && ! FRAME_MINIBUF_ONLY_P (f)) - /* Frame has both root and minibuffer. */ - { - /* - * Leave the minibuffer height the same if the frame has - * been initialized, and the minibuffer height is tall - * enough to display at least one line of text in the default - * font, and the old minibuffer height is a multiple of the - * default font height. This should cause the minibuffer - * height to be recomputed on font changes but not for - * other frame size changes, which seems reasonable. - */ - int old_minibuf_height = - XWINDOW(FRAME_MINIBUF_WINDOW(f))->pixel_height; - int minibuf_height = - f->init_finished && (old_minibuf_height % real_font_height) == 0 ? - max(old_minibuf_height, real_font_height) : - real_font_height; - set_window_pixheight (FRAME_ROOT_WINDOW (f), - /* - font_height for minibuffer */ - new_pixheight - minibuf_height, 0); - - XWINDOW (FRAME_MINIBUF_WINDOW (f))->pixel_top = - FRAME_TOP_BORDER_END (f) + - FRAME_TOP_GUTTER_BOUNDS (f) + - FRAME_BOTTOM_GUTTER_BOUNDS (f) + - new_pixheight - minibuf_height; - - set_window_pixheight (FRAME_MINIBUF_WINDOW (f), minibuf_height, 0); - } - else - /* Frame has just one top-level window. */ - set_window_pixheight (FRAME_ROOT_WINDOW (f), new_pixheight, 0); - - FRAME_HEIGHT (f) = newheight; - if (FRAME_TTY_P (f)) - f->pixheight = newheight; + /* + * Leave the minibuffer height the same if the frame has + * been initialized, and the minibuffer height is tall + * enough to display at least one line of text in the default + * font, and the old minibuffer height is a multiple of the + * default font height. This should cause the minibuffer + * height to be recomputed on font changes but not for + * other frame size changes, which seems reasonable. + */ + int old_minibuf_height = + XWINDOW (FRAME_MINIBUF_WINDOW (f))->pixel_height; + int minibuf_height = + f->init_finished && (old_minibuf_height % real_font_height) == 0 ? + max (old_minibuf_height, real_font_height) : + real_font_height; + set_window_pixheight (FRAME_ROOT_WINDOW (f), + /* - font_height for minibuffer */ + paned_pixheight - minibuf_height, 0); + + XWINDOW (FRAME_MINIBUF_WINDOW (f))->pixel_top = + FRAME_PANED_TOP_EDGE (f) + + FRAME_BOTTOM_GUTTER_BOUNDS (f) + + paned_pixheight - minibuf_height; + + set_window_pixheight (FRAME_MINIBUF_WINDOW (f), minibuf_height, 0); } - - if (new_pixwidth) + else + /* Frame has just one top-level window. */ + set_window_pixheight (FRAME_ROOT_WINDOW (f), paned_pixheight, 0); + + /* Set the value of FRAME_WIDTH/FRAME_HEIGHT and + FRAME_CHARWIDTH/FRAME_CHARHEIGHT. + + Question: Where is FRAME_PIXWIDTH/FRAME_PIXHEIGHT set? + Answer: In the device-specific code, as a result of a callback from + the window system indicating that the frame has changed size. + This happens: + + (1) in the WM_SIZE processing in event-msw.c + (2) in update_various_frame_slots() called from EmacsFrameResize() + (called from Xt when the frame is resized) in EmacsFrame.c for X + (3) in resize_event_cb() in frame-gtk.c + (4) For TTY's, there is no such callback, so we have to set it + ourselves. + */ + + FRAME_HEIGHT (f) = newheight; + if (FRAME_TTY_P (f)) + f->pixheight = newheight; + + XWINDOW (FRAME_ROOT_WINDOW (f))->pixel_left = FRAME_PANED_LEFT_EDGE (f); + set_window_pixwidth (FRAME_ROOT_WINDOW (f), paned_pixwidth, 0); + + if (FRAME_HAS_MINIBUF_P (f)) { - /* Adjust for gutters here so that we always get set - properly. */ - new_pixwidth -= - (FRAME_LEFT_GUTTER_BOUNDS (f) - + FRAME_RIGHT_GUTTER_BOUNDS (f)); - - XWINDOW (FRAME_ROOT_WINDOW (f))->pixel_left = - FRAME_LEFT_BORDER_END (f) + FRAME_LEFT_GUTTER_BOUNDS (f); - set_window_pixwidth (FRAME_ROOT_WINDOW (f), new_pixwidth, 0); - - if (FRAME_HAS_MINIBUF_P (f)) - { - XWINDOW (FRAME_MINIBUF_WINDOW (f))->pixel_left = - FRAME_LEFT_BORDER_END (f) + FRAME_LEFT_GUTTER_BOUNDS (f); - set_window_pixwidth (FRAME_MINIBUF_WINDOW (f), new_pixwidth, 0); - } - - FRAME_WIDTH (f) = newwidth; - if (FRAME_TTY_P (f)) - f->pixwidth = newwidth; + XWINDOW (FRAME_MINIBUF_WINDOW (f))->pixel_left = + FRAME_PANED_LEFT_EDGE (f); + set_window_pixwidth (FRAME_MINIBUF_WINDOW (f), paned_pixwidth, 0); } - if (window_system_pixelated_geometry (frame)) - pixel_to_real_char_size (f, FRAME_PIXWIDTH (f), FRAME_PIXHEIGHT (f), - &FRAME_CHARWIDTH (f), &FRAME_CHARHEIGHT (f)); + FRAME_WIDTH (f) = newwidth; + if (FRAME_TTY_P (f)) + f->pixwidth = newwidth; + + /* Set the frame character-cell width appropriately. */ + if (window_system_pixelated_geometry (wrap_frame (f))) + pixel_to_char_size (f, new_pixwidth, new_pixheight, + &FRAME_CHARWIDTH (f), &FRAME_CHARHEIGHT (f)); else { FRAME_CHARWIDTH (f) = FRAME_WIDTH (f); @@ -3437,13 +3741,30 @@ f->echo_area_garbaged = 1; } +/* This function is called to change the redisplay structures of a frame + to correspond to a new width and height. IT DOES NOT CHANGE THE ACTUAL + SIZE OF A FRAME. It is meant to be called after the frame has been + resized, either as a result of user action or a call to a function + such as `set-frame-size'. For example, under MS-Windows it is called + from mswindows_wnd_proc() when a WM_SIZE message is received, indicating + that the user resized the frame, and from mswindows_set_frame_size(), + which is the device method that is called (from internal_set_frame_size()) + when `set-frame-size' or similar function is called. + + Values passed in are in frame units (character cells on X/GTK, + displayable-area pixels on MS Windows or generally on pixelated-geometry + window systems). See discussion at top of file. + + See also internal_set_frame_size() and adjust_frame_size(). +*/ + void -change_frame_size (struct frame *f, int newheight, int newwidth, int delay) +change_frame_size (struct frame *f, int newwidth, int newheight, int delay) { /* sometimes we get passed a size that's too small (esp. when a client widget gets resized, since we have no control over this). So deal. */ - check_frame_size (f, &newheight, &newwidth); + check_frame_size (f, &newwidth, &newheight); /* Unconditionally mark that the frame has changed size. This is because many things need to know after the @@ -3470,13 +3791,153 @@ Lisp_Object frmcons; DEVICE_FRAME_LOOP (frmcons, XDEVICE (FRAME_DEVICE (f))) - change_frame_size_1 (XFRAME (XCAR (frmcons)), newheight, newwidth); + change_frame_size_1 (XFRAME (XCAR (frmcons)), newwidth, newheight); } else - change_frame_size_1 (f, newheight, newwidth); + change_frame_size_1 (f, newwidth, newheight); +} + + +/* This function is called from `set-frame-size' or the like, to explicitly + change the size of a frame. It calls the `set_frame_size' device + method, which makes the necessary window-system-specific call to change + the size of the frame and then calls change_frame_size() to change + the redisplay structures appropriately. + + Values passed in are in frame units (character cells on X/GTK, + displayable-area pixels on MS Windows or generally on pixelated-geometry + window systems). See discussion at top of file. + */ + +void +internal_set_frame_size (struct frame *f, int cols, int rows, int pretend) +{ + /* This can call Lisp. See mswindows_set_frame_size(). */ + /* An explicit size change cancels any pending frame size adjustment */ + CLEAR_FRAME_SIZE_SLIPPED (f); + + if (pretend || !HAS_FRAMEMETH_P (f, set_frame_size)) + change_frame_size (f, cols, rows, 0); + else + FRAMEMETH (f, set_frame_size, (f, cols, rows)); +} + +/* This function is called from redisplay_frame() as a result of the + "frame_slipped" flag being set. This flag is set when the default font + changes or when a change to scrollbar or toolbar visibility or size + is made (e.g. when a specifier such as `scrollbar-width' is changed). + Its purpose is to resize the frame so that its size in character-cell + units stays the same. + + #### It should also be triggered by a change the gutter visibility or + size. + + When a scrollbar or toolbar specifier is changed, the + frame_size_slipped() function is called (this happens because the + specifier's value_changed_in_frame() hook has been set to + frame_size_slipped() by a call to set_specifier_caching()). + All this does is call MARK_FRAME_SIZE_SLIPPED(), which sets the + frame_slipped flag, which gets noticed by redisplay_frame(), as just + discussed. + + The way things get triggered when a change is made to the default font + is as follows: + + (1) The specifier for the default font, which is attached to the + face named `default', has its "face" property set to the `default' + face. + + (2) font_after_change() (the font specifier's after_changed() method) + is called for the font specifier. + + + (3) It in turn calls face_property_was_changed(), passing in the + default face. + + (4) face_property_was_changed() notices that the default face is having + a property set and calls update_EmacsFrame(). + + (5) This in turn notices that the default face's font is being changed + and calls MARK_FRAME_SIZE_SLIPPED() -- see above. + */ + +void +adjust_frame_size (struct frame *f) +{ + /* This can call Lisp. */ + int keep_char_size = 0; + Lisp_Object frame = wrap_frame (f); + + if (!f->size_slipped) + return; + + /* Don't adjust tty frames. #### May break when TTY have menubars. + Then, write an Vadjust_frame_function which will return t for TTY + frames. Another solution is frame_size_fixed_p method for TTYs, + which always returned yes it's fixed. + */ + if (!FRAME_WIN_P (f)) + { + CLEAR_FRAME_SIZE_SLIPPED (f); + return; + } + + /* frame_size_fixed_p tells that frame size cannot currently + be changed change due to external conditions */ + if (!FRAMEMETH_OR_GIVEN (f, frame_size_fixed_p, (f), 0)) + { + if (NILP (Vadjust_frame_function)) + keep_char_size = 1; + else if (EQ (Vadjust_frame_function, Qt)) + keep_char_size = 0; + else + keep_char_size = + NILP (call1_trapping_problems ("Error in adjust-frame-function", + Vadjust_frame_function, frame, + 0)); + + if (keep_char_size) + Fset_frame_size (frame, make_int (FRAME_CHARWIDTH(f)), + make_int (FRAME_CHARHEIGHT(f)), Qnil); + } + + if (!keep_char_size) + { + int height, width; + pixel_to_frame_unit_size (f, FRAME_PIXWIDTH(f), FRAME_PIXHEIGHT(f), + &width, &height); + change_frame_size (f, width, height, 0); + CLEAR_FRAME_SIZE_SLIPPED (f); + } +} + +/* This is a "specifier changed in frame" handler for various specifiers + changing which causes frame size adjustment. See the discussion in + adjust_frame_size(). + */ + +void +frame_size_slipped (Lisp_Object UNUSED (specifier), struct frame *f, + Lisp_Object UNUSED (oldval)) +{ + MARK_FRAME_SIZE_SLIPPED (f); +} + +void +invalidate_vertical_divider_cache_in_frame (struct frame *f) +{ + /* Invalidate cached value of needs_vertical_divider_p in + every and all windows */ + map_windows (f, invalidate_vertical_divider_cache_in_window, 0); } +/**************************************************************************/ +/* */ +/* frame title, icon, pointer */ +/* */ +/**************************************************************************/ + /* The caller is responsible for freeing the returned string. */ static Ibyte * generate_title_string (struct window *w, Lisp_Object format_str, @@ -3603,6 +4064,53 @@ } +#ifdef MEMORY_USAGE_STATS + +struct frame_stats +{ + struct usage_stats u; + Bytecount gutter; + Bytecount expose_ignore; + Bytecount other; +}; + +static void +compute_frame_usage (struct frame *f, struct frame_stats *stats, + struct usage_stats *ustats) +{ + enum edge_pos edge; + EDGE_POS_LOOP (edge) + { + stats->gutter += + compute_display_line_dynarr_usage (f->current_display_lines[edge], + ustats); + stats->gutter += + compute_display_line_dynarr_usage (f->desired_display_lines[edge], + ustats); + } + { + struct expose_ignore *e; + + for (e = f->subwindow_exposures; e; e = e->next) + stats->expose_ignore += malloced_storage_size (e, sizeof (*e), ustats); + } + +#if 0 + stats->other += FRAMEMETH (f, frame_memory_usage, (f, ustats)); +#endif +} + +static void +frame_memory_usage (Lisp_Object frame, struct generic_usage_stats *gustats) +{ + struct frame_stats *stats = (struct frame_stats *) gustats; + + compute_frame_usage (XFRAME (frame), stats, &stats->u); +} + +#endif /* MEMORY_USAGE_STATS */ + + /***************************************************************************/ /* */ /* initialization */ @@ -3610,6 +4118,14 @@ /***************************************************************************/ void +frame_objects_create (void) +{ +#ifdef MEMORY_USAGE_STATS + OBJECT_HAS_METHOD (frame, memory_usage); +#endif +} + +void init_frame (void) { #ifndef PDUMP @@ -3624,9 +4140,9 @@ void syms_of_frame (void) { - INIT_LRECORD_IMPLEMENTATION (frame); + INIT_LISP_OBJECT (frame); #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (expose_ignore); + INIT_LISP_OBJECT (expose_ignore); #endif /* NEW_GC */ DEFSYMBOL (Qdelete_frame_hook); @@ -3755,6 +4271,12 @@ void vars_of_frame (void) { +#ifdef MEMORY_USAGE_STATS + OBJECT_HAS_PROPERTY + (frame, memusage_stats_list, list3 (Qgutter, intern ("expose-ignore"), + Qother)); +#endif /* MEMORY_USAGE_STATS */ + /* */ Vframe_being_created = Qnil; staticpro (&Vframe_being_created); diff -r 861f2601a38b -r 1f0b15040456 src/frame.h --- a/src/frame.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/frame.h Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,13 @@ /* Define frame-object for XEmacs. Copyright (C) 1988, 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995, 2002 Ben Wing. + Copyright (C) 1995, 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ @@ -60,7 +58,7 @@ extern Lisp_Object Vframe_icon_title_format, Vframe_title_format; extern Lisp_Object Vmouse_motion_handler; -DECLARE_LRECORD (frame, struct frame); +DECLARE_LISP_OBJECT (frame, struct frame); #define XFRAME(x) XRECORD (x, frame, struct frame) #define wrap_frame(p) wrap_record (p, frame) #define FRAMEP(x) RECORDP (x, frame) @@ -120,22 +118,22 @@ void update_frame_title (struct frame *f); Lisp_Object next_frame (Lisp_Object, Lisp_Object, Lisp_Object); Lisp_Object previous_frame (Lisp_Object, Lisp_Object, Lisp_Object); +void pixel_to_frame_unit_size (struct frame *f, int pixel_width, int pixel_height, + int *char_width, int *char_height); +void frame_unit_to_pixel_size (struct frame *f, int char_width, int char_height, + int *pixel_width, int *pixel_height); void pixel_to_char_size (struct frame *f, int pixel_width, int pixel_height, int *char_width, int *char_height); void char_to_pixel_size (struct frame *f, int char_width, int char_height, int *pixel_width, int *pixel_height); void round_size_to_char (struct frame *f, int in_width, int in_height, int *out_width, int *out_height); -void pixel_to_real_char_size (struct frame *f, int pixel_width, int pixel_height, - int *char_width, int *char_height); -void char_to_real_pixel_size (struct frame *f, int char_width, int char_height, - int *pixel_width, int *pixel_height); -void round_size_to_real_char (struct frame *f, int in_width, int in_height, - int *out_width, int *out_height); void change_frame_size (struct frame *frame, int newlength, int newwidth, int delay); void adjust_frame_size (struct frame *frame); +void internal_set_frame_size (struct frame *f, int cols, int rows, + int pretend); void frame_size_slipped (Lisp_Object specifier, struct frame *f, Lisp_Object oldval); void select_frame_1 (Lisp_Object frame); @@ -161,4 +159,18 @@ void init_frame (void); +enum edge_pos +{ + TOP_EDGE, + BOTTOM_EDGE, + LEFT_EDGE, + RIGHT_EDGE, + NUM_EDGES +}; + +/* Iterate over all possible edge positions */ +#define EDGE_POS_LOOP(var) \ + for (var = (enum edge_pos) 0; var < NUM_EDGES; \ + var = (enum edge_pos) (var + 1)) + #endif /* INCLUDED_frame_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/frameslots.h --- a/src/frameslots.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/frameslots.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. Split out of frame.h. */ diff -r 861f2601a38b -r 1f0b15040456 src/free-hook.c --- a/src/free-hook.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/free-hook.c Sun May 01 18:44:03 2011 +0100 @@ -1,9 +1,10 @@ -/* This file is part of XEmacs. +/* Copyright (C) 2010 Ben Wing. +This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -11,9 +12,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -26,7 +25,7 @@ * Trying to free a pointer not returned by malloc. * Trying to realloc a pointer not returned by malloc. - In addition, every word of every block freed is set to 0xdeadbeef + In addition, every word of every block freed is set to 0xDEADBEEF (-559038737). This causes many uses of freed storage to be trapped or recognized. @@ -43,10 +42,10 @@ return addresses. If UNMAPPED_FREE is defined, instead of setting every word of freed - storage to 0xdeadbeef, every call to malloc goes on its own page(s). + storage to 0xDEADBEEF, every call to malloc goes on its own page(s). When free() is called, the block is read and write protected. This is very useful when debugging, since it usually generates a bus error - when the deadbeef hack might only cause some garbage to be printed. + when the DEADBEEF hack might only cause some garbage to be printed. However, this is too slow for everyday use, since it takes an enormous number of pages. @@ -141,8 +140,7 @@ #if !defined(__linux__) /* I originally wrote: "There's really no need to drop core." I have seen the error of my ways. -slb */ - if (strict_free_check) - ABORT (); + assert (!strict_free_check); #endif printf("Freeing unmalloc'ed memory at %p\n", ptr); __free_hook = check_free; @@ -155,8 +153,7 @@ /* This happens when you free twice */ #if !defined(__linux__) /* See above comment. */ - if (strict_free_check) - ABORT (); + assert (!strict_free_check); #endif printf("Freeing %p twice\n", ptr); __free_hook = check_free; @@ -172,7 +169,7 @@ if (strict_free_check) mprotect (ptr, rounded_up_size, PROT_NONE); #else - /* Set every word in the block to 0xdeadbeef */ + /* Set every word in the block to 0xDEADBEEF */ if (strict_free_check) { unsigned long long_length = (size + (sizeof (long) - 1)) @@ -182,7 +179,7 @@ /* Not using the DEADBEEF_CONSTANT #define, since we don't know * that allocation sizes will be multiples of eight. */ for (i = 0; i < long_length; i++) - ((unsigned long *) ptr)[i] = 0xdeadbeef; + ((unsigned long *) ptr)[i] = 0xDEADBEEF; } #endif free_queue[current_free].address = ptr; @@ -448,7 +445,7 @@ note_block_input (char *file, int line) { note_block (file, line, block_type); - if (interrupt_input_blocked > 2) ABORT(); + assert (interrupt_input_blocked <= 2); } note_unblock_input (char* file, int line) @@ -488,13 +485,13 @@ if (type == ungcpro_type) { if (value == gcprolist) goto OK; - if (! gcprolist) ABORT (); + assert (gcprolist); if (value == gcprolist->next) goto OK; - if (! gcprolist->next) ABORT (); + assert (gcprolist->next); if (value == gcprolist->next->next) goto OK; - if (! gcprolist->next->next) ABORT (); + assert (gcprolist->next->next); if (value == gcprolist->next->next->next) goto OK; - if (! gcprolist->next->next->next) ABORT (); + assert (gcprolist->next->next->next); if (value == gcprolist->next->next->next->next) goto OK; ABORT (); OK:; diff -r 861f2601a38b -r 1f0b15040456 src/gc.c --- a/src/gc.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/gc.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,12 +15,322 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ +/* + Garbage Collectors in XEmacs + + Currently, XEmacs comes with two garbage collectors: + + - The "old garbage collector": a simple mark and sweep collector, + its implementation is mainly spread out over gc.c and alloc.c. + It is used by the default configuration or if you configure + `--with-newgc=no'. + + - The "new garbage collector": an incremental mark and sweep collector, + its implementation is in gc.c. It is used if you configure + `--with-newgc'. It comes with a new allocator, see mc-alloc.c, and + with the KKCC mark algorith, see below. + + Additionally, the old garbage collectors comes with two mark algorithms: + + - The "recursive mark algorithm" marks live objects by recursively + calling mark_* functions on live objects. It is the default mark + algorithm of the old garbage collector. + + - The "KKCC mark algorithm" uses an explicit stack that to keep + track of the current progress of traversal and uses memory layout + descriptions (that are also used by the portable dumper) instead + of the mark_* functions. The old garbage collector uses it if + you configure `--with-kkcc'. It is the default and only mark + algorithm of the new garbage collector. + + + The New Incremental Garbage Collector + + An incremental garbage collector keeps garbage collection pause + times short by interleaving small amounts of collection work with + program execution, it does that by instrumenting write barrier + algorithms that essentially allow interrupting the mark phase. + + + Write Barrier + + A write barrier is the most important prerequisite for fancy + garbage collection techniques. We implement a "Virtual Dirty Bit + (short: vdb) Write Barrier" that makes uses of the operating + system's memory-protection mechanisms: The write barrier + write-protects memory pages containing heap objects. If the + mutator tries to modify these objects by writing into the + write-protected page, the operating system generates a fault. The + write barrier catches this fault, reads out the error-causing + address and can thus identify the updated object and page. + + Not all environments and operating systems provide the mechanism to + write-protect memory, catch resulting write faults, and read out + the faulting address. But luckily, most of today's operating + systems provide the features needed for the write-barrier + implementation. Currently, XEmacs includes write-barrier + implementations for the following platforms: + + - POSIX-compliant platforms like up-to-date UNIX, Linux, Solaris, + etc. use the system call `mprotect' for memory protection, + `sigaction' for signal handling and get the faulting address from + `struct siginfo'. See file vdb-posix.c. + + - Mach-based systems like Mac OS X use "Mach Exception Handlers". + See file vdb-mach.c. + + - Windows systems like native Windows and Cygwin use Microsoft's + so-called "Structured Exception Handling". See file vdb-win32.c. + + The configure script determines which write barrier implementation + to use for a system. If no write barrier implementation is working + on that system, a fall-back "fake" implementation is used: This + implementation simply turns of the incremental write barrier at + runtime and does not allow any incremental collection (see + vdb-fake.c). The garbage collector then acts like a traditional + mark-and-sweep garbage collector. Generally, the incremental + garbage collector can be turned of at runtime by the user or by + applications, see below. + + + Memory Protection and Object Layout + + Implementations of a memory-protection mechanism may restrict the + size and the alignment of the memory region to be on page-size + boundaries. All objects subject to be covered by the write barrier + have to be allocated on logical memory pages, so that they meet the + requirement to be write-protected. The new allocator mc-alloc is + aware of a system page size---it allocates all Lisp objects on + logical memory pages and is therefore defaulted to on when the new + garbage collector is enabled. + + Unfortunately, the Lisp object layout that works with the old + collector leads to holes in the write barrier: Not all data + structures containing pointers to Lisp objects are allocated on the + Lisp heap. Some Lisp objects do not carry all their information in + the object itself. External parts are kept in separately allocated + memory blocks that are not managed by the new Lisp allocator. + Examples for these objects are hash tables and dynamic arrays, two + objects that can dynamically grow and shrink. The separate memory + blocks are not guaranteed to reside on page boundaries, and thus + cannot be watched by the write barrier. + + Moreover, the separate parts can contain live pointers to other Lisp + objects. These pointers are not covered by the write barrier and + modifications by the client during garbage collection do escape. In + this case, the client changes the connectivity of the reachability + graph behind the collector's back, which eventually leads to + erroneous collection of live objects. To solve this problem, I + transformed the separately allocated parts to fully qualified Lisp + objects that are managed by the allocator and thus are covered by + the write barrier. This also removes a lot of special allocation + and removal code for the out-sourced parts. Generally, allocating + all data structures that contain pointers to Lisp objects on one + heap makes the whole memory layout more consistent. + + + Debugging + + The virtual-dirty-bit write barrier provokes signals on purpose, + namely SIGSEGV and SIGBUS. When debugging XEmacs with this write + barrier running, the debugger always breaks whenever a signal + occurs. This behavior is generally desired: A debugger has to break + on signals, to allow the user to examine the cause of the + signal---especially for illegal memory access, which is a common + programming error. But the debugger should not break for signals + caused by the write barrier. Therefore, most debuggers provide the + ability to turn of their fault handling for specific signals. The + configure script generates the debugger's settings .gdbinit and + .dbxrc, adding code to turn of signal handling for SIGSEGV and + SIGBUS, if the new garbage collector is used. + + But what happens if a bug in XEmacs causes an illegal memory access? + To maintain basic debugging abilities, we use another signal: First, + the write-barrier signal handler has to determine if the current + error situation is caused by the write-barrier memory protection or + not. Therefore, the signal handler checks if the faulting address + has been write-protected before. If it has not, the fault is caused + by a bug; the debugger has to break in this situation. To achieve + this, the signal handler raises SIGABRT to abort the program. Since + SIGABRT is not masked out by the debugger, XEmacs aborts and allows + the user to examine the problem. + + + Incremental Garbage Collection + + The new garbage collector is still a mark-and-sweep collector, but + now the mark phase no longer runs in one atomic action, it is + interleaved with program execution. The incremental garbage + collector needs an explicit mark stack to store the state of the + incremental traversal: the KKCC mark algorithm is a prerequisite and + is enabled by default when the new garbage collector is on. + + Garbage collection is invoked as before: After `gc-cons-threshold' + bytes have been allocated since the last garbage collection (or + after `gc-cons-percentage' percentage of the total amount of memory + used for Lisp data has been allocated since the last garbage + collection) a collection starts. After some initialization, the + marking begins. + + The variable `gc-incremental-traversal-threshold' contains how many + steps of incremental work have to be executed in one incremental + traversal cycle. After that many steps have been made, the mark + phase is interrupted and the client resumes. Now, the Lisp memory + is write-protected and the write barrier records modified objects. + Incremental traversal is resumed after + `gc-cons-incremental-threshold' bytes have been allocated since the + interruption of garbage collection. Then, the objects recorded by + the write-barrier have to be re-examined by the traversal, i.e. they + are re-pushed onto the mark stack and processed again. Once the + mark stack is empty, the traversal is done. + + A full incremental collection is slightly slower than a full garbage + collection before: There is an overhead for storing pointers into + objects when the write barrier is running, and an overhead for + repeated traversal of modified objects. However, the new + incremental garbage collector reduces client pause times to + one-third, so even when a garbage collection is running, XEmacs + stays reactive. + + + Tricolor Marking: White, Black, and Grey Mark Bits + + Garbage collection traverses the graph of reachable objects and + colors them. The objects subject to garbage collection are white at + the beginning. By the end of the collection, those that will be + retained are colored black. When there are no reachable objects left + to blacken, the traversal of live data structures is finished. In + traditional mark-and-sweep collectors, this black and white coloring + is sufficient. + + In an incremental collector, the intermediate state of the traversal + is im- portant because of ongoing mutator activity: the mutator + cannot be allowed to change things in such way that the collector + will fail to find all reachable objects. To understand and prevent + such interactions between the mutator and the collector, it is + useful to introduce a third color, grey. + + Grey objects have been reached by the traversal, but its descendants + may not have been. White objects are changed to grey when they are + reached by the traversal. Grey objects mark the current state of the + traversal: traversal pro- ceeds by processing the grey objects. The + KKCC mark stack holds all the currently grey-colored objects. + Processing a grey object means following its outgoing pointers, and + coloring it black afterwards. + + Intuitively, the traversal proceeds in a wavefront of grey objects + that separates the unreached objects, which are colored white, from + the already processed black objects. + + The allocator takes care of storing the mark bits: The mark bits are + kept in a tree like structure, for details see mc-alloc.c. + + + Internal States of the Incremental Garbage Collector + + To keep track of its current state, the collector holds it's current + phase in the global `gc_state' variable. A collector phase is one + of the following: + + NONE No incremental or full collection is currently running. + + INIT_GC The collector prepares for a new collection, e.g. sets some + global variables. + + PUSH_ROOT_SET The collector pushes the root set on the mark stack + to start the traversal of live objects. + + MARK The traversal of live objects colors the reachable objects + white, grey, or black, according to their lifeness. The mark + phase can be interrupted by the incremental collection algorithm: + Before the client (i.e. the non collector part of XEmacs) resumes, + the write barrier has to be installed so that the collector knows + what objects get modified during the collector's pause. + Installing a write barrier means protecting pages that only + contain black objects and recording write access to these objects. + Pages with white or grey objects do not need to be protected, + since these pages are due to marking anyways when the collector + resumes. Once the collector resumes, it has to re-scan all + objects that have been modified during the collector pause and + have been caught by the write barrier. The mark phase is done when + there are no more grey objects on the heap, i.e. the KKCC mark stack + is empty. + + REPUSH_ROOT_SET After the mark phase is done, the collector has to + traverse the root set pointers again, since modifications to the + objects in the root set can not all be covered by the write barrier + (e.g. root set objects that are on the call stack). Therefore, the + collector has to traverse the root set again without interruption. + + FINISH_MARK After the mark phase is finished, some objects with + special liveness semantics have to be treated separately, e.g. + ephemerons and the various flavors of weak objects. + + FINALIZE The collector registers all objects that have finalizers + for finalization. Finalizations happens asynchronously sometimes + after the collection has finished. + + SWEEP The allocator scans the entire heap and frees all white marked + objects. The freed memory is recycled and can be re-used for future + allocations. The sweep phase is carried out atomically. + + FINISH_GC The collector cleans up after the garbage collection by + resetting some global variables. + + + Lisp Interface + + The new garbage collector can be accessed directly from Emacs Lisp. + Basically, two functions invoke the garbage collector: + + (gc-full) starts a full garbage collection. If an incremental + garbage collection is already running, it is finished without + further interruption. This function guarantees that unused + objects have been freed when it returns. + + (gc-incremental) starts an incremental garbage collection. If an + incremental garbage collection is already running, the next cycle + of incremental traversal is started. The garbage collection is + finished if the traversal completes. Note that this function does + not necessarily free any memory. It only guarantees that the + traversal of the heap makes progress. + + The old garbage collector uses the function (garbage-collect) to + invoke a garbage collection. This function is still in use by some + applications that explicitly want to invoke a garbage collection. + Since these applications may expect that unused memory has really + been freed when (garbage-collect) returns, it maps to (gc-full). + + The new garbage collector is highly customizable during runtime; it + can even be switched back to the traditional mark-and-sweep garbage + collector: The variable allow-incremental-gc controls whether + garbage collections may be interrupted or if they have to be carried + out in one atomic action. Setting allow-incremental-gc to nil + prevents incremental garbage collection, and the garbage collector + then only does full collects, even if (gc-incremental) is called. + Non-nil allows incremental garbage collection. + + This way applications can freely decide what garbage collection + algorithm is best for the upcoming memory usage. How frequently a + garbage collection occurs and how much traversal work is done in one + incremental cycle can also be modified during runtime. See + + M-x customize RET alloc RET + + for an overview of all settings. + + + More Information + + More details can be found in + http://crestani.de/xemacs/pdf/thesis-newgc.pdf . + +*/ + #include #include "lisp.h" @@ -50,8 +360,14 @@ #include "vdb.h" +/* Number of bytes of consing since gc before a full gc should happen. */ #define GC_CONS_THRESHOLD 2000000 + +/* Number of bytes of consing since gc before another cycle of the gc + should happen in incremental mode. */ #define GC_CONS_INCREMENTAL_THRESHOLD 200000 + +/* Number of elements marked in one cycle of incremental GC. */ #define GC_INCREMENTAL_TRAVERSAL_THRESHOLD 100000 /* Number of bytes of consing done since the last GC. */ @@ -184,7 +500,7 @@ gc_state.stat[GC_STAT_IN_THIS_GC] = 0; \ GC_STAT_RESUME (stat) -void +static void gc_stat_start_new_gc (void) { gc_state.n_gc[GC_STAT_TOTAL]++; @@ -201,7 +517,7 @@ GC_STAT_RESTART (freed); } -void +static void gc_stat_resume_gc (void) { gc_state.n_cycles[GC_STAT_TOTAL]++; @@ -381,9 +697,9 @@ default: stderr_out ("Unsupported count type : %d (line = %d, code = %ld)\n", idesc[line].type, line, (long) code); -#if defined(USE_KKCC) && defined(DEBUG_XEMACS) +#if defined (USE_KKCC) && defined (DEBUG_XEMACS) if (gc_in_progress) - kkcc_backtrace (); + kkcc_detailed_backtrace (); #endif #ifdef PDUMP if (in_pdump) @@ -436,7 +752,7 @@ case XD_OPAQUE_PTR: return sizeof (void *); #ifdef NEW_GC - case XD_LISP_OBJECT_BLOCK_PTR: + case XD_INLINE_LISP_OBJECT_BLOCK_PTR: #endif /* NEW_GC */ case XD_BLOCK_PTR: { @@ -557,8 +873,13 @@ EMACS_INT offset = lispdesc_indirect_count (desc[pos].offset, desc, obj); if (offset == max_offset) { +#if 0 + /* This can legitimately happen with gap arrays -- if there are + no elements in the array, and the gap size is 0, then both + parts of the array will be of size 0 and in the same place. */ stderr_out ("Two relocatable elements at same offset?\n"); ABORT (); +#endif } else if (offset > max_offset) { @@ -589,8 +910,8 @@ #else /* not NEW_GC */ #define GC_CHECK_NOT_FREE(lheader) \ gc_checking_assert (! LRECORD_FREE_P (lheader)); \ - gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->basic_p || \ - ! ((struct old_lcrecord_header *) lheader)->free) + gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->frob_block_p || \ + ! (lheader)->free) #endif /* not NEW_GC */ #ifdef USE_KKCC @@ -611,6 +932,7 @@ void *obj; const struct memory_description *desc; int pos; + int is_lisp; } kkcc_bt_stack_entry; static kkcc_bt_stack_entry *kkcc_bt; @@ -632,25 +954,33 @@ } } +/* Workhorse backtrace function. Not static because may potentially be + called from a debugger. */ + +void kkcc_backtrace_1 (int size, int detailed); void -kkcc_backtrace (void) +kkcc_backtrace_1 (int size, int detailed) { int i; stderr_out ("KKCC mark stack backtrace :\n"); - for (i = kkcc_bt_depth - 1; i >= 0; i--) + for (i = kkcc_bt_depth - 1; i >= kkcc_bt_depth - size && i >= 0; i--) { Lisp_Object obj = wrap_pointer_1 (kkcc_bt[i].obj); - stderr_out (" [%d]", i); - if ((XRECORD_LHEADER (obj)->type >= lrecord_type_last_built_in_type) - || (!LRECORDP (obj)) - || (!XRECORD_LHEADER_IMPLEMENTATION (obj))) + stderr_out (" [%d] ", i); + if (!kkcc_bt[i].is_lisp) + stderr_out ("non Lisp Object"); + else if (!LRECORDP (obj)) + stderr_out ("Lisp Object, non-record"); + else if (XRECORD_LHEADER (obj)->type >= lrecord_type_last_built_in_type + || (!XRECORD_LHEADER_IMPLEMENTATION (obj))) + stderr_out ("WARNING! Bad Lisp Object type %d", + XRECORD_LHEADER (obj)->type); + else + stderr_out ("%s", XRECORD_LHEADER_IMPLEMENTATION (obj)->name); + if (detailed && kkcc_bt[i].is_lisp) { - stderr_out (" non Lisp Object"); - } - else - { - stderr_out (" %s", - XRECORD_LHEADER_IMPLEMENTATION (obj)->name); + stderr_out (" "); + debug_print (obj); } stderr_out (" (addr: %p, desc: %p, ", (void *) kkcc_bt[i].obj, @@ -665,6 +995,76 @@ } } +/* Various front ends onto kkcc_backtrace_1(), meant to be called from + a debugger. + + The variants are: + + normal vs _full(): Normal displays up to the topmost 100 items on the + stack, whereas full displays all items (even if there are thousands) + + _detailed_() vs _short_(): Detailed here means print out the actual + Lisp objects on the stack using debug_print() in addition to their type, + whereas short means only show the type +*/ + +void +kkcc_detailed_backtrace (void) +{ + kkcc_backtrace_1 (100, 1); +} + +void kkcc_short_backtrace (void); +void +kkcc_short_backtrace (void) +{ + kkcc_backtrace_1 (100, 0); +} + +void kkcc_detailed_backtrace_full (void); +void +kkcc_detailed_backtrace_full (void) +{ + kkcc_backtrace_1 (kkcc_bt_depth, 1); +} + +void kkcc_short_backtrace_full (void); +void +kkcc_short_backtrace_full (void) +{ + kkcc_backtrace_1 (kkcc_bt_depth, 0); +} + +/* Short versions for ease in calling from a debugger */ + +void kbt (void); +void +kbt (void) +{ + kkcc_detailed_backtrace (); +} + +void kbts (void); +void +kbts (void) +{ + kkcc_short_backtrace (); +} + +void kbtf (void); +void +kbtf (void) +{ + kkcc_detailed_backtrace_full (); +} + +void kbtsf (void); +void +kbtsf (void) +{ + kkcc_short_backtrace_full (); +} + static void kkcc_bt_stack_realloc (void) { @@ -688,13 +1088,14 @@ } static void -kkcc_bt_push (void *obj, const struct memory_description *desc, - int level, int pos) +kkcc_bt_push (void *obj, const struct memory_description *desc, + int is_lisp DECLARE_KKCC_DEBUG_ARGS) { kkcc_bt_depth = level; kkcc_bt[kkcc_bt_depth].obj = obj; kkcc_bt[kkcc_bt_depth].desc = desc; kkcc_bt[kkcc_bt_depth].pos = pos; + kkcc_bt[kkcc_bt_depth].is_lisp = is_lisp; kkcc_bt_depth++; if (kkcc_bt_depth >= kkcc_bt_stack_size) kkcc_bt_stack_realloc (); @@ -702,7 +1103,7 @@ #else /* not DEBUG_XEMACS */ #define kkcc_bt_init() -#define kkcc_bt_push(obj, desc, level, pos) +#define kkcc_bt_push(obj, desc) #endif /* not DEBUG_XEMACS */ /* Object memory descriptions are in the lrecord_implementation structure. @@ -719,6 +1120,7 @@ #ifdef DEBUG_XEMACS int level; int pos; + int is_lisp; #endif } kkcc_gc_stack_entry; @@ -794,12 +1196,8 @@ } static void -#ifdef DEBUG_XEMACS -kkcc_gc_stack_push_1 (void *data, const struct memory_description *desc, - int level, int pos) -#else -kkcc_gc_stack_push_1 (void *data, const struct memory_description *desc) -#endif +kkcc_gc_stack_push (void *data, const struct memory_description *desc + DECLARE_KKCC_DEBUG_ARGS) { #ifdef NEW_GC GC_STAT_ENQUEUED; @@ -816,12 +1214,44 @@ } #ifdef DEBUG_XEMACS -#define kkcc_gc_stack_push(data, desc, level, pos) \ - kkcc_gc_stack_push_1 (data, desc, level, pos) -#else -#define kkcc_gc_stack_push(data, desc, level, pos) \ - kkcc_gc_stack_push_1 (data, desc) -#endif + +static inline void +kkcc_gc_stack_push_0 (void *data, const struct memory_description *desc, + int is_lisp DECLARE_KKCC_DEBUG_ARGS) +{ + kkcc_gc_stack_push (data, desc KKCC_DEBUG_ARGS); + kkcc_gc_stack_ptr[kkcc_gc_stack_rear].is_lisp = is_lisp; +} + +static inline void +kkcc_gc_stack_push_lisp (void *data, const struct memory_description *desc + DECLARE_KKCC_DEBUG_ARGS) +{ + kkcc_gc_stack_push_0 (data, desc, 1 KKCC_DEBUG_ARGS); +} + +static inline void +kkcc_gc_stack_push_nonlisp (void *data, const struct memory_description *desc + DECLARE_KKCC_DEBUG_ARGS) +{ + kkcc_gc_stack_push_0 (data, desc, 0 KKCC_DEBUG_ARGS); +} + +#else /* not DEBUG_XEMACS */ + +static inline void +kkcc_gc_stack_push_lisp (void *data, const struct memory_description *desc) +{ + kkcc_gc_stack_push (data, desc); +} + +static inline void +kkcc_gc_stack_push_nonlisp (void *data, const struct memory_description *desc) +{ + kkcc_gc_stack_push (data, desc); +} + +#endif /* (not) DEBUG_XEMACS */ static kkcc_gc_stack_entry * kkcc_gc_stack_pop (void) @@ -845,11 +1275,7 @@ } void -#ifdef DEBUG_XEMACS -kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj, int level, int pos) -#else -kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj) -#endif +kkcc_gc_stack_push_lisp_object (Lisp_Object obj DECLARE_KKCC_DEBUG_ARGS) { if (XTYPE (obj) == Lisp_Type_Record) { @@ -864,26 +1290,15 @@ #else /* not NEW_GC */ MARK_RECORD_HEADER (lheader); #endif /* not NEW_GC */ - kkcc_gc_stack_push ((void *) lheader, desc, level, pos); + kkcc_gc_stack_push_lisp ((void *) lheader, desc KKCC_DEBUG_ARGS); } } } #ifdef NEW_GC -#ifdef DEBUG_XEMACS -#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \ - kkcc_gc_stack_push_lisp_object_1 (obj, level, pos) -#else -#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \ - kkcc_gc_stack_push_lisp_object_1 (obj) -#endif void -#ifdef DEBUG_XEMACS -kkcc_gc_stack_repush_dirty_object_1 (Lisp_Object obj, int level, int pos) -#else -kkcc_gc_stack_repush_dirty_object_1 (Lisp_Object obj) -#endif +kkcc_gc_stack_repush_dirty_object (Lisp_Object obj DECLARE_KKCC_DEBUG_ARGS) { if (XTYPE (obj) == Lisp_Type_Record) { @@ -893,7 +1308,7 @@ GC_CHECK_LHEADER_INVARIANTS (lheader); desc = RECORD_DESCRIPTION (lheader); MARK_GREY (lheader); - kkcc_gc_stack_push ((void*) lheader, desc, level, pos); + kkcc_gc_stack_push_lisp ((void*) lheader, desc KKCC_DEBUG_ARGS); } } #endif /* NEW_GC */ @@ -909,48 +1324,23 @@ } \ } while (0) #else -#define KKCC_DO_CHECK_FREE(obj, allow_free) +#define KKCC_DO_CHECK_FREE(obj, allow_free) DO_NOTHING #endif -#ifdef ERROR_CHECK_GC -#ifdef DEBUG_XEMACS -static void -mark_object_maybe_checking_free_1 (Lisp_Object obj, int allow_free, - int level, int pos) -#else -static void -mark_object_maybe_checking_free_1 (Lisp_Object obj, int allow_free) -#endif +static inline void +mark_object_maybe_checking_free (Lisp_Object obj, int allow_free + DECLARE_KKCC_DEBUG_ARGS) { KKCC_DO_CHECK_FREE (obj, allow_free); - kkcc_gc_stack_push_lisp_object (obj, level, pos); + kkcc_gc_stack_push_lisp_object (obj KKCC_DEBUG_ARGS); } -#ifdef DEBUG_XEMACS -#define mark_object_maybe_checking_free(obj, allow_free, level, pos) \ - mark_object_maybe_checking_free_1 (obj, allow_free, level, pos) -#else -#define mark_object_maybe_checking_free(obj, allow_free, level, pos) \ - mark_object_maybe_checking_free_1 (obj, allow_free) -#endif -#else /* not ERROR_CHECK_GC */ -#define mark_object_maybe_checking_free(obj, allow_free, level, pos) \ - kkcc_gc_stack_push_lisp_object (obj, level, pos) -#endif /* not ERROR_CHECK_GC */ - - /* This function loops all elements of a struct pointer and calls mark_with_description with each element. */ static void -#ifdef DEBUG_XEMACS -mark_struct_contents_1 (const void *data, +mark_struct_contents (const void *data, const struct sized_memory_description *sdesc, - int count, int level, int pos) -#else -mark_struct_contents_1 (const void *data, - const struct sized_memory_description *sdesc, - int count) -#endif + int count DECLARE_KKCC_DEBUG_ARGS) { int i; Bytecount elsize; @@ -958,33 +1348,19 @@ for (i = 0; i < count; i++) { - kkcc_gc_stack_push (((char *) data) + elsize * i, sdesc->description, - level, pos); + kkcc_gc_stack_push_nonlisp (((char *) data) + elsize * i, + sdesc->description + KKCC_DEBUG_ARGS); } } -#ifdef DEBUG_XEMACS -#define mark_struct_contents(data, sdesc, count, level, pos) \ - mark_struct_contents_1 (data, sdesc, count, level, pos) -#else -#define mark_struct_contents(data, sdesc, count, level, pos) \ - mark_struct_contents_1 (data, sdesc, count) -#endif - - #ifdef NEW_GC /* This function loops all elements of a struct pointer and calls mark_with_description with each element. */ static void -#ifdef DEBUG_XEMACS -mark_lisp_object_block_contents_1 (const void *data, - const struct sized_memory_description *sdesc, - int count, int level, int pos) -#else -mark_lisp_object_block_contents_1 (const void *data, - const struct sized_memory_description *sdesc, - int count) -#endif +mark_lisp_object_block_contents (const void *data, + const struct sized_memory_description *sdesc, + int count DECLARE_KKCC_DEBUG_ARGS) { int i; Bytecount elsize; @@ -1002,19 +1378,12 @@ if (! MARKED_RECORD_HEADER_P (lheader)) { MARK_GREY (lheader); - kkcc_gc_stack_push ((void *) lheader, desc, level, pos); + kkcc_gc_stack_push_lisp ((void *) lheader, desc KKCC_DEBUG_ARGS); } } } } -#ifdef DEBUG_XEMACS -#define mark_lisp_object_block_contents(data, sdesc, count, level, pos) \ - mark_lisp_object_block_contents_1 (data, sdesc, count, level, pos) -#else -#define mark_lisp_object_block_contents(data, sdesc, count, level, pos) \ - mark_lisp_object_block_contents_1 (data, sdesc, count) -#endif #endif /* not NEW_GC */ /* This function implements the KKCC mark algorithm. @@ -1022,20 +1391,14 @@ on the kkcc_gc_stack. This function processes all elements on the stack according to their descriptions. */ static void -kkcc_marking ( -#ifdef NEW_GC - int cnt -#else /* not NEW_GC */ - int UNUSED(cnt) -#endif /* not NEW_GC */ - ) +kkcc_marking (int USED_IF_NEW_GC (cnt)) { kkcc_gc_stack_entry *stack_entry = 0; void *data = 0; const struct memory_description *desc = 0; int pos; #ifdef NEW_GC - int count = cnt; + int obj_count = cnt; #endif /* NEW_GC */ #ifdef DEBUG_XEMACS int level = 0; @@ -1047,8 +1410,11 @@ desc = stack_entry->desc; #ifdef DEBUG_XEMACS level = stack_entry->level + 1; + kkcc_bt_push (data, desc, stack_entry->is_lisp, stack_entry->level, + stack_entry->pos); +#else + kkcc_bt_push (data, desc); #endif - kkcc_bt_push (data, desc, stack_entry->level, stack_entry->pos); #ifdef NEW_GC /* Mark black if object is currently grey. This first checks, @@ -1099,11 +1465,12 @@ if (EQ (*stored_obj, Qnull_pointer)) break; #ifdef NEW_GC - mark_object_maybe_checking_free (*stored_obj, 0, level, pos); + mark_object_maybe_checking_free (*stored_obj, 0 + KKCC_DEBUG_ARGS); #else /* not NEW_GC */ mark_object_maybe_checking_free - (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT, - level, pos); + (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT + KKCC_DEBUG_ARGS); #endif /* not NEW_GC */ break; } @@ -1122,17 +1489,17 @@ break; #ifdef NEW_GC mark_object_maybe_checking_free - (*stored_obj, 0, level, pos); + (*stored_obj, 0 KKCC_DEBUG_ARGS); #else /* not NEW_GC */ mark_object_maybe_checking_free - (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT, - level, pos); + (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT + KKCC_DEBUG_ARGS); #endif /* not NEW_GC */ } break; } #ifdef NEW_GC - case XD_LISP_OBJECT_BLOCK_PTR: + case XD_INLINE_LISP_OBJECT_BLOCK_PTR: { EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, data); @@ -1141,7 +1508,7 @@ const char *dobj = * (const char **) rdata; if (dobj) mark_lisp_object_block_contents - (dobj, sdesc, count, level, pos); + (dobj, sdesc, count KKCC_DEBUG_ARGS); break; } #endif /* NEW_GC */ @@ -1153,7 +1520,7 @@ lispdesc_indirect_description (data, desc1->data2.descr); const char *dobj = * (const char **) rdata; if (dobj) - mark_struct_contents (dobj, sdesc, count, level, pos); + mark_struct_contents (dobj, sdesc, count KKCC_DEBUG_ARGS); break; } case XD_BLOCK_ARRAY: @@ -1163,7 +1530,7 @@ const struct sized_memory_description *sdesc = lispdesc_indirect_description (data, desc1->data2.descr); - mark_struct_contents (rdata, sdesc, count, level, pos); + mark_struct_contents (rdata, sdesc, count KKCC_DEBUG_ARGS); break; } case XD_UNION: @@ -1175,14 +1542,14 @@ default: stderr_out ("Unsupported description type : %d\n", desc1->type); - kkcc_backtrace (); + kkcc_detailed_backtrace (); ABORT (); } } #ifdef NEW_GC if (cnt) - if (!--count) + if (!--obj_count) break; #endif /* NEW_GC */ } @@ -1398,7 +1765,7 @@ } /* Keep objects alive that need to be finalized by marking Vfinalizers_to_run transitively. */ - kkcc_gc_stack_push_lisp_object (Vfinalizers_to_run, 0, -1); + kkcc_gc_stack_push_lisp_object_0 (Vfinalizers_to_run); kkcc_marking (0); } @@ -1620,7 +1987,7 @@ /* Mark all the special slots that serve as the roots of accessibility. */ #ifdef USE_KKCC -# define mark_object(obj) kkcc_gc_stack_push_lisp_object (obj, 0, -1) +# define mark_object(obj) kkcc_gc_stack_push_lisp_object_0 (obj) #endif /* USE_KKCC */ { /* staticpro() */ @@ -1706,6 +2073,7 @@ } mark_profiling_info (); + #ifdef USE_KKCC # undef mark_object #endif @@ -1780,6 +2148,7 @@ #ifdef NEW_GC GC_SET_PHASE (FINISH_GC); #endif /* NEW_GC */ + finish_object_memory_usage_stats (); consing_since_gc = 0; #ifndef DEBUG_XEMACS /* Allow you to set it really fucking low if you really want ... */ @@ -1894,7 +2263,7 @@ } -void +static void gc_1 (int incremental) { switch (GC_PHASE) @@ -1930,7 +2299,8 @@ } } -void gc (int incremental) +static void +gc (int incremental) { if (gc_currently_forbidden || in_display diff -r 861f2601a38b -r 1f0b15040456 src/gc.h --- a/src/gc.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/gc.h Sun May 01 18:44:03 2011 +0100 @@ -1,12 +1,13 @@ /* New incremental garbage collector for XEmacs. Copyright (C) 2005 Marcus Crestani. + Copyright (C) 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -106,31 +105,42 @@ void recompute_need_to_garbage_collect (void); +#ifdef DEBUG_XEMACS +#define KKCC_DEBUG_ARGS , level, pos +#define DECLARE_KKCC_DEBUG_ARGS , int level, int pos +#else +#define KKCC_DEBUG_ARGS +#define DECLARE_KKCC_DEBUG_ARGS +#endif + /* KKCC mark algorithm. */ +void kkcc_gc_stack_push_lisp_object (Lisp_Object obj DECLARE_KKCC_DEBUG_ARGS); +void kkcc_gc_stack_repush_dirty_object (Lisp_Object obj + DECLARE_KKCC_DEBUG_ARGS); + #ifdef DEBUG_XEMACS -void kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj, int level, int pos); -#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \ - kkcc_gc_stack_push_lisp_object_1 (obj, level, pos) -void kkcc_gc_stack_repush_dirty_object_1 (Lisp_Object obj, int level, int pos); -#define kkcc_gc_stack_repush_dirty_object(obj) \ - kkcc_gc_stack_repush_dirty_object_1 (obj, 0, -2) -void kkcc_backtrace (void); +#define kkcc_gc_stack_push_lisp_object_0(obj) \ + kkcc_gc_stack_push_lisp_object (obj, 0, -1) +void kkcc_backtrace_1 (int size, int detailed); +void kkcc_short_backtrace (void); +void kkcc_detailed_backtrace (void); +void kkcc_short_backtrace_full (void); +void kkcc_detailed_backtrace_full (void); #else -void kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj); -#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \ - kkcc_gc_stack_push_lisp_object_1 (obj) -void kkcc_gc_stack_repush_dirty_object_1 (Lisp_Object obj); -#define kkcc_gc_stack_repush_dirty_object(obj) \ - kkcc_gc_stack_repush_dirty_object_1 (obj) -#define kkcc_backtrace() +#define kkcc_gc_stack_push_lisp_object_0(obj) \ + kkcc_gc_stack_push_lisp_object (obj) +#define kkcc_detailed_backtrace() #endif #ifdef NEW_GC /* Repush objects that are caught by the write barrier. */ -#define gc_write_barrier(obj) kkcc_gc_stack_repush_dirty_object (obj); - +#ifdef DEBUG_XEMACS +#define gc_write_barrier(obj) kkcc_gc_stack_repush_dirty_object (obj, 0, -2) +#else +#define gc_write_barrier(obj) kkcc_gc_stack_repush_dirty_object (obj) +#endif /* GC functions: */ diff -r 861f2601a38b -r 1f0b15040456 src/gccache-gtk.c --- a/src/gccache-gtk.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/gccache-gtk.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -156,8 +154,8 @@ struct gc_cache_cell *cell, *next, *prev; struct gcv_and_mask gcvm; - if ((!!cache->head) != (!!cache->tail)) ABORT (); - if (cache->head && (cache->head->prev || cache->tail->next)) ABORT (); + assert ((!!cache->head) == (!!cache->tail)); + assert (!(cache->head && (cache->head->prev || cache->tail->next))); /* Gdk does not have the equivalent of 'None' for the clip_mask, so we need to check it carefully, or gdk_gc_new_with_values will @@ -212,10 +210,10 @@ cell->prev = cache->tail; cache->tail->next = cell; cache->tail = cell; - if (cache->head == cell) ABORT (); - if (cell->next) ABORT (); - if (cache->head->prev) ABORT (); - if (cache->tail->next) ABORT (); + assert (cache->head != cell); + assert (!cell->next); + assert (!cache->head->prev); + assert (!cache->tail->next); return cell->gc; } diff -r 861f2601a38b -r 1f0b15040456 src/gccache-gtk.h --- a/src/gccache-gtk.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/gccache-gtk.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/gccache-x.c --- a/src/gccache-x.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/gccache-x.c Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,14 @@ /* Efficient caching of X GCs (graphics contexts). Copyright (C) 1993 Free Software Foundation, Inc. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. + Copyright (C) 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -157,8 +156,8 @@ (void) describe_gc_cache (cache, DGCCFLAG_DISABLE); #endif - if ((!!cache->head) != (!!cache->tail)) ABORT (); - if (cache->head && (cache->head->prev || cache->tail->next)) ABORT (); + assert ((!!cache->head) == (!!cache->tail)); + assert (!(cache->head && (cache->head->prev || cache->tail->next))); gcvm.mask = mask; gcvm.gcv = *gcv; /* this copies... */ @@ -210,10 +209,10 @@ cell->prev = cache->tail; cache->tail->next = cell; cache->tail = cell; - if (cache->head == cell) ABORT (); - if (cell->next) ABORT (); - if (cache->head->prev) ABORT (); - if (cache->tail->next) ABORT (); + assert (cache->head != cell); + assert (!cell->next); + assert (!cache->head->prev); + assert (!cache->tail->next); return cell->gc; } diff -r 861f2601a38b -r 1f0b15040456 src/gccache-x.h --- a/src/gccache-x.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/gccache-x.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/general-slots.h --- a/src/general-slots.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/general-slots.h Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,13 @@ /* Commonly-used symbols -- include file Copyright (C) 1995 Sun Microsystems. - Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003 Ben Wing. + Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -32,6 +30,8 @@ SYMBOL_KEYWORD (Q_foo); declares a keyword symbol ":foo" SYMBOL_GENERAL (Qfoo, "bar"); declares a symbol named "bar" but stored in the variable Qfoo + SYMBOL_KEYWORD_GENERAL (Q_foo_, ":bar"); declares a keyword named ":bar" + but stored in the variable Q_foo_. To sort the crap in this file, use the following: @@ -46,9 +46,9 @@ SYMBOL (Qabort); SYMBOL_KEYWORD (Q_accelerator); SYMBOL_KEYWORD (Q_active); -SYMBOL (Qactually_requested); SYMBOL (Qafter); SYMBOL (Qall); +SYMBOL_KEYWORD (Q_allow_other_keys); SYMBOL (Qand); SYMBOL (Qappend); SYMBOL (Qascii); @@ -72,6 +72,7 @@ SYMBOL_KEYWORD (Q_callback); SYMBOL_KEYWORD (Q_callback_ex); SYMBOL (Qcancel); +SYMBOL (Qcar); SYMBOL (Qcategory); SYMBOL (Qccl_program); SYMBOL (Qcenter); @@ -91,15 +92,20 @@ SYMBOL (Qconsole); SYMBOL (Qcontrol_1); SYMBOL (Qcopies); +SYMBOL (Qcount); SYMBOL_MODULE_API (Qcritical); SYMBOL (Qctext); SYMBOL (Qcurrent); SYMBOL (Qcursor); SYMBOL (Qdata); +SYMBOL_KEYWORD (Q_data); SYMBOL (Qdde); SYMBOL (Qdead); SYMBOL (Qdebug); SYMBOL (Qdefault); +/* We name the C variable corresponding to the keyword Q_default_, not + Q_default, to allow it to be useful with PARSE_KEYWORDS (). */ +SYMBOL_KEYWORD_GENERAL (Q_default_, ":default"); SYMBOL_MODULE_API (Qdelete); SYMBOL (Qdelq); SYMBOL (Qdescription); @@ -114,13 +120,10 @@ SYMBOL (Qdoc_string); SYMBOL (Qdocumentation); SYMBOL (Qduplex); -SYMBOL (Qdynarr_overhead); SYMBOL (Qemergency); SYMBOL (Qempty); +SYMBOL_KEYWORD (Q_end); SYMBOL (Qencode_as_utf_8); -SYMBOL (Qeq); -SYMBOL (Qeql); -SYMBOL (Qequal); SYMBOL (Qeval); SYMBOL (Qevent); SYMBOL (Qextents); @@ -133,6 +136,7 @@ SYMBOL_KEYWORD (Q_filter); SYMBOL (Qfinal); SYMBOL (Qfixnum); +SYMBOL_MODULE_API (Qfixnump); SYMBOL (Qfloat); SYMBOL (Qfont); SYMBOL (Qframe); @@ -142,7 +146,6 @@ SYMBOL (Qfull_assoc); SYMBOL (Qfuncall); SYMBOL (Qfunction); -SYMBOL (Qgap_overhead); SYMBOL (Qgarbage_collection); SYMBOL (Qgeneric); SYMBOL (Qgeometry); @@ -173,6 +176,7 @@ SYMBOL_KEYWORD (Q_justify); SYMBOL_KEYWORD (Q_vertically_justify); SYMBOL_KEYWORD (Q_horizontally_justify); +SYMBOL_KEYWORD (Q_key); SYMBOL (Qkey); SYMBOL (Qkey_assoc); SYMBOL (Qkey_mapping); @@ -191,8 +195,8 @@ SYMBOL (Qlittle_endian); SYMBOL (Qlocale); SYMBOL (Qlow); +SYMBOL_GENERAL (Qlss, "<"); SYMBOL (Qmagic); -SYMBOL (Qmalloc_overhead); SYMBOL_KEYWORD (Q_margin_width); SYMBOL (Qmarkers); SYMBOL (Qmax); @@ -241,6 +245,7 @@ SYMBOL (Qquery_coding_warning_face); SYMBOL (Qquestion); SYMBOL_KEYWORD (Q_question); +SYMBOL (Qquote); SYMBOL (Qradio); SYMBOL (Qrassoc); SYMBOL (Qrassq); @@ -266,8 +271,10 @@ SYMBOL (Qspace); SYMBOL (Qspecifier); SYMBOL (Qstandard); +SYMBOL_KEYWORD (Q_start); SYMBOL (Qstream); SYMBOL (Qstring); +SYMBOL (Qstring_match); SYMBOL_KEYWORD (Q_style); SYMBOL_KEYWORD (Q_suffix); SYMBOL (Qsubtype); @@ -277,6 +284,7 @@ SYMBOL (Qsystem_default); SYMBOL (Qterminal); SYMBOL (Qtest); +SYMBOL_KEYWORD (Q_test); SYMBOL (Qtext); SYMBOL_KEYWORD (Q_text); SYMBOL (Qthis_command); @@ -290,6 +298,7 @@ SYMBOL (Qtop_margin); SYMBOL (Qtty); SYMBOL (Qtype); +SYMBOL_KEYWORD (Q_type); SYMBOL (Qundecided); SYMBOL (Qundefined); SYMBOL (Qunencodable); diff -r 861f2601a38b -r 1f0b15040456 src/general.c --- a/src/general.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/general.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -29,8 +27,9 @@ #define SYMBOL(fou) Lisp_Object fou #define SYMBOL_MODULE_API(fou) Lisp_Object fou -#define SYMBOL_KEYWORD(la_cle_est_fou) Lisp_Object la_cle_est_fou +#define SYMBOL_KEYWORD(la_cle_est_folle) Lisp_Object la_cle_est_folle #define SYMBOL_GENERAL(tout_le_monde, est_fou) Lisp_Object tout_le_monde +#define SYMBOL_KEYWORD_GENERAL(ponle, la_clave) Lisp_Object ponle #include "general-slots.h" @@ -38,6 +37,7 @@ #undef SYMBOL_MODULE_API #undef SYMBOL_KEYWORD #undef SYMBOL_GENERAL +#undef SYMBOL_KEYWORD_GENERAL void syms_of_general (void) @@ -46,10 +46,13 @@ #define SYMBOL_MODULE_API(loco) DEFSYMBOL (loco) #define SYMBOL_KEYWORD(meshugeneh) DEFKEYWORD (meshugeneh) #define SYMBOL_GENERAL(vachement, fou) defsymbol (&vachement, fou) +#define SYMBOL_KEYWORD_GENERAL(bescheuert, gaaanz_bescheuert) \ + defkeyword (&bescheuert, gaaanz_bescheuert) #include "general-slots.h" #undef SYMBOL #undef SYMBOL_KEYWORD #undef SYMBOL_GENERAL +#undef SYMBOL_KEYWORD_GENERAL } diff -r 861f2601a38b -r 1f0b15040456 src/getloadavg.c --- a/src/getloadavg.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/getloadavg.c Sun May 01 18:44:03 2011 +0100 @@ -8,10 +8,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -19,9 +19,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synced up with: FSF 23.1.92. */ /* Synced by: Ben Wing. */ diff -r 861f2601a38b -r 1f0b15040456 src/getpagesize.h --- a/src/getpagesize.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/getpagesize.h Sun May 01 18:44:03 2011 +0100 @@ -1,9 +1,9 @@ /* This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -11,9 +11,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ diff -r 861f2601a38b -r 1f0b15040456 src/glade.c --- a/src/glade.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/glade.c Sun May 01 18:44:03 2011 +0100 @@ -9,21 +9,18 @@ ** ** This file is part of XEmacs. ** -** XEmacs is free software; you can redistribute it and/or modify it +** 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. -** +** Free Software Foundation, either version 3 of the License, or (at your +** option) any later version. +** ** XEmacs is distributed in the hope that it will be useful, but WITHOUT ** ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ** FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ** for more details. -** +** ** You should have received a copy of the GNU General Public License -** along with XEmacs; see the file COPYING. If not, write to -** the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -** Boston, MA 02111-1301, USA. */ -*/ +** along with XEmacs. If not, see . */ #if defined(HAVE_GLADE_H) || defined(HAVE_GLADE_GLADE_H) diff -r 861f2601a38b -r 1f0b15040456 src/glyphs-eimage.c --- a/src/glyphs-eimage.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/glyphs-eimage.c Sun May 01 18:44:03 2011 +0100 @@ -2,15 +2,15 @@ Copyright (C) 1993, 1994, 1998 Free Software Foundation, Inc. Copyright (C) 1995 Board of Trustees, University of Illinois. Copyright (C) 1995 Tinker Systems - Copyright (C) 1995, 1996, 2001, 2002, 2004, 2005 Ben Wing + Copyright (C) 1995, 1996, 2001, 2002, 2004, 2005, 2010 Ben Wing Copyright (C) 1995 Sun Microsystems This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -18,9 +18,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -47,7 +45,7 @@ #include "device-impl.h" #include "faces.h" #include "glyphs.h" -#include "objects-impl.h" +#include "fontcolor-impl.h" #include "buffer.h" #include "frame.h" @@ -177,10 +175,16 @@ jpeg_destroy_decompress (data->cinfo_ptr); if (data->instream) - retry_fclose (data->instream); + { + retry_fclose (data->instream); + data->instream = 0; + } if (data->eimage) - xfree (data->eimage); + { + xfree (data->eimage); + data->eimage = 0; + } return Qnil; } @@ -577,10 +581,14 @@ if (data->giffile) { DGifCloseFile (data->giffile); - FreeSavedImages(data->giffile); + FreeSavedImages (data->giffile); + data->giffile = 0; } if (data->eimage) - xfree (data->eimage); + { + xfree (data->eimage); + data->eimage = 0; + } return Qnil; } @@ -684,7 +692,7 @@ /* 3. Now create the EImage(s) */ { - ColorMapObject *cmo = unwind.giffile->SColorMap; + ColorMapObject *cmo = (unwind.giffile->Image.ColorMap ? unwind.giffile->Image.ColorMap : unwind.giffile->SColorMap); int i, j, row, pass, interlace, slice; UINT_64_BIT pixels_sq; Binbyte *eip; @@ -693,6 +701,9 @@ static int InterlacedOffset[] = { 0, 4, 2, 1 }; static int InterlacedJumps[] = { 8, 8, 4, 2 }; + if (cmo == NULL) + signal_image_error ("GIF image has no color map", instantiator); + height = unwind.giffile->SHeight; width = unwind.giffile->SWidth; pixels_sq = (UINT_64_BIT) width * (UINT_64_BIT) height; @@ -878,10 +889,16 @@ } if (data->instream) - retry_fclose (data->instream); + { + retry_fclose (data->instream); + data->instream = 0; + } if (data->eimage) - xfree (data->eimage); + { + xfree (data->eimage); + data->eimage = 0; + } return Qnil; } @@ -963,8 +980,8 @@ int y, padding; Binbyte **row_pointers; UINT_64_BIT pixels_sq; - height = info_ptr->height; - width = info_ptr->width; + height = png_get_image_height (png_ptr, info_ptr); + width = png_get_image_width (png_ptr, info_ptr); pixels_sq = (UINT_64_BIT) width * (UINT_64_BIT) height; if (pixels_sq > ((size_t) -1) / 3) signal_image_error ("PNG image too large to instantiate", instantiator); @@ -1025,30 +1042,37 @@ /* Now that we're using EImage, ask for 8bit RGB triples for any type of image*/ - /* convert palette images to RGB */ - if (info_ptr->color_type == PNG_COLOR_TYPE_PALETTE) - png_set_palette_to_rgb (png_ptr); - /* convert grayscale images to RGB */ - else if (info_ptr->color_type == PNG_COLOR_TYPE_GRAY || - info_ptr->color_type == PNG_COLOR_TYPE_GRAY_ALPHA) - png_set_gray_to_rgb (png_ptr); - /* pad images with depth < 8 bits */ - else if (info_ptr->bit_depth < 8) + switch (png_get_color_type (png_ptr, info_ptr)) { - if (info_ptr->color_type == PNG_COLOR_TYPE_GRAY) - png_set_expand (png_ptr); - else - png_set_packing (png_ptr); + case PNG_COLOR_TYPE_PALETTE: + /* convert palette images to RGB */ + png_set_palette_to_rgb (png_ptr); + break; + + case PNG_COLOR_TYPE_GRAY: + case PNG_COLOR_TYPE_GRAY_ALPHA: + /* convert grayscale images to RGB */ + png_set_gray_to_rgb (png_ptr); + break; + + default: + /* pad images with depth < 8 bits */ + if (png_get_bit_depth (png_ptr, info_ptr) < 8) + { + png_set_packing (png_ptr); + } + break; } + /* strip 16-bit depth files down to 8 bits */ - if (info_ptr->bit_depth == 16) + if (png_get_bit_depth (png_ptr, info_ptr) == 16) png_set_strip_16 (png_ptr); /* strip alpha channel #### shouldn't we handle this? first call png_read_update_info in case above transformations have generated an alpha channel */ png_read_update_info(png_ptr, info_ptr); - if (info_ptr->color_type & PNG_COLOR_MASK_ALPHA) + if (png_get_color_type (png_ptr, info_ptr) & PNG_COLOR_MASK_ALPHA) png_set_strip_alpha (png_ptr); png_read_image (png_ptr, row_pointers); @@ -1058,23 +1082,25 @@ * into the glyph code, where you can get to it from lisp * anyway. - WMP */ { - int i; + int ii, num_text = 0; + png_textp text_ptr = NULL; DECLARE_EISTRING (key); DECLARE_EISTRING (text); - for (i = 0 ; i < info_ptr->num_text ; i++) - { - /* How paranoid do I have to be about no trailing NULLs, and - using (int)info_ptr->text[i].text_length, and strncpy and a temp - string somewhere? */ - eireset(key); - eireset(text); - eicpy_ext(key, info_ptr->text[i].key, Qbinary); - eicpy_ext(text, info_ptr->text[i].text, Qbinary); + if (png_get_text (png_ptr, info_ptr, &text_ptr, &num_text) > 0) + { + for (ii = 0 ; ii < num_text; ii++) + { + eireset (key); + eireset (text); - warn_when_safe (Qpng, Qinfo, "%s - %s", - eidata(key), eidata(text)); - } + eicpy_ext (key, text_ptr[ii].key, Qbinary); + eicpy_ext (text, text_ptr[ii].text, Qbinary); + + warn_when_safe (Qpng, Qinfo, "%s - %s", eidata (key), + eidata (text)); + } + } } xfree (row_pointers); @@ -1134,10 +1160,14 @@ free_opaque_ptr (unwind_obj); if (data->tiff) { - TIFFClose(data->tiff); + TIFFClose (data->tiff); + data->tiff = 0; } if (data->eimage) - xfree (data->eimage); + { + xfree (data->eimage); + data->eimage = 0; + } return Qnil; } diff -r 861f2601a38b -r 1f0b15040456 src/glyphs-gtk.c --- a/src/glyphs-gtk.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/glyphs-gtk.c Sun May 01 18:44:03 2011 +0100 @@ -2,15 +2,15 @@ Copyright (C) 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Board of Trustees, University of Illinois. Copyright (C) 1995 Tinker Systems - Copyright (C) 1995, 1996, 2001, 2002, 2004, 2005 Ben Wing + Copyright (C) 1995, 1996, 2001, 2002, 2004, 2005, 2010 Ben Wing Copyright (C) 1995 Sun Microsystems This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -18,9 +18,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -67,7 +65,7 @@ #include "console-gtk-impl.h" #include "glyphs-gtk.h" -#include "objects-gtk-impl.h" +#include "fontcolor-gtk-impl.h" #include "ui-gtk.h" #include "sysfile.h" @@ -483,7 +481,8 @@ } static Hashcode -gtk_image_instance_hash (struct Lisp_Image_Instance *p, int UNUSED (depth)) +gtk_image_instance_hash (struct Lisp_Image_Instance *p, int UNUSED (depth), + Boolint UNUSED (equalp)) { switch (IMAGE_INSTANCE_TYPE (p)) { @@ -819,8 +818,7 @@ GdkWindow *d; gint width, height, depth; - if (!DEVICE_GTK_P (device)) - ABORT (); + assert (DEVICE_GTK_P (device)); IMAGE_INSTANCE_DEVICE (ii) = device; IMAGE_INSTANCE_TYPE (ii) = IMAGE_COLOR_PIXMAP; diff -r 861f2601a38b -r 1f0b15040456 src/glyphs-gtk.h --- a/src/glyphs-gtk.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/glyphs-gtk.h Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ /* Gtk version by William Perry */ diff -r 861f2601a38b -r 1f0b15040456 src/glyphs-msw.c --- a/src/glyphs-msw.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/glyphs-msw.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -47,7 +45,7 @@ #include "console-msw-impl.h" #include "glyphs-msw.h" -#include "objects-msw-impl.h" +#include "fontcolor-msw-impl.h" #define WIDGET_GLYPH_SLOT 0 @@ -1962,7 +1960,7 @@ /* Doing this once does not seem to be enough, for instance when mapping the search dialog this gets called four times. If we only set on the first time through then the subwindow never - gets focus as intended. However, doing this everytime doesn't + gets focus as intended. However, doing this every time doesn't seem so bad, after all we only need to redo this after the focus changes - and if that happens resetting the initial focus doesn't seem so bad. */ @@ -2780,7 +2778,7 @@ pointer_bg, dest_mask, domain); /* We now have everything right apart from the height. */ - default_face_font_info (domain, 0, 0, &height, 0, 0); + default_face_font_info (domain, 0, 0, 0, &height, 0); GET_LIST_LENGTH (items, len); height = (height + DEFAULT_WIDGET_BORDER_WIDTH * 2 ) * len; diff -r 861f2601a38b -r 1f0b15040456 src/glyphs-msw.h --- a/src/glyphs-msw.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/glyphs-msw.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/glyphs-shared.c --- a/src/glyphs-shared.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/glyphs-shared.c Sun May 01 18:44:03 2011 +0100 @@ -8,10 +8,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -19,9 +19,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/glyphs-widget.c --- a/src/glyphs-widget.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/glyphs-widget.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -35,7 +33,7 @@ #include "gui.h" #include "insdel.h" #include "lstream.h" -#include "objects.h" +#include "fontcolor.h" #include "opaque.h" #include "window.h" @@ -281,7 +279,7 @@ widget_query_string_geometry (text, face, 0, &charheight, domain); /* For the returned value to be useful it needs to be big enough to - accomodate the largest single-height widget. This is currently + accommodate the largest single-height widget. This is currently the edit-field. */ return charheight + 2 * widget_spacing (domain) + 4 * widget_border_width (domain); @@ -811,7 +809,7 @@ if (tw) { int charwidth; - default_face_font_info (domain, 0, 0, 0, &charwidth, 0); + default_face_font_info (domain, 0, 0, &charwidth, 0, 0); pw = ROUND_UP (charwidth * tw + 4 * widget_instance_border_width (ii), charwidth); } @@ -827,7 +825,7 @@ } else { - default_face_font_info (domain, 0, 0, &charheight, 0, 0); + default_face_font_info (domain, 0, 0, 0, &charheight, 0); } ph = (charheight + 2 * widget_instance_border_width (ii)) * th; } @@ -949,7 +947,7 @@ { int len, h; /* #### widget face would be better here. */ - default_face_font_info (domain, 0, 0, &h, 0, 0); + default_face_font_info (domain, 0, 0, 0, &h, 0); GET_LIST_LENGTH (items, len); *height = len * h; } @@ -1303,7 +1301,7 @@ size of individual widgets will affect where they get placed. The same is true for several rows of widgets. To solve this problem we introduce the notion of `logical_unit_height'. This is a size - quantity that is designed to be big enough to accomodate the + quantity that is designed to be big enough to accommodate the largest `single height unit'. The function widget_logical_unit_height() determines the value of this in pixels. It is dependent on the widget face and some combination of @@ -1659,7 +1657,7 @@ if (HAS_DEVMETH_P (DOMAIN_XDEVICE (domain), widget_border_width)) border_width = DEVMETH (DOMAIN_XDEVICE (domain), widget_border_width, ()); - default_face_font_info (domain, 0, 0, 0, &charwidth, 0); + default_face_font_info (domain, 0, 0, &charwidth, 0, 0); neww = ROUND_UP (charwidth * w + 4 * border_width + 2 * widget_spacing (domain), charwidth) / charwidth; @@ -1673,7 +1671,7 @@ If the components of a widget layout are justified to the top or the bottom then they are aligned in terms of `logical units'. This is a -size quantity that is designed to be big enough to accomodate the +size quantity that is designed to be big enough to accommodate the largest `single height' widget. It is dependent on the widget face and some combination of spacing and border-width. Thus if you specify top or bottom justification in a vertical layout the subcontrols are laid @@ -1693,7 +1691,7 @@ h = XINT (height); - default_face_font_info (domain, 0, 0, &charheight, 0, 0); + default_face_font_info (domain, 0, 0, 0, &charheight, 0); newh = ROUND_UP (logical_unit_height (Fsymbol_name (Qwidget), Vwidget_face, domain) * h, charheight) / charheight; diff -r 861f2601a38b -r 1f0b15040456 src/glyphs-x.c --- a/src/glyphs-x.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/glyphs-x.c Sun May 01 18:44:03 2011 +0100 @@ -2,25 +2,24 @@ Copyright (C) 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Board of Trustees, University of Illinois. Copyright (C) 1995 Tinker Systems - Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005 Ben Wing + Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005, 2010 Ben Wing Copyright (C) 1995 Sun Microsystems Copyright (C) 1999, 2000, 2002 Andy Piper This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, or (at your +option) any later version. XEmacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -69,7 +68,7 @@ #include "console-x-impl.h" #include "glyphs-x.h" -#include "objects-x-impl.h" +#include "fontcolor-x-impl.h" #include "sysfile.h" #include "sysproc.h" /* for qxe_getpid() */ @@ -1335,8 +1334,7 @@ color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (XCDR (cons))); /* Duplicate the pixel value so that we still have a lock on it if the pixel we were passed is later freed. */ - if (! XAllocColor (dpy, cmap, &color)) - ABORT (); /* it must be allocable since we're just duplicating it */ + assert (XAllocColor (dpy, cmap, &color)); /* it must be allocable since we're just duplicating it */ symbols[i].name = LISP_STRING_TO_EXTERNAL_MALLOC (XCAR (cons), Qctext); diff -r 861f2601a38b -r 1f0b15040456 src/glyphs-x.h --- a/src/glyphs-x.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/glyphs-x.h Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/glyphs.c --- a/src/glyphs.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/glyphs.c Sun May 01 18:44:03 2011 +0100 @@ -4,14 +4,14 @@ Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004, 2005 Ben Wing Copyright (C) 1995 Sun Microsystems Copyright (C) 1998, 1999, 2000 Andy Piper - Copyright (C) 2007 Didier Verna + Copyright (C) 2007, 2010 Didier Verna This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -19,9 +19,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -57,7 +55,7 @@ #include "glyphs.h" #include "gui.h" #include "insdel.h" -#include "objects-impl.h" +#include "fontcolor-impl.h" #include "opaque.h" #include "rangetab.h" #include "redisplay.h" @@ -82,7 +80,7 @@ Lisp_Object Qwidget_image_instance_p; Lisp_Object Qconst_glyph_variable; Lisp_Object Qmono_pixmap, Qcolor_pixmap, Qsubwindow; -Lisp_Object Q_file, Q_data, Q_face, Q_pixel_width, Q_pixel_height; +Lisp_Object Q_file, Q_face, Q_pixel_width, Q_pixel_height; Lisp_Object Qformatted_string; Lisp_Object Vcurrent_display_table; Lisp_Object Vtruncation_glyph, Vcontinuation_glyph, Voctal_escape_glyph; @@ -94,6 +92,7 @@ Lisp_Object Vglyph_type_list; int disable_animated_pixmaps; +static Lisp_Object Vimage_instance_hash_table_test; DEFINE_IMAGE_INSTANTIATOR_FORMAT (nothing); DEFINE_IMAGE_INSTANTIATOR_FORMAT (inherit); @@ -992,7 +991,7 @@ Lisp_Image_Instance *ii = XIMAGE_INSTANCE (obj); if (print_readably) - printing_unreadable_lcrecord (obj, 0); + printing_unreadable_lisp_object (obj, 0); write_fmt_string_lisp (printcharfun, "#name)) @@ -1108,20 +1107,19 @@ MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain), print_image_instance, (ii, printcharfun, escapeflag)); - write_fmt_string (printcharfun, " 0x%x>", ii->header.uid); + write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); } static void -finalize_image_instance (void *header, int for_disksave) -{ - Lisp_Image_Instance *i = (Lisp_Image_Instance *) header; +finalize_image_instance (Lisp_Object obj) +{ + Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj); /* objects like this exist at dump time, so don't bomb out. */ if (IMAGE_INSTANCE_TYPE (i) == IMAGE_NOTHING || NILP (IMAGE_INSTANCE_DEVICE (i))) return; - if (for_disksave) finalose (i); /* We can't use the domain here, because it might have disappeared. */ @@ -1260,7 +1258,7 @@ } static Hashcode -image_instance_hash (Lisp_Object obj, int depth) +image_instance_hash (Lisp_Object obj, int depth, Boolint UNUSED (equalp)) { Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj); Hashcode hash = HASH5 (LISP_HASH (IMAGE_INSTANCE_DOMAIN (i)), @@ -1268,7 +1266,7 @@ IMAGE_INSTANCE_MARGIN_WIDTH (i), IMAGE_INSTANCE_HEIGHT (i), internal_hash (IMAGE_INSTANCE_INSTANTIATOR (i), - depth + 1)); + depth + 1, 0)); ERROR_CHECK_IMAGE_INSTANCE (obj); @@ -1279,7 +1277,7 @@ case IMAGE_TEXT: hash = HASH2 (hash, internal_hash (IMAGE_INSTANCE_TEXT_STRING (i), - depth + 1)); + depth + 1, 0)); break; case IMAGE_MONO_PIXMAP: @@ -1288,7 +1286,7 @@ hash = HASH4 (hash, IMAGE_INSTANCE_PIXMAP_DEPTH (i), IMAGE_INSTANCE_PIXMAP_SLICE (i), internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i), - depth + 1)); + depth + 1, 0)); break; case IMAGE_WIDGET: @@ -1296,10 +1294,12 @@ displayed. */ hash = HASH5 (hash, LISP_HASH (IMAGE_INSTANCE_WIDGET_TYPE (i)), - internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1), - internal_hash (IMAGE_INSTANCE_WIDGET_ITEMS (i), depth + 1), + internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), + depth + 1, 0), + internal_hash (IMAGE_INSTANCE_WIDGET_ITEMS (i), + depth + 1, 0), internal_hash (IMAGE_INSTANCE_LAYOUT_CHILDREN (i), - depth + 1)); + depth + 1, 0)); case IMAGE_SUBWINDOW: hash = HASH2 (hash, (EMACS_INT) IMAGE_INSTANCE_SUBWINDOW_ID (i)); break; @@ -1314,21 +1314,19 @@ 0)); } -DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance, - 0, /*dumpable-flag*/ - mark_image_instance, print_image_instance, - finalize_image_instance, image_instance_equal, - image_instance_hash, - image_instance_description, - Lisp_Image_Instance); +DEFINE_NODUMP_LISP_OBJECT ("image-instance", image_instance, + mark_image_instance, print_image_instance, + finalize_image_instance, image_instance_equal, + image_instance_hash, + image_instance_description, + Lisp_Image_Instance); static Lisp_Object allocate_image_instance (Lisp_Object governing_domain, Lisp_Object parent, Lisp_Object instantiator) { - Lisp_Image_Instance *lp = - ALLOC_LCRECORD_TYPE (Lisp_Image_Instance, &lrecord_image_instance); - Lisp_Object val; + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (image_instance); + Lisp_Image_Instance *lp = XIMAGE_INSTANCE (obj); /* It's not possible to simply keep a record of the domain in which the instance was instantiated. This is because caching may mean @@ -1351,10 +1349,9 @@ /* So that layouts get done. */ lp->layout_changed = 1; - val = wrap_image_instance (lp); MARK_GLYPHS_CHANGED; - return val; + return obj; } static enum image_instance_type @@ -1994,7 +1991,7 @@ device-specific method to copy the window-system subobject. */ new_ = allocate_image_instance (XIMAGE_INSTANCE_DOMAIN (image_instance), Qnil, Qnil); - COPY_LCRECORD (XIMAGE_INSTANCE (new_), XIMAGE_INSTANCE (image_instance)); + copy_lisp_object (new_, image_instance); /* note that if this method returns non-zero, this method MUST copy any window-system resources, so that when one image instance is freed, the other one is not hosed. */ @@ -2521,15 +2518,16 @@ /* pixmap file functions */ /************************************************************************/ -/* If INSTANTIATOR refers to inline data, return Qt. - If INSTANTIATOR refers to data in a file, return the full filename - if it exists, Qnil if there's no console method for locating the file, or - (filename) if there was an error locating the file. +/* - If INSTANTIATOR refers to inline data, or there is no file keyword, we + have nothing to do, so return Qt. + - If INSTANTIATOR refers to data in a file, return the full filename + if it exists; otherwise, return '(filename), meaning "file not found". + - If there is no locate_pixmap_file method for this console, return Qnil. FILE_KEYWORD and DATA_KEYWORD are symbols specifying the keywords used to look up the file and inline data, - respectively, in the instantiator. Normally these would - be Q_file and Q_data, but might be different for mask data. */ + respectively, in the instantiator. These would be Q_file and Q_data, + Q_mask_file or Q_mask_data. */ Lisp_Object potential_pixmap_file_instantiator (Lisp_Object instantiator, @@ -2630,7 +2628,7 @@ static void check_valid_xbm_inline (Lisp_Object data) { - Lisp_Object width, height, bits; + Lisp_Object width, height, bits, args[2]; if (!CONSP (data) || !CONSP (XCDR (data)) || @@ -2650,7 +2648,16 @@ if (!NATNUMP (height)) invalid_argument ("Height must be a natural number", height); - if (((XINT (width) * XINT (height)) / 8) > string_char_length (bits)) + args[0] = width; + args[1] = height; + + args[0] = Ftimes (countof (args), args); + args[1] = make_integer (8); + + args[0] = Fquo (countof (args), args); + args[1] = make_integer (string_char_length (bits)); + + if (!NILP (Fgtr (countof (args), args))) invalid_argument ("data is too short for width and height", vector3 (width, height, bits)); } @@ -2736,18 +2743,20 @@ return Qnil; /* not reached */ } +/* This function attempts to find implicit mask files by appending "Mask" or + "msk" to the original bitmap file name. This is more or less standard: a + number of bitmaps in /usr/include/X11/bitmaps use it. */ Lisp_Object xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file, Lisp_Object mask_file, Lisp_Object console_type) { - /* This is unclean but it's fairly standard -- a number of the - bitmaps in /usr/include/X11/bitmaps use it -- so we support - it. */ - if (EQ (mask_file, Qt) - /* don't override explicitly specified mask data. */ - && NILP (assq_no_quit (Q_mask_data, alist)) - && !EQ (file, Qt)) + /* Let's try to find an implicit mask file if we have neither an explicit + mask file name, nor inline mask data. Note that no errors are reported in + case of failure because the mask file we're looking for might not + exist. */ + if (EQ (mask_file, Qt) && NILP (assq_no_quit (Q_mask_data, alist))) { + assert (!EQ (file, Qt) && !EQ (file, Qnil)); mask_file = MAYBE_LISP_CONTYPE_METH (decode_console_type(console_type, ERROR_ME), locate_pixmap_file, (concat2 (file, build_ascstring ("Mask")))); @@ -2757,10 +2766,14 @@ locate_pixmap_file, (concat2 (file, build_ascstring ("msk")))); } + /* We got a mask file, either explicitely or from the search above. */ if (!NILP (mask_file)) { - Lisp_Object mask_data = - bitmap_to_lisp_data (mask_file, 0, 0, 0); + Lisp_Object mask_data; + + assert (!EQ (mask_file, Qt)); + + mask_data = bitmap_to_lisp_data (mask_file, 0, 0, 0); alist = remassq_no_quit (Q_mask_file, alist); /* there can't be a :mask-data at this point. */ alist = Fcons (Fcons (Q_mask_file, mask_file), @@ -2776,9 +2789,8 @@ xbm_normalize (Lisp_Object inst, Lisp_Object console_type, Lisp_Object UNUSED (dest_mask)) { - Lisp_Object file = Qnil, mask_file = Qnil; + Lisp_Object file = Qnil, mask_file = Qnil, alist = Qnil; struct gcpro gcpro1, gcpro2, gcpro3; - Lisp_Object alist = Qnil; GCPRO3 (file, mask_file, alist); @@ -2796,7 +2808,9 @@ mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file, Q_mask_data, console_type); - if (NILP (file)) /* normalization impossible for the console type */ + /* No locate_pixmap_file method for this console type, so we can't get a + file (neither a mask file BTW). */ + if (NILP (file)) RETURN_UNGCPRO (Qnil); if (CONSP (file)) /* failure locating filename */ @@ -2804,6 +2818,11 @@ "no such file or directory", Fcar (file)); + if (CONSP (mask_file)) /* failure locating filename */ + signal_double_image_error ("Opening bitmap mask file", + "no such file or directory", + Fcar (mask_file)); + if (EQ (file, Qt) && EQ (mask_file, Qt)) /* no conversion necessary */ RETURN_UNGCPRO (inst); @@ -2863,10 +2882,8 @@ xface_normalize (Lisp_Object inst, Lisp_Object console_type, Lisp_Object UNUSED (dest_mask)) { - /* This function can call lisp */ - Lisp_Object file = Qnil, mask_file = Qnil; + Lisp_Object file = Qnil, mask_file = Qnil, alist = Qnil; struct gcpro gcpro1, gcpro2, gcpro3; - Lisp_Object alist = Qnil; GCPRO3 (file, mask_file, alist); @@ -2884,28 +2901,34 @@ mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file, Q_mask_data, console_type); - if (NILP (file)) /* normalization impossible for the console type */ + /* No locate_pixmap_file method for this console type, so we can't get a + file (neither a mask file BTW). */ + if (NILP (file)) RETURN_UNGCPRO (Qnil); if (CONSP (file)) /* failure locating filename */ - signal_double_image_error ("Opening bitmap file", + signal_double_image_error ("Opening face file", "no such file or directory", Fcar (file)); + if (CONSP (mask_file)) /* failure locating filename */ + signal_double_image_error ("Opening face mask file", + "no such file or directory", + Fcar (mask_file)); + if (EQ (file, Qt) && EQ (mask_file, Qt)) /* no conversion necessary */ RETURN_UNGCPRO (inst); alist = tagged_vector_to_alist (inst); - { - /* #### FIXME: what if EQ (file, Qt) && !EQ (mask, Qt) ? Is that possible? - If so, we have a problem... -- dvl */ - Lisp_Object data = make_string_from_file (file); - alist = remassq_no_quit (Q_file, alist); - /* there can't be a :data at this point. */ - alist = Fcons (Fcons (Q_file, file), - Fcons (Fcons (Q_data, data), alist)); - } + if (!EQ (file, Qt)) + { + Lisp_Object data = make_string_from_file (file); + alist = remassq_no_quit (Q_file, alist); + /* there can't be a :data at this point. */ + alist = Fcons (Fcons (Q_file, file), + Fcons (Fcons (Q_data, data), alist)); + } alist = xbm_mask_file_munging (alist, file, mask_file, console_type); @@ -3189,29 +3212,29 @@ } static int -instantiator_eq_equal (Lisp_Object obj1, Lisp_Object obj2) +instantiator_eq_equal (const Hash_Table_Test *UNUSED (http), + Lisp_Object obj1, Lisp_Object obj2) { if (EQ (obj1, obj2)) return 1; else if (CONSP (obj1) && CONSP (obj2)) { - return instantiator_eq_equal (XCAR (obj1), XCAR (obj2)) - && - instantiator_eq_equal (XCDR (obj1), XCDR (obj2)); + return instantiator_eq_equal (NULL, XCAR (obj1), XCAR (obj2)) + && instantiator_eq_equal (NULL, XCDR (obj1), XCDR (obj2)); } return 0; } static Hashcode -instantiator_eq_hash (Lisp_Object obj) +instantiator_eq_hash (const Hash_Table_Test *UNUSED (http), Lisp_Object obj) { if (CONSP (obj)) { /* no point in worrying about tail recursion, since we're not going very deep */ - return HASH2 (instantiator_eq_hash (XCAR (obj)), - instantiator_eq_hash (XCDR (obj))); + return HASH2 (instantiator_eq_hash (NULL, XCAR (obj)), + instantiator_eq_hash (NULL, XCDR (obj))); } return LISP_HASH (obj); } @@ -3220,10 +3243,9 @@ Lisp_Object make_image_instance_cache_hash_table (void) { - return make_general_lisp_hash_table - (instantiator_eq_hash, instantiator_eq_equal, - 30, -1.0, -1.0, - HASH_TABLE_KEY_CAR_VALUE_WEAK); + return make_general_lisp_hash_table (Vimage_instance_hash_table_test, 30, + -1.0, -1.0, + HASH_TABLE_KEY_CAR_VALUE_WEAK); } static Lisp_Object @@ -3694,11 +3716,11 @@ Lisp_Glyph *glyph = XGLYPH (obj); if (print_readably) - printing_unreadable_lcrecord (obj, 0); + printing_unreadable_lisp_object (obj, 0); write_fmt_string_lisp (printcharfun, "#image); - write_fmt_string (printcharfun, "0x%x>", glyph->header.uid); + write_fmt_string (printcharfun, "0x%x>", LISP_OBJECT_UID (obj)); } /* Glyphs are equal if all of their display attributes are equal. We @@ -3724,14 +3746,14 @@ } static Hashcode -glyph_hash (Lisp_Object obj, int depth) +glyph_hash (Lisp_Object obj, int depth, Boolint UNUSED (equalp)) { depth++; /* No need to hash all of the elements; that would take too long. Just hash the most common ones. */ - return HASH2 (internal_hash (XGLYPH (obj)->image, depth), - internal_hash (XGLYPH (obj)->face, depth)); + return HASH2 (internal_hash (XGLYPH (obj)->image, depth, 0), + internal_hash (XGLYPH (obj)->face, depth, 0)); } static Lisp_Object @@ -3805,14 +3827,11 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph, - 1, /*dumpable-flag*/ - mark_glyph, print_glyph, 0, - glyph_equal, glyph_hash, - glyph_description, - glyph_getprop, glyph_putprop, - glyph_remprop, glyph_plist, - Lisp_Glyph); +DEFINE_DUMPABLE_LISP_OBJECT ("glyph", glyph, + mark_glyph, print_glyph, 0, + glyph_equal, glyph_hash, + glyph_description, + Lisp_Glyph); Lisp_Object allocate_glyph (enum glyph_type type, @@ -3820,8 +3839,8 @@ Lisp_Object locale)) { /* This function can GC */ - Lisp_Object obj = Qnil; - Lisp_Glyph *g = ALLOC_LCRECORD_TYPE (Lisp_Glyph, &lrecord_glyph); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (glyph); + Lisp_Glyph *g = XGLYPH (obj); g->type = type; g->image = Fmake_specifier (Qimage); /* This function can GC */ @@ -3867,7 +3886,6 @@ g->face = Qnil; g->plist = Qnil; g->after_change = after_change; - obj = wrap_glyph (g); set_image_attached_to (g->image, obj, Qimage); UNGCPRO; @@ -4465,12 +4483,12 @@ int compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels, - struct overhead_stats *ovstats) + struct usage_stats *ustats) { int total = 0; if (glyph_cachels) - total += Dynarr_memory_usage (glyph_cachels, ovstats); + total += Dynarr_memory_usage (glyph_cachels, ustats); return total; } @@ -4537,7 +4555,7 @@ XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)) = delq_no_quit (value, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))); - finalize_image_instance (XIMAGE_INSTANCE (value), 0); + finalize_image_instance (value); } } return 0; @@ -4640,7 +4658,7 @@ struct expose_ignore *ei; #ifdef NEW_GC - ei = alloc_lrecord_type (struct expose_ignore, &lrecord_expose_ignore); + ei = XEXPOSE_IGNORE (ALLOC_NORMAL_LISP_OBJECT (expose_ignore)); #else /* not NEW_GC */ ei = Blocktype_alloc (the_expose_ignore_blocktype); #endif /* not NEW_GC */ @@ -4750,7 +4768,8 @@ we might need. We can get better hashing by making the depth negative - currently it will recurse down 7 levels.*/ IMAGE_INSTANCE_DISPLAY_HASH (ii) = internal_hash (subwindow, - IMAGE_INSTANCE_HASH_DEPTH); + IMAGE_INSTANCE_HASH_DEPTH, + 0); unbind_to (count); } @@ -4769,7 +4788,7 @@ { Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); - if (internal_hash (subwindow, IMAGE_INSTANCE_HASH_DEPTH) != + if (internal_hash (subwindow, IMAGE_INSTANCE_HASH_DEPTH, 0) != IMAGE_INSTANCE_DISPLAY_HASH (ii)) return 1; /* #### I think there is probably a bug here. This gets called for @@ -5175,10 +5194,19 @@ *****************************************************************************/ void +glyph_objects_create (void) +{ + OBJECT_HAS_METHOD (glyph, getprop); + OBJECT_HAS_METHOD (glyph, putprop); + OBJECT_HAS_METHOD (glyph, remprop); + OBJECT_HAS_METHOD (glyph, plist); +} + +void syms_of_glyphs (void) { - INIT_LRECORD_IMPLEMENTATION (glyph); - INIT_LRECORD_IMPLEMENTATION (image_instance); + INIT_LISP_OBJECT (glyph); + INIT_LISP_OBJECT (image_instance); /* image instantiators */ @@ -5188,7 +5216,6 @@ DEFSUBR (Fconsole_type_image_conversion_list); DEFKEYWORD (Q_file); - DEFKEYWORD (Q_data); DEFKEYWORD (Q_face); DEFKEYWORD (Q_pixel_height); DEFKEYWORD (Q_pixel_width); @@ -5506,6 +5533,12 @@ Qpointer, Qsubwindow, Qwidget)); staticpro (&Vimage_instance_type_list); + /* The Qunbound name means this test is not available from Lisp. */ + Vimage_instance_hash_table_test + = define_hash_table_test (Qunbound, instantiator_eq_equal, + instantiator_eq_hash, Qunbound, Qunbound); + staticpro (&Vimage_instance_hash_table_test); + /* glyphs */ Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon); diff -r 861f2601a38b -r 1f0b15040456 src/glyphs.h --- a/src/glyphs.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/glyphs.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -432,7 +430,7 @@ /* Image Instance Object */ /************************************************************************/ -DECLARE_LRECORD (image_instance, Lisp_Image_Instance); +DECLARE_LISP_OBJECT (image_instance, Lisp_Image_Instance); #define XIMAGE_INSTANCE(x) XRECORD (x, image_instance, Lisp_Image_Instance) #define wrap_image_instance(p) wrap_record (p, image_instance) #define IMAGE_INSTANCEP(x) RECORDP (x, image_instance) @@ -596,7 +594,7 @@ struct Lisp_Image_Instance { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; Lisp_Object domain; /* The domain in which we were cached. */ Lisp_Object device; /* The device of the domain. Recorded since the domain may get deleted @@ -948,7 +946,7 @@ struct Lisp_Glyph { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; enum glyph_type type; @@ -968,7 +966,7 @@ }; typedef struct Lisp_Glyph Lisp_Glyph; -DECLARE_LRECORD (glyph, Lisp_Glyph); +DECLARE_LISP_OBJECT (glyph, Lisp_Glyph); #define XGLYPH(x) XRECORD (x, glyph, Lisp_Glyph) #define wrap_glyph(p) wrap_record (p, glyph) #define GLYPHP(x) RECORDP (x, glyph) @@ -1010,7 +1008,7 @@ #define MARK_GLYPH_CHANGED(g) (GLYPH_DIRTYP (g) = 1); extern Lisp_Object Qxpm, Qxface, Qetched_in, Qetched_out, Qbevel_in, Qbevel_out; -extern Lisp_Object Q_data, Q_file, Q_color_symbols, Qconst_glyph_variable; +extern Lisp_Object Q_file, Q_color_symbols, Qconst_glyph_variable; extern Lisp_Object Qxbm, Qedit_field, Qgroup, Qlabel, Qcombo_box, Qscrollbar; extern Lisp_Object Qtree_view, Qtab_control, Qprogress_gauge; extern Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y; @@ -1070,7 +1068,7 @@ struct glyph_cachel { #ifdef NEW_GC - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; #endif /* NEW_GC */ Lisp_Object glyph; @@ -1090,7 +1088,7 @@ #ifdef NEW_GC typedef struct glyph_cachel Lisp_Glyph_Cachel; -DECLARE_LRECORD (glyph_cachel, Lisp_Glyph_Cachel); +DECLARE_LISP_OBJECT (glyph_cachel, Lisp_Glyph_Cachel); #define XGLYPH_CACHEL(x) \ XRECORD (x, glyph_cachel, Lisp_Glyph_Cachel) @@ -1165,7 +1163,7 @@ #ifdef MEMORY_USAGE_STATS int compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels, - struct overhead_stats *ovstats); + struct usage_stats *ustats); #endif /* MEMORY_USAGE_STATS */ /************************************************************************/ @@ -1198,7 +1196,7 @@ struct expose_ignore { #ifdef NEW_GC - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; #endif /* NEW_GC */ int x, y; int width, height; @@ -1206,7 +1204,7 @@ }; #ifdef NEW_GC -DECLARE_LRECORD (expose_ignore, struct expose_ignore); +DECLARE_LISP_OBJECT (expose_ignore, struct expose_ignore); #define XEXPOSE_IGNORE(x) XRECORD (x, expose_ignore, struct expose_ignore) #define wrap_expose_ignore(p) wrap_record (p, expose_ignore) #define EXPOSE_IGNOREP(x) RECORDP (x, expose_ignore) diff -r 861f2601a38b -r 1f0b15040456 src/gmalloc.c --- a/src/gmalloc.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/gmalloc.c Sun May 01 18:44:03 2011 +0100 @@ -40,20 +40,18 @@ Copyright 1990, 1991, 1992, 1993 Free Software Foundation, Inc. Written May 1989 by Mike Haertel. -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public License as -published by the Free Software Foundation; either version 2 of the -License, or (at your option) any later version. +This library 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 3 of the License, or (at your +option) any later version. -This library 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 -Library General Public License for more details. +This library 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 this library; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. +along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation, Inc. */ @@ -302,20 +300,18 @@ /* Allocate memory on a page boundary. Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public License as -published by the Free Software Foundation; either version 2 of the -License, or (at your option) any later version. +This library 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 3 of the License, or (at your +option) any later version. -This library 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 -Library General Public License for more details. +This library 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 this library; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. +along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation, Inc. */ @@ -350,20 +346,18 @@ Copyright 1990, 1991, 1992, 1993, 1994 Free Software Foundation Written May 1989 by Mike Haertel. -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public License as -published by the Free Software Foundation; either version 2 of the -License, or (at your option) any later version. +This library 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 3 of the License, or (at your +option) any later version. -This library 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 -Library General Public License for more details. +This library 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 this library; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. +along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation, Inc. */ @@ -744,20 +738,18 @@ Copyright 1990, 1991, 1992, 1994 Free Software Foundation Written May 1989 by Mike Haertel. -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public License as -published by the Free Software Foundation; either version 2 of the -License, or (at your option) any later version. +This library 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 3 of the License, or (at your +option) any later version. -This library 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 -Library General Public License for more details. +This library 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 this library; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. +along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation, Inc. */ @@ -957,20 +949,18 @@ /* Copyright (C) 1991, 1993, 1994 Free Software Foundation, Inc. This file is part of the GNU C Library. -The GNU C Library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public License as -published by the Free Software Foundation; either version 2 of the -License, or (at your option) any later version. +The GNU C Library 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 3 of the License, or (at your +option) any later version. -The GNU C Library 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 -Library General Public License for more details. +The GNU C Library 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 this library; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with the GNU C Library. If not, see . */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL @@ -1001,20 +991,18 @@ Copyright 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. Written May 1989 by Mike Haertel. -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public License as -published by the Free Software Foundation; either version 2 of the -License, or (at your option) any later version. +This library 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 3 of the License, or (at your +option) any later version. -This library 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 -Library General Public License for more details. +This library 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 this library; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. +along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation, Inc. */ @@ -1157,20 +1145,18 @@ } /* Copyright (C) 1991, 1992, 1994 Free Software Foundation, Inc. -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public License as -published by the Free Software Foundation; either version 2 of the -License, or (at your option) any later version. +This library 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 3 of the License, or (at your +option) any later version. -This library 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 -Library General Public License for more details. +This library 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 this library; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. +along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation, Inc. */ @@ -1195,20 +1181,18 @@ /* Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc. This file is part of the GNU C Library. -The GNU C Library 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. +The GNU C Library 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 3 of the License, or (at your +option) any later version. -The GNU C Library 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. +The GNU C Library 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 the GNU C Library; see the file COPYING. If not, write to -the Free the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with the GNU C Library. If not, see . */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL @@ -1244,20 +1228,18 @@ } /* Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public License as -published by the Free Software Foundation; either version 2 of the -License, or (at your option) any later version. +This library 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 3 of the License, or (at your +option) any later version. -This library 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 -Library General Public License for more details. +This library 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 this library; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with this library. If not, see . */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL diff -r 861f2601a38b -r 1f0b15040456 src/gpmevent.c --- a/src/gpmevent.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/gpmevent.c Sun May 01 18:44:03 2011 +0100 @@ -5,20 +5,18 @@ This file is part of XEmacs. - XEmacs is free software; you can redistribute it and/or modify it + 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. - + Free Software Foundation, either version 3 of the License, or (at your + option) any later version. + XEmacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. - + You should have received a copy of the GNU General Public License - along with XEmacs; see the file COPYING. If not, write to - the Free Software Foundation, Inc., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ + along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/gpmevent.h --- a/src/gpmevent.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/gpmevent.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ #ifndef INCLUDED_gpmevent_h_ #define INCLUDED_gpmevent_h_ diff -r 861f2601a38b -r 1f0b15040456 src/gtk-glue.c --- a/src/gtk-glue.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/gtk-glue.c Sun May 01 18:44:03 2011 +0100 @@ -1,10 +1,13 @@ -/* +/* gtk-glue.c --- GTK interfaces with XEmacs + +Copyright (C) 2000, 2001 William M. Perry + This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -12,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -Boston, MA 02111-1301, USA. */ +along with XEmacs. If not, see . */ GtkType GTK_TYPE_ARRAY = 0; GtkType GTK_TYPE_STRING_ARRAY = 0; @@ -26,7 +27,7 @@ GtkType GTK_TYPE_GDK_GC = 0; #include "console-gtk.h" -#include "objects-gtk-impl.h" +#include "fontcolor-gtk-impl.h" static GtkType xemacs_type_register (gchar *name, GtkType parent) @@ -208,17 +209,21 @@ static GdkGC * face_to_gc (Lisp_Object face) { - Lisp_Object device = Fselected_device (Qnil); + Lisp_Object frame = Fselected_frame (Qnil); - return (gtk_get_gc (XDEVICE (device), + return (gtk_get_gc (XFRAME (frame), Fspecifier_instance (Fget (face, Qfont, Qnil), - device, Qnil, Qnil), + frame, Qnil, Qnil), Fspecifier_instance (Fget (face, Qforeground, Qnil), - device, Qnil, Qnil), + frame, Qnil, Qnil), Fspecifier_instance (Fget (face, Qbackground, Qnil), - device, Qnil, Qnil), + frame, Qnil, Qnil), Fspecifier_instance (Fget (face, Qbackground_pixmap, - Qnil), device, Qnil, Qnil), + Qnil), + frame, Qnil, Qnil), + Fspecifier_instance (Fget (face, Qbackground_placement, + Qnil), + frame, Qnil, Qnil), Qnil)); } diff -r 861f2601a38b -r 1f0b15040456 src/gtk-xemacs.c --- a/src/gtk-xemacs.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/gtk-xemacs.c Sun May 01 18:44:03 2011 +0100 @@ -4,23 +4,22 @@ ** ** Created by: William M. Perry ** Copyright (c) 2000 William M. Perry +** Copyright (C) 2010 Ben Wing. ** ** This file is part of XEmacs. ** -** XEmacs is free software; you can redistribute it and/or modify it +** 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. -** +** Free Software Foundation, either version 3 of the License, or (at your +** option) any later version. +** ** XEmacs is distributed in the hope that it will be useful, but WITHOUT ** ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ** FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ** for more details. -** +** ** You should have received a copy of the GNU General Public License -** along with XEmacs; see the file COPYING. If not, write to -** the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -** Boston, MA 02111-1301, USA. */ +** along with XEmacs. If not, see . */ #include @@ -35,7 +34,7 @@ #include "console-gtk-impl.h" #include "device-impl.h" #include "gtk-xemacs.h" -#include "objects-gtk.h" +#include "fontcolor-gtk.h" extern Lisp_Object Vmodeline_face; extern Lisp_Object Vscrollbar_on_left_p; @@ -130,7 +129,7 @@ frame. Well, wait, we do... otherwise there sre weird 'seethru' areas - even when XEmacs does a full redisplay. Most noticable in some + even when XEmacs does a full redisplay. Most noticeable in some areas of the modeline, or in the right-hand-side of the window between the scrollbar ad n the edge of the window. */ @@ -147,7 +146,7 @@ extern Lisp_Object xemacs_gtk_convert_color(GdkColor *c, GtkWidget *w); -/* From objects-gtk.c */ +/* From fontcolor-gtk.c */ extern Lisp_Object __get_gtk_font_truename (GdkFont *gdk_font, int expandp); #define convert_font(f) __get_gtk_font_truename (f, 0) @@ -275,7 +274,7 @@ if (f) { - char_to_pixel_size (f, FRAME_WIDTH (f), FRAME_HEIGHT (f), + frame_unit_to_pixel_size (f, FRAME_WIDTH (f), FRAME_HEIGHT (f), &width, &height); requisition->width = width; requisition->height = height; @@ -344,11 +343,11 @@ f->pixwidth = allocation->width; f->pixheight = allocation->height; - pixel_to_char_size (f, + pixel_to_frame_unit_size (f, allocation->width, allocation->height, &columns, &rows); - change_frame_size (f, rows, columns, 1); + change_frame_size (f, columns, rows, 1); } } diff -r 861f2601a38b -r 1f0b15040456 src/gtk-xemacs.h --- a/src/gtk-xemacs.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/gtk-xemacs.h Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ** ** This file is part of XEmacs. ** -** XEmacs is free software; you can redistribute it and/or modify it +** 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. -** +** Free Software Foundation, either version 3 of the License, or (at your +** option) any later version. +** ** XEmacs is distributed in the hope that it will be useful, but WITHOUT ** ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ** FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ** for more details. -** +** ** You should have received a copy of the GNU General Public License -** along with XEmacs; see the file COPYING. If not, write to -** the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -** Boston, MA 02111-1301, USA. */ +** along with XEmacs. If not, see . */ #ifndef __GTK_XEMACS_H__ #define __GTK_XEMACS_H__ diff -r 861f2601a38b -r 1f0b15040456 src/gui-gtk.c --- a/src/gui-gtk.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/gui-gtk.c Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/gui-msw.c --- a/src/gui-msw.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/gui-msw.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/gui-x.c --- a/src/gui-x.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/gui-x.c Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/gui.c --- a/src/gui.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/gui.c Sun May 01 18:44:03 2011 +0100 @@ -1,15 +1,15 @@ /* Generic GUI code. (menubars, scrollbars, toolbars, dialogs) Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003 Ben Wing. + Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003, 2010 Ben Wing. Copyright (C) 1995 Sun Microsystems, Inc. Copyright (C) 1998 Free Software Foundation, Inc. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -197,14 +195,10 @@ Lisp_Object allocate_gui_item (void) { - Lisp_Gui_Item *lp = ALLOC_LCRECORD_TYPE (Lisp_Gui_Item, &lrecord_gui_item); - Lisp_Object val; + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (gui_item); - val = wrap_gui_item (lp); - - gui_item_init (val); - - return val; + gui_item_init (obj); + return obj; } /* @@ -600,28 +594,28 @@ } static Hashcode -gui_item_hash (Lisp_Object obj, int depth) +gui_item_hash (Lisp_Object obj, int depth, Boolint UNUSED (equalp)) { Lisp_Gui_Item *p = XGUI_ITEM (obj); - return HASH2 (HASH6 (internal_hash (p->name, depth + 1), - internal_hash (p->callback, depth + 1), - internal_hash (p->callback_ex, depth + 1), - internal_hash (p->suffix, depth + 1), - internal_hash (p->active, depth + 1), - internal_hash (p->included, depth + 1)), - HASH6 (internal_hash (p->config, depth + 1), - internal_hash (p->filter, depth + 1), - internal_hash (p->style, depth + 1), - internal_hash (p->selected, depth + 1), - internal_hash (p->keys, depth + 1), - internal_hash (p->value, depth + 1))); + return HASH2 (HASH6 (internal_hash (p->name, depth + 1, 0), + internal_hash (p->callback, depth + 1, 0), + internal_hash (p->callback_ex, depth + 1, 0), + internal_hash (p->suffix, depth + 1, 0), + internal_hash (p->active, depth + 1, 0), + internal_hash (p->included, depth + 1, 0)), + HASH6 (internal_hash (p->config, depth + 1, 0), + internal_hash (p->filter, depth + 1, 0), + internal_hash (p->style, depth + 1, 0), + internal_hash (p->selected, depth + 1, 0), + internal_hash (p->keys, depth + 1, 0), + internal_hash (p->value, depth + 1, 0))); } int gui_item_id_hash (Lisp_Object hashtable, Lisp_Object gitem, int slot) { - int hashid = gui_item_hash (gitem, 0); + int hashid = gui_item_hash (gitem, 0, 0); int id = GUI_ITEM_ID_BITS (hashid, slot); while (!UNBOUNDP (Fgethash (make_int (id), hashtable, Qunbound))) { @@ -690,18 +684,6 @@ return 1; } -static void -print_gui_item (Lisp_Object obj, Lisp_Object printcharfun, - int UNUSED (escapeflag)) -{ - Lisp_Gui_Item *g = XGUI_ITEM (obj); - - if (print_readably) - printing_unreadable_lcrecord (obj, 0); - - write_fmt_string (printcharfun, "#", g->header.uid); -} - Lisp_Object copy_gui_item (Lisp_Object gui_item) { @@ -807,13 +789,12 @@ RETURN_UNGCPRO (ret); } -DEFINE_LRECORD_IMPLEMENTATION ("gui-item", gui_item, - 0, /*dumpable-flag*/ - mark_gui_item, print_gui_item, - 0, gui_item_equal, - gui_item_hash, - gui_item_description, - Lisp_Gui_Item); +DEFINE_NODUMP_LISP_OBJECT ("gui-item", gui_item, + mark_gui_item, external_object_printer, + 0, gui_item_equal, + gui_item_hash, + gui_item_description, + Lisp_Gui_Item); DOESNT_RETURN gui_error (const Ascbyte *reason, Lisp_Object frob) @@ -830,7 +811,7 @@ void syms_of_gui (void) { - INIT_LRECORD_IMPLEMENTATION (gui_item); + INIT_LISP_OBJECT (gui_item); DEFSYMBOL (Qmenu_no_selection_hook); diff -r 861f2601a38b -r 1f0b15040456 src/gui.h --- a/src/gui.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/gui.h Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -44,7 +42,7 @@ menu item or submenu properties */ struct Lisp_Gui_Item { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; Lisp_Object name; /* String */ Lisp_Object callback; /* Symbol or form */ Lisp_Object callback_ex; /* Form taking context arguments */ @@ -60,7 +58,7 @@ Lisp_Object value; /* Anything you like */ }; -DECLARE_LRECORD (gui_item, Lisp_Gui_Item); +DECLARE_LISP_OBJECT (gui_item, Lisp_Gui_Item); #define XGUI_ITEM(x) XRECORD (x, gui_item, Lisp_Gui_Item) #define wrap_gui_item(p) wrap_record (p, gui_item) #define GUI_ITEMP(x) RECORDP (x, gui_item) diff -r 861f2601a38b -r 1f0b15040456 src/gutter.c --- a/src/gutter.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/gutter.c Sun May 01 18:44:03 2011 +0100 @@ -1,12 +1,13 @@ /* Gutter implementation. Copyright (C) 1999, 2000 Andy Piper. + Copyright (C) 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -35,10 +34,10 @@ #include "window.h" #include "gutter.h" -Lisp_Object Vgutter[4]; -Lisp_Object Vgutter_size[4]; -Lisp_Object Vgutter_visible_p[4]; -Lisp_Object Vgutter_border_width[4]; +Lisp_Object Vgutter[NUM_EDGES]; +Lisp_Object Vgutter_size[NUM_EDGES]; +Lisp_Object Vgutter_visible_p[NUM_EDGES]; +Lisp_Object Vgutter_border_width[NUM_EDGES]; Lisp_Object Vdefault_gutter, Vdefault_gutter_visible_p; Lisp_Object Vdefault_gutter_width, Vdefault_gutter_height; @@ -51,46 +50,7 @@ Lisp_Object Qdefault_gutter_position_changed_hook; static void -update_gutter_geometry (struct frame *f, enum gutter_pos pos); - -#define SET_GUTTER_WAS_VISIBLE_FLAG(frame, pos, flag) \ - do { \ - switch (pos) \ - { \ - case TOP_GUTTER: \ - (frame)->top_gutter_was_visible = flag; \ - break; \ - case BOTTOM_GUTTER: \ - (frame)->bottom_gutter_was_visible = flag; \ - break; \ - case LEFT_GUTTER: \ - (frame)->left_gutter_was_visible = flag; \ - break; \ - case RIGHT_GUTTER: \ - (frame)->right_gutter_was_visible = flag; \ - break; \ - default: \ - ABORT (); \ - } \ - } while (0) - -static int gutter_was_visible (struct frame* frame, enum gutter_pos pos) -{ - switch (pos) - { - case TOP_GUTTER: - return frame->top_gutter_was_visible; - case BOTTOM_GUTTER: - return frame->bottom_gutter_was_visible; - case LEFT_GUTTER: - return frame->left_gutter_was_visible; - case RIGHT_GUTTER: - return frame->right_gutter_was_visible; - default: - ABORT (); - return 0; /* To keep the compiler happy */ - } -} +update_gutter_geometry (struct frame *f, enum edge_pos pos); #if 0 static Lisp_Object @@ -171,46 +131,48 @@ if it is not the window nearest the gutter. Instead we predetermine the nearest window and then use that.*/ static void -get_gutter_coords (struct frame *f, enum gutter_pos pos, int *x, int *y, +get_gutter_coords (struct frame *f, enum edge_pos pos, int *x, int *y, int *width, int *height) { - struct window - * bot = XWINDOW (frame_bottommost_window (f)); + /* We use the bottommost window (not the minibuffer, but the bottommost + non-minibuffer window) rather than any FRAME_BOTTOM_GUTTER_START + because the gutter goes *above* the minibuffer -- for this same reason, + FRAME_BOTTOM_GUTTER_START isn't currently defined. */ + struct window *bot = XWINDOW (frame_bottommost_window (f)); /* The top and bottom gutters take precedence over the left and right. */ switch (pos) { - case TOP_GUTTER: - *x = FRAME_LEFT_BORDER_END (f); - *y = FRAME_TOP_BORDER_END (f); - *width = FRAME_RIGHT_BORDER_START (f) - - FRAME_LEFT_BORDER_END (f); + case TOP_EDGE: + *x = FRAME_LEFT_GUTTER_START (f); + *y = FRAME_TOP_GUTTER_START (f); + *width = FRAME_RIGHT_GUTTER_END (f) - *x; *height = FRAME_TOP_GUTTER_BOUNDS (f); break; - case BOTTOM_GUTTER: - *x = FRAME_LEFT_BORDER_END (f); + case BOTTOM_EDGE: + *x = FRAME_LEFT_GUTTER_START (f); +#ifdef BOTTOM_GUTTER_IS_OUTSIDE_MINIBUFFER + *y = FRAME_BOTTOM_GUTTER_START (f); +#else *y = WINDOW_BOTTOM (bot); - *width = FRAME_RIGHT_BORDER_START (f) - - FRAME_LEFT_BORDER_END (f); +#endif + *width = FRAME_RIGHT_GUTTER_END (f) - *x; *height = FRAME_BOTTOM_GUTTER_BOUNDS (f); break; - case LEFT_GUTTER: - *x = FRAME_LEFT_BORDER_END (f); - *y = FRAME_TOP_BORDER_END (f) + FRAME_TOP_GUTTER_BOUNDS (f); + case LEFT_EDGE: + *x = FRAME_LEFT_GUTTER_START (f); + *y = FRAME_TOP_GUTTER_END (f); *width = FRAME_LEFT_GUTTER_BOUNDS (f); - *height = WINDOW_BOTTOM (bot) - - (FRAME_TOP_BORDER_END (f) + FRAME_TOP_GUTTER_BOUNDS (f)); + *height = WINDOW_BOTTOM (bot) - *y; break; - case RIGHT_GUTTER: - *x = FRAME_RIGHT_BORDER_START (f) - - FRAME_RIGHT_GUTTER_BOUNDS (f); - *y = FRAME_TOP_BORDER_END (f) + FRAME_TOP_GUTTER_BOUNDS (f); + case RIGHT_EDGE: + *x = FRAME_RIGHT_GUTTER_START (f); + *y = FRAME_TOP_GUTTER_END (f); *width = FRAME_RIGHT_GUTTER_BOUNDS (f); - *height = WINDOW_BOTTOM (bot) - - (FRAME_TOP_BORDER_END (f) + FRAME_TOP_GUTTER_BOUNDS (f)); + *height = WINDOW_BOTTOM (bot) - *y; break; default: @@ -229,8 +191,8 @@ int display_boxes_in_gutter_p (struct frame *f, struct display_box* db, struct display_glyph_area* dga) { - enum gutter_pos pos; - GUTTER_POS_LOOP (pos) + enum edge_pos pos; + EDGE_POS_LOOP (pos) { if (FRAME_GUTTER_VISIBLE (f, pos)) { @@ -256,7 +218,7 @@ /* Convert the gutter specifier into something we can actually display. */ static Lisp_Object construct_window_gutter_spec (struct window* w, - enum gutter_pos pos) + enum edge_pos pos) { Lisp_Object rest, *args; int nargs = 0; @@ -288,14 +250,14 @@ what height will accommodate all lines. This is useless on left and right gutters as we always have a maximal number of lines. */ static int -calculate_gutter_size_from_display_lines (enum gutter_pos pos, +calculate_gutter_size_from_display_lines (enum edge_pos pos, display_line_dynarr* ddla) { int size = 0; struct display_line *dl; /* For top and bottom the calculation is easy. */ - if (pos == TOP_GUTTER || pos == BOTTOM_GUTTER) + if (pos == TOP_EDGE || pos == BOTTOM_EDGE) { /* grab coordinates of last line */ if (Dynarr_length (ddla)) @@ -332,7 +294,7 @@ } static Lisp_Object -calculate_gutter_size (struct window *w, enum gutter_pos pos) +calculate_gutter_size (struct window *w, enum edge_pos pos) { struct frame* f = XFRAME (WINDOW_FRAME (w)); display_line_dynarr *ddla; @@ -359,12 +321,20 @@ ddla = Dynarr_new (display_line); /* generate some display lines */ generate_displayable_area (w, WINDOW_GUTTER (w, pos), - FRAME_LEFT_BORDER_END (f), - FRAME_TOP_BORDER_END (f), - FRAME_RIGHT_BORDER_START (f) - - FRAME_LEFT_BORDER_END (f), - FRAME_BOTTOM_BORDER_START (f) - - FRAME_TOP_BORDER_END (f), + FRAME_LEFT_GUTTER_START (f), + FRAME_TOP_GUTTER_START (f), + FRAME_RIGHT_GUTTER_END (f) + - FRAME_LEFT_GUTTER_START (f), +#ifdef BOTTOM_GUTTER_IS_OUTSIDE_MINIBUFFER + FRAME_BOTTOM_GUTTER_END (f) +#else + /* #### GEOM! This is how it used to read, + and this includes both gutter and + minibuffer below it. Not clear whether + it was intended that way. --ben */ + FRAME_BOTTOM_INTERNAL_BORDER_START (f) +#endif + - FRAME_TOP_GUTTER_START (f), ddla, 0, DEFAULT_INDEX); /* Let GC happen again. */ @@ -378,7 +348,7 @@ } static void -output_gutter (struct frame *f, enum gutter_pos pos, int force) +output_gutter (struct frame *f, enum edge_pos pos, int force) { Lisp_Object window = FRAME_LAST_NONMINIBUF_WINDOW (f); struct device *d = XDEVICE (f->device); @@ -425,9 +395,9 @@ { #ifdef DEBUG_GUTTERS stderr_out ("gutter redisplay [%s %dx%d@%d+%d] triggered by %s,\n", - pos == TOP_GUTTER ? "TOP" : - pos == BOTTOM_GUTTER ? "BOTTOM" : - pos == LEFT_GUTTER ? "LEFT" : "RIGHT", + pos == TOP_EDGE ? "TOP" : + pos == BOTTOM_EDGE ? "BOTTOM" : + pos == LEFT_EDGE ? "LEFT" : "RIGHT", width, height, x, y, force ? "force" : f->faces_changed ? "f->faces_changed" : f->frame_changed ? "f->frame_changed" : @@ -450,7 +420,7 @@ /* If the number of display lines has shrunk, adjust. */ if (cdla_len > Dynarr_length (ddla)) { - Dynarr_set_length (cdla, Dynarr_length (ddla)); + Dynarr_set_lengthr (cdla, Dynarr_length (ddla)); } /* grab coordinates of last line and blank after it. */ @@ -511,7 +481,7 @@ } static void -clear_gutter (struct frame *f, enum gutter_pos pos) +clear_gutter (struct frame *f, enum edge_pos pos) { int x, y, width, height; Lisp_Object window = FRAME_LAST_NONMINIBUF_WINDOW (f); @@ -519,7 +489,7 @@ Vwidget_face); get_gutter_coords (f, pos, &x, &y, &width, &height); - SET_GUTTER_WAS_VISIBLE_FLAG (f, pos, 0); + f->gutter_was_visible[pos] = 0; redisplay_clear_region (window, findex, x, y, width, height); } @@ -536,8 +506,8 @@ void mark_gutters (struct frame *f) { - enum gutter_pos pos; - GUTTER_POS_LOOP (pos) + enum edge_pos pos; + EDGE_POS_LOOP (pos) { if (f->current_display_lines[pos]) mark_redisplay_structs (f->current_display_lines[pos]); @@ -563,11 +533,11 @@ FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) { struct frame *f = XFRAME (XCAR (frmcons)); - enum gutter_pos pos; + enum edge_pos pos; Lisp_Object window = FRAME_LAST_NONMINIBUF_WINDOW (f); struct window* w = XWINDOW (window); - GUTTER_POS_LOOP (pos) + EDGE_POS_LOOP (pos) { if (EQ (WINDOW_GUTTER (w, pos), obj)) { @@ -580,7 +550,7 @@ /* We have to change the gutter geometry separately to the gutter update since it needs to occur outside of redisplay proper. */ static void -update_gutter_geometry (struct frame *f, enum gutter_pos pos) +update_gutter_geometry (struct frame *f, enum edge_pos pos) { /* If the gutter geometry has changed then re-layout the frame. If we are in display there is almost no point in doing @@ -589,9 +559,9 @@ if (FRAME_GUTTER_BOUNDS (f, pos) != f->current_gutter_bounds[pos]) { int width, height; - pixel_to_char_size (f, FRAME_PIXWIDTH (f), FRAME_PIXHEIGHT (f), + pixel_to_frame_unit_size (f, FRAME_PIXWIDTH (f), FRAME_PIXHEIGHT (f), &width, &height); - change_frame_size (f, height, width, 0); + change_frame_size (f, width, height, 0); MARK_FRAME_LAYOUT_CHANGED (f); } @@ -606,13 +576,13 @@ || f->frame_layout_changed || f->windows_structure_changed) { - enum gutter_pos pos; + enum edge_pos pos; /* If the gutter geometry has changed then re-layout the frame. If we are in display there is almost no point in doing anything else since the frame size changes will be delayed until we are out of redisplay proper. */ - GUTTER_POS_LOOP (pos) + EDGE_POS_LOOP (pos) { update_gutter_geometry (f, pos); } @@ -628,7 +598,7 @@ f->windows_changed || f->windows_structure_changed || f->extents_changed || f->frame_layout_changed) { - enum gutter_pos pos; + enum edge_pos pos; /* We don't actually care about these when outputting the gutter so locally disable them. */ @@ -638,12 +608,12 @@ f->buffers_changed = 0; /* and output */ - GUTTER_POS_LOOP (pos) + EDGE_POS_LOOP (pos) { if (FRAME_GUTTER_VISIBLE (f, pos)) output_gutter (f, pos, 0); - else if (gutter_was_visible (f, pos)) + else if (f->gutter_was_visible[pos]) clear_gutter (f, pos); } @@ -656,8 +626,8 @@ void reset_gutter_display_lines (struct frame* f) { - enum gutter_pos pos; - GUTTER_POS_LOOP (pos) + enum edge_pos pos; + EDGE_POS_LOOP (pos) { if (f->current_display_lines[pos]) Dynarr_reset (f->current_display_lines[pos]); @@ -665,7 +635,7 @@ } static void -redraw_exposed_gutter (struct frame *f, enum gutter_pos pos, int x, int y, +redraw_exposed_gutter (struct frame *f, enum edge_pos pos, int x, int y, int width, int height) { int g_x, g_y, g_width, g_height; @@ -696,10 +666,10 @@ redraw_exposed_gutters (struct frame *f, int x, int y, int width, int height) { - enum gutter_pos pos; + enum edge_pos pos; /* We are already inside the critical section -- our caller did that. */ - GUTTER_POS_LOOP (pos) + EDGE_POS_LOOP (pos) { if (FRAME_GUTTER_VISIBLE (f, pos)) redraw_exposed_gutter (f, pos, x, y, width, height); @@ -709,8 +679,8 @@ void free_frame_gutters (struct frame *f) { - enum gutter_pos pos; - GUTTER_POS_LOOP (pos) + enum edge_pos pos; + EDGE_POS_LOOP (pos) { if (f->current_display_lines[pos]) { @@ -725,16 +695,16 @@ } } -static enum gutter_pos +static enum edge_pos decode_gutter_position (Lisp_Object position) { - if (EQ (position, Qtop)) return TOP_GUTTER; - if (EQ (position, Qbottom)) return BOTTOM_GUTTER; - if (EQ (position, Qleft)) return LEFT_GUTTER; - if (EQ (position, Qright)) return RIGHT_GUTTER; + if (EQ (position, Qtop)) return TOP_EDGE; + if (EQ (position, Qbottom)) return BOTTOM_EDGE; + if (EQ (position, Qleft)) return LEFT_EDGE; + if (EQ (position, Qright)) return RIGHT_EDGE; invalid_constant ("Invalid gutter position", position); - RETURN_NOT_REACHED (TOP_GUTTER); + RETURN_NOT_REACHED (TOP_EDGE); } DEFUN ("set-default-gutter-position", Fset_default_gutter_position, 1, 1, 0, /* @@ -744,8 +714,8 @@ */ (position)) { - enum gutter_pos cur = decode_gutter_position (Vdefault_gutter_position); - enum gutter_pos new_ = decode_gutter_position (position); + enum edge_pos cur = decode_gutter_position (Vdefault_gutter_position); + enum edge_pos new_ = decode_gutter_position (position); if (cur != new_) { @@ -759,7 +729,7 @@ set_specifier_fallback (Vgutter[new_], Vdefault_gutter); set_specifier_fallback (Vgutter_size[cur], list1 (Fcons (Qnil, Qzero))); set_specifier_fallback (Vgutter_size[new_], - new_ == TOP_GUTTER || new_ == BOTTOM_GUTTER + new_ == TOP_EDGE || new_ == BOTTOM_EDGE ? Vdefault_gutter_height : Vdefault_gutter_width); set_specifier_fallback (Vgutter_border_width[cur], @@ -796,7 +766,7 @@ (pos, locale)) { int x, y, width, height; - enum gutter_pos p = TOP_GUTTER; + enum edge_pos p = TOP_EDGE; struct frame *f = decode_frame (FW_FRAME (locale)); if (NILP (pos)) @@ -817,7 +787,7 @@ (pos, locale)) { int x, y, width, height; - enum gutter_pos p = TOP_GUTTER; + enum edge_pos p = TOP_EDGE; struct frame *f = decode_frame (FW_FRAME (locale)); if (NILP (pos)) @@ -879,26 +849,26 @@ specifier caching changes */ static void -recompute_overlaying_specifier (Lisp_Object real_one[4]) +recompute_overlaying_specifier (Lisp_Object real_one[NUM_EDGES]) { - enum gutter_pos pos = decode_gutter_position (Vdefault_gutter_position); + enum edge_pos pos = decode_gutter_position (Vdefault_gutter_position); Fset_specifier_dirty_flag (real_one[pos]); } static void gutter_specs_changed (Lisp_Object specifier, struct window *w, - Lisp_Object oldval, enum gutter_pos pos); + Lisp_Object oldval, enum edge_pos pos); static void gutter_specs_changed_1 (Lisp_Object arg) { gutter_specs_changed (X1ST (arg), XWINDOW (X2ND (arg)), - X3RD (arg), (enum gutter_pos) XINT (X4TH (arg))); + X3RD (arg), (enum edge_pos) XINT (X4TH (arg))); free_list (arg); } static void gutter_specs_changed (Lisp_Object specifier, struct window *w, - Lisp_Object oldval, enum gutter_pos pos) + Lisp_Object oldval, enum edge_pos pos) { if (in_display) register_post_redisplay_action (gutter_specs_changed_1, @@ -925,28 +895,28 @@ top_gutter_specs_changed (Lisp_Object specifier, struct window *w, Lisp_Object oldval) { - gutter_specs_changed (specifier, w, oldval, TOP_GUTTER); + gutter_specs_changed (specifier, w, oldval, TOP_EDGE); } static void bottom_gutter_specs_changed (Lisp_Object specifier, struct window *w, Lisp_Object oldval) { - gutter_specs_changed (specifier, w, oldval, BOTTOM_GUTTER); + gutter_specs_changed (specifier, w, oldval, BOTTOM_EDGE); } static void left_gutter_specs_changed (Lisp_Object specifier, struct window *w, Lisp_Object oldval) { - gutter_specs_changed (specifier, w, oldval, LEFT_GUTTER); + gutter_specs_changed (specifier, w, oldval, LEFT_EDGE); } static void right_gutter_specs_changed (Lisp_Object specifier, struct window *w, Lisp_Object oldval) { - gutter_specs_changed (specifier, w, oldval, RIGHT_GUTTER); + gutter_specs_changed (specifier, w, oldval, RIGHT_EDGE); } static void @@ -979,8 +949,8 @@ oldval)); else { - enum gutter_pos pos; - GUTTER_POS_LOOP (pos) + enum edge_pos pos; + EDGE_POS_LOOP (pos) { w->real_gutter_size[pos] = w->gutter_size[pos]; if (EQ (w->real_gutter_size[pos], Qautodetect) @@ -1151,12 +1121,12 @@ void init_frame_gutters (struct frame *f) { - enum gutter_pos pos; + enum edge_pos pos; struct window* w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)); /* We are here as far in frame creation so cached specifiers are already recomputed, and possibly modified by resource initialization. We need to recalculate autodetected gutters. */ - GUTTER_POS_LOOP (pos) + EDGE_POS_LOOP (pos) { w->real_gutter[pos] = construct_window_gutter_spec (w, pos); w->real_gutter_size[pos] = w->gutter_size[pos]; @@ -1170,7 +1140,7 @@ } /* Keep a record of the current sizes of things. */ - GUTTER_POS_LOOP (pos) + EDGE_POS_LOOP (pos) { f->current_gutter_bounds[pos] = FRAME_GUTTER_BOUNDS (f, pos); } @@ -1278,19 +1248,19 @@ 0, 0, 1); DEFVAR_SPECIFIER ("top-gutter", - &Vgutter[TOP_GUTTER] /* + &Vgutter[TOP_EDGE] /* Specifier for the gutter at the top of the frame. Use `set-specifier' to change this. See `default-gutter' for a description of a valid gutter instantiator. */ ); - Vgutter[TOP_GUTTER] = Fmake_specifier (Qgutter); - set_specifier_caching (Vgutter[TOP_GUTTER], - offsetof (struct window, gutter[TOP_GUTTER]), + Vgutter[TOP_EDGE] = Fmake_specifier (Qgutter); + set_specifier_caching (Vgutter[TOP_EDGE], + offsetof (struct window, gutter[TOP_EDGE]), top_gutter_specs_changed, 0, 0, 1); DEFVAR_SPECIFIER ("bottom-gutter", - &Vgutter[BOTTOM_GUTTER] /* + &Vgutter[BOTTOM_EDGE] /* Specifier for the gutter at the bottom of the frame. Use `set-specifier' to change this. See `default-gutter' for a description of a valid gutter instantiator. @@ -1300,14 +1270,14 @@ `bottom-gutter-height') is 0; thus, a bottom gutter will not be displayed even if you provide a value for `bottom-gutter'. */ ); - Vgutter[BOTTOM_GUTTER] = Fmake_specifier (Qgutter); - set_specifier_caching (Vgutter[BOTTOM_GUTTER], - offsetof (struct window, gutter[BOTTOM_GUTTER]), + Vgutter[BOTTOM_EDGE] = Fmake_specifier (Qgutter); + set_specifier_caching (Vgutter[BOTTOM_EDGE], + offsetof (struct window, gutter[BOTTOM_EDGE]), bottom_gutter_specs_changed, 0, 0, 1); DEFVAR_SPECIFIER ("left-gutter", - &Vgutter[LEFT_GUTTER] /* + &Vgutter[LEFT_EDGE] /* Specifier for the gutter at the left edge of the frame. Use `set-specifier' to change this. See `default-gutter' for a description of a valid gutter instantiator. @@ -1317,14 +1287,14 @@ `left-gutter-width') is 0; thus, a left gutter will not be displayed even if you provide a value for `left-gutter'. */ ); - Vgutter[LEFT_GUTTER] = Fmake_specifier (Qgutter); - set_specifier_caching (Vgutter[LEFT_GUTTER], - offsetof (struct window, gutter[LEFT_GUTTER]), + Vgutter[LEFT_EDGE] = Fmake_specifier (Qgutter); + set_specifier_caching (Vgutter[LEFT_EDGE], + offsetof (struct window, gutter[LEFT_EDGE]), left_gutter_specs_changed, 0, 0, 1); DEFVAR_SPECIFIER ("right-gutter", - &Vgutter[RIGHT_GUTTER] /* + &Vgutter[RIGHT_EDGE] /* Specifier for the gutter at the right edge of the frame. Use `set-specifier' to change this. See `default-gutter' for a description of a valid gutter instantiator. @@ -1334,9 +1304,9 @@ `right-gutter-width') is 0; thus, a right gutter will not be displayed even if you provide a value for `right-gutter'. */ ); - Vgutter[RIGHT_GUTTER] = Fmake_specifier (Qgutter); - set_specifier_caching (Vgutter[RIGHT_GUTTER], - offsetof (struct window, gutter[RIGHT_GUTTER]), + Vgutter[RIGHT_EDGE] = Fmake_specifier (Qgutter); + set_specifier_caching (Vgutter[RIGHT_EDGE], + offsetof (struct window, gutter[RIGHT_EDGE]), right_gutter_specs_changed, 0, 0, 1); @@ -1344,10 +1314,10 @@ changed with `set-default-gutter-position'. */ fb = list1 (Fcons (Qnil, Qnil)); set_specifier_fallback (Vdefault_gutter, fb); - set_specifier_fallback (Vgutter[TOP_GUTTER], Vdefault_gutter); - set_specifier_fallback (Vgutter[BOTTOM_GUTTER], fb); - set_specifier_fallback (Vgutter[LEFT_GUTTER], fb); - set_specifier_fallback (Vgutter[RIGHT_GUTTER], fb); + set_specifier_fallback (Vgutter[TOP_EDGE], Vdefault_gutter); + set_specifier_fallback (Vgutter[BOTTOM_EDGE], fb); + set_specifier_fallback (Vgutter[LEFT_EDGE], fb); + set_specifier_fallback (Vgutter[RIGHT_EDGE], fb); DEFVAR_SPECIFIER ("default-gutter-height", &Vdefault_gutter_height /* *Height of the default gutter, if it's oriented horizontally. @@ -1393,51 +1363,51 @@ 0, 0, 1); DEFVAR_SPECIFIER ("top-gutter-height", - &Vgutter_size[TOP_GUTTER] /* + &Vgutter_size[TOP_EDGE] /* *Height of the top gutter. This is a specifier; use `set-specifier' to change it. See `default-gutter-height' for more information. */ ); - Vgutter_size[TOP_GUTTER] = Fmake_specifier (Qgutter_size); - set_specifier_caching (Vgutter_size[TOP_GUTTER], - offsetof (struct window, gutter_size[TOP_GUTTER]), + Vgutter_size[TOP_EDGE] = Fmake_specifier (Qgutter_size); + set_specifier_caching (Vgutter_size[TOP_EDGE], + offsetof (struct window, gutter_size[TOP_EDGE]), gutter_geometry_changed_in_window, 0, 0, 1); DEFVAR_SPECIFIER ("bottom-gutter-height", - &Vgutter_size[BOTTOM_GUTTER] /* + &Vgutter_size[BOTTOM_EDGE] /* *Height of the bottom gutter. This is a specifier; use `set-specifier' to change it. See `default-gutter-height' for more information. */ ); - Vgutter_size[BOTTOM_GUTTER] = Fmake_specifier (Qgutter_size); - set_specifier_caching (Vgutter_size[BOTTOM_GUTTER], - offsetof (struct window, gutter_size[BOTTOM_GUTTER]), + Vgutter_size[BOTTOM_EDGE] = Fmake_specifier (Qgutter_size); + set_specifier_caching (Vgutter_size[BOTTOM_EDGE], + offsetof (struct window, gutter_size[BOTTOM_EDGE]), gutter_geometry_changed_in_window, 0, 0, 1); DEFVAR_SPECIFIER ("left-gutter-width", - &Vgutter_size[LEFT_GUTTER] /* + &Vgutter_size[LEFT_EDGE] /* *Width of left gutter. This is a specifier; use `set-specifier' to change it. See `default-gutter-height' for more information. */ ); - Vgutter_size[LEFT_GUTTER] = Fmake_specifier (Qgutter_size); - set_specifier_caching (Vgutter_size[LEFT_GUTTER], - offsetof (struct window, gutter_size[LEFT_GUTTER]), + Vgutter_size[LEFT_EDGE] = Fmake_specifier (Qgutter_size); + set_specifier_caching (Vgutter_size[LEFT_EDGE], + offsetof (struct window, gutter_size[LEFT_EDGE]), gutter_geometry_changed_in_window, 0, 0, 1); DEFVAR_SPECIFIER ("right-gutter-width", - &Vgutter_size[RIGHT_GUTTER] /* + &Vgutter_size[RIGHT_EDGE] /* *Width of right gutter. This is a specifier; use `set-specifier' to change it. See `default-gutter-height' for more information. */ ); - Vgutter_size[RIGHT_GUTTER] = Fmake_specifier (Qgutter_size); - set_specifier_caching (Vgutter_size[RIGHT_GUTTER], - offsetof (struct window, gutter_size[RIGHT_GUTTER]), + Vgutter_size[RIGHT_EDGE] = Fmake_specifier (Qgutter_size); + set_specifier_caching (Vgutter_size[RIGHT_EDGE], + offsetof (struct window, gutter_size[RIGHT_EDGE]), gutter_geometry_changed_in_window, 0, 0, 1); fb = Qnil; @@ -1474,11 +1444,11 @@ if (!NILP (fb)) set_specifier_fallback (Vdefault_gutter_width, fb); - set_specifier_fallback (Vgutter_size[TOP_GUTTER], Vdefault_gutter_height); + set_specifier_fallback (Vgutter_size[TOP_EDGE], Vdefault_gutter_height); fb = list1 (Fcons (Qnil, Qzero)); - set_specifier_fallback (Vgutter_size[BOTTOM_GUTTER], fb); - set_specifier_fallback (Vgutter_size[LEFT_GUTTER], fb); - set_specifier_fallback (Vgutter_size[RIGHT_GUTTER], fb); + set_specifier_fallback (Vgutter_size[BOTTOM_EDGE], fb); + set_specifier_fallback (Vgutter_size[LEFT_EDGE], fb); + set_specifier_fallback (Vgutter_size[RIGHT_EDGE], fb); DEFVAR_SPECIFIER ("default-gutter-border-width", &Vdefault_gutter_border_width /* @@ -1501,55 +1471,55 @@ 0, 0, 0); DEFVAR_SPECIFIER ("top-gutter-border-width", - &Vgutter_border_width[TOP_GUTTER] /* + &Vgutter_border_width[TOP_EDGE] /* *Border width of the top gutter. This is a specifier; use `set-specifier' to change it. See `default-gutter-height' for more information. */ ); - Vgutter_border_width[TOP_GUTTER] = Fmake_specifier (Qnatnum); - set_specifier_caching (Vgutter_border_width[TOP_GUTTER], + Vgutter_border_width[TOP_EDGE] = Fmake_specifier (Qnatnum); + set_specifier_caching (Vgutter_border_width[TOP_EDGE], offsetof (struct window, - gutter_border_width[TOP_GUTTER]), + gutter_border_width[TOP_EDGE]), gutter_geometry_changed_in_window, 0, 0, 0); DEFVAR_SPECIFIER ("bottom-gutter-border-width", - &Vgutter_border_width[BOTTOM_GUTTER] /* + &Vgutter_border_width[BOTTOM_EDGE] /* *Border width of the bottom gutter. This is a specifier; use `set-specifier' to change it. See `default-gutter-height' for more information. */ ); - Vgutter_border_width[BOTTOM_GUTTER] = Fmake_specifier (Qnatnum); - set_specifier_caching (Vgutter_border_width[BOTTOM_GUTTER], + Vgutter_border_width[BOTTOM_EDGE] = Fmake_specifier (Qnatnum); + set_specifier_caching (Vgutter_border_width[BOTTOM_EDGE], offsetof (struct window, - gutter_border_width[BOTTOM_GUTTER]), + gutter_border_width[BOTTOM_EDGE]), gutter_geometry_changed_in_window, 0, 0, 0); DEFVAR_SPECIFIER ("left-gutter-border-width", - &Vgutter_border_width[LEFT_GUTTER] /* + &Vgutter_border_width[LEFT_EDGE] /* *Border width of left gutter. This is a specifier; use `set-specifier' to change it. See `default-gutter-height' for more information. */ ); - Vgutter_border_width[LEFT_GUTTER] = Fmake_specifier (Qnatnum); - set_specifier_caching (Vgutter_border_width[LEFT_GUTTER], + Vgutter_border_width[LEFT_EDGE] = Fmake_specifier (Qnatnum); + set_specifier_caching (Vgutter_border_width[LEFT_EDGE], offsetof (struct window, - gutter_border_width[LEFT_GUTTER]), + gutter_border_width[LEFT_EDGE]), gutter_geometry_changed_in_window, 0, 0, 0); DEFVAR_SPECIFIER ("right-gutter-border-width", - &Vgutter_border_width[RIGHT_GUTTER] /* + &Vgutter_border_width[RIGHT_EDGE] /* *Border width of right gutter. This is a specifier; use `set-specifier' to change it. See `default-gutter-height' for more information. */ ); - Vgutter_border_width[RIGHT_GUTTER] = Fmake_specifier (Qnatnum); - set_specifier_caching (Vgutter_border_width[RIGHT_GUTTER], + Vgutter_border_width[RIGHT_EDGE] = Fmake_specifier (Qnatnum); + set_specifier_caching (Vgutter_border_width[RIGHT_EDGE], offsetof (struct window, - gutter_border_width[RIGHT_GUTTER]), + gutter_border_width[RIGHT_EDGE]), gutter_geometry_changed_in_window, 0, 0, 0); fb = Qnil; @@ -1566,11 +1536,11 @@ if (!NILP (fb)) set_specifier_fallback (Vdefault_gutter_border_width, fb); - set_specifier_fallback (Vgutter_border_width[TOP_GUTTER], Vdefault_gutter_border_width); + set_specifier_fallback (Vgutter_border_width[TOP_EDGE], Vdefault_gutter_border_width); fb = list1 (Fcons (Qnil, Qzero)); - set_specifier_fallback (Vgutter_border_width[BOTTOM_GUTTER], fb); - set_specifier_fallback (Vgutter_border_width[LEFT_GUTTER], fb); - set_specifier_fallback (Vgutter_border_width[RIGHT_GUTTER], fb); + set_specifier_fallback (Vgutter_border_width[BOTTOM_EDGE], fb); + set_specifier_fallback (Vgutter_border_width[LEFT_EDGE], fb); + set_specifier_fallback (Vgutter_border_width[RIGHT_EDGE], fb); DEFVAR_SPECIFIER ("default-gutter-visible-p", &Vdefault_gutter_visible_p /* *Whether the default gutter is visible. @@ -1595,64 +1565,64 @@ 0, 0, 0); DEFVAR_SPECIFIER ("top-gutter-visible-p", - &Vgutter_visible_p[TOP_GUTTER] /* + &Vgutter_visible_p[TOP_EDGE] /* *Whether the top gutter is visible. This is a specifier; use `set-specifier' to change it. See `default-gutter-visible-p' for more information. */ ); - Vgutter_visible_p[TOP_GUTTER] = Fmake_specifier (Qgutter_visible); - set_specifier_caching (Vgutter_visible_p[TOP_GUTTER], + Vgutter_visible_p[TOP_EDGE] = Fmake_specifier (Qgutter_visible); + set_specifier_caching (Vgutter_visible_p[TOP_EDGE], offsetof (struct window, - gutter_visible_p[TOP_GUTTER]), + gutter_visible_p[TOP_EDGE]), top_gutter_specs_changed, 0, 0, 0); DEFVAR_SPECIFIER ("bottom-gutter-visible-p", - &Vgutter_visible_p[BOTTOM_GUTTER] /* + &Vgutter_visible_p[BOTTOM_EDGE] /* *Whether the bottom gutter is visible. This is a specifier; use `set-specifier' to change it. See `default-gutter-visible-p' for more information. */ ); - Vgutter_visible_p[BOTTOM_GUTTER] = Fmake_specifier (Qgutter_visible); - set_specifier_caching (Vgutter_visible_p[BOTTOM_GUTTER], + Vgutter_visible_p[BOTTOM_EDGE] = Fmake_specifier (Qgutter_visible); + set_specifier_caching (Vgutter_visible_p[BOTTOM_EDGE], offsetof (struct window, - gutter_visible_p[BOTTOM_GUTTER]), + gutter_visible_p[BOTTOM_EDGE]), bottom_gutter_specs_changed, 0, 0, 0); DEFVAR_SPECIFIER ("left-gutter-visible-p", - &Vgutter_visible_p[LEFT_GUTTER] /* + &Vgutter_visible_p[LEFT_EDGE] /* *Whether the left gutter is visible. This is a specifier; use `set-specifier' to change it. See `default-gutter-visible-p' for more information. */ ); - Vgutter_visible_p[LEFT_GUTTER] = Fmake_specifier (Qgutter_visible); - set_specifier_caching (Vgutter_visible_p[LEFT_GUTTER], + Vgutter_visible_p[LEFT_EDGE] = Fmake_specifier (Qgutter_visible); + set_specifier_caching (Vgutter_visible_p[LEFT_EDGE], offsetof (struct window, - gutter_visible_p[LEFT_GUTTER]), + gutter_visible_p[LEFT_EDGE]), left_gutter_specs_changed, 0, 0, 0); DEFVAR_SPECIFIER ("right-gutter-visible-p", - &Vgutter_visible_p[RIGHT_GUTTER] /* + &Vgutter_visible_p[RIGHT_EDGE] /* *Whether the right gutter is visible. This is a specifier; use `set-specifier' to change it. See `default-gutter-visible-p' for more information. */ ); - Vgutter_visible_p[RIGHT_GUTTER] = Fmake_specifier (Qgutter_visible); - set_specifier_caching (Vgutter_visible_p[RIGHT_GUTTER], + Vgutter_visible_p[RIGHT_EDGE] = Fmake_specifier (Qgutter_visible); + set_specifier_caching (Vgutter_visible_p[RIGHT_EDGE], offsetof (struct window, - gutter_visible_p[RIGHT_GUTTER]), + gutter_visible_p[RIGHT_EDGE]), right_gutter_specs_changed, 0, 0, 0); /* initially, top inherits from default; this can be changed with `set-default-gutter-position'. */ fb = list1 (Fcons (Qnil, Qt)); set_specifier_fallback (Vdefault_gutter_visible_p, fb); - set_specifier_fallback (Vgutter_visible_p[TOP_GUTTER], + set_specifier_fallback (Vgutter_visible_p[TOP_EDGE], Vdefault_gutter_visible_p); - set_specifier_fallback (Vgutter_visible_p[BOTTOM_GUTTER], fb); - set_specifier_fallback (Vgutter_visible_p[LEFT_GUTTER], fb); - set_specifier_fallback (Vgutter_visible_p[RIGHT_GUTTER], fb); + set_specifier_fallback (Vgutter_visible_p[BOTTOM_EDGE], fb); + set_specifier_fallback (Vgutter_visible_p[LEFT_EDGE], fb); + set_specifier_fallback (Vgutter_visible_p[RIGHT_EDGE], fb); } diff -r 861f2601a38b -r 1f0b15040456 src/gutter.h --- a/src/gutter.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/gutter.h Sun May 01 18:44:03 2011 +0100 @@ -1,12 +1,13 @@ /* Define general gutter support. Copyright (C) 1999 Andy Piper. + Copyright (C) 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -36,18 +35,6 @@ #define DEFAULT_GUTTER_WIDTH 40 #define DEFAULT_GUTTER_BORDER_WIDTH 2 -enum gutter_pos -{ - TOP_GUTTER = 0, - BOTTOM_GUTTER = 1, - LEFT_GUTTER = 2, - RIGHT_GUTTER = 3 -}; - -/* Iterate over all possible gutter positions */ -#define GUTTER_POS_LOOP(var) \ - for (var = (enum gutter_pos) 0; var < 4; var = (enum gutter_pos) (var + 1)) - extern Lisp_Object Qgutter; extern Lisp_Object Vgutter_size[4]; @@ -97,13 +84,13 @@ /* these macros predicate size on position and type of window */ #define WINDOW_REAL_TOP_GUTTER_BOUNDS(w) \ - WINDOW_REAL_GUTTER_BOUNDS (w,TOP_GUTTER) + WINDOW_REAL_GUTTER_BOUNDS (w, TOP_EDGE) #define WINDOW_REAL_BOTTOM_GUTTER_BOUNDS(w) \ - WINDOW_REAL_GUTTER_BOUNDS (w,BOTTOM_GUTTER) + WINDOW_REAL_GUTTER_BOUNDS (w, BOTTOM_EDGE) #define WINDOW_REAL_LEFT_GUTTER_BOUNDS(w) \ - WINDOW_REAL_GUTTER_BOUNDS (w,LEFT_GUTTER) + WINDOW_REAL_GUTTER_BOUNDS (w, LEFT_EDGE) #define WINDOW_REAL_RIGHT_GUTTER_BOUNDS(w) \ - WINDOW_REAL_GUTTER_BOUNDS (w,RIGHT_GUTTER) + WINDOW_REAL_GUTTER_BOUNDS (w, RIGHT_EDGE) #define FRAME_GUTTER_VISIBLE(f, pos) \ WINDOW_REAL_GUTTER_VISIBLE (XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)), pos) @@ -118,13 +105,9 @@ WINDOW_GUTTER (XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)), pos) /* these macros predicate size on position and type of window */ -#define FRAME_TOP_GUTTER_BOUNDS(f) \ - WINDOW_REAL_GUTTER_BOUNDS (XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)), TOP_GUTTER) -#define FRAME_BOTTOM_GUTTER_BOUNDS(f) \ - WINDOW_REAL_GUTTER_BOUNDS (XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)), BOTTOM_GUTTER) -#define FRAME_LEFT_GUTTER_BOUNDS(f) \ - WINDOW_REAL_GUTTER_BOUNDS (XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)), LEFT_GUTTER) -#define FRAME_RIGHT_GUTTER_BOUNDS(f) \ - WINDOW_REAL_GUTTER_BOUNDS (XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)), RIGHT_GUTTER) +#define FRAME_TOP_GUTTER_BOUNDS(f) FRAME_GUTTER_BOUNDS (f, TOP_EDGE) +#define FRAME_BOTTOM_GUTTER_BOUNDS(f) FRAME_GUTTER_BOUNDS (f, BOTTOM_EDGE) +#define FRAME_LEFT_GUTTER_BOUNDS(f) FRAME_GUTTER_BOUNDS (f, LEFT_EDGE) +#define FRAME_RIGHT_GUTTER_BOUNDS(f) FRAME_GUTTER_BOUNDS (f, RIGHT_EDGE) #endif /* INCLUDED_gutter_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/hash.c --- a/src/hash.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/hash.c Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,13 @@ /* Hash tables. Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 2003, 2004 Ben Wing. + Copyright (C) 2003, 2004, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -28,7 +26,7 @@ #include "lisp.h" #include "hash.h" -#define NULL_ENTRY ((void *) 0xdeadbeef) /* -559038737 base 10 */ +#define NULL_ENTRY ((void *) 0xDEADBEEF) /* -559038737 base 10 */ #define COMFORTABLE_SIZE(size) (21 * (size) / 16) diff -r 861f2601a38b -r 1f0b15040456 src/hash.h --- a/src/hash.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/hash.h Sun May 01 18:44:03 2011 +0100 @@ -1,10 +1,10 @@ /* Copyright (C) 2003 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -12,9 +12,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/hpplay.c --- a/src/hpplay.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/hpplay.c Sun May 01 18:44:03 2011 +0100 @@ -2,10 +2,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -13,9 +13,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/imgproc.c --- a/src/imgproc.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/imgproc.c Sun May 01 18:44:03 2011 +0100 @@ -1,12 +1,12 @@ /* Image processing functions Copyright (C) 1998 Jareth Hein -This file is a part of XEmacs +This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -27,6 +25,7 @@ Copyright (c) 1988-1997 Sam Leffler Copyright (c) 1991-1997 Silicon Graphics, Inc. + Copyright (C) 2010 Ben Wing. Permission to use, copy, modify, distribute, and sell this software and its documentation for any purpose is hereby granted without fee, provided @@ -551,8 +550,12 @@ /* 5c: done with ColorCells */ for (i = 0; i < C_LEN*C_LEN*C_LEN; i++) if (qt->ColorCells[i]) - xfree (qt->ColorCells[i]); + { + xfree (qt->ColorCells[i]); + qt->ColorCells[i] = 0; + } xfree (qt->ColorCells); + qt->ColorCells = 0; if (res) { diff -r 861f2601a38b -r 1f0b15040456 src/imgproc.h --- a/src/imgproc.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/imgproc.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is a part of XEmacs -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ #ifndef INCLUDED_imgproc_h_ #define INCLUDED_imgproc_h_ diff -r 861f2601a38b -r 1f0b15040456 src/indent.c --- a/src/indent.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/indent.c Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* This file has been Mule-ized. */ @@ -412,7 +410,8 @@ buffer = wrap_buffer (buf); if (tab_width <= 0 || tab_width > 1000) tab_width = 8; - CHECK_NATNUM (column); + + check_integer_range (column, Qzero, make_integer (EMACS_INT_MAX)); goal = XINT (column); retry: @@ -801,7 +800,7 @@ eobuf = BUF_ZV (XBUFFER (w->buffer)); bobuf = BUF_BEGV (XBUFFER (w->buffer)); - default_face_height_and_width (window, &defheight, NULL); + default_face_width_and_height (window, NULL, &defheight); /* guess num lines needed in line start cache + a few extra */ abspix = abs (pixels); diff -r 861f2601a38b -r 1f0b15040456 src/inline.c --- a/src/inline.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/inline.c Sun May 01 18:44:03 2011 +0100 @@ -1,12 +1,13 @@ /* Repository for inline functions Copyright (C) 1995 Sun Microsystems, Inc. + Copyright (C) 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -35,8 +34,8 @@ */ /* Note to maintainers: This file contains a list of all header files - that use the INLINE macro, either directly, or by using DECLARE_LRECORD. - i.e. the output of ``grep -l -w 'DECLARE_LRECORD|INLINE_HEADER' *.h'' */ + that use the INLINE macro, either directly, or by using DECLARE_LISP_OBJECT. + i.e. the output of ``grep -l -w 'DECLARE_LISP_OBJECT|INLINE_HEADER' *.h'' */ #define DONT_EXTERN_INLINE_HEADER_FUNCTIONS @@ -59,7 +58,7 @@ #include "gui.h" #include "keymap.h" #include "lstream.h" -#include "objects-impl.h" +#include "fontcolor-impl.h" #include "opaque.h" #include "process.h" #include "rangetab.h" @@ -99,19 +98,26 @@ #include "database.h" #endif +#include "console-stream-impl.h" + #ifdef HAVE_X_WINDOWS -#include "glyphs-x.h" +#include "console-x-impl.h" #ifdef HAVE_XFT #include "font-mgr.h" #endif #endif #ifdef HAVE_MS_WINDOWS -#include "console-msw.h" +#include "console-msw-impl.h" +#endif + +#ifdef HAVE_TTY +#include "console-tty-impl.h" +#include "fontcolor-tty-impl.h" #endif #ifdef HAVE_GTK -#include "console-gtk.h" +#include "console-gtk-impl.h" #include "ui-gtk.h" #endif diff -r 861f2601a38b -r 1f0b15040456 src/input-method-motif.c --- a/src/input-method-motif.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/input-method-motif.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/input-method-xlib.c --- a/src/input-method-xlib.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/input-method-xlib.c Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,13 @@ /* Various functions for X11R5+ input methods, using the Xlib interface. Copyright (C) 1996 Sun Microsystems. - Copyright (C) 2002 Ben Wing. + Copyright (C) 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -411,10 +409,15 @@ if (needed->width == 0) /* Use XNArea instead of XNAreaNeeded */ XIC_Value (Get, xic, XNStatusAttributes, XNArea, &needed); + /* #### This will partially cover the gutter if there is a bottom + gutter. Perhaps what was intended was FRAME_PANED_RIGHT_EDGE() + and FRAME_PANED_BOTTOM_EDGE()? That will actually place itself + in the paned area (covering the right edge of the minibuffer) + in all circumstances. */ area.width = needed->width; area.height = needed->height; - area.x = FRAME_RIGHT_BORDER_START (f) - area.width; - area.y = FRAME_BOTTOM_BORDER_START (f) - area.height; + area.x = FRAME_RIGHT_INTERNAL_BORDER_START (f) - area.width; + area.y = FRAME_BOTTOM_INTERNAL_BORDER_START (f) - area.height; #ifdef DEBUG_XIM stderr_out ("Putting StatusArea in x=%d y=%d w=%d h=%d\n", @@ -430,10 +433,10 @@ /* We include the border because Preedit window might be larger than display line at edge. #### FIX: we should adjust to make sure that there is always room for the spot sub-window */ - area.x = FRAME_LEFT_BORDER_START (f); - area.y = FRAME_TOP_BORDER_START (f); - area.width = FRAME_RIGHT_BORDER_END (f) - area.x; - area.height = FRAME_BOTTOM_BORDER_END (f) - area.y; + area.x = FRAME_LEFT_INTERNAL_BORDER_START (f); + area.y = FRAME_TOP_INTERNAL_BORDER_START (f); + area.width = FRAME_RIGHT_INTERNAL_BORDER_END (f) - area.x; + area.height = FRAME_BOTTOM_INTERNAL_BORDER_END (f) - area.y; XIC_Value(Set, xic, XNPreeditAttributes, XNArea, &area); } diff -r 861f2601a38b -r 1f0b15040456 src/insdel.c --- a/src/insdel.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/insdel.c Sun May 01 18:44:03 2011 +0100 @@ -2,14 +2,14 @@ Copyright (C) 1985, 1986, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2001, 2002, 2003, 2004 Ben Wing. + Copyright (C) 2001, 2002, 2003, 2004, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.0, FSF 19.30. Diverges significantly. */ @@ -420,8 +418,7 @@ static void move_gap (struct buffer *buf, Charbpos cpos, Bytebpos bpos) { - if (! BUF_BEG_ADDR (buf)) - ABORT (); + assert (BUF_BEG_ADDR (buf)); if (bpos < BYTE_BUF_GPT (buf)) gap_left (buf, cpos, bpos); else if (bpos > BYTE_BUF_GPT (buf)) @@ -1839,8 +1836,10 @@ { BUFFER_FREE (b->text->beg); xfree (b->text->changes); + b->text->changes = 0; } xfree (b->changes); + b->changes = 0; #ifdef REGION_CACHE_NEEDS_WORK if (b->newline_cache) diff -r 861f2601a38b -r 1f0b15040456 src/insdel.h --- a/src/insdel.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/insdel.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/intl-encap-win32.c --- a/src/intl-encap-win32.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/intl-encap-win32.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/intl-win32.c --- a/src/intl-win32.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/intl-win32.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -42,7 +40,7 @@ #include "window-impl.h" #include "console-msw-impl.h" -#include "objects-msw-impl.h" +#include "fontcolor-msw-impl.h" #ifndef CYGWIN_HEADERS # include @@ -1792,9 +1790,14 @@ data->cp_type = MULTIBYTE_MAC; else { - CHECK_NATNUM (value); data->locale_type = MULTIBYTE_SPECIFIED_CODE_PAGE; - data->cp = XINT (value); +#ifdef HAVE_BIGNUM + check_integer_range (value, Qzero, make_integer (INT_MAX)); + data->cp = BIGNUMP (value) ? bignum_to_int (XBIGNUM_DATA (value)) : XINT (value); +#else + CHECK_NATNUM (value); + data->cp = XINT (value); +#endif } } else if (EQ (key, Qlocale)) @@ -2329,10 +2332,10 @@ { #ifdef MULE Vmswindows_charset_code_page_table = - make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, Qeq); staticpro (&Vmswindows_charset_code_page_table); Vmswindows_charset_registry_table = - make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, Qeq); staticpro (&Vmswindows_charset_registry_table); #endif /* MULE */ } @@ -2353,14 +2356,15 @@ Fmake_coding_system_internal (Qmswindows_unicode, Qunicode, build_defer_string ("MS Windows Unicode"), - nconc2 (list4 (Qdocumentation, - build_defer_string ( + listu (Qdocumentation, + build_defer_string ( "Converts to the Unicode encoding for Windows API calls.\n" "This encoding is equivalent to standard UTF16, little-endian." ), - Qmnemonic, build_ascstring ("MSW-U")), - list4 (Qunicode_type, Qutf_16, - Qlittle_endian, Qt))); + Qmnemonic, build_ascstring ("MSW-U"), + Qunicode_type, Qutf_16, + Qlittle_endian, Qt, + Qunbound)); #ifdef MULE /* Just temporarily. This will get fixed in mule-msw-init.el. */ diff -r 861f2601a38b -r 1f0b15040456 src/intl-x.c --- a/src/intl-x.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/intl-x.c Sun May 01 18:44:03 2011 +0100 @@ -2,12 +2,12 @@ Copyright (C) 1996 Sun Microsystems. Copyright (C) 2000, 2001 Ben Wing. -This file is a part of XEmacs. +This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ #include #include "lisp.h" diff -r 861f2601a38b -r 1f0b15040456 src/intl.c --- a/src/intl.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/intl.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/keymap-buttons.h --- a/src/keymap-buttons.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/keymap-buttons.h Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. Split out of keymap.c. */ diff -r 861f2601a38b -r 1f0b15040456 src/keymap-slots.h --- a/src/keymap-slots.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/keymap-slots.h Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. Split out of keymap.c. */ diff -r 861f2601a38b -r 1f0b15040456 src/keymap.c --- a/src/keymap.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/keymap.c Sun May 01 18:44:03 2011 +0100 @@ -2,15 +2,15 @@ Copyright (C) 1985, 1991-1995 Free Software Foundation, Inc. Copyright (C) 1995 Board of Trustees, University of Illinois. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2001, 2002 Ben Wing. + Copyright (C) 2001, 2002, 2010 Ben Wing. Totally redesigned by jwz in 1991. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -18,9 +18,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.0. Not synched with FSF. Substantially different from FSF. */ @@ -148,7 +146,7 @@ struct Lisp_Keymap { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; #define MARKED_SLOT(x) Lisp_Object x; #include "keymap-slots.h" }; @@ -253,7 +251,7 @@ } static Hashcode -keymap_hash (Lisp_Object obj, int depth) +keymap_hash (Lisp_Object obj, int depth, Boolint UNUSED (equalp)) { Lisp_Keymap *k = XKEYMAP (obj); Hashcode hash = 0xCAFEBABE; /* why not? */ @@ -261,7 +259,7 @@ depth++; #define MARKED_SLOT(x) \ - hash = HASH2 (hash, internal_hash (k->x, depth)); + hash = HASH2 (hash, internal_hash (k->x, depth, 0)); #define MARKED_SLOT_NOCOMPARE(x) #include "keymap-slots.h" @@ -284,14 +282,15 @@ /* This function can GC */ Lisp_Keymap *keymap = XKEYMAP (obj); if (print_readably) - printing_unreadable_lcrecord (obj, 0); + printing_unreadable_lisp_object (obj, 0); write_ascstring (printcharfun, "#name)) { write_fmt_string_lisp (printcharfun, "%S ", 1, keymap->name); } write_fmt_string (printcharfun, "size %ld 0x%x>", - (long) XINT (Fkeymap_fullness (obj)), keymap->header.uid); + (long) XINT (Fkeymap_fullness (obj)), + LISP_OBJECT_UID (obj)); } static const struct memory_description keymap_description[] = { @@ -300,12 +299,11 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("keymap", keymap, - 1, /*dumpable-flag*/ - mark_keymap, print_keymap, 0, - keymap_equal, keymap_hash, - keymap_description, - Lisp_Keymap); +DEFINE_DUMPABLE_LISP_OBJECT ("keymap", keymap, + mark_keymap, print_keymap, 0, + keymap_equal, keymap_hash, + keymap_description, + Lisp_Keymap); /************************************************************************/ /* Traversing keymaps and their parents */ @@ -490,10 +488,10 @@ #define FROB(num) XEMACS_MOD_BUTTON##num | #include "keymap-buttons.h" 0); - if ((modifiers & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER - | XEMACS_MOD_HYPER | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT)) - != 0) - ABORT (); + assert ((modifiers & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META | + XEMACS_MOD_SUPER | XEMACS_MOD_HYPER | + XEMACS_MOD_ALT | XEMACS_MOD_SHIFT)) + == 0); k = XKEYMAP (keymap); @@ -567,8 +565,7 @@ Lisp_Object tail; Lisp_Object *prev; - if (UNBOUNDP (keys)) - ABORT (); + assert (!UNBOUNDP (keys)); for (prev = &new_keys, tail = new_keys; ; @@ -738,8 +735,9 @@ return 0; } -static int map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, - Lisp_Object pred); +static Boolint map_keymap_sort_predicate (Lisp_Object pred, Lisp_Object key, + Lisp_Object obj1, Lisp_Object obj2); + static Lisp_Object keymap_submaps (Lisp_Object keymap) @@ -762,9 +760,8 @@ elisp_maphash (keymap_submaps_mapper, k->table, &keymap_submaps_closure); /* keep it sorted so that the result of accessible-keymaps is ordered */ - k->sub_maps_cache = list_sort (result, - Qnil, - map_keymap_sort_predicate); + k->sub_maps_cache = list_sort (result, map_keymap_sort_predicate, + Qnil, Qnil); UNGCPRO; } return k->sub_maps_cache; @@ -778,10 +775,8 @@ static Lisp_Object make_keymap (Elemcount size) { - Lisp_Object result; - Lisp_Keymap *keymap = ALLOC_LCRECORD_TYPE (Lisp_Keymap, &lrecord_keymap); - - result = wrap_keymap (keymap); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (keymap); + Lisp_Keymap *keymap = XKEYMAP (obj); #define MARKED_SLOT(x) keymap->x = Qnil; #include "keymap-slots.h" @@ -789,14 +784,14 @@ if (size != 0) /* hack for copy-keymap */ { keymap->table = - make_lisp_hash_table (size, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (size, HASH_TABLE_NON_WEAK, Qeq); /* Inverse table is often less dense because of duplicate key-bindings. If not, it will grow anyway. */ keymap->inverse_table = make_lisp_hash_table (size * 3 / 4, HASH_TABLE_NON_WEAK, - HASH_TABLE_EQ); + Qeq); } - return result; + return obj; } DEFUN ("make-keymap", Fmake_keymap, 0, 1, 0, /* @@ -1530,7 +1525,13 @@ define_key_parser (list, &raw_key); - if ( + /* The first zero is needed for Apple's i686-apple-darwin8-g++-4.0.1, + otherwise the build fails with: + + In function ‘void key_desc_list_to_event(Lisp_Object, Lisp_Object, int)’: + cc1plus: error: expected primary-expression + cc1plus: error: expected `)' */ + if (0 || #define INCLUDE_BUTTON_ZERO #define FROB(num) \ EQ (raw_key.keysym, Qbutton##num) || \ @@ -1732,7 +1733,7 @@ if (indx == 0) new_keys = keys; else if (STRINGP (keys)) - new_keys = Fsubstring (keys, Qzero, make_int (indx)); + new_keys = Fsubseq (keys, Qzero, make_int (indx)); else if (VECTORP (keys)) { new_keys = make_vector (indx, Qnil); @@ -2892,9 +2893,9 @@ /* used by map_keymap_sorted(), describe_map_sort_predicate(), and keymap_submaps(). */ -static int -map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, - Lisp_Object UNUSED (pred)) +static Boolint +map_keymap_sort_predicate (Lisp_Object UNUSED (pred), Lisp_Object UNUSED (key), + Lisp_Object obj1, Lisp_Object obj2) { /* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored. */ @@ -2907,12 +2908,12 @@ obj2 = XCAR (obj2); if (EQ (obj1, obj2)) - return -1; + return 0; bit1 = MODIFIER_HASH_KEY_BITS (obj1); bit2 = MODIFIER_HASH_KEY_BITS (obj2); - /* If either is a symbol with a Qcharacter_of_keysym property, then sort it by - that code instead of alphabetically. + /* If either is a symbol with a Qcharacter_of_keysym property, then sort + it by that code instead of alphabetically. */ if (! bit1 && SYMBOLP (obj1)) { @@ -2937,7 +2938,7 @@ /* all symbols (non-ASCIIs) come after characters (ASCIIs) */ if (XTYPE (obj1) != XTYPE (obj2)) - return SYMBOLP (obj2) ? 1 : -1; + return SYMBOLP (obj2); if (! bit1 && CHARP (obj1)) /* they're both ASCII */ { @@ -2945,24 +2946,24 @@ int o2 = XCHAR (obj2); if (o1 == o2 && /* If one started out as a symbol and the */ sym1_p != sym2_p) /* other didn't, the symbol comes last. */ - return sym2_p ? 1 : -1; - - return o1 < o2 ? 1 : -1; /* else just compare them */ + return sym2_p; + + return o1 < o2; /* else just compare them */ } /* else they're both symbols. If they're both buckys, then order them. */ if (bit1 && bit2) - return bit1 < bit2 ? 1 : -1; + return bit1 < bit2; /* if only one is a bucky, then it comes later */ if (bit1 || bit2) - return bit2 ? 1 : -1; + return bit2; /* otherwise, string-sort them. */ { Ibyte *s1 = XSTRING_DATA (XSYMBOL (obj1)->name); Ibyte *s2 = XSTRING_DATA (XSYMBOL (obj2)->name); - return 0 > qxestrcmp (s1, s2) ? 1 : -1; + return 0 > qxestrcmp (s1, s2); } } @@ -2990,7 +2991,7 @@ c1.result_locative = &contents; elisp_maphash (map_keymap_sorted_mapper, keymap_table, &c1); } - contents = list_sort (contents, Qnil, map_keymap_sort_predicate); + contents = list_sort (contents, map_keymap_sort_predicate, Qnil, Qidentity); for (; !NILP (contents); contents = XCDR (contents)) { Lisp_Object keysym = XCAR (XCAR (contents)); @@ -3132,11 +3133,9 @@ key.keysym = keysym; key.modifiers = modifiers; - if (NILP (cmd)) - ABORT (); + assert (!NILP (cmd)); cmd = get_keymap (cmd, 0, 1); - if (!KEYMAPP (cmd)) - ABORT (); + assert (KEYMAPP (cmd)); vec = make_vector (XVECTOR_LENGTH (thisseq) + 1, Qnil); len = XVECTOR_LENGTH (thisseq); @@ -3665,7 +3664,7 @@ /* OK, the key is for real */ if (target_buffer) { - if (!firstonly) ABORT (); + assert (firstonly); format_raw_keys (so_far, keys_count + 1, target_buffer); return make_int (1); } @@ -4084,10 +4083,10 @@ *(closure->list)); } - -static int -describe_map_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, - Lisp_Object pred) +static Boolint +describe_map_sort_predicate (Lisp_Object pred, Lisp_Object key_func, + Lisp_Object obj1, Lisp_Object obj2) + { /* obj1 and obj2 are conses of the form ( ( . ) . ) @@ -4099,9 +4098,9 @@ bit1 = XINT (XCDR (obj1)); bit2 = XINT (XCDR (obj2)); if (bit1 != bit2) - return bit1 < bit2 ? 1 : -1; + return bit1 < bit2; else - return map_keymap_sort_predicate (obj1, obj2, pred); + return map_keymap_sort_predicate (pred, key_func, obj1, obj2); } /* Elide 2 or more consecutive numeric keysyms bound to the same thing, @@ -4209,7 +4208,7 @@ if (!NILP (list)) { - list = list_sort (list, Qnil, describe_map_sort_predicate); + list = list_sort (list, describe_map_sort_predicate, Qnil, Qnil); buffer_insert_ascstring (buf, "\n"); while (!NILP (list)) { @@ -4298,7 +4297,7 @@ void syms_of_keymap (void) { - INIT_LRECORD_IMPLEMENTATION (keymap); + INIT_LISP_OBJECT (keymap); DEFSYMBOL (Qminor_mode_map_alist); diff -r 861f2601a38b -r 1f0b15040456 src/keymap.h --- a/src/keymap.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/keymap.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -26,7 +24,7 @@ typedef struct Lisp_Keymap Lisp_Keymap; -DECLARE_LRECORD (keymap, Lisp_Keymap); +DECLARE_LISP_OBJECT (keymap, Lisp_Keymap); #define XKEYMAP(x) XRECORD (x, keymap, Lisp_Keymap) #define wrap_keymap(p) wrap_record (p, keymap) #define KEYMAPP(x) RECORDP (x, keymap) diff -r 861f2601a38b -r 1f0b15040456 src/lastfile.c --- a/src/lastfile.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/lastfile.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ diff -r 861f2601a38b -r 1f0b15040456 src/libinterface.c --- a/src/libinterface.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/libinterface.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/libinterface.h --- a/src/libinterface.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/libinterface.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/line-number.c --- a/src/line-number.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/line-number.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/line-number.h --- a/src/line-number.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/line-number.h Sun May 01 18:44:03 2011 +0100 @@ -2,10 +2,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -13,9 +13,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ #ifndef INCLUDED_line_number_h_ #define INCLUDED_line_number_h_ diff -r 861f2601a38b -r 1f0b15040456 src/linuxplay.c --- a/src/linuxplay.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/linuxplay.c Sun May 01 18:44:03 2011 +0100 @@ -72,7 +72,7 @@ static int mix_fd; static int audio_vol; static int audio_fd; -static Ascbyte *audio_dev = "/dev/dsp"; +static const Ascbyte *audio_dev = "/dev/dsp"; /* Intercept SIGINT and SIGHUP in order to close the audio and mixer devices before terminating sound output; this requires reliable diff -r 861f2601a38b -r 1f0b15040456 src/lisp-disunion.h --- a/src/lisp-disunion.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/lisp-disunion.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. Split out from lisp.h. */ /* This file has diverged greatly from FSF Emacs. Syncing is no diff -r 861f2601a38b -r 1f0b15040456 src/lisp-union.h --- a/src/lisp-union.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/lisp-union.h Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Divergent from FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/lisp.h --- a/src/lisp.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/lisp.h Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ @@ -85,6 +83,16 @@ %%#### marks places that need work for KKCC (the new garbage collector). + @@#### marks places that need work to get Unicode-internal working, + i.e. using UTF-8 as the internal text format. + + #### BILL! marks places that need work for GTK. + + #### GEOM! marks places needing work to fix various bugs in the handling + of window and frame sizing and positioning. Often the root of the + problems is that the code was originally written before there was a + gutter and then not completely fixed up to accommodate the gutter. + */ /************************************************************************/ @@ -109,6 +117,7 @@ #include /* offsetof */ #include #include +#include #ifdef __cplusplus #include /* necessary for max()/min() under G++ 4 */ #endif @@ -317,8 +326,8 @@ #ifdef ERROR_CHECK_STRUCTURES /* Check for problems with the catch list and specbind stack */ #define ERROR_CHECK_CATCH -/* Check for incoherent Dynarr structures, attempts to access Dynarr - positions out of range, reentrant use of Dynarrs through Dynarr locking, +/* Check for incoherent dynarr structures, attempts to access Dynarr + positions out of range, reentrant use of dynarrs through dynarr locking, etc. */ #define ERROR_CHECK_DYNARR /* Check for insufficient use of call_trapping_problems(), particularly @@ -1229,12 +1238,16 @@ /* Highly dubious kludge */ /* (thanks, Jamie, I feel better now -- ben) */ MODULE_API void assert_failed (const Ascbyte *, int, const Ascbyte *); +void assert_equal_failed (const Ascbyte *file, int line, EMACS_INT x, + EMACS_INT y, const Ascbyte *exprx, + const Ascbyte *expry); #define ABORT() assert_failed (__FILE__, __LINE__, "ABORT()") #define abort_with_message(msg) assert_failed (__FILE__, __LINE__, msg) /* This used to be ((void) (0)) but that triggers lots of unused variable - warnings. It's pointless to force all that code to be rewritten, with - added ifdefs. Any reasonable compiler will eliminate an expression with + warnings -- furthermore, if `x' has any side effects, e.g. + assert (++depth <= 20);, we DEFINITELY want to execute the code inside of + `x'. Any reasonable compiler will eliminate an expression with no effects. We keep this abstracted out like this in case we want to change it in the future. */ #define disabled_assert(x) ((void) (x)) @@ -1248,6 +1261,10 @@ ((x) ? (void) 0 : assert_failed (__FILE__, __LINE__, msg)) # define assert_at_line(x, file, line) \ ((x) ? (void) 0 : assert_failed (file, line, #x)) +# define assert_equal(x, y) \ + ((x) == (y) ? (void) 0 : \ + assert_equal_failed (__FILE__, __LINE__, (EMACS_INT) x, (EMACS_INT) y, \ + #x, #y)) #else /* This used to be ((void) (0)) but that triggers lots of unused variable warnings. It's pointless to force all that code to be rewritten, with @@ -1256,6 +1273,7 @@ # define assert(x) disabled_assert (x) # define assert_with_message(x, msg) disabled_assert_with_message (x, msg) # define assert_at_line(x, file, line) disabled_assert_at_line (x, file, line) +# define assert_equal(x, y) disabled_assert ((x) == (y)) #endif /************************************************************************/ @@ -1422,6 +1440,16 @@ memcpy (*_bsta_, _bsta_2, 1 + _bsta_3); \ } while (0) +/* Make an alloca'd copy of a Extbyte * */ +#define EXTBYTE_STRING_TO_ALLOCA(p, lval) \ +do { \ + Extbyte **_esta_ = (Extbyte **) &(lval); \ + const Extbyte *_esta_2 = (p); \ + Bytecount _esta_3 = strlen (_esta_2); \ + *_esta_ = alloca_extbytes (1 + _esta_3); \ + memcpy (*_esta_, _esta_2, 1 + _esta_3); \ +} while (0) + /* ----------------- convenience functions for reallocation --------------- */ #define XREALLOC_ARRAY(ptr, type, len) \ @@ -1455,7 +1483,7 @@ /* We put typedefs here so that prototype declarations don't choke. Note that we don't actually declare the structures here (except - maybe for simple structures like Dynarrs); that keeps them private + maybe for simple structures like dynarrs); that keeps them private to the routines that actually use them. */ /* ------------------------------- */ @@ -1527,8 +1555,8 @@ typedef struct Lisp_Event Lisp_Event; /* "events.h" */ typedef struct Lisp_Face Lisp_Face; /* "faces-impl.h" */ typedef struct Lisp_Process Lisp_Process; /* "procimpl.h" */ -typedef struct Lisp_Color_Instance Lisp_Color_Instance; /* objects-impl.h */ -typedef struct Lisp_Font_Instance Lisp_Font_Instance; /* objects-impl.h */ +typedef struct Lisp_Color_Instance Lisp_Color_Instance; /* fontcolor-impl.h */ +typedef struct Lisp_Font_Instance Lisp_Font_Instance; /* fontcolor-impl.h */ typedef struct Lisp_Image_Instance Lisp_Image_Instance; /* glyphs.h */ typedef struct Lisp_Gui_Item Lisp_Gui_Item; @@ -1543,16 +1571,6 @@ RUN_HOOKS_UNTIL_FAILURE }; -#ifdef HAVE_TOOLBARS -enum toolbar_pos -{ - TOP_TOOLBAR, - BOTTOM_TOOLBAR, - LEFT_TOOLBAR, - RIGHT_TOOLBAR -}; -#endif - enum edge_style { EDGE_ETCHED_IN, @@ -1583,8 +1601,6 @@ /* misc */ /* ------------------------------- */ -#ifdef MEMORY_USAGE_STATS - /* This structure is used to keep statistics on the amount of memory in use. @@ -1604,15 +1620,31 @@ the fields to 0, and add any existing values to whatever was there before; this way, you can get a cumulative effect. */ -struct overhead_stats +struct usage_stats { - int was_requested; - int malloc_overhead; - int dynarr_overhead; - int gap_overhead; + Bytecount was_requested; + Bytecount malloc_overhead; + Bytecount dynarr_overhead; + Bytecount gap_overhead; }; -#endif /* MEMORY_USAGE_STATS */ +/* Generic version of usage stats structure including extra non-Lisp and + Lisp storage associated with the object, but not including the memory + used to hold the object itself. Up to 32 statistics are allowed, + in addition to the statistics in `U', which store another slice onto the + ancillary non-Lisp storage. + + Normally, each object creates its own version of this structure, e.g. + `struct window_stats', which parallels the structure in beginning with + a `struct usage_stats' and followed by Bytecount fields, so that a + pointer to that structure can be cast to a pointer of this structure + and sensible results gotten. */ + +struct generic_usage_stats +{ + struct usage_stats u; + Bytecount othervals[32]; +}; /************************************************************************/ @@ -1645,6 +1677,10 @@ #define INT_VALBITS (BITS_PER_EMACS_INT - INT_GCBITS) #define VALBITS (BITS_PER_EMACS_INT - GCBITS) +/* This is badly named; it's not the maximum value that an EMACS_INT can + have, it's the maximum value that a Lisp-visible fixnum can have (half + the maximum value an EMACS_INT can have) and as such would be better + called MOST_POSITIVE_FIXNUM. Similarly for MOST_NEGATIVE_FIXNUM. */ #define EMACS_INT_MAX ((EMACS_INT) ((1UL << (INT_VALBITS - 1)) -1UL)) #define EMACS_INT_MIN (-(EMACS_INT_MAX) - 1) /* WARNING: evaluates its arg twice. */ @@ -1721,358 +1757,10 @@ } /************************************************************************/ -/** Definitions of dynamic arrays (Dynarrs) and other allocators **/ +/** Definitions of dynarrs and other allocators **/ /************************************************************************/ -BEGIN_C_DECLS - -/************* Dynarr declaration *************/ - -#ifdef NEW_GC -#define DECLARE_DYNARR_LISP_IMP() \ - const struct lrecord_implementation *lisp_imp; -#else -#define DECLARE_DYNARR_LISP_IMP() -#endif - -#ifdef ERROR_CHECK_DYNARR -#define DECLARE_DYNARR_LOCKED() \ - int locked; -#else -#define DECLARE_DYNARR_LOCKED() -#endif - -#define Dynarr_declare(type) \ - struct lrecord_header header; \ - type *base; \ - DECLARE_DYNARR_LISP_IMP () \ - DECLARE_DYNARR_LOCKED () \ - int elsize; \ - int len_; \ - int largest_; \ - int max_ - -typedef struct dynarr -{ - Dynarr_declare (void); -} Dynarr; - -#define XD_DYNARR_DESC(base_type, sub_desc) \ - { XD_BLOCK_PTR, offsetof (base_type, base), \ - XD_INDIRECT(1, 0), {sub_desc} }, \ - { XD_INT, offsetof (base_type, len_) }, \ - { XD_INT_RESET, offsetof (base_type, largest_), XD_INDIRECT(1, 0) }, \ - { XD_INT_RESET, offsetof (base_type, max_), XD_INDIRECT(1, 0) } - -#ifdef NEW_GC -#define XD_LISP_DYNARR_DESC(base_type, sub_desc) \ - { XD_LISP_OBJECT_BLOCK_PTR, offsetof (base_type, base), \ - XD_INDIRECT(1, 0), {sub_desc} }, \ - { XD_INT, offsetof (base_type, len_) }, \ - { XD_INT_RESET, offsetof (base_type, largest_), XD_INDIRECT(1, 0) }, \ - { XD_INT_RESET, offsetof (base_type, max_), XD_INDIRECT(1, 0) } -#endif /* NEW_GC */ - -/************* Dynarr verification *************/ - -#ifdef ERROR_CHECK_DYNARR -DECLARE_INLINE_HEADER ( -int -Dynarr_verify_pos_at (void *d, int pos, const Ascbyte *file, int line) -) -{ - Dynarr *dy = (Dynarr *) d; - /* We use `largest', not `len', because the redisplay code often - accesses stuff between len and largest. */ - assert_at_line (pos >= 0 && pos < dy->largest_, file, line); - return pos; -} - -DECLARE_INLINE_HEADER ( -int -Dynarr_verify_pos_atp (void *d, int pos, const Ascbyte *file, int line) -) -{ - Dynarr *dy = (Dynarr *) d; - /* We use `largest', not `len', because the redisplay code often - accesses stuff between len and largest. */ - /* [[ Code will often do something like ... - - val = make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0), - Dynarr_length (dyn)); - - which works fine when the Dynarr_length is non-zero, but when zero, - the result of Dynarr_atp() not only points past the end of the - allocated array, but the array may not have ever been allocated and - hence the return value is NULL. But the length of 0 causes the - pointer to never get checked. These can occur throughout the code - so we put in a special check. --ben ]] - - Update: The common idiom `Dynarr_atp (dyn, 0)' has been changed to - `Dynarr_begin (dyn)'. Possibly this special check at POS 0 can be - done only for Dynarr_begin() not for general Dynarr_atp(). --ben */ - if (pos == 0 && dy->len_ == 0) - return pos; - /* #### It's vaguely possible that some code could legitimately want to - retrieve a pointer to the position just past the end of dynarr memory. - This could happen with Dynarr_atp() but not Dynarr_at(). If so, it - will trigger this assert(). In such cases, it should be obvious that - the code wants to do this; rather than relaxing the assert, we should - probably create a new macro Dynarr_atp_allow_end() which is like - Dynarr_atp() but which allows for pointing at invalid addresses -- we - really want to check for cases of accessing just past the end of - memory, which is a likely off-by-one problem to occur and will usually - not trigger a protection fault (instead, you'll just get random - behavior, possibly overwriting other memory, which is bad). --ben */ - assert_at_line (pos >= 0 && pos < dy->largest_, file, line); - return pos; -} - -DECLARE_INLINE_HEADER ( -int -Dynarr_verify_pos_atp_allow_end (void *d, int pos, const Ascbyte *file, - int line) -) -{ - Dynarr *dy = (Dynarr *) d; - /* We use `largest', not `len', because the redisplay code often - accesses stuff between len and largest. - We also allow referencing the very end, past the end of allocated - legitimately space. See comments in Dynarr_verify_pos_atp.()*/ - assert_at_line (pos >= 0 && pos <= dy->largest_, file, line); - return pos; -} - -#else -#define Dynarr_verify_pos_at(d, pos, file, line) (pos) -#define Dynarr_verify_pos_atp(d, pos, file, line) (pos) -#define Dynarr_verify_pos_atp_allow_end(d, pos, file, line) (pos) -#endif /* ERROR_CHECK_DYNARR */ - -#ifdef ERROR_CHECK_DYNARR -DECLARE_INLINE_HEADER ( -Dynarr * -Dynarr_verify_1 (void *d, const Ascbyte *file, int line) -) -{ - Dynarr *dy = (Dynarr *) d; - assert_at_line (dy->len_ >= 0 && dy->len_ <= dy->largest_ && - dy->largest_ <= dy->max_, file, line); - return dy; -} - -DECLARE_INLINE_HEADER ( -Dynarr * -Dynarr_verify_mod_1 (void *d, const Ascbyte *file, int line) -) -{ - Dynarr *dy = (Dynarr *) d; - assert_at_line (!dy->locked, file, line); - return Dynarr_verify_1 (d, file, line); -} - -#define Dynarr_verify(d) Dynarr_verify_1 (d, __FILE__, __LINE__) -#define Dynarr_verify_mod(d) Dynarr_verify_mod_1 (d, __FILE__, __LINE__) -#define Dynarr_lock(d) \ -do { \ - Dynarr *dy = Dynarr_verify_mod (d); \ - dy->locked = 1; \ -} while (0) -#define Dynarr_unlock(d) \ -do { \ - Dynarr *dy = Dynarr_verify (d); \ - dy->locked = 0; \ -} while (0) -#else -#define Dynarr_verify(d) ((Dynarr *) d) -#define Dynarr_verify_mod(d) ((Dynarr *) d) -#define Dynarr_lock(d) DO_NOTHING -#define Dynarr_unlock(d) DO_NOTHING -#endif /* ERROR_CHECK_DYNARR */ - -/************* Dynarr creation *************/ - -MODULE_API void *Dynarr_newf (int elsize); -MODULE_API void Dynarr_free (void *d); - -#ifdef NEW_GC -MODULE_API void *Dynarr_lisp_newf (int elsize, - const struct lrecord_implementation - *dynarr_imp, - const struct lrecord_implementation *imp); - -#define Dynarr_lisp_new(type, dynarr_imp, imp) \ - ((type##_dynarr *) Dynarr_lisp_newf (sizeof (type), dynarr_imp, imp)) -#define Dynarr_lisp_new2(dynarr_type, type, dynarr_imp, imp) \ - ((dynarr_type *) Dynarr_lisp_newf (sizeof (type)), dynarr_imp, imp) -#endif /* NEW_GC */ -#define Dynarr_new(type) ((type##_dynarr *) Dynarr_newf (sizeof (type))) -#define Dynarr_new2(dynarr_type, type) \ - ((dynarr_type *) Dynarr_newf (sizeof (type))) - -/************* Dynarr access *************/ - -#ifdef ERROR_CHECK_DYNARR -#define Dynarr_at(d, pos) \ - ((d)->base[Dynarr_verify_pos_at (d, pos, __FILE__, __LINE__)]) -#define Dynarr_atp_allow_end(d, pos) \ - (&((d)->base[Dynarr_verify_pos_atp_allow_end (d, pos, __FILE__, __LINE__)])) -#define Dynarr_atp(d, pos) \ - (&((d)->base[Dynarr_verify_pos_atp (d, pos, __FILE__, __LINE__)])) -#else -#define Dynarr_at(d, pos) ((d)->base[pos]) -#define Dynarr_atp(d, pos) (&Dynarr_at (d, pos)) -#define Dynarr_atp_allow_end(d, pos) Dynarr_atp (d, pos) -#endif - -/* Old #define Dynarr_atp(d, pos) (&Dynarr_at (d, pos)) */ -#define Dynarr_begin(d) Dynarr_atp (d, 0) -#define Dynarr_lastp(d) Dynarr_atp (d, Dynarr_length (d) - 1) -#define Dynarr_past_lastp(d) Dynarr_atp_allow_end (d, Dynarr_length (d)) - - -/************* Dynarr length/size retrieval and setting *************/ - -/* Retrieve the length of a Dynarr. The `+ 0' is to ensure that this cannot - be used as an lvalue. */ -#define Dynarr_length(d) (Dynarr_verify (d)->len_ + 0) -/* Retrieve the largest ever length seen of a Dynarr. The `+ 0' is to - ensure that this cannot be used as an lvalue. */ -#define Dynarr_largest(d) (Dynarr_verify (d)->largest_ + 0) -/* Retrieve the number of elements that fit in the currently allocated - space. The `+ 0' is to ensure that this cannot be used as an lvalue. */ -#define Dynarr_max(d) (Dynarr_verify (d)->max_ + 0) -/* Retrieve the advertised memory usage of a Dynarr, i.e. the number of - bytes occupied by the elements in the Dynarr, not counting any overhead. */ -#define Dynarr_sizeof(d) (Dynarr_length (d) * (d)->elsize) -/* Actually set the length of a Dynarr. This is a low-level routine that - should not be directly used; use Dynarr_set_length() instead if you need - to, but be very careful when doing so! */ -#define Dynarr_set_length_1(d, n) \ -do { \ - Elemcount _dsl1_n = (n); \ - dynarr_checking_assert (_dsl1_n >= 0 && _dsl1_n <= Dynarr_max (d)); \ - (void) Dynarr_verify_mod (d); \ - (d)->len_ = _dsl1_n; \ - /* Use the raw field references here otherwise we get a crash because \ - we've set the length but not yet fixed up the largest value. */ \ - if ((d)->len_ > (d)->largest_) \ - (d)->largest_ = (d)->len_; \ - (void) Dynarr_verify_mod (d); \ -} while (0) - -/* The following two defines will get you into real trouble if you aren't - careful. But they can save a lot of execution time when used wisely. */ -#define Dynarr_set_length(d, n) \ -do { \ - Elemcount _dsl_n = (n); \ - dynarr_checking_assert (_dsl_n >= 0 && _dsl_n <= Dynarr_largest (d)); \ - Dynarr_set_length_1 (d, _dsl_n); \ -} while (0) -#define Dynarr_increment(d) \ - Dynarr_set_length (d, Dynarr_length (d) + 1) - -/* Reset the Dynarr's length to 0. */ -#define Dynarr_reset(d) Dynarr_set_length (d, 0) - -MODULE_API void Dynarr_resize (void *dy, Elemcount size); - -#define Dynarr_resize_if(d, numels) \ -do { \ - Elemcount _dri_numels = (numels); \ - if (Dynarr_length (d) + _dri_numels > Dynarr_max (d)) \ - Dynarr_resize (d, Dynarr_length (d) + _dri_numels); \ -} while (0) - -#ifdef MEMORY_USAGE_STATS -struct overhead_stats; -Bytecount Dynarr_memory_usage (void *d, struct overhead_stats *stats); -#endif - -/************* Adding/deleting elements to/from a Dynarr *************/ - -#ifdef NEW_GC -#define Dynarr_add(d, el) \ -do { \ - const struct lrecord_implementation *imp = (d)->lisp_imp; \ - (void) Dynarr_verify_mod (d); \ - Dynarr_resize_if (d, 1); \ - ((d)->base)[Dynarr_length (d)] = (el); \ - if (imp) \ - set_lheader_implementation \ - ((struct lrecord_header *)&(((d)->base)[Dynarr_length (d)]), imp); \ - Dynarr_set_length_1 (d, Dynarr_length (d) + 1); \ - (void) Dynarr_verify_mod (d); \ -} while (0) -#else /* not NEW_GC */ -#define Dynarr_add(d, el) \ -do { \ - (void) Dynarr_verify_mod (d); \ - Dynarr_resize_if (d, 1); \ - ((d)->base)[Dynarr_length (d)] = (el); \ - Dynarr_set_length_1 (d, Dynarr_length (d) + 1); \ - (void) Dynarr_verify_mod (d); \ -} while (0) -#endif /* not NEW_GC */ - - -MODULE_API void Dynarr_insert_many (void *d, const void *el, int len, - int start); -MODULE_API void Dynarr_delete_many (void *d, int start, int len); - -#define Dynarr_insert_many_at_start(d, el, len) \ - Dynarr_insert_many (d, el, len, 0) -#define Dynarr_add_literal_string(d, s) Dynarr_add_many (d, s, sizeof (s) - 1) -#define Dynarr_add_lisp_string(d, s, codesys) \ -do { \ - Lisp_Object dyna_ls_s = (s); \ - Lisp_Object dyna_ls_cs = (codesys); \ - Extbyte *dyna_ls_eb; \ - Bytecount dyna_ls_bc; \ - \ - LISP_STRING_TO_SIZED_EXTERNAL (dyna_ls_s, dyna_ls_eb, \ - dyna_ls_bc, dyna_ls_cs); \ - Dynarr_add_many (d, dyna_ls_eb, dyna_ls_bc); \ -} while (0) - -/* Add LEN contiguous elements to a Dynarr */ - -DECLARE_INLINE_HEADER ( -void -Dynarr_add_many (void *d, const void *el, int len) -) -{ - /* This duplicates Dynarr_insert_many to some extent; but since it is - called so often, it seemed useful to remove the unnecessary stuff - from that function and to make it inline */ - Dynarr *dy = Dynarr_verify_mod (d); - Dynarr_resize_if (dy, len); - /* Some functions call us with a value of 0 to mean "reserve space but - don't write into it" */ - if (el) - memcpy ((char *) dy->base + Dynarr_sizeof (dy), el, len*dy->elsize); - Dynarr_set_length_1 (dy, Dynarr_length (dy) + len); - (void) Dynarr_verify_mod (dy); -} - -#define Dynarr_pop(d) \ - (dynarr_checking_assert (Dynarr_length (d) > 0), \ - Dynarr_verify_mod (d)->len_--, \ - Dynarr_at (d, Dynarr_length (d))) -#define Dynarr_delete(d, i) Dynarr_delete_many (d, i, 1) -#define Dynarr_delete_by_pointer(d, p) \ - Dynarr_delete_many (d, (p) - ((d)->base), 1) - -#define Dynarr_delete_object(d, el) \ -do \ -{ \ - REGISTER int i; \ - for (i = Dynarr_length (d) - 1; i >= 0; i--) \ - { \ - if (el == Dynarr_at (d, i)) \ - Dynarr_delete_many (d, i, 1); \ - } \ -} while (0) +#include "array.h" /************* Dynarr typedefs *************/ @@ -2157,7 +1845,7 @@ } face_cachel_dynarr; #ifdef NEW_GC -DECLARE_LRECORD (face_cachel_dynarr, face_cachel_dynarr); +DECLARE_LISP_OBJECT (face_cachel_dynarr, face_cachel_dynarr); #define XFACE_CACHEL_DYNARR(x) \ XRECORD (x, face_cachel_dynarr, face_cachel_dynarr) #define wrap_face_cachel_dynarr(p) wrap_record (p, face_cachel_dynarr) @@ -2172,7 +1860,7 @@ } glyph_cachel_dynarr; #ifdef NEW_GC -DECLARE_LRECORD (glyph_cachel_dynarr, glyph_cachel_dynarr); +DECLARE_LISP_OBJECT (glyph_cachel_dynarr, glyph_cachel_dynarr); #define XGLYPH_CACHEL_DYNARR(x) \ XRECORD (x, glyph_cachel_dynarr, glyph_cachel_dynarr) #define wrap_glyph_cachel_dynarr(p) wrap_record (p, glyph_cachel_dynarr) @@ -2200,12 +1888,6 @@ } Lisp_Object_ptr_dynarr; -/************* Stack-like malloc/free: Another allocator *************/ - -void *stack_like_malloc (Bytecount size); -void stack_like_free (void *val); - - /************************************************************************/ /** Definitions of other basic Lisp objects **/ /************************************************************************/ @@ -2233,7 +1915,7 @@ struct Lisp_Cons { - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; Lisp_Object car_, cdr_; }; typedef struct Lisp_Cons Lisp_Cons; @@ -2250,7 +1932,7 @@ }; #endif -DECLARE_MODULE_API_LRECORD (cons, Lisp_Cons); +DECLARE_MODULE_API_LISP_OBJECT (cons, Lisp_Cons); #define XCONS(x) XRECORD (x, cons, Lisp_Cons) #define wrap_cons(p) wrap_record (p, cons) #define CONSP(x) RECORDP (x, cons) @@ -2439,6 +2121,16 @@ PRIVATE_EXTERNAL_LIST_LOOP_6 (elt, list, len_##elt, tail, \ tortoise_##elt, CIRCULAR_LIST_SUSPICION_LENGTH) +#define GC_EXTERNAL_LIST_LOOP_3(elt, list, tail) \ +do { \ + XGCDECL3 (elt); \ + Lisp_Object elt, tail, tortoise_##elt; \ + EMACS_INT len_##elt; \ + XGCPRO3 (elt, elt, tail, tortoise_##elt); \ + PRIVATE_EXTERNAL_LIST_LOOP_6 (elt, list, len_##elt, tail, \ + tortoise_##elt, \ + CIRCULAR_LIST_SUSPICION_LENGTH) + #define EXTERNAL_LIST_LOOP_4_NO_DECLARE(elt, list, tail, len) \ Lisp_Object tortoise_##elt; \ PRIVATE_EXTERNAL_LIST_LOOP_6 (elt, list, len, tail, \ @@ -2450,21 +2142,55 @@ PRIVATE_EXTERNAL_LIST_LOOP_6 (elt, list, len, tail, \ tortoise_##elt, CIRCULAR_LIST_SUSPICION_LENGTH) - -#define PRIVATE_EXTERNAL_LIST_LOOP_6(elt, list, len, hare, \ - tortoise, suspicion_length) \ +#define GC_EXTERNAL_LIST_LOOP_4(elt, list, tail, len) \ +do { \ + XGCDECL3 (elt); \ + Lisp_Object elt, tail, tortoise_##elt; \ + XGCPRO3 (elt, elt, tail, tortoise_##elt); \ + PRIVATE_EXTERNAL_LIST_LOOP_6 (elt, list, len, tail, \ + tortoise_##elt, \ + CIRCULAR_LIST_SUSPICION_LENGTH) + +#define PRIVATE_UNVERIFIED_LIST_LOOP_7(elt, list, len, hare, \ + tortoise, suspicion_length, \ + signalp) \ for (tortoise = hare = list, len = 0; \ \ (CONSP (hare) ? ((elt = XCAR (hare)), 1) : \ (NILP (hare) ? 0 : \ - (signal_malformed_list_error (list), 0))); \ + ((signalp ? signal_malformed_list_error (list) : (void) 0), 0)));\ \ hare = XCDR (hare), \ (void) \ ((++len > suspicion_length) \ && \ ((((len & 1) != 0) && (tortoise = XCDR (tortoise), 0)), \ - (EQ (hare, tortoise) && (signal_circular_list_error (list), 0))))) + (EQ (hare, tortoise) && \ + ((signalp ? signal_circular_list_error (list) : (void) 0), 0))))) + +#define PRIVATE_EXTERNAL_LIST_LOOP_6(elt, list, len, hare, \ + tortoise, suspicion_length) \ + PRIVATE_UNVERIFIED_LIST_LOOP_7 (elt, list, len, hare, tortoise, \ + suspicion_length, 1) + +#define PRIVATE_SAFE_LIST_LOOP_6(elt, list, len, hare, \ + tortoise, suspicion_length) \ + PRIVATE_UNVERIFIED_LIST_LOOP_7 (elt, list, len, hare, tortoise, \ + suspicion_length, 0) + +/* Similar to EXTERNAL_LIST_LOOP_2() but don't signal when an error + is detected, just stop. */ +#define SAFE_LIST_LOOP_2(elt, list) \ +Lisp_Object elt, hare_##elt, tortoise_##elt; \ +EMACS_INT len_##elt; \ +PRIVATE_SAFE_LIST_LOOP_6 (elt, list, len_##elt, hare_##elt, \ + tortoise_##elt, CIRCULAR_LIST_SUSPICION_LENGTH) + +#define SAFE_LIST_LOOP_3(elt, list, tail) \ +Lisp_Object elt, tail, tortoise_##elt; \ +EMACS_INT len_##elt; \ +PRIVATE_SAFE_LIST_LOOP_6 (elt, list, len_##elt, tail, \ + tortoise_##elt, CIRCULAR_LIST_SUSPICION_LENGTH) /* GET_LIST_LENGTH and GET_EXTERNAL_LIST_LENGTH: @@ -2788,13 +2514,13 @@ #ifdef NEW_GC struct Lisp_String_Direct_Data { - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; Bytecount size; Ibyte data[1]; }; typedef struct Lisp_String_Direct_Data Lisp_String_Direct_Data; -DECLARE_MODULE_API_LRECORD (string_direct_data, Lisp_String_Direct_Data); +DECLARE_MODULE_API_LISP_OBJECT (string_direct_data, Lisp_String_Direct_Data); #define XSTRING_DIRECT_DATA(x) \ XRECORD (x, string_direct_data, Lisp_String_Direct_Data) #define wrap_string_direct_data(p) wrap_record (p, string_direct_data) @@ -2808,13 +2534,13 @@ struct Lisp_String_Indirect_Data { - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; Bytecount size; Ibyte *data; }; typedef struct Lisp_String_Indirect_Data Lisp_String_Indirect_Data; -DECLARE_MODULE_API_LRECORD (string_indirect_data, Lisp_String_Indirect_Data); +DECLARE_MODULE_API_LISP_OBJECT (string_indirect_data, Lisp_String_Indirect_Data); #define XSTRING_INDIRECT_DATA(x) \ XRECORD (x, string_indirect_data, Lisp_String_Indirect_Data) #define wrap_string_indirect_data(p) wrap_record (p, string_indirect_data) @@ -2854,7 +2580,9 @@ struct { /* WARNING: Everything before ascii_begin must agree exactly with - struct lrecord_header */ + struct lrecord_header. (Actually, the `free' field in old-GC + overlaps with ascii_begin there; we can get away with this + because in old-GC the `free' field is used only for lcrecords. */ unsigned int type :8; #ifdef NEW_GC unsigned int lisp_readonly :1; @@ -2889,7 +2617,7 @@ #define MAX_STRING_ASCII_BEGIN ((1 << 21) - 1) #endif /* not NEW_GC */ -DECLARE_MODULE_API_LRECORD (string, Lisp_String); +DECLARE_MODULE_API_LISP_OBJECT (string, Lisp_String); #define XSTRING(x) XRECORD (x, string, Lisp_String) #define wrap_string(p) wrap_record (p, string) #define STRINGP(x) RECORDP (x, string) @@ -2962,13 +2690,13 @@ struct Lisp_Vector { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; long size; Lisp_Object contents[1]; }; typedef struct Lisp_Vector Lisp_Vector; -DECLARE_LRECORD (vector, Lisp_Vector); +DECLARE_LISP_OBJECT (vector, Lisp_Vector); #define XVECTOR(x) XRECORD (x, vector, Lisp_Vector) #define wrap_vector(p) wrap_record (p, vector) #define VECTORP(x) RECORDP (x, vector) @@ -2999,13 +2727,13 @@ struct Lisp_Bit_Vector { - struct LCRECORD_HEADER lheader; + NORMAL_LISP_OBJECT_HEADER lheader; Elemcount size; unsigned long bits[1]; }; typedef struct Lisp_Bit_Vector Lisp_Bit_Vector; -DECLARE_LRECORD (bit_vector, Lisp_Bit_Vector); +DECLARE_LISP_OBJECT (bit_vector, Lisp_Bit_Vector); #define XBIT_VECTOR(x) XRECORD (x, bit_vector, Lisp_Bit_Vector) #define wrap_bit_vector(p) wrap_record (p, bit_vector) #define BIT_VECTORP(x) RECORDP (x, bit_vector) @@ -3053,7 +2781,7 @@ /* For when we want to include a bit vector in another structure, and we know it's of a fixed size. */ #define DECLARE_INLINE_LISP_BIT_VECTOR(numbits) struct { \ - struct LCRECORD_HEADER lheader; \ + NORMAL_LISP_OBJECT_HEADER lheader; \ Elemcount size; \ unsigned long bits[BIT_VECTOR_LONG_STORAGE(numbits)]; \ } @@ -3088,7 +2816,7 @@ typedef struct Lisp_Symbol Lisp_Symbol; struct Lisp_Symbol { - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; /* next symbol in this obarray bucket */ Lisp_Symbol *next; Lisp_Object name; @@ -3104,7 +2832,7 @@ XSTRING_LENGTH (symbol_name (XSYMBOL (sym)))))) #define KEYWORDP(obj) (SYMBOLP (obj) && SYMBOL_IS_KEYWORD (obj)) -DECLARE_MODULE_API_LRECORD (symbol, Lisp_Symbol); +DECLARE_MODULE_API_LISP_OBJECT (symbol, Lisp_Symbol); #define XSYMBOL(x) XRECORD (x, symbol, Lisp_Symbol) #define wrap_symbol(p) wrap_record (p, symbol) #define SYMBOLP(x) RECORDP (x, symbol) @@ -3132,7 +2860,7 @@ struct Lisp_Subr { - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; short min_args; short max_args; /* #### We should make these const Ascbyte * or const Ibyte *, not const @@ -3144,7 +2872,7 @@ }; typedef struct Lisp_Subr Lisp_Subr; -DECLARE_LRECORD (subr, Lisp_Subr); +DECLARE_LISP_OBJECT (subr, Lisp_Subr); #define XSUBR(x) XRECORD (x, subr, Lisp_Subr) #define wrap_subr(p) wrap_record (p, subr) #define SUBRP(x) RECORDP (x, subr) @@ -3162,7 +2890,7 @@ typedef struct Lisp_Marker Lisp_Marker; struct Lisp_Marker { - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; Lisp_Marker *next; Lisp_Marker *prev; struct buffer *buffer; @@ -3170,7 +2898,7 @@ char insertion_type; }; -DECLARE_MODULE_API_LRECORD (marker, Lisp_Marker); +DECLARE_MODULE_API_LISP_OBJECT (marker, Lisp_Marker); #define XMARKER(x) XRECORD (x, marker, Lisp_Marker) #define wrap_marker(p) wrap_record (p, marker) #define MARKERP(x) RECORDP (x, marker) @@ -3178,7 +2906,7 @@ #define CONCHECK_MARKER(x) CONCHECK_RECORD (x, marker) /* The second check was looking for GCed markers still in use */ -/* if (INTP (XMARKER (x)->lheader.next.v)) ABORT (); */ +/* assert (!INTP (XMARKER (x)->lheader.next.v)); */ #define marker_next(m) ((m)->next) #define marker_prev(m) ((m)->prev) @@ -3200,36 +2928,34 @@ return XREALINT (obj); } -#else /* no error checking */ +#else /* not ERROR_CHECK_TYPES */ #define XINT(obj) XREALINT (obj) -#endif /* no error checking */ +#endif /* (not) ERROR_CHECK_TYPES */ #define CHECK_INT(x) do { \ if (!INTP (x)) \ - dead_wrong_type_argument (Qintegerp, x); \ + dead_wrong_type_argument (Qfixnump, x); \ } while (0) #define CONCHECK_INT(x) do { \ if (!INTP (x)) \ - x = wrong_type_argument (Qintegerp, x); \ + x = wrong_type_argument (Qfixnump, x); \ } while (0) -#define NATNUMP(x) (INTP (x) && XINT (x) >= 0) - -#define CHECK_NATNUM(x) do { \ - if (!NATNUMP (x)) \ - dead_wrong_type_argument (Qnatnump, x); \ -} while (0) - -#define CONCHECK_NATNUM(x) do { \ - if (!NATNUMP (x)) \ - x = wrong_type_argument (Qnatnump, x); \ -} while (0) +END_C_DECLS + +/* -------------- properties of internally-formatted text ------------- */ + +#include "text.h" /*------------------------------- char ---------------------------------*/ +BEGIN_C_DECLS + +#ifdef ERROR_CHECK_TYPES + /* NOTE: There are basic functions for converting between a character and the string representation of a character in text.h, as well as lots of other character-related stuff. There are other functions/macros for @@ -3237,31 +2963,6 @@ Ichar, the length of an Ichar when converted to text, etc. */ -#ifdef MULE - -MODULE_API int non_ascii_valid_ichar_p (Ichar ch); - -/* Return whether the given Ichar is valid. - */ - -DECLARE_INLINE_HEADER ( -int -valid_ichar_p (Ichar ch) -) -{ - return (! (ch & ~0xFF)) || non_ascii_valid_ichar_p (ch); -} - -#else /* not MULE */ - -/* This works when CH is negative, and correctly returns non-zero only when CH - is in the range [0, 255], inclusive. */ -#define valid_ichar_p(ch) (! (ch & ~0xFF)) - -#endif /* not MULE */ - -#ifdef ERROR_CHECK_TYPES - DECLARE_INLINE_HEADER ( int CHARP_1 (Lisp_Object obj, const Ascbyte *file, int line) @@ -3416,12 +3117,12 @@ struct Lisp_Float { - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; union { double d; struct Lisp_Float *unused_next_; } data; }; typedef struct Lisp_Float Lisp_Float; -DECLARE_LRECORD (float, Lisp_Float); +DECLARE_LISP_OBJECT (float, Lisp_Float); #define XFLOAT(x) XRECORD (x, float, Lisp_Float) #define wrap_float(p) wrap_record (p, float) #define FLOATP(x) RECORDP (x, float) @@ -3445,6 +3146,10 @@ # define INT_OR_FLOATP(x) (INTP (x) || FLOATP (x)) +/* #### change for 64-bit machines */ +#define FLOAT_HASHCODE_FROM_DOUBLE(dbl) \ + (unsigned long)(fmod (dbl, 4e9)) + /*--------------------------- readonly objects -------------------------*/ #ifndef NEW_GC @@ -3504,7 +3209,7 @@ struct weak_box { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; Lisp_Object value; Lisp_Object next_weak_box; /* don't mark through this! */ @@ -3514,7 +3219,7 @@ Lisp_Object make_weak_box (Lisp_Object value); Lisp_Object weak_box_ref (Lisp_Object value); -DECLARE_LRECORD (weak_box, struct weak_box); +DECLARE_LISP_OBJECT (weak_box, struct weak_box); #define XWEAK_BOX(x) XRECORD (x, weak_box, struct weak_box) #define XSET_WEAK_BOX(x, v) (XWEAK_BOX (x)->value = (v)) #define wrap_weak_box(p) wrap_record (p, weak_box) @@ -3526,7 +3231,7 @@ struct ephemeron { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; Lisp_Object key; @@ -3551,7 +3256,7 @@ Lisp_Object zap_finalize_list(void); Lisp_Object make_ephemeron(Lisp_Object key, Lisp_Object value, Lisp_Object finalizer); -DECLARE_LRECORD(ephemeron, struct ephemeron); +DECLARE_LISP_OBJECT(ephemeron, struct ephemeron); #define XEPHEMERON(x) XRECORD (x, ephemeron, struct ephemeron) #define XEPHEMERON_REF(x) (XEPHEMERON (x)->value) #define XEPHEMERON_NEXT(x) (XCDR (XEPHEMERON(x)->cons_chain)) @@ -3585,13 +3290,13 @@ struct weak_list { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; Lisp_Object list; /* don't mark through this! */ enum weak_list_type type; Lisp_Object next_weak; /* don't mark through this! */ }; -DECLARE_LRECORD (weak_list, struct weak_list); +DECLARE_LISP_OBJECT (weak_list, struct weak_list); #define XWEAK_LIST(x) XRECORD (x, weak_list, struct weak_list) #define wrap_weak_list(p) wrap_record (p, weak_list) #define WEAK_LISTP(x) RECORDP (x, weak_list) @@ -3609,37 +3314,6 @@ END_C_DECLS /************************************************************************/ -/* Definitions related to the format of text and of characters */ -/************************************************************************/ - -/* Note: - - "internally formatted text" and the term "internal format" in - general are likely to refer to the format of text in buffers and - strings; "externally formatted text" and the term "external format" - refer to any text format used in the O.S. or elsewhere outside of - XEmacs. The format of text and of a character are related and - there must be a one-to-one relationship (hopefully through a - relatively simple algorithmic means of conversion) between a string - of text and an equivalent array of characters, but the conversion - between the two is NOT necessarily trivial. - - In a non-Mule XEmacs, allowed characters are numbered 0 through - 255, where no fixed meaning is assigned to them, but (when - representing text, rather than bytes in a binary file) in practice - the lower half represents ASCII and the upper half some other 8-bit - character set (chosen by setting the font, case tables, syntax - tables, etc. appropriately for the character set through ad-hoc - means such as the `iso-8859-1' file and the - `standard-display-european' function). - - #### Finish this. - - */ -#include "text.h" - - -/************************************************************************/ /* Definitions of primitive Lisp functions and variables */ /************************************************************************/ @@ -3735,7 +3409,7 @@ static struct Lisp_Subr *S##Fname; \ DOESNT_RETURN_TYPE (Lisp_Object) Fname (DEFUN_##max_args arglist) #define GET_DEFUN_LISP_OBJECT(Fname) \ - wrap_subr (S##Fname); + wrap_subr (&MC_ALLOC_S##Fname) #else /* not NEW_GC */ #define DEFUN(lname, Fname, min_args, max_args, prompt, arglist) \ Lisp_Object Fname (EXFUN_##max_args); \ @@ -3746,7 +3420,6 @@ 1, /* mark bit */ \ 1, /* c_readonly bit */ \ 1, /* lisp_readonly bit */ \ - 0 /* unused */ \ }, \ min_args, \ max_args, \ @@ -3766,7 +3439,6 @@ 1, /* mark bit */ \ 1, /* c_readonly bit */ \ 1, /* lisp_readonly bit */ \ - 0 /* unused */ \ }, \ min_args, \ max_args, \ @@ -3777,7 +3449,7 @@ }; \ DOESNT_RETURN_TYPE (Lisp_Object) Fname (DEFUN_##max_args arglist) #define GET_DEFUN_LISP_OBJECT(Fname) \ - wrap_subr (&S##Fname); + wrap_subr (&S##Fname) #endif /* not NEW_GC */ /* Heavy ANSI C preprocessor hackery to get DEFUN to declare a @@ -3821,6 +3493,199 @@ while (NILP (Ffunctionp (fun))) \ signal_invalid_function_error (fun); \ } while (0) + +/************************************************************************/ +/* Parsing keyword arguments */ +/************************************************************************/ + +/* The C subr must have been declared with MANY as its max args, and this + PARSE_KEYWORDS call must come before any statements. Equivalently, it + can appear within braces. + + FUNCTION is the C name of the current DEFUN. If there is no current + DEFUN, use the PARSE_KEYWORDS_8 macro, not PARSE_KEYWORDS. If the + current DEFUN has optional arguments that are not keywords, you also need + to use the PARSE_KEYWORDS_8 macro. This is also the case if there are + optional arguments that come before the keywords, as Common Lisp + specifies for #'parse-integer. + + NARGS is the count of arguments supplied to FUNCTION. + + ARGS is a pointer to the argument vector (not a Lisp vector) supplied to + FUNCTION. + + KEYWORD_COUNT is the number of keywords FUNCTION is normally prepared to + handle. + + KEYWORDS is a parenthesised list of those keywords, without the initial + Q_. + + KEYWORD_DEFAULTS allows you to set non-nil defaults. Put (keywordname = + initial_value) in this parameter, a collection of C statements surrounded + by parentheses and separated by the comma operator. If you don't need + this, supply NULL as KEYWORD_DEFAULTS. + + For keywords which appear multiple times in the called argument list, the + leftmost one overrides, as specified in section 7.1.1 of the CLHS. + + If you want to check whether a given keyword argument was set (as in the + SVAR argument to defun*), supply Qunbound as its default in + KEYWORD_DEFAULTS, and examine it once PARSE_KEYWORDS is done. Lisp code + cannot supply Qunbound as an argument, so if it is still Qunbound, it was + not set. + + There is no elegant way with this macro to have one name for the keyword + and an unrelated name for the local variable, as is possible with the + ((:keyword unrelated-var)) syntax in defun* and in Common Lisp. That + shouldn't matter in practice. */ +#if defined (DEBUG_XEMACS) && defined (__STDC_VERSION__) && \ + __STDC_VERSION__ >= 199901L + +/* This version has the advantage that DEFUN without DEFSUBR still provokes + a defined but not used warning, and it provokes an assertion failure at + runtime if someone has copied and pasted the PARSE_KEYWORDS macro from + another function without changing FUNCTION; that would lead to an + incorrect determination of KEYWORDS_OFFSET. */ + +#define PARSE_KEYWORDS(function, nargs, args, keyword_count, keywords, \ + keyword_defaults) \ + PARSE_KEYWORDS_8 (intern_massaging_name (1 + #function), nargs, args, \ + keyword_count, keywords, keyword_defaults, \ + /* Can't XSUBR (Fsymbol_function (...))->min_args, \ + the function may be advised. */ \ + XINT (Ffunction_min_args \ + (intern_massaging_name (1 + #function))), \ + 0); \ + assert (0 == strcmp (__func__, #function)) +#else /* defined (DEBUG_XEMACS) && ... */ +#define PARSE_KEYWORDS(function, nargs, args, keyword_count, keywords, \ + keyword_defaults) \ + PARSE_KEYWORDS_8 (intern (subr_name (XSUBR \ + (GET_DEFUN_LISP_OBJECT (function)))), \ + nargs, args, keyword_count, keywords, \ + keyword_defaults, \ + XSUBR (GET_DEFUN_LISP_OBJECT (function))->min_args, \ + 0) +#endif /* defined (DEBUG_XEMACS) && defined (__STDC_VERSION__) ... */ + +/* PARSE_KEYWORDS_8 is a more fine-grained version of PARSE_KEYWORDS. The + differences are as follows: + + FUNC_SYM is a symbol reflecting the name of the function for which + keywords are being parsed. In PARSE_KEYWORDS, it is the Lisp-visible + name of C_FUNC, interned as a symbol in obarray. + + KEYWORDS_OFFSET is the offset into ARGS where the keyword arguments + start. In PARSE_KEYWORDS, this is the index of the first optional + argument, determined from the information known about C_FUNC. + + ALLOW_OTHER_KEYS corresponds to the &allow-other-keys argument list entry + in defun*; it is 1 if other keys are normally allowed, 0 otherwise. This + may be overridden in the caller by specifying :allow-other-keys t in the + argument list. In PARSE_KEYWORDS, ALLOW_OTHER_KEYS is always 0. */ + +#define PARSE_KEYWORDS_8(func_sym, nargs, args, \ + keyword_count, keywords, keyword_defaults, \ + keywords_offset, allow_other_keys) \ + DECLARE_N_KEYWORDS_##keyword_count keywords; \ + \ + do \ + { \ + Lisp_Object pk_key, pk_value; \ + Elemcount pk_i = nargs - 1, pk_offset = keywords_offset; \ + Boolint pk_allow_other_keys = allow_other_keys; \ + \ + if ((nargs - pk_offset) & 1) \ + { \ + if (!allow_other_keys \ + && !(pk_allow_other_keys \ + = non_nil_allow_other_keys_p (pk_offset, \ + nargs, args))) \ + { \ + signal_wrong_number_of_arguments_error (func_sym, nargs); \ + } \ + else \ + { \ + /* Ignore the trailing arg; so below always sees an even \ + number of arguments. */ \ + pk_i -= 1; \ + } \ + } \ + \ + (void)(keyword_defaults); \ + \ + /* Start from the end, because the leftmost element overrides. */ \ + while (pk_i > pk_offset) \ + { \ + pk_value = args[pk_i--]; \ + pk_key = args[pk_i--]; \ + \ + if (0) {} \ + CHECK_N_KEYWORDS_##keyword_count keywords \ + else if (allow_other_keys || pk_allow_other_keys) \ + { \ + continue; \ + } \ + else if ((pk_allow_other_keys \ + = non_nil_allow_other_keys_p (pk_offset, \ + nargs, args))) \ + { \ + continue; \ + } \ + else if (EQ (pk_key, Q_allow_other_keys) && \ + NILP (pk_value)) \ + { \ + continue; \ + } \ + else \ + { \ + invalid_keyword_argument (func_sym, pk_key); \ + } \ + } \ + } while (0) + +#define DECLARE_N_KEYWORDS_1(a) \ + Lisp_Object a = Qnil +#define DECLARE_N_KEYWORDS_2(a,b) \ + DECLARE_N_KEYWORDS_1(a), b = Qnil +#define DECLARE_N_KEYWORDS_3(a,b,c) \ + DECLARE_N_KEYWORDS_2(a,b), c = Qnil +#define DECLARE_N_KEYWORDS_4(a,b,c,d) \ + DECLARE_N_KEYWORDS_3(a,b,c), d = Qnil +#define DECLARE_N_KEYWORDS_5(a,b,c,d,e) \ + DECLARE_N_KEYWORDS_4(a,b,c,d), e = Qnil +#define DECLARE_N_KEYWORDS_6(a,b,c,d,e,f) \ + DECLARE_N_KEYWORDS_5(a,b,c,d,e), f = Qnil +#define DECLARE_N_KEYWORDS_7(a,b,c,d,e,f,g) \ + DECLARE_N_KEYWORDS_6(a,b,c,d,e,f), g = Qnil +#define DECLARE_N_KEYWORDS_8(a,b,c,d,e,f,g,h) \ + DECLARE_N_KEYWORDS_7(a,b,c,d,e,f,g), h = Qnil +#define DECLARE_N_KEYWORDS_9(a,b,c,d,e,f,g,h,i) \ + DECLARE_N_KEYWORDS_8(a,b,c,d,e,f,g,h), i = Qnil + +#define CHECK_N_KEYWORDS_1(a) \ + else if (EQ (pk_key, Q_##a)) { a = pk_value; } +#define CHECK_N_KEYWORDS_2(a,b) CHECK_N_KEYWORDS_1(a) \ + else if (EQ (pk_key, Q_##b)) { b = pk_value; } +#define CHECK_N_KEYWORDS_3(a,b,c) CHECK_N_KEYWORDS_2(a,b) \ + else if (EQ (pk_key, Q_##c)) { c = pk_value; } +#define CHECK_N_KEYWORDS_4(a,b,c,d) CHECK_N_KEYWORDS_3(a,b,c) \ + else if (EQ (pk_key, Q_##d)) { d = pk_value; } +#define CHECK_N_KEYWORDS_5(a,b,c,d,e) CHECK_N_KEYWORDS_4(a,b,c,d) \ + else if (EQ (pk_key, Q_##e)) { e = pk_value; } +#define CHECK_N_KEYWORDS_6(a,b,c,d,e,f) CHECK_N_KEYWORDS_5(a,b,c,d,e) \ + else if (EQ (pk_key, Q_##f)) { f = pk_value; } +#define CHECK_N_KEYWORDS_7(a,b,c,d,e,f,g) CHECK_N_KEYWORDS_6(a,b,c,d,e,f) \ + else if (EQ (pk_key, Q_##g)) { g = pk_value; } +#define CHECK_N_KEYWORDS_8(a,b,c,d,e,f,g,h) \ + CHECK_N_KEYWORDS_7(a,b,c,d,e,f,g) \ + else if (EQ (pk_key, Q_##h)) { h = pk_value; } +#define CHECK_N_KEYWORDS_9(a,b,c,d,e,f,g,h,i) \ + CHECK_N_KEYWORDS_8(a,b,c,d,e,f,g,h) \ + else if (EQ (pk_key, Q_##i)) { i = pk_value; } + +Boolint non_nil_allow_other_keys_p (Elemcount offset, int nargs, + Lisp_Object *args); /************************************************************************/ @@ -3923,8 +3788,9 @@ #define LISP_HASH(obj) ((unsigned long) STORE_LISP_IN_VOID (obj)) Hashcode memory_hash (const void *xv, Bytecount size); -Hashcode internal_hash (Lisp_Object obj, int depth); -Hashcode internal_array_hash (Lisp_Object *arr, int size, int depth); +Hashcode internal_hash (Lisp_Object obj, int depth, Boolint equalp); +Hashcode internal_array_hash (Lisp_Object *arr, int size, int depth, + Boolint equalp); /************************************************************************/ @@ -4415,8 +4281,6 @@ number of header files that need to be included -- good for a number of reasons. --ben */ -/*--------------- prototypes for various public c functions ------------*/ - /* Prototypes for all init/syms_of/vars_of initialization functions. */ #include "symsinit.h" @@ -4428,6 +4292,7 @@ /* Defined in alloc.c */ MODULE_API EXFUN (Fcons, 2); MODULE_API EXFUN (Flist, MANY); +MODULE_API EXFUN (Facons, 3); EXFUN (Fbit_vector, MANY); EXFUN (Fmake_byte_code, MANY); MODULE_API EXFUN (Fmake_list, 2); @@ -4437,6 +4302,7 @@ MODULE_API EXFUN (Fmake_vector, 2); MODULE_API EXFUN (Fvector, MANY); +void deadbeef_memory (void *ptr, Bytecount size); #ifndef NEW_GC void release_breathing_space (void); #endif /* not NEW_GC */ @@ -4451,26 +4317,29 @@ #ifndef NEW_GC void garbage_collect_1 (void); #endif /* not NEW_GC */ -MODULE_API Lisp_Object acons (Lisp_Object, Lisp_Object, Lisp_Object); MODULE_API Lisp_Object cons3 (Lisp_Object, Lisp_Object, Lisp_Object); MODULE_API Lisp_Object list1 (Lisp_Object); MODULE_API Lisp_Object list2 (Lisp_Object, Lisp_Object); MODULE_API Lisp_Object list3 (Lisp_Object, Lisp_Object, Lisp_Object); MODULE_API Lisp_Object list4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); -MODULE_API Lisp_Object list5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, - Lisp_Object); -MODULE_API Lisp_Object list6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, +MODULE_API Lisp_Object list5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); +MODULE_API Lisp_Object list6 (Lisp_Object, Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object, Lisp_Object); +MODULE_API Lisp_Object listn (int numargs, ...); +MODULE_API Lisp_Object listu (Lisp_Object, ...); DECLARE_DOESNT_RETURN (memory_full (void)); void disksave_object_finalization (void); +void finish_object_memory_usage_stats (void); extern int purify_flag; +#define ARRAY_DIMENSION_LIMIT EMACS_INT_MAX +extern Fixnum Varray_dimension_limit; #ifndef NEW_GC extern EMACS_INT gc_generation_number[1]; #endif /* not NEW_GC */ int c_readonly (Lisp_Object); int lisp_readonly (Lisp_Object); -MODULE_API void copy_lisp_object (Lisp_Object dst, Lisp_Object src); MODULE_API Lisp_Object build_istring (const Ibyte *); MODULE_API Lisp_Object build_cistring (const CIbyte *); MODULE_API Lisp_Object build_ascstring (const Ascbyte *); @@ -4487,21 +4356,6 @@ void free_marker (Lisp_Object); int object_dead_p (Lisp_Object); void mark_object (Lisp_Object obj); -#ifndef NEW_GC -#ifdef USE_KKCC -#ifdef DEBUG_XEMACS -void kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj, int level, int pos); -#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \ - kkcc_gc_stack_push_lisp_object_1 (obj, level, pos) -void kkcc_backtrace (void); -#else -void kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj); -#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \ - kkcc_gc_stack_push_lisp_object_1 (obj) -#define kkcc_backtrace() -#endif -#endif /* USE_KKCC */ -#endif /* not NEW_GC */ int marked_p (Lisp_Object obj); extern int funcall_allocation_flag; extern int need_to_garbage_collect; @@ -4510,10 +4364,7 @@ extern Lisp_Object Qpost_gc_hook, Qgarbage_collecting; void recompute_funcall_allocation_flag (void); -#ifdef MEMORY_USAGE_STATS -Bytecount malloced_storage_size (void *, Bytecount, struct overhead_stats *); -Bytecount fixed_type_block_overhead (Bytecount); -#endif +Bytecount malloced_storage_size (void *, Bytecount, struct usage_stats *); #ifdef EVENT_DATA_AS_OBJECTS Lisp_Object make_key_data (void); @@ -4576,6 +4427,7 @@ extern Lisp_Object Qbefore_change_function, Qbefore_change_functions; extern Lisp_Object Qbuffer_or_string_p, Qdefault_directory, Qfirst_change_hook; extern Lisp_Object Qpermanent_local, Vafter_change_function; +extern Lisp_Object Qbuffer_live_p; extern Lisp_Object Vafter_change_functions, Vbefore_change_function; extern Lisp_Object Vbefore_change_functions, Vbuffer_alist, Vbuffer_defaults; extern Lisp_Object Vinhibit_read_only, Vtransient_mark_mode; @@ -4591,6 +4443,12 @@ /* Defined in callint.c */ EXFUN (Fcall_interactively, 3); EXFUN (Fprefix_numeric_value, 1); +extern Lisp_Object Qcall_interactively; +extern Lisp_Object Qmouse_leave_buffer_hook; +extern Lisp_Object Qread_from_minibuffer; +extern Lisp_Object Vcommand_history; +extern Lisp_Object Vcurrent_prefix_arg; +extern Lisp_Object Vmark_even_if_inactive; /* Defined in casefiddle.c */ EXFUN (Fdowncase, 2); @@ -4605,12 +4463,28 @@ /* Defined in chartab.c */ EXFUN (Freset_char_table, 1); +extern Lisp_Object Qcategory_designator_p; +extern Lisp_Object Qcategory_table_value_p; + +/* Defined in cmdloop.c */ +extern Lisp_Object Qdisabled_command_hook; +extern Lisp_Object Qreally_early_error_handler; +extern Lisp_Object Qtop_level; +extern Lisp_Object Vdisabled_command_hook; /* Defined in cmds.c */ EXFUN (Fbeginning_of_line, 2); EXFUN (Fend_of_line, 2); EXFUN (Fforward_char, 2); EXFUN (Fforward_line, 2); +extern Lisp_Object Qself_insert_command; + +/* Defined in console.c */ +extern Lisp_Object Qconsole_live_p; +extern Lisp_Object Vconsole_list; + +/* Defined in console-stream.c */ +extern Lisp_Object Vstdio_str; /* Defined in data.c */ EXFUN (Fadd1, 1); @@ -4648,7 +4522,7 @@ MODULE_API Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); MODULE_API DECLARE_DOESNT_RETURN (dead_wrong_type_argument (Lisp_Object, Lisp_Object)); -void check_int_range (EMACS_INT, EMACS_INT, EMACS_INT); +void check_integer_range (Lisp_Object, Lisp_Object, Lisp_Object); EXFUN (Fint_to_char, 1); EXFUN (Fchar_to_int, 1); @@ -4674,11 +4548,13 @@ Qnonnegativep, Qnumber_char_or_marker_p, Qnumberp, Qquote, Qtrue_list_p; extern MODULE_API Lisp_Object Qintegerp; -extern Lisp_Object Qarith_error, Qbeginning_of_buffer, Qbuffer_read_only, - Qcircular_list, Qcircular_property_list, Qconversion_error, - Qcyclic_variable_indirection, Qdomain_error, Qediting_error, - Qend_of_buffer, Qend_of_file, Qerror, Qfile_error, Qinternal_error, - Qinvalid_change, Qinvalid_constant, Qinvalid_function, Qinvalid_operation, +extern Lisp_Object Qargs_out_of_range, Qarith_error, Qbeginning_of_buffer, + Qbuffer_read_only, Qextent_read_only, + Qcircular_list, Qcircular_property_list, + Qconversion_error, Qcyclic_variable_indirection, Qdomain_error, + Qediting_error, Qend_of_buffer, Qend_of_file, Qerror, Qfile_error, + Qinternal_error, Qinvalid_change, Qinvalid_constant, Qinvalid_function, + Qinvalid_keyword_argument, Qinvalid_operation, Qinvalid_read_syntax, Qinvalid_state, Qio_error, Qlist_formation_error, Qmalformed_list, Qmalformed_property_list, Qno_catch, Qout_of_memory, Qoverflow_error, Qprinting_unreadable_object, Qquit, Qrange_error, @@ -4686,11 +4562,21 @@ Qstructure_formation_error, Qtext_conversion_error, Qunderflow_error, Qvoid_function, Qvoid_variable, Qwrong_number_of_arguments, Qwrong_type_argument; + +extern Lisp_Object Qcdr; +extern Lisp_Object Qerror_lacks_explanatory_string; +extern Lisp_Object Qfile_error; +extern Lisp_Object Qsequencep; extern MODULE_API Lisp_Object Qinvalid_argument, Qsyntax_error; +/* Defined in device.c */ +extern Lisp_Object Qdevice_live_p; + +/* Defined in device-x.c */ +extern Lisp_Object Vx_initial_argv_list; + /* Defined in dired.c */ -Lisp_Object make_directory_hash_table (const Ibyte *); -Lisp_Object wasteful_word_to_lisp (unsigned int); +Lisp_Object make_directory_hash_table (Lisp_Object); /* Defined in doc.c */ EXFUN (Fsubstitute_command_keys, 1); @@ -4700,6 +4586,7 @@ Lisp_Object name_reloc, int standard_doc_file); Lisp_Object read_doc_string (Lisp_Object); +extern Lisp_Object Vinternal_doc_file_name; /* Defined in doprnt.c */ Bytecount emacs_doprnt_va (Lisp_Object stream, const Ibyte *format_nonreloc, @@ -4739,6 +4626,7 @@ EXFUN (Fbuffer_substring, 3); EXFUN (Fchar_after, 2); EXFUN (Fchar_to_string, 1); +EXFUN (Fcurrent_time, 0); EXFUN (Fdelete_region, 3); EXFUN (Feobp, 1); EXFUN (Feolp, 1); @@ -4772,10 +4660,16 @@ Lisp_Object save_restriction_restore (Lisp_Object); void widen_buffer (struct buffer *b, int no_clip); int beginning_of_line_p (struct buffer *b, Charbpos pt); - -/* Defined in emacsfns.c */ Lisp_Object save_current_buffer_restore (Lisp_Object); +extern Lisp_Object Qformat; +extern Lisp_Object Qmark; +extern Lisp_Object Qpoint; +extern Lisp_Object Qregion_beginning; +extern Lisp_Object Qregion_end; +extern Lisp_Object Quser_files_and_directories; +extern Lisp_Object Vsystem_name; + /* Defined in emacs.c */ EXFUN_NORETURN (Fkill_emacs, 1); EXFUN (Frunning_temacs_p, 0); @@ -4799,12 +4693,31 @@ DECLARE_DOESNT_RETURN (really_abort (void)); void zero_out_command_line_status_vars (void); +extern Lisp_Object Qsave_buffers_kill_emacs; +extern Lisp_Object Vcommand_line_args; +extern Lisp_Object Vconfigure_info_directory; +extern Lisp_Object Vconfigure_site_directory; +extern Lisp_Object Vconfigure_site_module_directory; +extern Lisp_Object Vdata_directory; +extern Lisp_Object Vdoc_directory; +extern Lisp_Object Vemacs_major_version; +extern Lisp_Object Vemacs_minor_version; +extern Lisp_Object Vexec_directory; +extern Lisp_Object Vexec_path; +extern Lisp_Object Vinvocation_directory; +extern Lisp_Object Vinvocation_name; +extern Lisp_Object Vmodule_directory; +extern Lisp_Object Vsite_directory; +extern Lisp_Object Vsite_module_directory; + /* Defined in emodules.c */ #ifdef HAVE_SHLIB EXFUN (Flist_modules, 0); EXFUN (Fload_module, 3); extern int unloading_module; #endif +extern Lisp_Object Qdll_error; +extern Lisp_Object Qmodule; /* Defined in eval.c */ MODULE_API EXFUN (Fapply, MANY); @@ -4827,6 +4740,10 @@ Lisp_Object, int, Lisp_Object, Lisp_Object)); +MODULE_API DECLARE_DOESNT_RETURN (throw_or_bomb_out_unsafe (Lisp_Object, + Lisp_Object, int, + Lisp_Object, Lisp_Object)); + MODULE_API DECLARE_DOESNT_RETURN (signal_error_1 (Lisp_Object, Lisp_Object)); void maybe_signal_error_1 (Lisp_Object, Lisp_Object, Lisp_Object, Error_Behavior); @@ -4906,6 +4823,8 @@ Lisp_Object frob2)); void maybe_invalid_argument (const Ascbyte *, Lisp_Object, Lisp_Object, Error_Behavior); +MODULE_API DECLARE_DOESNT_RETURN (invalid_keyword_argument (Lisp_Object fun, + Lisp_Object kw)); MODULE_API DECLARE_DOESNT_RETURN (invalid_operation (const Ascbyte *reason, Lisp_Object frob)); MODULE_API DECLARE_DOESNT_RETURN (invalid_operation_2 (const Ascbyte *reason, @@ -5114,9 +5033,25 @@ MODULE_API void warn_when_safe (Lisp_Object, Lisp_Object, const Ascbyte *, ...) PRINTF_ARGS (3, 4); extern int backtrace_with_internal_sections; - +extern Fixnum Vmultiple_values_limit; + +extern Lisp_Object Qand_optional; +extern Lisp_Object Qand_rest; +extern Lisp_Object Qautoload; +extern Lisp_Object Qcommandp; +extern Lisp_Object Qdefun; +extern Lisp_Object Qexit; +extern Lisp_Object Qinhibit_quit; +extern Lisp_Object Qinteractive; +extern Lisp_Object Qmacro; +extern Lisp_Object Qprogn; +extern Lisp_Object Qrun_hooks; +extern Lisp_Object Qvalues; extern Lisp_Object Vdebug_on_error; extern Lisp_Object Vstack_trace_on_error; +extern Lisp_Object Vautoload_queue; + +extern MODULE_API Lisp_Object Vinhibit_quit, Vquit_flag; /* Defined in event-stream.c */ EXFUN (Faccept_process_output, 3); @@ -5138,6 +5073,19 @@ Lisp_Object, int, int, int, int); extern int modifier_keys_are_sticky; +extern Lisp_Object Qdisabled; +extern Lisp_Object Qsans_modifiers; +extern Lisp_Object Qself_insert_defer_undo; +extern Lisp_Object Vcontrolling_terminal; +extern Lisp_Object Vcurrent_mouse_event; +extern Lisp_Object Vlast_command; +extern Lisp_Object Vlast_command_char; +extern Lisp_Object Vlast_command_event; +extern Lisp_Object Vlast_input_event; +extern Lisp_Object Vrecent_keys_ring; +extern Lisp_Object Vthis_command_keys; +extern Lisp_Object Vunread_command_event; + /* Defined in event-Xt.c */ void signal_special_Xt_user_event (Lisp_Object, Lisp_Object, Lisp_Object); @@ -5152,6 +5100,22 @@ EXFUN (Fevent_x_pixel, 1); EXFUN (Fevent_y_pixel, 1); +extern Lisp_Object Qevent_live_p; + + +/* Defined in extents.c */ +extern Lisp_Object Qend_open; +extern Lisp_Object Qextent_live_p; +extern Lisp_Object Qstart_open; + +/* Defined in faces.c */ +extern Lisp_Object Qbackground; +extern Lisp_Object Qbackground_pixmap; +extern Lisp_Object Qblinking; +extern Lisp_Object Qdim; +extern Lisp_Object Qdisplay_table; +extern Lisp_Object Qforeground; +extern Lisp_Object Qunderline; /* Defined in file-coding.c */ EXFUN (Fcoding_category_list, 0); @@ -5239,6 +5203,9 @@ Ibyte *find_end_of_directory_component (const Ibyte *path, Bytecount len); +extern Lisp_Object Qfile_name_sans_extension; +extern Lisp_Object Vdirectory_sep_char; + /* Defined in filelock.c */ EXFUN (Funlock_buffer, 0); @@ -5264,8 +5231,6 @@ EXFUN (Fcopy_list, 1); EXFUN (Fcopy_sequence, 1); EXFUN (Fcopy_tree, 2); -EXFUN (Fdelete, 2); -EXFUN (Fdelq, 2); EXFUN (Fdestructive_alist_to_plist, 1); EXFUN (Felt, 2); MODULE_API EXFUN (Fequal, 2); @@ -5296,15 +5261,25 @@ EXFUN (Freplace_list, 2); MODULE_API EXFUN (Freverse, 1); EXFUN (Fsafe_length, 1); -EXFUN (Fsort, 2); EXFUN (Fstring_equal, 2); EXFUN (Fstring_lessp, 2); -EXFUN (Fsubstring, 3); +EXFUN (Fsubseq, 3); EXFUN (Fvalid_plist_p, 1); -Lisp_Object list_sort (Lisp_Object, Lisp_Object, - int (*) (Lisp_Object, Lisp_Object, Lisp_Object)); -Lisp_Object merge (Lisp_Object, Lisp_Object, Lisp_Object); +extern Boolint check_lss_key_car (Lisp_Object, Lisp_Object, Lisp_Object, + Lisp_Object); +extern Boolint check_string_lessp_nokey (Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object); + +typedef Boolint (*check_test_func_t) (Lisp_Object test, Lisp_Object key, + Lisp_Object item, Lisp_Object elt); + +Lisp_Object list_merge (Lisp_Object org_l1, Lisp_Object org_l2, + check_test_func_t check_merge, + Lisp_Object predicate, Lisp_Object key_func); +Lisp_Object list_sort (Lisp_Object list, + check_test_func_t check_merge, + Lisp_Object predicate, Lisp_Object key_func); void bump_string_modiff (Lisp_Object); Lisp_Object memq_no_quit (Lisp_Object, Lisp_Object); @@ -5350,15 +5325,56 @@ Lisp_Object add_prefix_to_symbol (const Ascbyte *ascii_string, Lisp_Object symbol); +extern Lisp_Object Qidentity; +extern Lisp_Object Qstring_lessp; +extern Lisp_Object Qyes_or_no_p; +extern Lisp_Object Vfeatures; + +/* Defined in frame.c */ +extern Lisp_Object Qframe_live_p; + /* Defined in free-hook.c */ EXFUN (Freally_free, 1); +/* Defined in general.c */ +#define SYMBOL(fou) extern Lisp_Object fou +#define SYMBOL_MODULE_API(fou) extern MODULE_API Lisp_Object fou +#define SYMBOL_KEYWORD(la_cle_est_folle) extern Lisp_Object la_cle_est_folle +#define SYMBOL_GENERAL(tout_le_monde, est_fou) \ + extern Lisp_Object tout_le_monde +#define SYMBOL_KEYWORD_GENERAL(y_compris_ben, mais_que_peut_on_faire) \ + extern Lisp_Object y_compris_ben + +#include "general-slots.h" + +#undef SYMBOL +#undef SYMBOL_MODULE_API +#undef SYMBOL_KEYWORD +#undef SYMBOL_GENERAL +#undef SYMBOL_KEYWORD_GENERAL + +extern Lisp_Object Qeq; +extern Lisp_Object Qeql; +extern Lisp_Object Qequal; +extern Lisp_Object Qequalp; + /* Defined in glyphs.c */ EXFUN (Fmake_glyph_internal, 1); Error_Behavior decode_error_behavior_flag (Lisp_Object); Lisp_Object encode_error_behavior_flag (Error_Behavior); +extern Lisp_Object Qbuffer_glyph_p; +extern Lisp_Object Qcolor_pixmap_image_instance_p; +extern Lisp_Object Qicon_glyph_p; +extern Lisp_Object Qmono_pixmap_image_instance_p; +extern Lisp_Object Qnothing_image_instance_p; +extern Lisp_Object Qpointer_glyph_p; +extern Lisp_Object Qpointer_image_instance_p; +extern Lisp_Object Qsubwindow; +extern Lisp_Object Qsubwindow_image_instance_p; +extern Lisp_Object Qtext_image_instance_p; + /* Defined in glyphs-shared.c */ void shared_resource_validate (Lisp_Object instantiator); Lisp_Object shared_resource_normalize (Lisp_Object inst, @@ -5367,11 +5383,17 @@ Lisp_Object tag); extern Lisp_Object Q_resource_type, Q_resource_id; +/* Defined in glyphs-widget.c */ +extern Lisp_Object Qlayout; +extern Lisp_Object Qnative_layout; + /* Defined in gui.c */ DECLARE_DOESNT_RETURN (gui_error (const Ascbyte *reason, Lisp_Object frob)); DECLARE_DOESNT_RETURN (gui_error_2 (const Ascbyte *reason, Lisp_Object frob0, Lisp_Object frob1)); +extern Lisp_Object Qgui_error; + /* Defined in indent.c */ EXFUN (Findent_to, 3); EXFUN (Fvertical_motion, 3); @@ -5406,9 +5428,7 @@ int locate_file (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object *, int); EXFUN (Flocate_file_clear_hashing, 1); int isfloat_string (const char *); -#ifdef HAVE_RATIO int isratio_string (const char *); -#endif /* Well, I've decided to enable this. -- ben */ /* And I've decided to make it work right. -- sb */ @@ -5426,9 +5446,22 @@ # define LOADHIST_ATTACH(x) #endif /*! LOADHIST */ +extern Lisp_Object Qfeaturep; +extern Lisp_Object Qload; +extern Lisp_Object Qread_char; +extern Lisp_Object Qstandard_input; +extern Lisp_Object Vcurrent_load_list; +extern Lisp_Object Vfile_domain; +extern Lisp_Object Vload_file_name_internal; +extern Lisp_Object Vload_history; +extern Lisp_Object Vload_path; +extern Lisp_Object Vstandard_input; + /* Defined in macros.c */ EXFUN (Fexecute_kbd_macro, 2); +extern Lisp_Object Vexecuting_macro; + /* Defined in marker.c */ EXFUN (Fcopy_marker, 2); EXFUN (Fmake_marker, 0); @@ -5445,11 +5478,18 @@ Lisp_Object noseeum_copy_marker (Lisp_Object, Lisp_Object); Lisp_Object set_marker_restricted (Lisp_Object, Lisp_Object, Lisp_Object); #ifdef MEMORY_USAGE_STATS -int compute_buffer_marker_usage (struct buffer *, struct overhead_stats *); +Bytecount compute_buffer_marker_usage (struct buffer *b); #endif void init_buffer_markers (struct buffer *b); void uninit_buffer_markers (struct buffer *b); +/* Defined in menubar.c */ +extern Lisp_Object Qactivate_menubar_hook; +extern Lisp_Object Qcurrent_menubar; +extern Lisp_Object Vactivate_menubar_hook; +extern Lisp_Object Vblank_menubar; +extern Lisp_Object Vmenubar_configuration; + /* Defined in minibuf.c */ extern int minibuf_level; Charcount scmp_1 (const Ibyte *, const Ibyte *, Charcount, int); @@ -5474,10 +5514,26 @@ void message_no_translate (const char *, ...) PRINTF_ARGS (1, 2); void clear_message (void); +extern Lisp_Object Qcompletion_ignore_case; +extern Lisp_Object Vecho_area_buffer; +extern Lisp_Object Vminibuf_preprompt; +extern Lisp_Object Vminibuf_prompt; +extern Lisp_Object Vminibuffer_zero; + /* Defined in mule-charset.c */ EXFUN (Fmake_charset, 3); extern Lisp_Object Ql2r, Qr2l; +extern Lisp_Object Qdirection; +extern Lisp_Object Qfinal; +extern Lisp_Object Qgraphic; +extern Lisp_Object Qlong_name; +extern Lisp_Object Qregistries; +extern Lisp_Object Qreverse_direction_charset; +extern Lisp_Object Qshort_name; + +/* Defined in nt.c */ +extern Lisp_Object Vmswindows_get_true_file_attributes; /* Defined in print.c */ EXFUN (Fdisplay_error, 2); @@ -5518,6 +5574,7 @@ void stdout_out (const CIbyte *, ...) PRINTF_ARGS (1, 2); void external_out (int dest, const CIbyte *fmt, ...) PRINTF_ARGS (2, 3); void debug_out (const CIbyte *, ...) PRINTF_ARGS (1, 2); +void debug_out_lisp (const CIbyte *, int nargs, ...); DECLARE_DOESNT_RETURN (fatal (const CIbyte *, ...)) PRINTF_ARGS(1, 2); /* Internal functions: */ @@ -5548,13 +5605,30 @@ Lisp_Object (*) (Lisp_Object), Lisp_Object, Lisp_Object); void float_to_string (char *, double); -void internal_object_printer (Lisp_Object, Lisp_Object, int); -MODULE_API DECLARE_DOESNT_RETURN (printing_unreadable_object (const CIbyte *, +void internal_object_printer (Lisp_Object obj, Lisp_Object printcharfun, + int UNUSED (escapeflag)); +void external_object_printer (Lisp_Object obj, Lisp_Object printcharfun, + int UNUSED (escapeflag)); +MODULE_API DECLARE_DOESNT_RETURN (printing_unreadable_object_fmt (const CIbyte *, ...)) PRINTF_ARGS (1, 2); -DECLARE_DOESNT_RETURN (printing_unreadable_lcrecord (Lisp_Object obj, +DECLARE_DOESNT_RETURN (printing_unreadable_lisp_object (Lisp_Object obj, const Ibyte *name)); +extern Lisp_Object Qexternal_debugging_output; +extern Lisp_Object Qprint_length; +extern Lisp_Object Qprint_string_length; +extern Lisp_Object Qstandard_output; +extern Lisp_Object Vprint_length; +extern Lisp_Object Vprint_level; +extern Lisp_Object Vstandard_output; + +/* Defined in process.c */ +extern Lisp_Object Qnetwork_error; +extern MODULE_API Lisp_Object Qprocess_error; +extern Lisp_Object Vprocess_environment; +extern Lisp_Object Vshell_file_name; + /* Defined in rangetab.c */ EXFUN (Fclear_range_table, 1); EXFUN (Fget_range_table, 3); @@ -5616,6 +5690,9 @@ void init_device_sound (struct device *); DECLARE_DOESNT_RETURN (report_sound_error (const Ascbyte *, Lisp_Object)); +extern Lisp_Object Qsound_error; +extern Lisp_Object Vsynchronous_sounds; + /* Defined in specifier.c */ EXFUN (Fadd_spec_to_specifier, 5); EXFUN (Fspecifier_spec_list, 4); @@ -5645,7 +5722,7 @@ unsigned int hash_string (const Ibyte *, Bytecount); Lisp_Object intern_istring (const Ibyte *str); MODULE_API Lisp_Object intern (const CIbyte *str); -Lisp_Object intern_converting_underscores_to_dashes (const CIbyte *str); +Lisp_Object intern_massaging_name (const CIbyte *str); Lisp_Object oblookup (Lisp_Object, const Ibyte *, Bytecount); void map_obarray (Lisp_Object, int (*) (Lisp_Object, void *), void *); Lisp_Object indirect_function (Lisp_Object, int); @@ -5659,6 +5736,14 @@ int function_p, Lisp_Object follow_past_lisp_magic); +extern Lisp_Object Qconst_specifier; +extern Lisp_Object Qmakunbound; +extern Lisp_Object Qset; +extern Lisp_Object Qvariable_documentation; +extern Lisp_Object Qvariable_domain; +extern MODULE_API Lisp_Object Qt, Qunbound; +extern Lisp_Object Vobarray; + /* Defined in syntax.c */ Charbpos scan_words (struct buffer *, Charbpos, int); EXFUN (Fchar_syntax, 2); @@ -6056,6 +6141,9 @@ MODULE_API int find_pos_of_existing_active_alloca_convert (const char * srctext); +/* Defined in undo.c */ +extern Lisp_Object Qinhibit_read_only; + /* Defined in unicode.c */ extern const struct sized_memory_description to_unicode_description; extern const struct sized_memory_description from_unicode_description; @@ -6066,9 +6154,9 @@ extern Lisp_Object Qutf_16, Qutf_8, Qucs_4, Qutf_7, Qutf_32; #ifdef MEMORY_USAGE_STATS Bytecount compute_from_unicode_table_size (Lisp_Object charset, - struct overhead_stats *stats); + struct usage_stats *stats); Bytecount compute_to_unicode_table_size (Lisp_Object charset, - struct overhead_stats *stats); + struct usage_stats *stats); #endif /* MEMORY_USAGE_STATS */ /* Defined in undo.c */ @@ -6093,139 +6181,11 @@ /* Defined in vm-limit.c */ void memory_warnings (void *, void (*) (const char *)); -/*--------------- prototypes for constant symbols ------------*/ - -/* #### We should get rid of this and put the prototypes back up there in - #### the per-file stuff, where they belong. */ - -/* Use the following when you have to add a bunch of symbols. */ - -/* - -(defun redo-symbols (beg end) - "Snarf any symbols out of the region and print them into a temporary buffer, -which is displayed when the function finishes. The symbols are laid out with -`extern Lisp_Object ' before each one, with as many as can fit on one line -\(the maximum line width is controlled by the constant `max-line-length' in the -code)." - (interactive "r") - (save-excursion - (goto-char beg) - (let (syms) - (while (re-search-forward "\\s-\\(Q[A-Za-z_0-9]+\\)" end t) - (push (match-string 1) syms)) - (setq syms (sort syms #'string-lessp)) - (with-output-to-temp-buffer "*Symbols*" - (let* ((col 0) - (start "extern Lisp_Object ") - (startlen (length start)) - ;; with a default-width frame of 80 chars, you can only fit - ;; 79 before wrapping. you can see this to a lower value if - ;; you don't want it right up against the right margin. - (max-line-length 79)) - (dolist (sym syms) - (cond (;; if something already on line (this will always be the - ;; case except the very first iteration), see what - ;; space we've got. (need to take into account 2 - ;; for the comma+space, 1 for the semicolon at the - ;; end.) if enough space, do it. - (and (> col 0) (< (+ col (length sym) 2) - (1- max-line-length))) - (princ ", ") - (princ sym) - (incf col 2) - (incf col (length sym))) - (t - ;; either we're first iteration or we ran out of space. - ;; if the latter, terminate the previous line. this - ;; loop is written on purpose so that it always prints - ;; at least one item, even if that would go over. - (when (> col 0) - (princ ";\n") - (setq col 0)) - (princ start) - (incf col startlen) - (princ sym) - (incf col (length sym))))) - ;; finally terminate the last line. - (princ ";\n")))))) - -*/ - -extern Lisp_Object Qactivate_menubar_hook, Qand_optional, Qand_rest, Qautoload, - Qbackground, Qbackground_pixmap, Qblinking, Qbuffer_glyph_p, Qbuffer_live_p, - Qcall_interactively, Qcategory_designator_p, - Qcategory_table_value_p, Qcdr, Qcolor_pixmap_image_instance_p, Qcommandp, - Qcompletion_ignore_case, Qconsole_live_p, Qconst_specifier, Qcurrent_menubar, - Qdefun, Qdevice_live_p, Qdim, Qdirection, Qdisabled, Qdisabled_command_hook, - Qdisplay_table, Qdll_error, Qend_open, Qerror_lacks_explanatory_string, - Qevent_live_p, Qexit, Qextent_live_p, Qexternal_debugging_output, Qfeaturep, - Qfile_error, Qfile_name_sans_extension, Qfinal, Qforeground, Qformat, - Qframe_live_p, Qgraphic, Qgui_error, Qicon_glyph_p, Qidentity, Qinhibit_quit, - Qinhibit_read_only, Qinteractive, Qlayout, Qload, Qlong_name, Qmacro, - Qmakunbound, Qmark, Qmodule, Qmono_pixmap_image_instance_p, - Qmouse_leave_buffer_hook, Qnative_layout, Qnetwork_error, - Qnothing_image_instance_p, Qpoint, Qpointer_glyph_p, - Qpointer_image_instance_p, Qprint_length, Qprint_string_length, Qprogn, - Qread_char, Qread_from_minibuffer, Qreally_early_error_handler, - Qregion_beginning, Qregion_end, Qregistries, Qreverse_direction_charset, - Qrun_hooks, Qsans_modifiers, Qsave_buffers_kill_emacs, Qself_insert_command, - Qself_insert_defer_undo, Qsequencep, Qset, Qshort_name, Qsound_error, - Qstandard_input, Qstandard_output, Qstart_open, Qstring_lessp, Qsubwindow, - Qsubwindow_image_instance_p, Qtext_image_instance_p, Qtop_level, Qunderline, - Quser_files_and_directories, Qvalues, Qvariable_documentation, - Qvariable_domain, Qwindow_live_p, Qyes_or_no_p; - -extern MODULE_API Lisp_Object Qprocess_error, Qt, Qunbound; - -#define SYMBOL(fou) extern Lisp_Object fou -#define SYMBOL_MODULE_API(fou) extern MODULE_API Lisp_Object fou -#define SYMBOL_KEYWORD(la_cle_est_fou) extern Lisp_Object la_cle_est_fou -#define SYMBOL_GENERAL(tout_le_monde, est_fou) \ - extern Lisp_Object tout_le_monde - -#include "general-slots.h" - -#undef SYMBOL -#undef SYMBOL_MODULE_API -#undef SYMBOL_KEYWORD -#undef SYMBOL_GENERAL - -/*--------------- prototypes for variables of type Lisp_Object ------------*/ - -/* #### We should get rid of this and put the prototypes back up there in - #### the per-file stuff, where they belong. */ - -extern Lisp_Object Vactivate_menubar_hook; -extern Lisp_Object Vautoload_queue, Vblank_menubar; -extern Lisp_Object Vcommand_history; -extern Lisp_Object Vcommand_line_args, Vconfigure_info_directory; -extern Lisp_Object Vconfigure_site_directory, Vconfigure_site_module_directory; -extern Lisp_Object Vconsole_list, Vcontrolling_terminal; -extern Lisp_Object Vcurrent_load_list; -extern Lisp_Object Vcurrent_mouse_event, Vcurrent_prefix_arg, Vdata_directory; -extern Lisp_Object Vdirectory_sep_char, Vdisabled_command_hook; -extern Lisp_Object Vdoc_directory, Vinternal_doc_file_name; -extern Lisp_Object Vecho_area_buffer, Vemacs_major_version; -extern Lisp_Object Vemacs_minor_version, Vexec_directory, Vexec_path; -extern Lisp_Object Vexecuting_macro, Vfeatures, Vfile_domain; -extern Lisp_Object Vinvocation_directory, Vinvocation_name; -extern Lisp_Object Vlast_command, Vlast_command_char; -extern Lisp_Object Vlast_command_event, Vlast_input_event; -extern Lisp_Object Vload_file_name_internal, Vload_history; -extern Lisp_Object Vload_path, Vmark_even_if_inactive, Vmenubar_configuration; -extern Lisp_Object Vminibuf_preprompt, Vminibuf_prompt, Vminibuffer_zero; -extern Lisp_Object Vmodule_directory, Vmswindows_downcase_file_names; -extern Lisp_Object Vmswindows_get_true_file_attributes, Vobarray; -extern Lisp_Object Vprint_length, Vprint_level, Vprocess_environment; -extern Lisp_Object Vrecent_keys_ring, Vshell_file_name, Vsite_directory; -extern Lisp_Object Vsite_module_directory; -extern Lisp_Object Vstandard_input, Vstandard_output, Vstdio_str; -extern Lisp_Object Vsynchronous_sounds, Vsystem_name; -extern Lisp_Object Vthis_command_keys, Vunread_command_event; -extern Lisp_Object Vx_initial_argv_list; - -extern MODULE_API Lisp_Object Vinhibit_quit, Vquit_flag; +/* Defined in win32.c */ +extern Lisp_Object Vmswindows_downcase_file_names; + +/* Defined in window.c */ +extern Lisp_Object Qwindow_live_p; END_C_DECLS diff -r 861f2601a38b -r 1f0b15040456 src/lread.c --- a/src/lread.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/lread.c Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.0, FSF 19.30. */ @@ -844,9 +842,9 @@ return W_OK; else if (EQ (mode, Qreadable)) return R_OK; - else if (INTP (mode)) + else if (INTEGERP (mode)) { - check_int_range (XINT (mode), 0, 7); + check_integer_range (mode, Qzero, make_int (7)); return XINT (mode); } else @@ -915,8 +913,7 @@ static Lisp_Object locate_file_refresh_hashing (Lisp_Object directory) { - Lisp_Object hash = - make_directory_hash_table (XSTRING_DATA (directory)); + Lisp_Object hash = make_directory_hash_table (directory); if (!NILP (hash)) Fputhash (directory, hash, Vlocate_file_hash_table); @@ -1819,8 +1816,12 @@ } } if (i >= 0400) - syntax_error ("Non-ISO-8859-1 character specified with octal escape", - make_int (i)); + { + read_syntax_error ((Ascbyte *) emacs_sprintf_malloc + (NULL, + "Non-ISO-8859-1 octal character escape, " + "?\\%.3o", i)); + } return i; } @@ -1828,13 +1829,23 @@ /* A hex escape, as in ANSI C, except that we only allow latin-1 characters to be read this way. What is "\x4e03" supposed to mean, anyways, if the internal representation is hidden? - This is also consistent with the treatment of octal escapes. */ + This is also consistent with the treatment of octal escapes. + + Note that we don't accept ?\XAB as specifying the character with + numeric value 171; it must be ?\xAB. */ { +#define OVERLONG_INFO "Overlong hex character escape, ?\\x" + REGISTER Ichar i = 0; REGISTER int count = 0; + Ascbyte seen[] = OVERLONG_INFO "\0\0\0\0\0"; + REGISTER Ascbyte *seenp = seen + sizeof (OVERLONG_INFO) - 1; + +#undef OVERLONG_INFO + while (++count <= 2) { - c = readchar (readcharfun); + c = readchar (readcharfun), *seenp = c, ++seenp; /* Remember, can't use isdigit(), isalpha() etc. on Ichars */ if (c >= '0' && c <= '9') i = (i << 4) + (c - '0'); else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10; @@ -1848,21 +1859,12 @@ if (count == 3) { - c = readchar (readcharfun); + c = readchar (readcharfun), *seenp = c, ++seenp; if ((c >= '0' && c <= '9') || (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F')) { - Lisp_Object args[2]; - - if (c >= '0' && c <= '9') i = (i << 4) + (c - '0'); - else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10; - else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10; - - args[0] = build_ascstring ("?\\x%x"); - args[1] = make_int (i); - syntax_error ("Overlong hex character escape", - Fformat (2, args)); + read_syntax_error (seen); } unreadchar (readcharfun, c); } @@ -1982,8 +1984,14 @@ if (*read_ptr == '+') read_ptr++; ratio_set_string (scratch_ratio, read_ptr, 0); - ratio_canonicalize (scratch_ratio); - return Fcanonicalize_number (make_ratio_rt (scratch_ratio)); + if (bignum_sign (ratio_denominator (scratch_ratio)) != 0) { + ratio_canonicalize (scratch_ratio); + return Fcanonicalize_number (make_ratio_rt (scratch_ratio)); + } + return Fsignal (Qinvalid_read_syntax, + list2 (build_msg_string + ("Invalid ratio constant in reader"), + make_string ((Ibyte *) read_ptr, len))); } #endif if (isfloat_string (read_ptr)) @@ -2020,6 +2028,9 @@ else if (*p == '+') { p++; + /* GMP deals with a leading plus sign, badly, make sure it doesn't see + it. */ + buf++; } if (p == lim) @@ -2647,11 +2658,11 @@ /* bit vectors */ case '*': return read_bit_vector (readcharfun); /* #o10 => 8 -- octal constant syntax */ - case 'o': return read_integer (readcharfun, 8); + case 'o': case 'O': return read_integer (readcharfun, 8); /* #xdead => 57005 -- hex constant syntax */ - case 'x': return read_integer (readcharfun, 16); + case 'x': case 'X': return read_integer (readcharfun, 16); /* #b010 => 2 -- binary constant syntax */ - case 'b': return read_integer (readcharfun, 2); + case 'b': case 'B': return read_integer (readcharfun, 2); /* #r"raw\stringt" -- raw string syntax */ case 'r': return read_raw_string(readcharfun); /* #s(foobar key1 val1 key2 val2) -- structure syntax */ @@ -2871,7 +2882,6 @@ || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT))); } -#ifdef HAVE_RATIO int isratio_string (const char *cp) { @@ -2902,7 +2912,7 @@ return *cp == '\0' || *cp == ' ' || *cp =='\t' || *cp == '\n' || *cp == '\r' || *cp == '\f'; } -#endif + static void * sequence_reader (Lisp_Object readcharfun, @@ -3455,9 +3465,6 @@ #ifdef FEATUREP_SYNTAX DEFSYMBOL (Qfeaturep); Fprovide (intern ("xemacs")); -#ifdef INFODOCK - Fprovide (intern ("infodock")); -#endif /* INFODOCK */ #endif /* FEATUREP_SYNTAX */ #ifdef LISP_BACKQUOTES @@ -3466,6 +3473,7 @@ #ifdef I18N3 Vfile_domain = Qnil; + staticpro (&Vfile_domain); #endif Vread_objects = Qnil; @@ -3473,7 +3481,12 @@ Vlocate_file_hash_table = make_lisp_hash_table (200, HASH_TABLE_NON_WEAK, - HASH_TABLE_EQUAL); +#ifdef DEFAULT_FILE_SYSTEM_IGNORE_CASE + Qequalp +#else + Qequal +#endif + ); staticpro (&Vlocate_file_hash_table); #ifdef DEBUG_XEMACS symbol_value (XSYMBOL (intern ("Vlocate-file-hash-table"))) diff -r 861f2601a38b -r 1f0b15040456 src/lrecord.h --- a/src/lrecord.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/lrecord.h Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,13 @@ /* The "lrecord" structure (header of a compound lisp object). Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1996, 2001, 2002, 2004, 2005, 2010 Ben Wing. + Copyright (C) 1996, 2001, 2002, 2004, 2005, 2009, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -26,40 +24,132 @@ #ifndef INCLUDED_lrecord_h_ #define INCLUDED_lrecord_h_ -/* The "lrecord" type of Lisp object is used for all object types other - than a few simple ones (like char and int). This allows many types to be - implemented but only a few bits required in a Lisp object for type - information. (The tradeoff is that each object has its type marked in - it, thereby increasing its size.) All lrecords begin with a `struct - lrecord_header', which identifies the lisp object type, by providing an - index into a table of `struct lrecord_implementation', which describes - the behavior of the lisp object. It also contains some other data bits. +/* All objects other than char and int are implemented as structures and + passed by reference. Such objects are called "record objects" ("record" + is another term for "structure"). The "wrapped" value of such an object + (i.e. when stored in a variable of type Lisp_Object) is simply the raw + pointer coerced to an integral type the same size as the pointer + (usually `long'). + + Under old-GC (i.e. when NEW_GC is not defined), there are two kinds of + record objects: normal objects (those allocated on their own with + xmalloc()) and frob-block objects (those allocated as pieces of large, + usually 2K, chunks of memory known as "frob blocks"). Under NEW_GC, + there is only one type of record object. Stuff below that applies to + frob-block objects is assumed to apply to the same type of object as + normal objects under NEW_GC. + + Record objects have a header at the beginning of their structure, which + is used internally to identify the type of the object (so that an + object's type can be recovered from its pointer); in addition, it holds + a few flags and a "UID", which for most objects is shown when it is + printed, and is primarily useful for debugging purposes. The header of + a normal object is declared as NORMAL_LISP_OBJECT_HEADER and that of a + frob-block object FROB_BLOCK_LISP_OBJECT_HEADER. + + FROB_BLOCK_LISP_OBJECT_HEADER boils down to a `struct lrecord_header'. + This is a 32-bit value made up of bit fields, where 8 bits are used to + hold the type, 2 or 3 bits are used for flags associated with the + garbage collector, and the remaining 21 or 22 bits hold the UID. + + Under NEW_GC, NORMAL_LISP_OBJECT_HEADER also resolves to `struct + lrecord_header'. Under old-GC, however, NORMAL_LISP_OBJECT_HEADER + resolves to a `struct old_lcrecord_header' (note the `c'), which is a + larger structure -- on 32-bit machines it occupies 2 machine words + instead of 1. Such an object is known internally as an "lcrecord". The + first word of `struct old_lcrecord_header' is an embedded `struct + lrecord_header' with the same information as for frob-block objects; + that way, all objects can be cast to a `struct lrecord_header' to + determine their type or other info. The other word is a pointer, used + to thread all lcrecords together in one big linked list. + + Under old-GC, normal objects (i.e. lcrecords) are allocated in + individual chunks using the underlying allocator (i.e. xmalloc(), which + is a thin wrapper around malloc()). Frob-block objects are more + efficient than normal objects, as they have a smaller header and don't + have the additional memory overhead associated with malloc() -- instead, + as mentioned above, they are carved out of 2K chunks of memory called + "frob blocks"). However, it is slightly more tricky to create such + objects, as they require special routines in alloc.c to create an object + of each such type and to sweep them during garbage collection. In + addition, there is currently no mechanism for handling variable-sized + frob-block objects (e.g. vectors), whereas variable-sized normal objects + are not a problem. Frob-block objects are typically used for basic + objects that exist in large numbers, such as `cons' or `string'. -#ifndef NEW_GC - Lrecords are of two types: straight lrecords, and lcrecords. - Straight lrecords are used for those types of objects that have - their own allocation routines (typically allocated out of 2K chunks - of memory called `frob blocks'). These objects have a `struct - lrecord_header' at the top, containing only the bits needed to find - the lrecord_implementation for the object. There are special - routines in alloc.c to create an object of each such type. + Note that strings are an apparent exception to the statement above that + variable-sized objects can't be handled. Under old-GC strings work as + follows. A string consists of two parts -- a fixed-size "string header" + that is allocated as a standard frob-block object, and a "string-chars" + structure that is allocated out of special 8K-sized frob blocks that + have a dedicated garbage-collection handler that compacts the blocks + during the sweep stage, relocating the string-chars data (but not the + string headers) to eliminate gaps. Strings larger than 8K are not + placed in frob blocks, but instead are stored as individually malloc()ed + blocks of memory. Strings larger than 8K are called "big strings" and + those smaller than 8K are called "small strings". + + Under new-GC, there is no difference between big and small strings, + just as there is no difference between normal and frob-block objects. + There is only one allocation method, which is capable of handling + variable-sized objects. This apparently allocates all objects in + frob blocks according to the size of the object. + + To create a new normal Lisp object, see the toolbar-button example + below. To create a new frob-block Lisp object, follow the lead of + one of the existing frob-block objects, such as extents or events. + Note that you do not need to supply all the methods (see below); + reasonable defaults are provided for many of them. Alternatively, if + you're just looking for a way of encapsulating data (which possibly + could contain Lisp_Objects in it), you may well be able to use the + opaque type. +*/ + +/* + How to declare a Lisp object: + + NORMAL_LISP_OBJECT_HEADER: + Header for normal objects + + FROB_BLOCK_LISP_OBJECT_HEADER: + Header for frob-block objects - Lcrecords are used for less common sorts of objects that don't do - their own allocation. Each such object is malloc()ed individually, - and the objects are chained together through a `next' pointer. - Lcrecords have a `struct old_lcrecord_header' at the top, which - contains a `struct lrecord_header' and a `next' pointer, and are - allocated using old_alloc_lcrecord_type() or its variants. -#endif + How to allocate a Lisp object: + + - For normal objects of a fixed size, simply call + ALLOC_NORMAL_LISP_OBJECT (type), where TYPE is the name of the type + (e.g. toolbar_button). Such objects can be freed manually using + free_normal_lisp_object. + + - For normal objects whose size can vary (and hence which have a + size_in_bytes_method rather than a static_size), call + ALLOC_SIZED_LISP_OBJECT (size, type), where TYPE is the + name of the type. NOTE: You cannot call free_normal_lisp_object() on such + on object! (At least when not NEW_GC) + + - For frob-block objects, use + ALLOC_FROB_BLOCK_LISP_OBJECT (type, lisp_type, var, lrec_ptr). + But these objects need special handling; if you don't understand this, + just ignore it. - Creating a new Lisp object type is fairly easy; just follow the - lead of some existing type (e.g. hash tables). Note that you - do not need to supply all the methods (see below); reasonable - defaults are provided for many of them. Alternatively, if you're - just looking for a way of encapsulating data (which possibly - could contain Lisp_Objects in it), you may well be able to use - the opaque type. -*/ + - Some lrecords, which are used totally internally, use the + noseeum-* functions for debugging reasons. + + Other operations: + + - copy_lisp_object (dst, src) + + - zero_nonsized_lisp_object (obj), zero_sized_lisp_object (obj, size): + BUT NOTE, it is not necessary to zero out newly allocated Lisp objects. + This happens automatically. + + - lisp_object_size (obj): Return the size of a Lisp object. NOTE: This + requires that the object is properly initialized. + + - lisp_object_storage_size (obj, stats): Return the storage size of a + Lisp objcet, including malloc or frob-block overhead; also, if STATS + is non-NULL, accumulate info about the size and overhead into STATS. + */ #ifdef NEW_GC /* @@ -74,44 +164,42 @@ object descriptions exist to indicate the size of these structures and the Lisp object pointers within them. - At least one definite issue is that under New-GC dumpable objects cannot - contain any finalizers (see pdump_register_object()). This means that any - substructures in dumpable objects that are allocated separately and - normally freed in a finalizer need instead to be made into actual Lisp - objects. If those structures are Dynarrs, they need to be made into - Dynarr Lisp objects (e.g. face-cachel-dynarr or glyph-cachel-dynarr), - which are created using Dynarr_lisp_new() or Dynarr_new_new2(). - Furthermore, the objects contained in the Dynarr also need to be Lisp - objects (e.g. face-cachel or glyph-cachel). + At least one definite issue is that under New-GC dumpable objects cannot + contain any finalizers (see pdump_register_object()). This means that + any substructures in dumpable objects that are allocated separately and + normally freed in a finalizer need instead to be made into actual Lisp + objects. If those structures are Dynarrs, they need to be made into + Dynarr Lisp objects (e.g. face-cachel-dynarr or glyph-cachel-dynarr), + which are created using Dynarr_lisp_new() or Dynarr_new_new2(). + Furthermore, the objects contained in the Dynarr also need to be Lisp + objects (e.g. face-cachel or glyph-cachel). --ben */ - #endif - - #ifdef NEW_GC -#define ALLOC_LCRECORD_TYPE alloc_lrecord_type -#define COPY_SIZED_LCRECORD copy_sized_lrecord -#define COPY_LCRECORD copy_lrecord -#define LISPOBJ_STORAGE_SIZE(ptr, size, stats) \ - mc_alloced_storage_size (size, stats) -#define ZERO_LCRECORD zero_lrecord -#define LCRECORD_HEADER lrecord_header -#define BASIC_ALLOC_LCRECORD alloc_lrecord -#define FREE_LCRECORD free_lrecord +#define ALLOC_NORMAL_LISP_OBJECT(type) alloc_lrecord (&lrecord_##type) +#define ALLOC_SIZED_LISP_OBJECT(size, type) \ + alloc_sized_lrecord (size, &lrecord_##type) +#define NORMAL_LISP_OBJECT_HEADER struct lrecord_header +#define FROB_BLOCK_LISP_OBJECT_HEADER struct lrecord_header +#define LISP_OBJECT_FROB_BLOCK_P(obj) 0 +#define IF_NEW_GC(x) x +#define IF_OLD_GC(x) 0 #else /* not NEW_GC */ -#define ALLOC_LCRECORD_TYPE old_alloc_lcrecord_type -#define COPY_SIZED_LCRECORD old_copy_sized_lcrecord -#define COPY_LCRECORD old_copy_lcrecord -#define LISPOBJ_STORAGE_SIZE malloced_storage_size -#define ZERO_LCRECORD old_zero_lcrecord -#define LCRECORD_HEADER old_lcrecord_header -#define BASIC_ALLOC_LCRECORD old_basic_alloc_lcrecord -#define FREE_LCRECORD old_free_lcrecord +#define ALLOC_NORMAL_LISP_OBJECT(type) alloc_automanaged_lcrecord (&lrecord_##type) +#define ALLOC_SIZED_LISP_OBJECT(size, type) \ + old_alloc_sized_lcrecord (size, &lrecord_##type) +#define NORMAL_LISP_OBJECT_HEADER struct old_lcrecord_header +#define FROB_BLOCK_LISP_OBJECT_HEADER struct lrecord_header +#define LISP_OBJECT_FROB_BLOCK_P(obj) (XRECORD_LHEADER_IMPLEMENTATION(obj)->frob_block_p) +#define IF_NEW_GC(x) 0 +#define IF_OLD_GC(x) x #endif /* not NEW_GC */ +#define LISP_OBJECT_UID(obj) (XRECORD_LHEADER (obj)->uid) + BEGIN_C_DECLS struct lrecord_header @@ -150,34 +238,45 @@ /* 1 if the object is readonly from lisp */ unsigned int lisp_readonly :1; + /* The `free' field is currently used only for lcrecords under old-GC. + It is a flag that indicates whether this lcrecord is on a "free list". + Free lists are used to minimize the number of calls to malloc() when + we're repeatedly allocating and freeing a number of the same sort of + lcrecord. Lcrecords on a free list always get marked in a different + fashion, so we can use this flag as a sanity check to make sure that + free lists only have freed lcrecords and there are no freed lcrecords + elsewhere. */ + unsigned int free :1; + /* The `uid' field is just for debugging/printing convenience. Having this slot doesn't hurt us spacewise, since the bits are unused anyway. (The bits are used for strings, though.) */ - unsigned int uid :21; + unsigned int uid :20; #endif /* not NEW_GC */ }; struct lrecord_implementation; int lrecord_type_index (const struct lrecord_implementation *implementation); -extern int lrecord_uid_counter; +extern int lrecord_uid_counter[]; #ifdef NEW_GC -#define set_lheader_implementation(header,imp) do { \ - struct lrecord_header* SLI_header = (header); \ - SLI_header->type = (imp)->lrecord_type_index; \ - SLI_header->lisp_readonly = 0; \ - SLI_header->free = 0; \ - SLI_header->uid = lrecord_uid_counter++; \ +#define set_lheader_implementation(header,imp) do { \ + struct lrecord_header* SLI_header = (header); \ + SLI_header->type = (imp)->lrecord_type_index; \ + SLI_header->lisp_readonly = 0; \ + SLI_header->free = 0; \ + SLI_header->uid = lrecord_uid_counter[(imp)->lrecord_type_index]++; \ } while (0) #else /* not NEW_GC */ -#define set_lheader_implementation(header,imp) do { \ - struct lrecord_header* SLI_header = (header); \ - SLI_header->type = (imp)->lrecord_type_index; \ - SLI_header->mark = 0; \ - SLI_header->c_readonly = 0; \ - SLI_header->lisp_readonly = 0; \ - SLI_header->uid = lrecord_uid_counter++; \ +#define set_lheader_implementation(header,imp) do { \ + struct lrecord_header* SLI_header = (header); \ + SLI_header->type = (imp)->lrecord_type_index; \ + SLI_header->mark = 0; \ + SLI_header->c_readonly = 0; \ + SLI_header->lisp_readonly = 0; \ + SLI_header->free = 0; \ + SLI_header->uid = lrecord_uid_counter[(imp)->lrecord_type_index]++; \ } while (0) #endif /* not NEW_GC */ @@ -188,7 +287,7 @@ /* The `next' field is normally used to chain all lcrecords together so that the GC can find (and free) all of them. - `old_basic_alloc_lcrecord' threads lcrecords together. + `old_alloc_sized_lcrecord' threads lcrecords together. The `next' field may be used for other purposes as long as some other mechanism is provided for letting the GC do its work. @@ -197,20 +296,6 @@ out of memory chunks, and are able to find all unmarked members by sweeping through the elements of the list of chunks. */ struct old_lcrecord_header *next; - - /* The `uid' field is just for debugging/printing convenience. - Having this slot doesn't hurt us much spacewise, since an - lcrecord already has the above slots plus malloc overhead. */ - unsigned int uid :31; - - /* The `free' field is a flag that indicates whether this lcrecord - is on a "free list". Free lists are used to minimize the number - of calls to malloc() when we're repeatedly allocating and freeing - a number of the same sort of lcrecord. Lcrecords on a free list - always get marked in a different fashion, so we can use this flag - as a sanity check to make sure that free lists only have freed - lcrecords and there are no freed lcrecords elsewhere. */ - unsigned int free :1; }; /* Used for lcrecords in an lcrecord-list. */ @@ -227,7 +312,9 @@ /* Symbol value magic types come first to make SYMBOL_VALUE_MAGIC_P fast. #### This should be replaced by a symbol_value_magic_p flag in the Lisp_Symbol lrecord_header. */ - lrecord_type_symbol_value_forward, /* 0 */ + /* Don't assign any type to 0, so in case we come across zeroed memory + it will be more obvious when printed */ + lrecord_type_symbol_value_forward = 1, lrecord_type_symbol_value_varalias, lrecord_type_symbol_value_lisp_magic, lrecord_type_symbol_value_buffer_local, @@ -245,6 +332,7 @@ lrecord_type_weak_list, lrecord_type_bit_vector, lrecord_type_float, + lrecord_type_hash_table_test, lrecord_type_hash_table, lrecord_type_lstream, lrecord_type_process, @@ -281,9 +369,7 @@ lrecord_type_frame, lrecord_type_window, lrecord_type_window_mirror, - lrecord_type_window_configuration, lrecord_type_gui_item, - lrecord_type_popup_data, lrecord_type_toolbar_button, lrecord_type_scrollbar_instance, lrecord_type_color_instance, @@ -376,21 +462,20 @@ mark methods will be removed. */ Lisp_Object (*marker) (Lisp_Object); - /* `printer' converts the object to a printed representation. - This can be NULL; in this case default_object_printer() will be - used instead. */ + /* `printer' converts the object to a printed representation. `printer' + should never be NULL (if so, you will get an assertion failure when + trying to print such an object). Either supply a specific printing + method, or use the default methods internal_object_printer() (for + internal objects that should not be visible at Lisp level) or + external_object_printer() (for objects visible at Lisp level). */ void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag); - /* `finalizer' is called at GC time when the object is about to be freed, - and at dump time (FOR_DISKSAVE will be non-zero in this case). It - should perform any necessary cleanup (e.g. freeing malloc()ed memory - or releasing objects created in external libraries, such as - window-system windows or file handles). This can be NULL, meaning no - special finalization is necessary. - - WARNING: remember that `finalizer' is called at dump time even though - the object is not being freed -- check the FOR_DISKSAVE argument. */ - void (*finalizer) (void *header, int for_disksave); + /* `finalizer' is called at GC time when the object is about to be freed. + It should perform any necessary cleanup, such as freeing malloc()ed + memory or releasing pointers or handles to objects created in external + libraries, such as window-system windows or file handles. This can be + NULL, meaning no special finalization is necessary. */ + void (*finalizer) (Lisp_Object obj); /* This can be NULL, meaning compare objects with EQ(). */ int (*equal) (Lisp_Object obj1, Lisp_Object obj2, int depth, @@ -403,11 +488,34 @@ hash to the same value in order for hash tables to work properly. This means that `hash' can be NULL only if the `equal' method is also NULL. */ - Hashcode (*hash) (Lisp_Object, int); + Hashcode (*hash) (Lisp_Object, int, Boolint); /* Data layout description for your object. See long comment below. */ const struct memory_description *description; + /* Only one of `static_size' and `size_in_bytes_method' is non-0. If + `static_size' is 0, this type is not instantiable by + ALLOC_NORMAL_LISP_OBJECT(). If both are 0 (this should never happen), + this object cannot be instantiated; you will get an abort() if you + try.*/ + Bytecount static_size; + Bytecount (*size_in_bytes_method) (Lisp_Object); + + /* The (constant) index into lrecord_implementations_table */ + enum lrecord_type lrecord_type_index; + +#ifndef NEW_GC + /* A "frob-block" lrecord is any lrecord that's not an lcrecord, i.e. + one that does not have an old_lcrecord_header at the front and which + is (usually) allocated in frob blocks. */ + unsigned int frob_block_p :1; +#endif /* not NEW_GC */ + + /**********************************************************************/ + /* Remaining stuff is not assignable statically using + DEFINE_*_LISP_OBJECT, but must be assigned with OBJECT_HAS_METHOD, + OBJECT_HAS_PROPERTY or the like. */ + /* These functions allow any object type to have builtin property lists that can be manipulated from the lisp level with `get', `put', `remprop', and `object-plist'. */ @@ -415,26 +523,93 @@ int (*putprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object val); int (*remprop) (Lisp_Object obj, Lisp_Object prop); Lisp_Object (*plist) (Lisp_Object obj); + Lisp_Object (*setplist) (Lisp_Object obj, Lisp_Object newplist); -#ifdef NEW_GC - /* Only one of `static_size' and `size_in_bytes_method' is non-0. */ -#else /* not NEW_GC */ - /* Only one of `static_size' and `size_in_bytes_method' is non-0. - If both are 0, this type is not instantiable by - old_basic_alloc_lcrecord(). */ -#endif /* not NEW_GC */ - Bytecount static_size; - Bytecount (*size_in_bytes_method) (const void *header); + /* `disksave' is called at dump time. It is used for objects that + contain pointers or handles to objects created in external libraries, + such as window-system windows or file handles. Such external objects + cannot be dumped, so it is necessary to release them at dump time and + arrange somehow or other for them to be resurrected if necessary later + on. + + It seems that even non-dumpable objects may be around at dump time, + and a disksave may be provided. (In fact, the only object currently + with a disksave, lstream, is non-dumpable.) + + Objects rarely need to provide this method; most of the time it will + be NULL. */ + void (*disksave) (Lisp_Object); + +#ifdef MEMORY_USAGE_STATS + /* Return memory-usage information about the object in question, stored + into STATS. + + Two types of information are stored: storage (including overhead) for + ancillary non-Lisp structures attached to the object, and storage + (including overhead) for ancillary Lisp objects attached to the + object. The third type of memory-usage information (storage for the + object itself) is not noted here, because it's computed automatically + by the calling function. Also, the computed storage for ancillary + Lisp objects is the sum of all three source of memory associated with + the Lisp object: the object itself, ancillary non-Lisp structures and + ancillary Lisp objects. Note also that the `struct usage_stats u' at + the beginning of the STATS structure is for ancillary non-Lisp usage + *ONLY*; do not store any memory into it related to ancillary Lisp + objects. + + Note that it may be subjective which Lisp objects are considered + "attached" to the object. Some guidelines: + + -- Lisp objects which are "internal" to the main object and not + accessible except through the main object should be included + -- Objects linked by a weak reference should *NOT* be included + */ + void (*memory_usage) (Lisp_Object obj, struct generic_usage_stats *stats); - /* The (constant) index into lrecord_implementations_table */ - enum lrecord_type lrecord_type_index; + /* List of tags to be given to the extra statistics, one per statistic. + Qnil or Qt can be present to separate off different slices. Qnil + separates different slices within the same group of statistics. + These represent different ways of partitioning the same memory space. + Qt separates different groups; these represent different spaces of + memory. + + If Qt is not present, all slices describe extra non-Lisp-Object memory + associated with a Lisp object. If Qt is present, slices before Qt + describe non-Lisp-Object memory, as before, and slices after Qt + describe ancillary Lisp-Object memory logically associated with the + object. For example, if the object is a table, then ancillary + Lisp-Object memory might be the entries in the table. This info is + only advisory since it will duplicate memory described elsewhere and + since it may not be possible to be completely accurate, e.g. it may + not be clear what to count in "ancillary objects", and the value may + be too high if the same object occurs multiple times in the table. */ + Lisp_Object memusage_stats_list; + + /* --------------------------------------------------------------------- */ -#ifndef NEW_GC - /* A "basic" lrecord is any lrecord that's not an lcrecord, i.e. - one that does not have an old_lcrecord_header at the front and which - is (usually) allocated in frob blocks. */ - unsigned int basic_p :1; -#endif /* not NEW_GC */ + /* The following are automatically computed based on the value in + `memusage_stats_list' (see compute_memusage_stats_length()). */ + + /* Total number of additional type-specific statistics related to memory + usage. */ + Elemcount num_extra_memusage_stats; + + /* Number of additional type-specific statistics belonging to the first + slice of the group describing non-Lisp-Object memory usage for this + object. These stats occur starting at offset 0. */ + Elemcount num_extra_nonlisp_memusage_stats; + + /* The offset into the extra statistics at which the Lisp-Object + memory-usage statistics begin. */ + Elemcount offset_lisp_ancillary_memusage_stats; + + /* Number of additional type-specific statistics belonging to the first + slice of the group describing Lisp-Object memory usage for this + object. These stats occur starting at offset + `offset_lisp_ancillary_memusage_stats'. */ + Elemcount num_extra_lisp_ancillary_memusage_stats; + +#endif /* MEMORY_USAGE_STATS */ }; /* All the built-in lisp object types are enumerated in `enum lrecord_type'. @@ -442,9 +617,11 @@ room in `lrecord_implementations_table' for such new lisp object types. */ #define MODULE_DEFINABLE_TYPE_COUNT 32 -extern MODULE_API const struct lrecord_implementation * +extern MODULE_API struct lrecord_implementation * lrecord_implementations_table[lrecord_type_last_built_in_type + MODULE_DEFINABLE_TYPE_COUNT]; +/* Given a Lisp object, return its implementation + (struct lrecord_implementation) */ #define XRECORD_LHEADER_IMPLEMENTATION(obj) \ LHEADER_IMPLEMENTATION (XRECORD_LHEADER (obj)) #define LHEADER_IMPLEMENTATION(lh) lrecord_implementations_table[(lh)->type] @@ -481,7 +658,7 @@ if (MCACF_implementation && MCACF_implementation->finalizer) \ { \ GC_STAT_FINALIZED; \ - MCACF_implementation->finalizer (ptr, 0); \ + MCACF_implementation->finalizer (MCACF_obj); \ } \ } \ } while (0) @@ -496,8 +673,8 @@ { \ const struct lrecord_implementation *MCACF_implementation \ = LHEADER_IMPLEMENTATION (MCACF_lheader); \ - if (MCACF_implementation && MCACF_implementation->finalizer) \ - MCACF_implementation->finalizer (ptr, 1); \ + if (MCACF_implementation && MCACF_implementation->disksave) \ + MCACF_implementation->disksave (MCACF_obj); \ } \ } while (0) @@ -523,6 +700,16 @@ #else /* not NEW_GC */ +enum lrecord_alloc_status +{ + ALLOC_IN_USE, + ALLOC_FREE, + ALLOC_ON_FREE_LIST +}; + +void tick_lrecord_stats (const struct lrecord_header *h, + enum lrecord_alloc_status status); + #define LRECORD_FREE_P(ptr) \ (((struct lrecord_header *) ptr)->type == lrecord_type_free) @@ -635,12 +822,10 @@ doesn't care about the dumper flag and makes use of some of the stuff normally omitted from the "abbreviated" description -- see above. - A memory_description is an array of values. (This is actually - misnamed, in that it does not just describe lrecords, but any - blocks of memory.) The first value of each line is a type, the - second the offset in the lrecord structure. The third and - following elements are parameters; their presence, type and number - is type-dependent. + A memory_description is an array of values. The first value of each + line is a type, the second the offset in the lrecord structure. The + third and following elements are parameters; their presence, type and + number is type-dependent. The description ends with an "XD_END" record. @@ -744,7 +929,7 @@ struct Lisp_Hash_Table { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; Elemcount size; Elemcount count; Elemcount rehash_count; @@ -809,7 +994,7 @@ struct Lisp_Specifier { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; struct specifier_methods *methods; ... @@ -834,17 +1019,28 @@ XD_LISP_OBJECT - A Lisp object. This is also the type to use for pointers to other lrecords + A Lisp_Object. This is also the type to use for pointers to other lrecords (e.g. struct frame *). XD_LISP_OBJECT_ARRAY - An array of Lisp objects or (equivalently) pointers to lrecords. + An array of Lisp_Objects or (equivalently) pointers to lrecords. The parameter (i.e. third element) is the count. This would be declared as Lisp_Object foo[666]. For something declared as Lisp_Object *foo, use XD_BLOCK_PTR, whose description parameter is a sized_memory_description consisting of only XD_LISP_OBJECT and XD_END. + XD_INLINE_LISP_OBJECT_BLOCK_PTR + + An pointer to a contiguous block of inline Lisp objects -- i.e., the Lisp + object itself rather than a Lisp_Object pointer is stored in the block. + This is used only under NEW_GC and is useful for increased efficiency when + an array of the same kind of object is needed. Examples of the use of this + type are Lisp dynarrs, where the array elements are inline Lisp objects + rather than non-Lisp structures, as is normally the case; and hash tables, + where the key/value pairs are encapsulated as hash-table-entry objects and + an array of inline hash-table-entry objects is stored. + XD_LO_LINK Weak link in a linked list of objects of the same type. This is a @@ -927,7 +1123,7 @@ "inline" to the union data, like XD_BLOCK_ARRAY and not XD_BLOCK_PTR. If the union data is a pointer to different types of structures, each element in the memory_description should be an XD_BLOCK_PTR. See - unicode.c, redisplay.c and objects.c for examples of XD_UNION. + unicode.c, redisplay.c and fontcolor.c for examples of XD_UNION. XD_UNION_DYNAMIC_SIZE @@ -1010,7 +1206,7 @@ XD_LISP_OBJECT_ARRAY, XD_LISP_OBJECT, #ifdef NEW_GC - XD_LISP_OBJECT_BLOCK_PTR, + XD_INLINE_LISP_OBJECT_BLOCK_PTR, #endif /* NEW_GC */ XD_LO_LINK, XD_OPAQUE_PTR, @@ -1060,10 +1256,9 @@ lcrecord-lists, where the objects have had their type changed to lrecord_type_free and also have had their free bit set, but we mark them as normal. */ - XD_FLAG_FREE_LISP_OBJECT = 8 + XD_FLAG_FREE_LISP_OBJECT = 8, #endif /* not NEW_GC */ #if 0 - , /* Suggestions for other possible flags: */ /* Eliminate XD_UNION_DYNAMIC_SIZE and replace it with a flag, like this. */ @@ -1075,7 +1270,7 @@ expanded and we need to stick a pointer in the second slot (although we could still ensure that the second slot in the first entry was NULL or <0). */ - XD_FLAG_DESCRIPTION_MAP = 32 + XD_FLAG_DESCRIPTION_MAP = 32, #endif }; @@ -1118,20 +1313,20 @@ This function must put a pointer to the opaque result in *data and its size in *size. */ - void (*convert)(const void *object, void **data, Bytecount *size); + void (*convert) (const void *object, void **data, Bytecount *size); /* Post-conversion cleanup. Optional (null if not provided). When provided it will be called post-dumping to free any storage allocated for the conversion results. */ - void (*convert_free)(const void *object, void *data, Bytecount size); + void (*convert_free) (const void *object, void *data, Bytecount size); /* De-conversion. At reload time, rebuilds the object from the converted form. "object" is 0 for the PTR case, return is ignored in the DATA case. */ - void *(*deconvert)(void *object, void *data, Bytecount size); + void *(*deconvert) (void *object, void *data, Bytecount size); }; @@ -1143,133 +1338,257 @@ #define XD_INDIRECT_VAL(code) ((-1 - (code)) & 255) #define XD_INDIRECT_DELTA(code) ((-1 - (code)) >> 8) -/* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size. - DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION is for objects whose size varies. +/* DEFINE_*_LISP_OBJECT is for objects with constant size. (Either + DEFINE_DUMPABLE_LISP_OBJECT for objects that can be saved in a dumped + executable, or DEFINE_NODUMP_LISP_OBJECT for objects that cannot be + saved -- e.g. that contain pointers to non-persistent external objects + such as window-system windows.) + + DEFINE_*_SIZABLE_LISP_OBJECT is for objects whose size varies. + + DEFINE_*_FROB_BLOCK_LISP_OBJECT is for objects that are allocated in + large blocks ("frob blocks"), which are parceled up individually. Such + objects need special handling in alloc.c. This does not apply to + NEW_GC, because it does this automatically. + + DEFINE_*_INTERNAL_LISP_OBJECT is for "internal" objects that should + never be visible on the Lisp level. This is a shorthand for the most + common type of internal objects, which have no equal or hash method + (since they generally won't appear in hash tables), no finalizer and + internal_object_printer() as their print method (which prints that the + object is internal and shouldn't be visible externally). For internal + objects needing a finalizer, equal or hash method, or wanting to + customize the print method, use the normal DEFINE_*_LISP_OBJECT + mechanism for defining these objects. + + DEFINE_MODULE_* is for objects defined in an external module. + + MAKE_LISP_OBJECT and MAKE_MODULE_LISP_OBJECT are what underlies all of + these; they define a structure containing pointers to object methods + and other info such as the size of the structure containing the object. */ +/* #### FIXME What's going on here? */ #if defined (ERROR_CHECK_TYPES) # define DECLARE_ERROR_CHECK_TYPES(c_name, structtype) #else # define DECLARE_ERROR_CHECK_TYPES(c_name, structtype) #endif +/********* The dumpable versions *********** */ -#define DEFINE_BASIC_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ -DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) +#define DEFINE_DUMPABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \ +MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,sizeof (structtype),0,0,structtype) + +#define DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ +MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,0,sizer,0,structtype) -#define DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \ -MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof(structtype),0,1,structtype) +#define DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \ +MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,sizeof(structtype),0,1,structtype) + +#define DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ +MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,0,sizer,1,structtype) -#define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ -DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) +#define DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,structtype) \ +DEFINE_DUMPABLE_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,structtype) + +#define DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,sizer,structtype) \ +DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,sizer,structtype) -#define DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \ -MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype) +/********* The non-dumpable versions *********** */ + +#define DEFINE_NODUMP_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \ +MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,sizeof (structtype),0,0,structtype) -#define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype) +#define DEFINE_NODUMP_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ +MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,0,sizer,0,structtype) + +#define DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \ +MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,sizeof(structtype),0,1,structtype) -#define DEFINE_BASIC_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ -MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,1,structtype) +#define DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ +MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,0,sizer,1,structtype) -#define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \ -MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) +#define DEFINE_NODUMP_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,structtype) \ +DEFINE_NODUMP_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,structtype) + +#define DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,sizer,structtype) \ +DEFINE_NODUMP_SIZABLE_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,sizer,structtype) + +/********* MAKE_LISP_OBJECT, the underlying macro *********** */ #ifdef NEW_GC -#define MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ +#define MAKE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker, \ +equal,hash,desc,size,sizer,frob_block_p,structtype) \ DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ -const struct lrecord_implementation lrecord_##c_name = \ +struct lrecord_implementation lrecord_##c_name = \ { name, dumpable, marker, printer, nuker, equal, hash, desc, \ - getprop, putprop, remprop, plist, size, sizer, \ - lrecord_type_##c_name } + size, sizer, lrecord_type_##c_name } #else /* not NEW_GC */ -#define MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ +#define MAKE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,size,sizer,frob_block_p,structtype) \ DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ -const struct lrecord_implementation lrecord_##c_name = \ +struct lrecord_implementation lrecord_##c_name = \ { name, dumpable, marker, printer, nuker, equal, hash, desc, \ - getprop, putprop, remprop, plist, size, sizer, \ - lrecord_type_##c_name, basic_p } + size, sizer, lrecord_type_##c_name, frob_block_p } #endif /* not NEW_GC */ -#define DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ -DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) + +/********* The module dumpable versions *********** */ -#define DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \ -MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype) +#define DEFINE_DUMPABLE_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ +MAKE_MODULE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,sizeof (structtype),0,0,structtype) + +#define DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ +MAKE_MODULE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,0,sizer,0,structtype) + +/********* The module non-dumpable versions *********** */ -#define DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ -DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype) +#define DEFINE_NODUMP_MODULE_LISP_OBJECT(name,c_name,dumpable,marker, \ +printer,nuker,equal,hash,desc,structtype) \ +MAKE_MODULE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer, \ +nuker,equal,hash,desc,sizeof (structtype),0,0,structtype) -#define DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \ -MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) +#define DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT(name,c_name,dumpable, \ +marker,printer,nuker,equal,hash,desc,sizer,structtype) \ +MAKE_MODULE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer, \ +nuker,equal,hash,desc,0,sizer,0,structtype) + +/********* MAKE_MODULE_LISP_OBJECT, the underlying macro *********** */ #ifdef NEW_GC -#define MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ +#define MAKE_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer, \ +nuker,equal,hash,desc,size,sizer,frob_block_p,structtype) \ DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ int lrecord_type_##c_name; \ struct lrecord_implementation lrecord_##c_name = \ { name, dumpable, marker, printer, nuker, equal, hash, desc, \ - getprop, putprop, remprop, plist, size, sizer, \ - lrecord_type_last_built_in_type } + size, sizer, lrecord_type_last_built_in_type } #else /* not NEW_GC */ -#define MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ +#define MAKE_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer, \ +nuker,equal,hash,desc,size,sizer,frob_block_p,structtype) \ DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ int lrecord_type_##c_name; \ struct lrecord_implementation lrecord_##c_name = \ { name, dumpable, marker, printer, nuker, equal, hash, desc, \ - getprop, putprop, remprop, plist, size, sizer, \ - lrecord_type_last_built_in_type, basic_p } + size, sizer, lrecord_type_last_built_in_type, frob_block_p } #endif /* not NEW_GC */ +#ifdef MEMORY_USAGE_STATS +#define INIT_MEMORY_USAGE_STATS(type) \ +do \ +{ \ + lrecord_implementations_table[lrecord_type_##type]-> \ + memusage_stats_list = Qnil; \ + lrecord_implementations_table[lrecord_type_##type]-> \ + num_extra_memusage_stats = -1; \ + lrecord_implementations_table[lrecord_type_##type]-> \ + num_extra_nonlisp_memusage_stats = -1; \ + staticpro (&lrecord_implementations_table[lrecord_type_##type]-> \ + memusage_stats_list); \ +} while (0) +#else +#define INIT_MEMORY_USAGE_STATS(type) DO_NOTHING +#endif /* (not) MEMORY_USAGE_STATS */ + +#define INIT_LISP_OBJECT_BEGINNING(type) \ +do \ +{ \ + lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \ + INIT_MEMORY_USAGE_STATS (type); \ +} while (0) + #ifdef USE_KKCC extern MODULE_API const struct memory_description *lrecord_memory_descriptions[]; -#define INIT_LRECORD_IMPLEMENTATION(type) do { \ - lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \ +#define INIT_LISP_OBJECT(type) do { \ + INIT_LISP_OBJECT_BEGINNING (type); \ lrecord_memory_descriptions[lrecord_type_##type] = \ lrecord_implementations_table[lrecord_type_##type]->description; \ } while (0) #else /* not USE_KKCC */ extern MODULE_API Lisp_Object (*lrecord_markers[]) (Lisp_Object); -#define INIT_LRECORD_IMPLEMENTATION(type) do { \ - lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \ - lrecord_markers[lrecord_type_##type] = \ - lrecord_implementations_table[lrecord_type_##type]->marker; \ +#define INIT_LISP_OBJECT(type) do { \ + INIT_LISP_OBJECT_BEGINNING (type); \ + lrecord_markers[lrecord_type_##type] = \ + lrecord_implementations_table[lrecord_type_##type]->marker; \ } while (0) #endif /* not USE_KKCC */ -#define INIT_EXTERNAL_LRECORD_IMPLEMENTATION(type) do { \ - lrecord_type_##type = lrecord_type_count++; \ - lrecord_##type.lrecord_type_index = lrecord_type_##type; \ - INIT_LRECORD_IMPLEMENTATION(type); \ +#define INIT_MODULE_LISP_OBJECT(type) do { \ + lrecord_type_##type = lrecord_type_count++; \ + lrecord_##type.lrecord_type_index = lrecord_type_##type; \ + INIT_LISP_OBJECT (type); \ } while (0) #ifdef HAVE_SHLIB /* Allow undefining types in order to support module unloading. */ #ifdef USE_KKCC -#define UNDEF_LRECORD_IMPLEMENTATION(type) do { \ - lrecord_implementations_table[lrecord_type_##type] = NULL; \ - lrecord_memory_descriptions[lrecord_type_##type] = NULL; \ +#define UNDEF_LISP_OBJECT(type) do { \ + lrecord_implementations_table[lrecord_type_##type] = NULL; \ + lrecord_memory_descriptions[lrecord_type_##type] = NULL; \ } while (0) #else /* not USE_KKCC */ -#define UNDEF_LRECORD_IMPLEMENTATION(type) do { \ - lrecord_implementations_table[lrecord_type_##type] = NULL; \ - lrecord_markers[lrecord_type_##type] = NULL; \ +#define UNDEF_LISP_OBJECT(type) do { \ + lrecord_implementations_table[lrecord_type_##type] = NULL; \ + lrecord_markers[lrecord_type_##type] = NULL; \ } while (0) #endif /* not USE_KKCC */ -#define UNDEF_EXTERNAL_LRECORD_IMPLEMENTATION(type) do { \ +#define UNDEF_MODULE_LISP_OBJECT(type) do { \ if (lrecord_##type.lrecord_type_index == lrecord_type_count - 1) { \ /* This is the most recently defined type. Clean up nicely. */ \ lrecord_type_##type = lrecord_type_count--; \ } /* Else we can't help leaving a hole with this implementation. */ \ - UNDEF_LRECORD_IMPLEMENTATION(type); \ + UNDEF_LISP_OBJECT(type); \ } while (0) #endif /* HAVE_SHLIB */ +/*************** Macros for declaring that a Lisp object has a + particular method, or for calling such a method. ********/ + +/* Declare that object-type TYPE has method M; used in + initialization routines */ +#define OBJECT_HAS_METHOD(type, m) \ + (lrecord_##type.m = type##_##m) +/* Same but the method name come before the type */ +#define OBJECT_HAS_PREMETHOD(type, m) \ + (lrecord_##type.m = m##_##type) +/* Same but the name of the method is explicitly given */ +#define OBJECT_HAS_NAMED_METHOD(type, m, func) \ + (lrecord_##type.m = (func)) +/* Object type has a property with the given value. */ +#define OBJECT_HAS_PROPERTY(type, prop, val) \ + (lrecord_##type.prop = (val)) + +/* Does the given object method exist? */ +#define HAS_OBJECT_METH_P(obj, m) \ + (!!(XRECORD_LHEADER_IMPLEMENTATION (obj)->m)) +/* Call an object method. */ +#define OBJECT_METH(obj, m, args) \ + ((XRECORD_LHEADER_IMPLEMENTATION (obj)->m) args) + +/* Call an object method, if it exists. */ +#define MAYBE_OBJECT_METH(obj, m, args) \ +do \ +{ \ + const struct lrecord_implementation *_mom_imp = \ + XRECORD_LHEADER_IMPLEMENTATION (obj); \ + if (_mom_imp->m) \ + ((_mom_imp->m) args); \ +} while (0) + +/* Call an object method, if it exists, or return GIVEN. NOTE: + Multiply-evaluates OBJ. */ +#define OBJECT_METH_OR_GIVEN(obj, m, args, given) \ + (HAS_OBJECT_METH_P (obj, m) ? OBJECT_METH (obj, m, args) : (given)) + +#define OBJECT_PROPERTY(obj, prop) (XRECORD_LHEADER_IMPLEMENTATION (obj)->prop) + +/************** Other stuff **************/ + #define LRECORDP(a) (XTYPE (a) == Lisp_Type_Record) #define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a)) @@ -1281,9 +1600,9 @@ 1. Declare the struct for your object in a header file somewhere. Remember that it must begin with - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; - 2. Put the "standard junk" (DECLARE_RECORD()/XFOO/etc.) below the + 2. Put the "standard junk" (DECLARE_LISP_OBJECT()/XFOO/etc.) below the struct definition -- see below. 3. Add this header file to inline.c. @@ -1296,12 +1615,17 @@ describing the purpose of the descriptions; and comments elsewhere in this file describing the exact syntax of the description structures. - 6. Define your object with DEFINE_LRECORD_IMPLEMENTATION() or some - variant. + 6. Define your object with DEFINE_*_LISP_OBJECT() or some + variant. At the minimum, you need to decide whether your object can + be dumped. Objects that are created as part of the loadup process and + need to be persistent across dumping should be created dumpable. + Nondumpable objects are generally those associated with display, + particularly those containing a pointer to an external library object + (e.g. a window-system window). 7. Include the header file in the .c file where you defined the object. - 8. Put a call to INIT_LRECORD_IMPLEMENTATION() for the object in the + 8. Put a call to INIT_LISP_OBJECT() for the object in the .c file's syms_of_foo() function. 9. Add a type enum for the object to enum lrecord_type, earlier in this @@ -1309,132 +1633,165 @@ --ben -An example: + An example: ------------------------------ in toolbar.h ----------------------------- -struct toolbar_button -{ - struct LCRECORD_HEADER header; - - Lisp_Object next; - Lisp_Object frame; - - Lisp_Object up_glyph; - Lisp_Object down_glyph; - Lisp_Object disabled_glyph; - - Lisp_Object cap_up_glyph; - Lisp_Object cap_down_glyph; - Lisp_Object cap_disabled_glyph; - - Lisp_Object callback; - Lisp_Object enabled_p; - Lisp_Object help_string; - - char enabled; - char down; - char pushright; - char blank; - - int x, y; - int width, height; - int dirty; - int vertical; - int border_width; -}; - -[[ the standard junk: ]] - -DECLARE_LRECORD (toolbar_button, struct toolbar_button); -#define XTOOLBAR_BUTTON(x) XRECORD (x, toolbar_button, struct toolbar_button) -#define wrap_toolbar_button(p) wrap_record (p, toolbar_button) -#define TOOLBAR_BUTTONP(x) RECORDP (x, toolbar_button) -#define CHECK_TOOLBAR_BUTTON(x) CHECK_RECORD (x, toolbar_button) -#define CONCHECK_TOOLBAR_BUTTON(x) CONCHECK_RECORD (x, toolbar_button) - + struct toolbar_button + { + NORMAL_LISP_OBJECT_HEADER header; + + Lisp_Object next; + Lisp_Object frame; + + Lisp_Object up_glyph; + Lisp_Object down_glyph; + Lisp_Object disabled_glyph; + + Lisp_Object cap_up_glyph; + Lisp_Object cap_down_glyph; + Lisp_Object cap_disabled_glyph; + + Lisp_Object callback; + Lisp_Object enabled_p; + Lisp_Object help_string; + + char enabled; + char down; + char pushright; + char blank; + + int x, y; + int width, height; + int dirty; + int vertical; + int border_width; + }; + + [[ the standard junk: ]] + + DECLARE_LISP_OBJECT (toolbar_button, struct toolbar_button); + #define XTOOLBAR_BUTTON(x) XRECORD (x, toolbar_button, struct toolbar_button) + #define wrap_toolbar_button(p) wrap_record (p, toolbar_button) + #define TOOLBAR_BUTTONP(x) RECORDP (x, toolbar_button) + #define CHECK_TOOLBAR_BUTTON(x) CHECK_RECORD (x, toolbar_button) + #define CONCHECK_TOOLBAR_BUTTON(x) CONCHECK_RECORD (x, toolbar_button) + ------------------------------ in toolbar.c ----------------------------- - -#include "toolbar.h" - -... + + #include "toolbar.h" + + ... + + static const struct memory_description toolbar_button_description [] = { + { XD_LISP_OBJECT, offsetof (struct toolbar_button, next) }, + { XD_LISP_OBJECT, offsetof (struct toolbar_button, frame) }, + { XD_LISP_OBJECT, offsetof (struct toolbar_button, up_glyph) }, + { XD_LISP_OBJECT, offsetof (struct toolbar_button, down_glyph) }, + { XD_LISP_OBJECT, offsetof (struct toolbar_button, disabled_glyph) }, + { XD_LISP_OBJECT, offsetof (struct toolbar_button, cap_up_glyph) }, + { XD_LISP_OBJECT, offsetof (struct toolbar_button, cap_down_glyph) }, + { XD_LISP_OBJECT, offsetof (struct toolbar_button, cap_disabled_glyph) }, + { XD_LISP_OBJECT, offsetof (struct toolbar_button, callback) }, + { XD_LISP_OBJECT, offsetof (struct toolbar_button, enabled_p) }, + { XD_LISP_OBJECT, offsetof (struct toolbar_button, help_string) }, + { XD_END } + }; + + static Lisp_Object + allocate_toolbar_button (struct frame *f, int pushright) + { + struct toolbar_button *tb; + + tb = XTOOLBAR_BUTTON (ALLOC_NORMAL_LISP_OBJECT (toolbar_button)); + tb->next = Qnil; + tb->frame = wrap_frame (f); + tb->up_glyph = Qnil; + tb->down_glyph = Qnil; + tb->disabled_glyph = Qnil; + tb->cap_up_glyph = Qnil; + tb->cap_down_glyph = Qnil; + tb->cap_disabled_glyph = Qnil; + tb->callback = Qnil; + tb->enabled_p = Qnil; + tb->help_string = Qnil; + + tb->pushright = pushright; + tb->x = tb->y = tb->width = tb->height = -1; + tb->dirty = 1; + + return wrap_toolbar_button (tb); + } + + static Lisp_Object + mark_toolbar_button (Lisp_Object obj) + { + struct toolbar_button *data = XTOOLBAR_BUTTON (obj); + mark_object (data->next); + mark_object (data->frame); + mark_object (data->up_glyph); + mark_object (data->down_glyph); + mark_object (data->disabled_glyph); + mark_object (data->cap_up_glyph); + mark_object (data->cap_down_glyph); + mark_object (data->cap_disabled_glyph); + mark_object (data->callback); + mark_object (data->enabled_p); + return data->help_string; + } + + DEFINE_NODUMP_LISP_OBJECT ("toolbar-button", toolbar_button, + mark_toolbar_button, + external_object_printer, 0, 0, 0, + toolbar_button_description, + struct toolbar_button); + + ... + + void + syms_of_toolbar (void) + { + INIT_LISP_OBJECT (toolbar_button); + + ...; + } + +------------------------------ in inline.c ----------------------------- + + #ifdef HAVE_TOOLBARS + #include "toolbar.h" + #endif + +------------------------------ in lrecord.h ----------------------------- + + enum lrecord_type + { + ... + lrecord_type_toolbar_button, + ... + }; -static const struct memory_description toolbar_button_description [] = { - { XD_LISP_OBJECT, offsetof (struct toolbar_button, next) }, - { XD_LISP_OBJECT, offsetof (struct toolbar_button, frame) }, - { XD_LISP_OBJECT, offsetof (struct toolbar_button, up_glyph) }, - { XD_LISP_OBJECT, offsetof (struct toolbar_button, down_glyph) }, - { XD_LISP_OBJECT, offsetof (struct toolbar_button, disabled_glyph) }, - { XD_LISP_OBJECT, offsetof (struct toolbar_button, cap_up_glyph) }, - { XD_LISP_OBJECT, offsetof (struct toolbar_button, cap_down_glyph) }, - { XD_LISP_OBJECT, offsetof (struct toolbar_button, cap_disabled_glyph) }, - { XD_LISP_OBJECT, offsetof (struct toolbar_button, callback) }, - { XD_LISP_OBJECT, offsetof (struct toolbar_button, enabled_p) }, - { XD_LISP_OBJECT, offsetof (struct toolbar_button, help_string) }, - { XD_END } -}; - -static Lisp_Object -mark_toolbar_button (Lisp_Object obj) -\{ - struct toolbar_button *data = XTOOLBAR_BUTTON (obj); - mark_object (data->next); - mark_object (data->frame); - mark_object (data->up_glyph); - mark_object (data->down_glyph); - mark_object (data->disabled_glyph); - mark_object (data->cap_up_glyph); - mark_object (data->cap_down_glyph); - mark_object (data->cap_disabled_glyph); - mark_object (data->callback); - mark_object (data->enabled_p); - return data->help_string; -} +------------------------------ in .gdbinit.in.in ----------------------------- -[[ If your object should never escape to Lisp, declare its print method - as internal_object_printer instead of 0. ]] - -DEFINE_LRECORD_IMPLEMENTATION ("toolbar-button", toolbar_button, - 0, mark_toolbar_button, 0, 0, 0, 0, - toolbar_button_description, - struct toolbar_button); - -... - -void -syms_of_toolbar (void) -{ - INIT_LRECORD_IMPLEMENTATION (toolbar_button); - - ...; -} + ... + else + if $lrecord_type == lrecord_type_toolbar_button + pstructtype toolbar_button + ... + ... + ... + end ------------------------------- in inline.c ----------------------------- - -#ifdef HAVE_TOOLBARS -#include "toolbar.h" -#endif - ------------------------------- in lrecord.h ----------------------------- - -enum lrecord_type -{ - ... - lrecord_type_toolbar_button, - ... -}; - - ---ben + --ben */ /* Note: Object types defined in external dynamically-loaded modules (not -part of the XEmacs main source code) should use DECLARE_EXTERNAL_LRECORD -and DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION rather than DECLARE_LRECORD -and DEFINE_LRECORD_IMPLEMENTATION. The EXTERNAL versions declare and +part of the XEmacs main source code) should use DECLARE_*_MODULE_LISP_OBJECT +and DEFINE_*_MODULE_LISP_OBJECT rather than DECLARE_*_LISP_OBJECT +and DEFINE_*_LISP_OBJECT. The MODULE versions declare and allocate an enumerator for the type being defined. */ @@ -1442,58 +1799,45 @@ #ifdef ERROR_CHECK_TYPES -# define DECLARE_LRECORD(c_name, structtype) \ -extern const struct lrecord_implementation lrecord_##c_name; \ -DECLARE_INLINE_HEADER ( \ -structtype * \ -error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \ -) \ -{ \ +# define DECLARE_LISP_OBJECT(c_name, structtype) \ +extern struct lrecord_implementation lrecord_##c_name; \ +DECLARE_INLINE_HEADER ( \ +structtype * \ +error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \ +) \ +{ \ assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \ - return (structtype *) XPNTR (obj); \ -} \ + return (structtype *) XPNTR (obj); \ +} \ extern Lisp_Object Q##c_name##p -# define DECLARE_MODULE_API_LRECORD(c_name, structtype) \ -extern MODULE_API const struct lrecord_implementation lrecord_##c_name; \ -DECLARE_INLINE_HEADER ( \ -structtype * \ -error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \ -) \ -{ \ - assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \ - return (structtype *) XPNTR (obj); \ -} \ -extern MODULE_API Lisp_Object Q##c_name##p - -# define DECLARE_EXTERNAL_LRECORD(c_name, structtype) \ -extern int lrecord_type_##c_name; \ -extern struct lrecord_implementation lrecord_##c_name; \ -DECLARE_INLINE_HEADER ( \ -structtype * \ -error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \ -) \ -{ \ - assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \ - return (structtype *) XPNTR (obj); \ -} \ -extern Lisp_Object Q##c_name##p - -# define DECLARE_NONRECORD(c_name, type_enum, structtype) \ +# define DECLARE_MODULE_API_LISP_OBJECT(c_name, structtype) \ +extern MODULE_API struct lrecord_implementation lrecord_##c_name; \ DECLARE_INLINE_HEADER ( \ structtype * \ error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \ ) \ { \ - assert_at_line (XTYPE (obj) == type_enum, file, line); \ + assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \ + return (structtype *) XPNTR (obj); \ +} \ +extern MODULE_API Lisp_Object Q##c_name##p + +# define DECLARE_MODULE_LISP_OBJECT(c_name, structtype) \ +extern int lrecord_type_##c_name; \ +extern struct lrecord_implementation lrecord_##c_name; \ +DECLARE_INLINE_HEADER ( \ +structtype * \ +error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \ +) \ +{ \ + assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \ return (structtype *) XPNTR (obj); \ } \ extern Lisp_Object Q##c_name##p # define XRECORD(x, c_name, structtype) \ error_check_##c_name (x, __FILE__, __LINE__) -# define XNONRECORD(x, c_name, type_enum, structtype) \ - error_check_##c_name (x, __FILE__, __LINE__) DECLARE_INLINE_HEADER ( Lisp_Object @@ -1512,21 +1856,17 @@ #else /* not ERROR_CHECK_TYPES */ -# define DECLARE_LRECORD(c_name, structtype) \ +# define DECLARE_LISP_OBJECT(c_name, structtype) \ extern Lisp_Object Q##c_name##p; \ -extern const struct lrecord_implementation lrecord_##c_name -# define DECLARE_MODULE_API_LRECORD(c_name, structtype) \ -extern MODULE_API Lisp_Object Q##c_name##p; \ -extern MODULE_API const struct lrecord_implementation lrecord_##c_name -# define DECLARE_EXTERNAL_LRECORD(c_name, structtype) \ +extern struct lrecord_implementation lrecord_##c_name +# define DECLARE_MODULE_API_LISP_OBJECT(c_name, structtype) \ +extern MODULE_API Lisp_Object Q##c_name##p; \ +extern MODULE_API struct lrecord_implementation lrecord_##c_name +# define DECLARE_MODULE_LISP_OBJECT(c_name, structtype) \ extern Lisp_Object Q##c_name##p; \ extern int lrecord_type_##c_name; \ extern struct lrecord_implementation lrecord_##c_name -# define DECLARE_NONRECORD(c_name, type_enum, structtype) \ -extern Lisp_Object Q##c_name##p # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x)) -# define XNONRECORD(x, c_name, type_enum, structtype) \ - ((structtype *) XPNTR (x)) /* wrap_pointer_1 is so named as a suggestion not to use it unless you know what you're doing. */ #define wrap_record(ptr, ty) wrap_pointer_1 (ptr) @@ -1580,13 +1920,13 @@ struct lcrecord_list { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; Lisp_Object free; Elemcount size; const struct lrecord_implementation *implementation; }; -DECLARE_LRECORD (lcrecord_list, struct lcrecord_list); +DECLARE_LISP_OBJECT (lcrecord_list, struct lcrecord_list); #define XLCRECORD_LIST(x) XRECORD (x, lcrecord_list, struct lcrecord_list) #define wrap_lcrecord_list(p) wrap_record (p, lcrecord_list) #define LCRECORD_LISTP(x) RECORDP (x, lcrecord_list) @@ -1601,13 +1941,13 @@ lrecords. lcrecords themselves are divided into three types: (1) auto-managed, (2) hand-managed, and (3) unmanaged. "Managed" refers to using a special object called an lcrecord-list to keep track of freed - lcrecords, which can freed with FREE_LCRECORD() or the like and later be - recycled when a new lcrecord is required, rather than requiring new - malloc(). Thus, allocation of lcrecords can be very + lcrecords, which can freed with free_normal_lisp_object() or the like + and later be recycled when a new lcrecord is required, rather than + requiring new malloc(). Thus, allocation of lcrecords can be very cheap. (Technically, the lcrecord-list manager could divide up large chunks of memory and allocate out of that, mimicking what happens with lrecords. At that point, however, we'd want to rethink the whole - division between lrecords and lcrecords.) + division between lrecords and lcrecords.) NOTE: There is a fundamental limitation of lcrecord-lists, which is that they only handle blocks of a particular, fixed size. Thus, objects that @@ -1615,9 +1955,9 @@ in particular dictate the various types of management: -- "Auto-managed" means that you just go ahead and allocate the lcrecord - whenever you want, using old_alloc_lcrecord_type(), and the appropriate + whenever you want, using ALLOC_NORMAL_LISP_OBJECT(), and the appropriate lcrecord-list manager is automatically created. To free, you just call - "FREE_LCRECORD()" and the appropriate lcrecord-list manager is + "free_normal_lisp_object()" and the appropriate lcrecord-list manager is automatically located and called. The limitation here of course is that all your objects are of the same size. (#### Eventually we should have a more sophisticated system that tracks the sizes seen and creates one @@ -1638,7 +1978,7 @@ to hand-manage them, or (b) the objects you create are always or almost always Lisp-visible, and thus there's no point in freeing them (and it wouldn't be safe to do so). You just create them with - BASIC_ALLOC_LCRECORD(), and that's it. + ALLOC_SIZED_LISP_OBJECT(), and that's it. --ben @@ -1651,10 +1991,10 @@ 1) Create an lcrecord-list object using make_lcrecord_list(). This is often done at initialization. Remember to staticpro_nodump() this object! The arguments to make_lcrecord_list() are the same as would be - passed to BASIC_ALLOC_LCRECORD(). + passed to ALLOC_SIZED_LISP_OBJECT(). - 2) Instead of calling BASIC_ALLOC_LCRECORD(), call alloc_managed_lcrecord() - and pass the lcrecord-list earlier created. + 2) Instead of calling ALLOC_SIZED_LISP_OBJECT(), call + alloc_managed_lcrecord() and pass the lcrecord-list earlier created. 3) When done with the lcrecord, call free_managed_lcrecord(). The standard freeing caveats apply: ** make sure there are no pointers to @@ -1664,7 +2004,7 @@ lcrecord goodbye as if it were garbage-collected. This means: -- the contents of the freed lcrecord are undefined, and the contents of something produced by alloc_managed_lcrecord() - are undefined, just like for BASIC_ALLOC_LCRECORD(). + are undefined, just like for ALLOC_SIZED_LISP_OBJECT(). -- the mark method for the lcrecord's type will *NEVER* be called on freed lcrecords. -- the finalize method for the lcrecord's type will be called @@ -1672,8 +2012,9 @@ */ /* UNMANAGED MODEL: */ -void *old_basic_alloc_lcrecord (Bytecount size, - const struct lrecord_implementation *); +Lisp_Object old_alloc_lcrecord (const struct lrecord_implementation *); +Lisp_Object old_alloc_sized_lcrecord (Bytecount size, + const struct lrecord_implementation *); /* HAND-MANAGED MODEL: */ Lisp_Object make_lcrecord_list (Elemcount size, @@ -1683,85 +2024,34 @@ void free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord); /* AUTO-MANAGED MODEL: */ -MODULE_API void * -alloc_automanaged_lcrecord (Bytecount size, - const struct lrecord_implementation *); +MODULE_API Lisp_Object +alloc_automanaged_sized_lcrecord (Bytecount size, + const struct lrecord_implementation *imp); +MODULE_API Lisp_Object +alloc_automanaged_lcrecord (const struct lrecord_implementation *imp); -#define old_alloc_lcrecord_type(type, lrecord_implementation) \ - ((type *) alloc_automanaged_lcrecord (sizeof (type), lrecord_implementation)) +#define old_alloc_lcrecord_type(type, imp) \ + ((type *) XPNTR (alloc_automanaged_lcrecord (sizeof (type), imp))) void old_free_lcrecord (Lisp_Object rec); - -/* Copy the data from one lcrecord structure into another, but don't - overwrite the header information. */ - -#define old_copy_sized_lcrecord(dst, src, size) \ - memcpy ((Rawbyte *) (dst) + sizeof (struct old_lcrecord_header), \ - (Rawbyte *) (src) + sizeof (struct old_lcrecord_header), \ - (size) - sizeof (struct old_lcrecord_header)) - -#define old_copy_lcrecord(dst, src) \ - old_copy_sized_lcrecord (dst, src, sizeof (*(dst))) - -#define old_zero_sized_lcrecord(lcr, size) \ - memset ((Rawbyte *) (lcr) + sizeof (struct old_lcrecord_header), 0, \ - (size) - sizeof (struct old_lcrecord_header)) - -#define old_zero_lcrecord(lcr) old_zero_sized_lcrecord (lcr, sizeof (*(lcr))) - #else /* NEW_GC */ -/* How to allocate a lrecord: - - - If the size of the lrecord is fix, say it equals its size of its - struct, then use alloc_lrecord_type. - - - If the size varies, i.e. it is not equal to the size of its - struct, use alloc_lrecord and specify the amount of storage you - need for the object. - - - Some lrecords, which are used totally internally, use the - noseeum-* functions for the reason of debugging. - - - To free a Lisp_Object manually, use free_lrecord. */ - -void *alloc_lrecord (Bytecount size, - const struct lrecord_implementation *); - -void *alloc_lrecord_array (Bytecount size, int elemcount, - const struct lrecord_implementation *); +MODULE_API Lisp_Object alloc_sized_lrecord (Bytecount size, + const struct lrecord_implementation *imp); +Lisp_Object noseeum_alloc_sized_lrecord (Bytecount size, + const struct lrecord_implementation *imp); +MODULE_API Lisp_Object alloc_lrecord (const struct lrecord_implementation *imp); +Lisp_Object noseeum_alloc_lrecord (const struct lrecord_implementation *imp); -#define alloc_lrecord_type(type, lrecord_implementation) \ - ((type *) alloc_lrecord (sizeof (type), lrecord_implementation)) - -void *noseeum_alloc_lrecord (Bytecount size, - const struct lrecord_implementation *); - -#define noseeum_alloc_lrecord_type(type, lrecord_implementation) \ - ((type *) noseeum_alloc_lrecord (sizeof (type), lrecord_implementation)) - -void free_lrecord (Lisp_Object rec); - - -/* Copy the data from one lrecord structure into another, but don't - overwrite the header information. */ - -#define copy_sized_lrecord(dst, src, size) \ - memcpy ((char *) (dst) + sizeof (struct lrecord_header), \ - (char *) (src) + sizeof (struct lrecord_header), \ - (size) - sizeof (struct lrecord_header)) - -#define copy_lrecord(dst, src) copy_sized_lrecord (dst, src, sizeof (*(dst))) +MODULE_API Lisp_Object alloc_lrecord_array (int elemcount, + const struct lrecord_implementation *imp); +MODULE_API Lisp_Object alloc_sized_lrecord_array (Bytecount size, + int elemcount, + const struct lrecord_implementation *imp); #endif /* NEW_GC */ -#define zero_sized_lrecord(lcr, size) \ - memset ((char *) (lcr) + sizeof (struct lrecord_header), 0, \ - (size) - sizeof (struct lrecord_header)) - -#define zero_lrecord(lcr) zero_sized_lrecord (lcr, sizeof (*(lcr))) - DECLARE_INLINE_HEADER ( Bytecount detagged_lisp_object_size (const struct lrecord_header *h) @@ -1770,7 +2060,7 @@ const struct lrecord_implementation *imp = LHEADER_IMPLEMENTATION (h); return (imp->size_in_bytes_method ? - imp->size_in_bytes_method (h) : + imp->size_in_bytes_method (wrap_pointer_1 (h)) : imp->static_size); } @@ -1782,6 +2072,22 @@ return detagged_lisp_object_size (XRECORD_LHEADER (o)); } +struct usage_stats; + +MODULE_API void copy_lisp_object (Lisp_Object dst, Lisp_Object src); +MODULE_API void zero_sized_lisp_object (Lisp_Object obj, Bytecount size); +MODULE_API void zero_nonsized_lisp_object (Lisp_Object obj); +Bytecount lisp_object_storage_size (Lisp_Object obj, + struct usage_stats *ustats); +Bytecount lisp_object_memory_usage_full (Lisp_Object object, + Bytecount *storage_size, + Bytecount *extra_nonlisp_storage, + Bytecount *extra_lisp_storage, + struct generic_usage_stats *stats); +Bytecount lisp_object_memory_usage (Lisp_Object object); +Bytecount tree_memory_usage (Lisp_Object arg, int vectorp); +void free_normal_lisp_object (Lisp_Object obj); + /************************************************************************/ /* Dumping */ diff -r 861f2601a38b -r 1f0b15040456 src/lstream.c --- a/src/lstream.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/lstream.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* Generic stream implementation. Copyright (C) 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1996, 2001, 2002 Ben Wing. + Copyright (C) 1996, 2001, 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -64,42 +62,36 @@ Lstream *lstr = XLSTREAM (obj); write_fmt_string (printcharfun, - "#", - lstr->imp->name, (long) lstr); + "#", + lstr->imp->name, LISP_OBJECT_UID (obj)); } static void -finalize_lstream (void *header, int for_disksave) +finalize_lstream (Lisp_Object obj) { /* WARNING WARNING WARNING. This function (and all finalize functions) - may get called more than once on the same object, and may get called - (at dump time) on objects that are not being released. */ - Lstream *lstr = (Lstream *) header; + may get called more than once on the same object. */ + Lstream *lstr = XLSTREAM (obj); + + if (lstr->flags & LSTREAM_FL_IS_OPEN) + Lstream_close (lstr); + + if (lstr->imp->finalizer) + (lstr->imp->finalizer) (lstr); +} + +static void +disksave_lstream (Lisp_Object lstream) +{ + Lstream *lstr = XLSTREAM (lstream); #if 0 /* this may cause weird Broken Pipes? */ - if (for_disksave) - { - Lstream_pseudo_close (lstr); - return; - } + Lstream_pseudo_close (lstr); + return; #endif - if (lstr->flags & LSTREAM_FL_IS_OPEN) - { - if (for_disksave) - { - if (lstr->flags & LSTREAM_FL_CLOSE_AT_DISKSAVE) - Lstream_close (lstr); - } - else - /* Just close. */ - Lstream_close (lstr); - } - - if (!for_disksave) - { - if (lstr->imp->finalizer) - (lstr->imp->finalizer) (lstr); - } + if ((lstr->flags & LSTREAM_FL_IS_OPEN) && + (lstr->flags & LSTREAM_FL_CLOSE_AT_DISKSAVE)) + Lstream_close (lstr); } inline static Bytecount @@ -110,9 +102,9 @@ } static Bytecount -sizeof_lstream (const void *header) +sizeof_lstream (Lisp_Object obj) { - return aligned_sizeof_lstream (((const Lstream *) header)->imp->size); + return aligned_sizeof_lstream (XLSTREAM (obj)->imp->size); } static const struct memory_description lstream_implementation_description_1[] @@ -150,12 +142,12 @@ 0, lstream_empty_extra_description_1 }; -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("stream", lstream, - 0, /*dumpable-flag*/ - mark_lstream, print_lstream, - finalize_lstream, 0, 0, - lstream_description, - sizeof_lstream, Lstream); +DEFINE_NODUMP_SIZABLE_LISP_OBJECT ("stream", lstream, + mark_lstream, print_lstream, + finalize_lstream, + 0, 0, /* no equal or hash */ + lstream_description, + sizeof_lstream, Lstream); /* Change the buffering of a stream. See lstream.h. By default the @@ -197,9 +189,8 @@ { Lstream *p; #ifdef NEW_GC - p = XLSTREAM (wrap_pointer_1 - (alloc_lrecord (aligned_sizeof_lstream (imp->size), - &lrecord_lstream))); + p = XLSTREAM (ALLOC_SIZED_LISP_OBJECT (aligned_sizeof_lstream (imp->size), + lstream)); #else /* not NEW_GC */ int i; @@ -221,9 +212,10 @@ p = XLSTREAM (alloc_managed_lcrecord (Vlstream_free_list[i])); #endif /* not NEW_GC */ - /* Zero it out, except the header. */ - memset ((char *) p + sizeof (p->header), '\0', - aligned_sizeof_lstream (imp->size) - sizeof (p->header)); + /* Formerly, we zeroed out the object minus its header, but it's now + handled automatically. ALLOC_SIZED_LISP_OBJECT() always zeroes out + the whole object other than its header, and alloc_managed_lcrecord() + does the same. */ p->imp = imp; Lstream_set_buffering (p, LSTREAM_BLOCK_BUFFERED, 0); p->flags = LSTREAM_FL_IS_OPEN; @@ -302,7 +294,7 @@ Lisp_Object val = wrap_lstream (lstr); #ifdef NEW_GC - free_lrecord (val); + free_normal_lisp_object (val); #else /* not NEW_GC */ for (i = 0; i < lstream_type_count; i++) { @@ -1659,8 +1651,7 @@ int reading = !strcmp (mode, "r"); /* Make sure the luser didn't pass "w" in. */ - if (!strcmp (mode, "w")) - ABORT (); + assert (strcmp (mode, "w")); if (flags & LSTR_IGNORE_ACCESSIBLE) { @@ -1827,6 +1818,18 @@ /************************************************************************/ void +syms_of_lstream (void) +{ + INIT_LISP_OBJECT (lstream); +} + +void +lstream_objects_create (void) +{ + OBJECT_HAS_PREMETHOD (lstream, disksave); +} + +void lstream_type_create (void) { LSTREAM_HAS_METHOD (stdio, reader); @@ -1882,5 +1885,4 @@ void vars_of_lstream (void) { - INIT_LRECORD_IMPLEMENTATION (lstream); } diff -r 861f2601a38b -r 1f0b15040456 src/lstream.h --- a/src/lstream.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/lstream.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -30,7 +28,7 @@ /* definition of Lstream object */ /************************************************************************/ -DECLARE_LRECORD (lstream, struct lstream); +DECLARE_LISP_OBJECT (lstream, struct lstream); #define XLSTREAM(x) XRECORD (x, lstream, struct lstream) #define wrap_lstream(p) wrap_record (p, lstream) #define LSTREAMP(x) RECORDP (x, lstream) @@ -230,7 +228,7 @@ struct lstream { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; const Lstream_implementation *imp; /* methods for this stream */ Lstream_buffering buffering; /* type of buffering in use */ Bytecount buffering_size; /* number of bytes buffered */ diff -r 861f2601a38b -r 1f0b15040456 src/m/alpha.h --- a/src/m/alpha.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/m/alpha.h Sun May 01 18:44:03 2011 +0100 @@ -3,20 +3,18 @@ This file is part of XEmacs. -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 1, or (at your option) -any later version. +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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ #ifndef __ELF__ diff -r 861f2601a38b -r 1f0b15040456 src/m/arm.h --- a/src/m/arm.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/m/arm.h Sun May 01 18:44:03 2011 +0100 @@ -1,22 +1,20 @@ /* Machine description file for digital/intel arm/strongarm Copyright (C) 1987 Free Software Foundation, Inc. -This file is part of GNU Emacs. +This file is part of XEmacs. -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. +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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.31. */ diff -r 861f2601a38b -r 1f0b15040456 src/m/hp800.h --- a/src/m/hp800.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/m/hp800.h Sun May 01 18:44:03 2011 +0100 @@ -2,22 +2,20 @@ Copyright (C) 1987 Free Software Foundation, Inc. Copyright (C) 2010 Ben Wing. -This file is part of GNU Emacs. +This file is part of XEmacs. -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. +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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.31. */ diff -r 861f2601a38b -r 1f0b15040456 src/m/ibmrs6000.h --- a/src/m/ibmrs6000.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/m/ibmrs6000.h Sun May 01 18:44:03 2011 +0100 @@ -1,22 +1,20 @@ /* R2 AIX machine/system dependent defines Copyright (C) 1988 Free Software Foundation, Inc. -This file is part of GNU Emacs. +This file is part of XEmacs. -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. +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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.31. */ diff -r 861f2601a38b -r 1f0b15040456 src/m/intel386.h --- a/src/m/intel386.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/m/intel386.h Sun May 01 18:44:03 2011 +0100 @@ -1,22 +1,20 @@ /* Machine description file for intel 386. Copyright (C) 1987 Free Software Foundation, Inc. -This file is part of GNU Emacs. +This file is part of XEmacs. -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. +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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.31. */ diff -r 861f2601a38b -r 1f0b15040456 src/m/m68k.h --- a/src/m/m68k.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/m/m68k.h Sun May 01 18:44:03 2011 +0100 @@ -1,22 +1,20 @@ /* Machine description file for generic Motorola 68k. Copyright (C) 1985, 1995 Free Software Foundation, Inc. -This file is part of GNU Emacs. +This file is part of XEmacs. -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. +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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.31. */ diff -r 861f2601a38b -r 1f0b15040456 src/m/mips.h --- a/src/m/mips.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/m/mips.h Sun May 01 18:44:03 2011 +0100 @@ -1,22 +1,20 @@ /* m- file for Mips machines. Copyright (C) 1987, 1992 Free Software Foundation, Inc. -This file is part of GNU Emacs. +This file is part of XEmacs. -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. +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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.31. */ diff -r 861f2601a38b -r 1f0b15040456 src/m/powerpc.h --- a/src/m/powerpc.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/m/powerpc.h Sun May 01 18:44:03 2011 +0100 @@ -5,20 +5,18 @@ 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. diff -r 861f2601a38b -r 1f0b15040456 src/m/sparc.h --- a/src/m/sparc.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/m/sparc.h Sun May 01 18:44:03 2011 +0100 @@ -1,22 +1,20 @@ /* machine description file for Sun 4 SPARC. Copyright (C) 1987, 1994 Free Software Foundation, Inc. -This file is part of GNU Emacs. +This file is part of XEmacs. -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. +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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.31. */ diff -r 861f2601a38b -r 1f0b15040456 src/m/template.h --- a/src/m/template.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/m/template.h Sun May 01 18:44:03 2011 +0100 @@ -2,22 +2,20 @@ Copyright (C) 1985, 1986 Free Software Foundation, Inc. Copyright (C) 2010 Ben Wing. -This file is part of GNU Emacs. +This file is part of XEmacs. -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. +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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.31. */ diff -r 861f2601a38b -r 1f0b15040456 src/m/windowsnt.h --- a/src/m/windowsnt.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/m/windowsnt.h Sun May 01 18:44:03 2011 +0100 @@ -2,22 +2,20 @@ Copyright (C) 1993, 1994 Free Software Foundation, Inc. -This file is part of GNU Emacs. +This file is part of XEmacs. -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. +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 3 of the License, 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. +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 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. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.31. */ diff -r 861f2601a38b -r 1f0b15040456 src/macros.c --- a/src/macros.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/macros.c Sun May 01 18:44:03 2011 +0100 @@ -1,12 +1,13 @@ /* Keyboard macros. Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc. + Copyright (C) 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ @@ -181,7 +180,7 @@ void pop_kbd_macro_event (Lisp_Object event) { - if (NILP (Vexecuting_macro)) ABORT (); + assert (!NILP (Vexecuting_macro)); if (STRINGP (Vexecuting_macro) || VECTORP (Vexecuting_macro)) { diff -r 861f2601a38b -r 1f0b15040456 src/macros.h --- a/src/macros.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/macros.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ diff -r 861f2601a38b -r 1f0b15040456 src/make-src-depend --- a/src/make-src-depend Sat Feb 20 06:03:00 2010 -0600 +++ b/src/make-src-depend Sun May 01 18:44:03 2011 +0100 @@ -3,26 +3,25 @@ ### make-src-depend --- update the Makefile dependency information for XEmacs # Copyright (C) 1998 Free Software Foundation, Inc. +# Copyright (C) 2010 Ben Wing. ## Author: Martin Buchholz ## Maintainer: XEmacs Development Team ## 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 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 3 of the License, 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. +## XEmacs is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +## for more details. ## You should have received a copy of the GNU General Public License -## along with XEmacs; see the file COPYING. If not, write to the Free -## Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -## 02111-1307, USA. +## along with XEmacs. If not, see . eval 'exec perl -w -S $0 ${1+"$@"}' if 0; @@ -114,16 +113,16 @@ sub PrintDeps { my $file = shift; my $ofile = $file; $ofile =~ s/c$/o/; print "$ofile: "; - if (exists $uses{$file}{'lisp.h'}) { - delete $uses{$file}{@LISP_H}; - $uses{$file}{'$(LISP_H)'} = 1; - } - # Note: If both config.h and lisp.h are dependencies, config.h got deleted - # by the last clause. if (exists $uses{$file}{'config.h'}) { delete $uses{$file}{'config.h'}; $uses{$file}{'$(CONFIG_H)'} = 1; } + if (exists $uses{$file}{'lisp.h'}) { + for my $x (@LISP_H) { + delete $uses{$file}{$x}; + } + $uses{$file}{'$(LISP_H)'} = 1; + } # Huge hack. With QUICK_BUILD, general.c has no dependence on # general-slots.h but really should. $uses{$file}{'general-slots.h'} = 1 if $file eq "general.c"; diff -r 861f2601a38b -r 1f0b15040456 src/marker.c --- a/src/marker.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/marker.c Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,13 @@ /* Markers: examining, setting and killing. Copyright (C) 1985, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 2002 Ben Wing. + Copyright (C) 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ @@ -60,7 +58,7 @@ Lisp_Marker *marker = XMARKER (obj); if (print_readably) - printing_unreadable_object ("#", (long) marker); + printing_unreadable_object_fmt ("#", LISP_OBJECT_UID (obj)); write_ascstring (printcharfun, GETTEXT ("#buffer) @@ -73,7 +71,7 @@ } if (marker->insertion_type) write_ascstring (printcharfun, " insertion-type=t"); - write_fmt_string (printcharfun, " 0x%lx>", (long) marker); + write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); } static int @@ -90,7 +88,7 @@ } static Hashcode -marker_hash (Lisp_Object obj, int UNUSED (depth)) +marker_hash (Lisp_Object obj, int UNUSED (depth), Boolint UNUSED (equalp)) { Hashcode hash = (Hashcode) XMARKER (obj)->buffer; if (hash) @@ -107,28 +105,17 @@ #ifdef NEW_GC static void -finalize_marker (void *header, int for_disksave) +finalize_marker (Lisp_Object obj) { - if (!for_disksave) - { - Lisp_Object tem = wrap_marker (header); - unchain_marker (tem); - } + unchain_marker (obj); } +#endif /* NEW_GC */ -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker, - 1, /*dumpable-flag*/ - mark_marker, print_marker, - finalize_marker, - marker_equal, marker_hash, - marker_description, Lisp_Marker); -#else /* not NEW_GC */ -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker, - 1, /*dumpable-flag*/ - mark_marker, print_marker, 0, - marker_equal, marker_hash, - marker_description, Lisp_Marker); -#endif /* not NEW_GC */ +DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("marker", marker, + mark_marker, print_marker, + IF_NEW_GC (finalize_marker), + marker_equal, marker_hash, + marker_description, Lisp_Marker); /* Operations on markers. */ @@ -503,25 +490,15 @@ #ifdef MEMORY_USAGE_STATS -int -compute_buffer_marker_usage (struct buffer *b, struct overhead_stats *ovstats) +Bytecount +compute_buffer_marker_usage (struct buffer *b) { Lisp_Marker *m; - int total = 0; - int overhead; + Bytecount total = 0; for (m = BUF_MARKERS (b); m; m = m->next) - total += sizeof (Lisp_Marker); - ovstats->was_requested += total; -#ifdef NEW_GC - overhead = mc_alloced_storage_size (total, 0); -#else /* not NEW_GC */ - overhead = fixed_type_block_overhead (total); -#endif /* not NEW_GC */ - /* #### claiming this is all malloc overhead is not really right, - but it has to go somewhere. */ - ovstats->malloc_overhead += overhead; - return total + overhead; + total += lisp_object_memory_usage (wrap_marker (m)); + return total; } #endif /* MEMORY_USAGE_STATS */ @@ -530,7 +507,7 @@ void syms_of_marker (void) { - INIT_LRECORD_IMPLEMENTATION (marker); + INIT_LISP_OBJECT (marker); DEFSUBR (Fmarker_position); DEFSUBR (Fmarker_buffer); diff -r 861f2601a38b -r 1f0b15040456 src/mc-alloc.c --- a/src/mc-alloc.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/mc-alloc.c Sun May 01 18:44:03 2011 +0100 @@ -1,12 +1,13 @@ /* New size-based allocator for XEmacs. Copyright (C) 2005 Marcus Crestani. + Copyright (C) 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,12 +15,231 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ +/* + The New Allocator + + The ideas and algorithms are based on the allocator of the + Boehm-Demers-Weiser conservative garbage collector. See + http://www.hpl.hp.com/personal/Hans_ Boehm/gc/index.html. + + The new allocator is enabled when the new garbage collector + is enabled (with `--with-newgc'). The implementation of + the new garbage collector is in gc.c. + + The new allocator takes care of: + - allocating objects in a write-barrier-friendly way + - manage object's mark bits + + Three-Level Allocation + + The new allocator efficiently manages the allocation of Lisp + objects by minimizing the number of times malloc() and free() are + called. The allocation process has three layers of abstraction: + + 1. It allocates memory in very large chunks called heap sections. + + 2. The heap sections are subdivided into pages. The page size is + determined by the constant PAGE_SIZE. It holds the size of a page + in bytes. + + 3. One page consists of one or more cells. Each cell represents + a memory location for an object. The cells on one page all have + the same size, thus every page only contains equal-sized + objects. + + If an object is bigger than page size, it is allocated on a + multi-page. Then there is only one cell on a multi-page (the cell + covers the full multi-page). Is an object smaller than 1/2 PAGE_SIZE, + a page contains several objects and several cells. There + is only one cell on a page for object sizes from 1/2 PAGE_SIZE to + PAGE_SIZE (whereas multi-pages always contain 2 only one + cell). Only in layer one malloc() and free() are called. + + + Size Classes and Page Lists + + Meta-information about every page and multi-page is kept in a page + header. The page header contains some bookkeeping information like + number of used and free cells, and pointers to other page + headers. The page headers are linked in a page list. + + Every page list builds a size class. A size class contains all + pages (linked via page headers) for objects of the same size. The + new allocator does not group objects based on their type, it groups + objects based on their sizes. + + Here is an example: A cons contains a lrecord_header, a car and cdr + field. Altogether it uses 12 bytes of memory (on 32 bits + machines). All conses are allocated on pages with a cell size of 12 + bytes. All theses pages are kept together in a page list, which + represents the size class for 12 bytes objects. But this size class + is not exclusively for conses only. Other objects, which are also + 12 bytes big (e.g. weak-boxes), are allocated in the same size + class and on the same pages. + + The number of size classes is customizable, so is the size step + between successive size classes. + + + Used and Unused Heap + + The memory which is managed by the allocator can be divided in two + logical parts: + + The used heap contains pages, on which objects are allocated. These + pages are com- pletely or partially occupied. In the used heap, it + is important to quickly find a free spot for a new + object. Therefore the size classes of the used heap are defined by + the size of the cells on the pages. The size classes should match + common object sizes, to avoid wasting memory. + + The unused heap only contains completely empty pages. They have + never been used or have been freed completely again. In the unused + heap, the size of consecutive memory tips the scales. A page is the + smallest entity which is asked for. Therefore, the size classes of + the unused heap are defined by the number of consecutive pages. + + The parameters for the different size classes can be adjusted + independently, see `configurable values' below. + + + The Allocator's Data Structures + + The struct `mc_allocator_globals holds' all the data structures + that the new allocator uses (lists of used and unused pages, mark + bits, etc.). + + + Mapping of Heap Pointers to Page Headers + + For caching benefits, the page headers and mark bits are stored + separately from their associated page. During garbage collection + (i.e. for marking and freeing objects) it is important to identify + the page header which is responsible for a given Lisp object. + + To do this task quickly, I added a two level search tree: the upper + 10 bits of the heap pointer are the index of the first level. This + entry of the first level links to the second level, where the next + 10 bits of the heap pointer are used to identify the page + header. The remaining bits point to the object relative to the + page. + + On architectures with more than 32 bits pointers, a hash value of + the upper bits is used to index into the first level. + + + Mark Bits + + For caching purposes, the mark bits are no longer kept within the + objects, they are kept in a separate bit field. + + Every page header has a field for the mark bits of the objects on + the page. If there are less cells on the page than there fit bits + in the integral data type EMACS_INT, the mark bits are stored + directly in this EMACS_INT. + + Otherwise, the mark bits are written in a separate space, with the + page header pointing to this space. This happens to pages with + rather small objects: many cells fit on a page, thus many mark bits + are needed. + + + Allocate Memory + + Use + void *mc_alloc (size_t size) + to request memory from the allocator. This returns a pointer to a + newly allocated block of memory of given size. + + This is how the new allocator allocates memory: + 1. Determine the size class of the object. + 2. Is there already a page in this size class and is there a free + cell on this page? + * YES + 3. Unlink free cell from free list, return address of free cell. + DONE. + * NO + 3. Is there a page in the unused heap? + * YES + 4. Move unused page to used heap. + 5. Initialize page header, free list, and mark bits. + 6. Unlink first cell from free list, return address of cell. + DONE. + * NO + 4. Expand the heap, add new memory to unused heap + [go back to 3. and proceed with the YES case]. + + The allocator puts partially filled pages to the front of the page + list, completely filled ones to the end. That guarantees a fast + terminating search for free cells. Are there two successive full + pages at the front of the page list, the complete size class is + full, a new page has to be added. + + + Expand Heap + + To expand the heap, a big chunk of contiguous memory is allocated + using malloc(). These pieces are called heap sections. How big a new + heap section is (and thus the growth of the heap) is adjustable: See + MIN_HEAP_INCREASE, MAX_HEAP_INCREASE, and HEAP_GROWTH_DIVISOR below. + + + Free Memory + + One optimization in XEmacs is that locally used Lisp objects are + freed manually (the memory is not wasted till the next garbage + collection). Therefore the new allocator provides this function: + void mc_free (void *ptr) + That frees the object pointed to by ptr. + + This function is also used internally during sweep phase of the + garbage collection. This is how it works in detail: + + 1. Use pointer to identify page header + (use lookup mechanism described above). + 2. Mark cell as free and hook it into free list. + 3. Is the page completely empty? + * YES + 4. Unlink page from page list. + 5. Remove page header, free list, and mark bits. + 6. Move page to unused heap. + * NO + 4. Move page to front of size class (to speed up allocation + of objects). + + If the last object of a page is freed, the empty page is returned to + the unused heap. The allocator tries to coalesce adjacent pages, to + gain a big piece of contiguous memory. The resulting chunk is hooked + into the according size class of the unused heap. If this created a + complete heap section, the heap section is returned to the operating + system by using free(). + + + Allocator and Garbage Collector + + The new allocator simplifies the interface to the Garbage Collector: + * mark live objects: MARK_[WHITE|GREY|BLACK] (ptr) + * sweep heap: EMACS_INT mc_sweep (void) + * run finalizers: EMACS_INT mc_finalize (void) + + + Allocator and Dumper + + The new allocator provides special finalization for the portable + dumper (to save disk space): EMACS_INT mc_finalize_for_disksave (void) + + + More Information + + More details can be found in + http://crestani.de/xemacs/pdf/mc-alloc.pdf . + +*/ + #include #include "lisp.h" @@ -296,6 +516,9 @@ to guarantee fast allocation on partially filled pages. */ page_list_header *used_heap_pages; + /* Holds all allocated pages that contain array elements. */ + page_list_header array_heap_pages; + /* Holds all free pages in the heap. N multiples of PAGE_SIZE are kept on the Nth free list. Contiguos pages are coalesced. */ page_list_header free_heap_pages[N_FREE_PAGE_LISTS]; @@ -323,6 +546,9 @@ #define USED_HEAP_PAGES(i) \ ((page_list_header*) &mc_allocator_globals.used_heap_pages[i]) +#define ARRAY_HEAP_PAGES \ + ((page_list_header*) &mc_allocator_globals.array_heap_pages) + #define FREE_HEAP_PAGES(i) \ ((page_list_header*) &mc_allocator_globals.free_heap_pages[i]) @@ -416,20 +642,6 @@ /*--- misc functions ---------------------------------------------------*/ -/* moved here from alloc.c */ -#ifdef ERROR_CHECK_GC -static void -deadbeef_memory (void *ptr, Bytecount size) -{ - UINT_32_BIT *ptr4 = (UINT_32_BIT *) ptr; - Bytecount beefs = size >> 2; - - /* In practice, size will always be a multiple of four. */ - while (beefs--) - (*ptr4++) = 0xDEADBEEF; /* -559038737 base 10 */ -} -#endif /* ERROR_CHECK_GC */ - /* Visits all pages (page_headers) hooked into the used heap pages list and executes f with the current page header as argument. Needed for sweep. Returns number of processed pages. */ @@ -450,6 +662,19 @@ } number_of_pages_processed += f (ph); } + + if (PLH_FIRST (ARRAY_HEAP_PAGES)) + { + page_header *ph = PLH_FIRST (ARRAY_HEAP_PAGES); + while (PH_NEXT (ph)) + { + page_header *next = PH_NEXT (ph); /* in case f removes the page */ + number_of_pages_processed += f (ph); + ph = next; + } + number_of_pages_processed += f (ph); + } + return number_of_pages_processed; } @@ -921,18 +1146,18 @@ { if (size <= USED_LIST_MIN_OBJECT_SIZE) { - // printf ("size %d -> index %d\n", size, 0); + /* printf ("size %d -> index %d\n", size, 0); */ return 0; } if (size <= (size_t) USED_LIST_UPPER_THRESHOLD) { - // printf ("size %d -> index %d\n", size, - // ((size - USED_LIST_MIN_OBJECT_SIZE - 1) - // / USED_LIST_LIN_STEP) + 1); + /* printf ("size %d -> index %d\n", size, */ + /* ((size - USED_LIST_MIN_OBJECT_SIZE - 1) */ + /* / USED_LIST_LIN_STEP) + 1); */ return ((size - USED_LIST_MIN_OBJECT_SIZE - 1) / USED_LIST_LIN_STEP) + 1; } - // printf ("size %d -> index %d\n", size, N_USED_PAGE_LISTS - 1); + /* printf ("size %d -> index %d\n", size, N_USED_PAGE_LISTS - 1); */ return N_USED_PAGE_LISTS - 1; } @@ -975,9 +1200,8 @@ } -#ifdef MEMORY_USAGE_STATS Bytecount -mc_alloced_storage_size (Bytecount claimed_size, struct overhead_stats *stats) +mc_alloced_storage_size (Bytecount claimed_size, struct usage_stats *stats) { size_t used_size = get_used_list_size_value (get_used_list_index (claimed_size)); @@ -992,7 +1216,6 @@ return used_size; } -#endif /* not MEMORY_USAGE_STATS */ @@ -1187,7 +1410,7 @@ /*--- used heap functions ----------------------------------------------*/ /* Installs initial free list. */ static void -install_cell_free_list (page_header *ph, EMACS_INT elemcount) +install_cell_free_list (page_header *ph) { Rawbyte *p; EMACS_INT i; @@ -1200,7 +1423,7 @@ assert (!LRECORD_FREE_P (p)); MARK_LRECORD_AS_FREE (p); #endif - if (elemcount == 1) + if (!PH_ARRAY_BIT (ph)) NEXT_FREE (p) = FREE_LIST (p + cell_size); set_lookup_table (p, ph); p += cell_size; @@ -1242,7 +1465,10 @@ else PH_CELL_SIZE (ph) = size; if (elemcount == 1) - PH_CELLS_ON_PAGE (ph) = (PAGE_SIZE * PH_N_PAGES (ph)) / PH_CELL_SIZE (ph); + { + PH_CELLS_ON_PAGE (ph) = (PAGE_SIZE * PH_N_PAGES (ph)) / PH_CELL_SIZE (ph); + PH_ARRAY_BIT (ph) = 0; + } else { PH_CELLS_ON_PAGE (ph) = elemcount; @@ -1255,7 +1481,7 @@ /* install mark bits and initialize cell free list */ install_mark_bits (ph); - install_cell_free_list (ph, elemcount); + install_cell_free_list (ph); #ifdef MEMORY_USAGE_STATS PLH_TOTAL_CELLS (plh) += PH_CELLS_ON_PAGE (ph); @@ -1272,7 +1498,7 @@ { page_list_header *plh = PH_PLH (ph); - if (gc_in_progress && PH_PROTECTION_BIT (ph)) ABORT(); + assert (!(gc_in_progress && PH_PROTECTION_BIT (ph))); /* cleanup: remove memory protection, zero page_header bits. */ #ifdef MEMORY_USAGE_STATS @@ -1394,13 +1620,21 @@ page_header *ph = 0; void *result = 0; - plh = USED_HEAP_PAGES (get_used_list_index (size)); - if (size == 0) return 0; - if ((elemcount == 1) && (size < (size_t) PAGE_SIZE_DIV_2)) - /* first check any free cells */ - ph = allocate_cell (plh); + + if (elemcount == 1) + { + plh = USED_HEAP_PAGES (get_used_list_index (size)); + if (size < (size_t) USED_LIST_UPPER_THRESHOLD) + /* first check any free cells */ + ph = allocate_cell (plh); + } + else + { + plh = ARRAY_HEAP_PAGES; + } + if (!ph) /* allocate a new page */ ph = allocate_new_page (plh, size, elemcount); @@ -1578,7 +1812,7 @@ /* Changes the size of the cell pointed to by ptr. Returns the new address of the new cell with new size. */ -void * +static void * mc_realloc_1 (void *ptr, size_t size, int elemcount) { if (ptr) @@ -1685,6 +1919,22 @@ #endif } + { + page_list_header *plh = ARRAY_HEAP_PAGES; + PLH_LIST_TYPE (plh) = USED_LIST; + PLH_SIZE (plh) = 0; + PLH_FIRST (plh) = 0; + PLH_LAST (plh) = 0; + PLH_MARK_BIT_FREE_LIST (plh) = 0; +#ifdef MEMORY_USAGE_STATS + PLH_PAGE_COUNT (plh) = 0; + PLH_USED_CELLS (plh) = 0; + PLH_USED_SPACE (plh) = 0; + PLH_TOTAL_CELLS (plh) = 0; + PLH_TOTAL_SPACE (plh) = 0; +#endif + } + for (i = 0; i < N_FREE_PAGE_LISTS; i++) { page_list_header *plh = FREE_HEAP_PAGES (i); @@ -1735,21 +1985,30 @@ for (i = 0; i < N_FREE_PAGE_LISTS; i++) if (PLH_PAGE_COUNT (FREE_HEAP_PAGES(i)) > 0) free_plhs = - acons (make_int (PLH_SIZE (FREE_HEAP_PAGES(i))), - list1 (make_int (PLH_PAGE_COUNT (FREE_HEAP_PAGES(i)))), - free_plhs); + Facons (make_int (PLH_SIZE (FREE_HEAP_PAGES(i))), + list1 (make_int (PLH_PAGE_COUNT (FREE_HEAP_PAGES(i)))), + free_plhs); for (i = 0; i < N_USED_PAGE_LISTS; i++) if (PLH_PAGE_COUNT (USED_HEAP_PAGES(i)) > 0) used_plhs = - acons (make_int (PLH_SIZE (USED_HEAP_PAGES(i))), - list5 (make_int (PLH_PAGE_COUNT (USED_HEAP_PAGES(i))), - make_int (PLH_USED_CELLS (USED_HEAP_PAGES(i))), - make_int (PLH_USED_SPACE (USED_HEAP_PAGES(i))), - make_int (PLH_TOTAL_CELLS (USED_HEAP_PAGES(i))), - make_int (PLH_TOTAL_SPACE (USED_HEAP_PAGES(i)))), - used_plhs); + Facons (make_int (PLH_SIZE (USED_HEAP_PAGES(i))), + list5 (make_int (PLH_PAGE_COUNT (USED_HEAP_PAGES(i))), + make_int (PLH_USED_CELLS (USED_HEAP_PAGES(i))), + make_int (PLH_USED_SPACE (USED_HEAP_PAGES(i))), + make_int (PLH_TOTAL_CELLS (USED_HEAP_PAGES(i))), + make_int (PLH_TOTAL_SPACE (USED_HEAP_PAGES(i)))), + used_plhs); + used_plhs = + Facons (make_int (0), + list5 (make_int (PLH_PAGE_COUNT(ARRAY_HEAP_PAGES)), + make_int (PLH_USED_CELLS (ARRAY_HEAP_PAGES)), + make_int (PLH_USED_SPACE (ARRAY_HEAP_PAGES)), + make_int (PLH_TOTAL_CELLS (ARRAY_HEAP_PAGES)), + make_int (PLH_TOTAL_SPACE (ARRAY_HEAP_PAGES))), + used_plhs); + for (i = 0; i < N_HEAP_SECTIONS; i++) { used_size += HEAP_SECTION(i).n_pages * PAGE_SIZE; real_size += @@ -1781,26 +2040,28 @@ /*--- incremental garbage collector ----------------------------------*/ +#if 0 /* currently unused */ + /* access dirty bit of page header */ -void +static void set_dirty_bit (page_header *ph, unsigned int value) { PH_DIRTY_BIT (ph) = value; } -void +static void set_dirty_bit_for_address (void *ptr, unsigned int value) { set_dirty_bit (get_page_header (ptr), value); } -unsigned int +static unsigned int get_dirty_bit (page_header *ph) { return PH_DIRTY_BIT (ph); } -unsigned int +static unsigned int get_dirty_bit_for_address (void *ptr) { return get_dirty_bit (get_page_header (ptr)); @@ -1808,25 +2069,25 @@ /* access protection bit of page header */ -void +static void set_protection_bit (page_header *ph, unsigned int value) { PH_PROTECTION_BIT (ph) = value; } -void +static void set_protection_bit_for_address (void *ptr, unsigned int value) { set_protection_bit (get_page_header (ptr), value); } -unsigned int +static unsigned int get_protection_bit (page_header *ph) { return PH_PROTECTION_BIT (ph); } -unsigned int +static unsigned int get_protection_bit_for_address (void *ptr) { return get_protection_bit (get_page_header (ptr)); @@ -1834,12 +2095,14 @@ /* Returns the start of the page of the object pointed to by ptr. */ -void * +static void * get_page_start (void *ptr) { return PH_HEAP_SPACE (get_page_header (ptr)); } +#endif /* 0 */ + /* Make PAGE_SIZE globally available. */ EMACS_INT mc_get_page_size () diff -r 861f2601a38b -r 1f0b15040456 src/mc-alloc.h --- a/src/mc-alloc.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/mc-alloc.h Sun May 01 18:44:03 2011 +0100 @@ -1,12 +1,13 @@ /* New allocator for XEmacs. Copyright (C) 2005 Marcus Crestani. + Copyright (C) 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -122,12 +121,10 @@ /* Functions and macros related with allocation statistics: */ -#ifdef MEMORY_USAGE_STATS /* Returns the real size, including overhead, which is actually alloced for an object with given claimed_size. */ Bytecount mc_alloced_storage_size (Bytecount claimed_size, - struct overhead_stats *stats); -#endif /* MEMORY_USAGE_STATS */ + struct usage_stats *stats); /* Incremental Garbage Collector / Write Barrier Support: */ diff -r 861f2601a38b -r 1f0b15040456 src/md5.c --- a/src/md5.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/md5.c Sun May 01 18:44:03 2011 +0100 @@ -5,20 +5,20 @@ NOTE: The canonical source of this file is maintained with the GNU C Library. Bugs can be reported to bug-glibc@prep.ai.mit.edu. - This program is free software; you can redistribute it and/or modify it + 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. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - + Free Software Foundation, either version 3 of the License, 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 this program; if not, write to the Free Software Foundation, - Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ - + along with XEmacs. If not, see . */ /* Written by Ulrich Drepper , 1995. */ /* XEmacs frontend written by Ben Wing, Jareth Hein and Hrvoje Niksic. */ diff -r 861f2601a38b -r 1f0b15040456 src/mem-limits.h --- a/src/mem-limits.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/mem-limits.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ diff -r 861f2601a38b -r 1f0b15040456 src/menubar-gtk.c --- a/src/menubar-gtk.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/menubar-gtk.c Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -1299,7 +1297,7 @@ return (menubar_visible); } -/* Called from gtk_create_widgets() to create the inital menubar of a frame +/* Called from gtk_create_widgets() to create the initial menubar of a frame before it is mapped, so that the window is mapped with the menubar already there instead of us tacking it on later and thrashing the window after it is visible. */ diff -r 861f2601a38b -r 1f0b15040456 src/menubar-msw.c --- a/src/menubar-msw.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/menubar-msw.c Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -160,9 +158,9 @@ static Lisp_Object allocate_menu_item_id (Lisp_Object path, Lisp_Object name, Lisp_Object suffix) { - UINT id = MENU_ITEM_ID_BITS (HASH3 (internal_hash (path, 0), - internal_hash (name, 0), - internal_hash (suffix, 0))); + UINT id = MENU_ITEM_ID_BITS (HASH3 (internal_hash (path, 0, 0), + internal_hash (name, 0, 0), + internal_hash (suffix, 0, 0))); do { id = MENU_ITEM_ID_BITS (id + 1); } while (GetMenuState (top_level_menu, id, MF_BYCOMMAND) != 0xFFFFFFFF); @@ -202,18 +200,18 @@ if (separator_string_p (XSTRING_DATA (item))) return 13; else - return internal_hash (item, 0) + 13; + return internal_hash (item, 0, 0) + 13; } else if (CONSP (item)) { /* Submenu - hash by its string name + 0 */ - return internal_hash (XCAR (item), 0); + return internal_hash (XCAR (item), 0, 0); } else if (VECTORP (item)) { /* An ordinary item - hash its name and callback form. */ - return HASH2 (internal_hash (XVECTOR_DATA(item)[0], 0), - internal_hash (XVECTOR_DATA(item)[1], 0)); + return HASH2 (internal_hash (XVECTOR_DATA(item)[0], 0, 0), + internal_hash (XVECTOR_DATA(item)[1], 0, 0)); } /* An error - will be caught later */ @@ -521,7 +519,7 @@ /* Come with empty hash table */ if (NILP (FRAME_MSWINDOWS_MENU_HASH_TABLE (f))) FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = - make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, Qequal); else Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); @@ -832,7 +830,7 @@ current_menudesc = menu_desc; current_hash_table = - make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, Qequal); menu = create_empty_popup_menu (); Fputhash (hmenu_to_lisp_object (menu), Qnil, current_hash_table); top_level_menu = menu; diff -r 861f2601a38b -r 1f0b15040456 src/menubar-x.c --- a/src/menubar-x.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/menubar-x.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* Implements an elisp-programmable menubar -- X interface. Copyright (C) 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Tinker Systems and INS Engineering Corp. - Copyright (C) 2000, 2001, 2002, 2003 Ben Wing. + Copyright (C) 2000, 2001, 2002, 2003, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -575,8 +573,7 @@ menubar_visible = !NILP (w->menubar_visible_p); data = compute_menubar_data (f, menubar, deep_p); - if (!data || (!data->next && !data->contents)) - ABORT (); + assert (data && (data->next || data->contents)); if (!FRAME_X_MENUBAR_ID (f)) FRAME_X_MENUBAR_ID (f) = new_lwlib_id (); diff -r 861f2601a38b -r 1f0b15040456 src/menubar.c --- a/src/menubar.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/menubar.c Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/menubar.h --- a/src/menubar.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/menubar.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/minibuf.c --- a/src/minibuf.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/minibuf.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* Minibuffer input and completion. Copyright (C) 1985, 1986, 1992-1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2002 Ben Wing. + Copyright (C) 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.0, FSF 19.28. Mule-ized except as noted. Substantially different from FSF. */ @@ -513,7 +511,7 @@ return Qt; /* Else extract the part in which all completions agree */ - return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize)); + return Fsubseq (bestmatch, Qzero, make_int (bestmatchsize)); } @@ -991,8 +989,10 @@ #endif Vminibuffer_zero = Fget_buffer_create (build_ascstring (" *Minibuf-0*")); + staticpro_nodump (&Vminibuffer_zero); Vecho_area_buffer = Fget_buffer_create (build_ascstring (" *Echo Area*")); + staticpro_nodump (&Vecho_area_buffer); } void diff -r 861f2601a38b -r 1f0b15040456 src/mule-ccl.c --- a/src/mule-ccl.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/mule-ccl.c Sun May 01 18:44:03 2011 +0100 @@ -5,20 +5,18 @@ 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with : FSF Emacs 21.0.90 except TranslateCharacter */ @@ -566,7 +564,7 @@ If VALn is lambda, move to the next map set like reaching to the end of the current map set. - If VALn is a symbol, call the CCL program refered by it. + If VALn is a symbol, call the CCL program referred to by it. Then, use reg[rrr] as a mapped value except for -1, -2 and -3. Such special values are regarded as nil, t, and lambda respectively. @@ -953,7 +951,7 @@ register Lisp_Object *ccl_prog = ccl->prog; const unsigned char *src = source, *src_end = src + src_bytes; int jump_address; - int i, j, op; + int i = 0, j, op; int stack_idx = ccl->stack_idx; /* Instruction counter of the current CCL code. */ int this_ic = 0; @@ -2123,7 +2121,7 @@ val = Fget (ccl_prog, Qccl_program_idx, Qnil); if (! NATNUMP (val) - || XINT (val) >= XVECTOR_LENGTH (Vccl_program_table)) + || -1 != bytecode_arithcompare (val, Flength (Vccl_program_table))) return Qnil; slot = XVECTOR_DATA (Vccl_program_table)[XINT (val)]; if (! VECTORP (slot) diff -r 861f2601a38b -r 1f0b15040456 src/mule-ccl.h --- a/src/mule-ccl.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/mule-ccl.h Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,18 @@ 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ #ifndef INCLUDED_mule_ccl_h_ #define INCLUDED_mule_ccl_h_ diff -r 861f2601a38b -r 1f0b15040456 src/mule-charset.c --- a/src/mule-charset.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/mule-charset.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* Functions to handle multilingual characters. Copyright (C) 1992, 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2001, 2002, 2004, 2005 Ben Wing. + Copyright (C) 2001, 2002, 2004, 2005, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 20.3. Not in FSF. */ @@ -34,7 +32,7 @@ #include "faces.h" #include "lstream.h" #include "mule-ccl.h" -#include "objects.h" +#include "fontcolor.h" #include "specifier.h" /* The various pre-defined charsets. */ @@ -141,7 +139,7 @@ Lisp_Charset *cs = XCHARSET (obj); if (print_readably) - printing_unreadable_lcrecord + printing_unreadable_lisp_object (obj, XSTRING_DATA (XSYMBOL (XCHARSET_NAME (obj))->name)); write_fmt_string_lisp (printcharfun, "#", cs->header.uid); + write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); } static const struct memory_description charset_description[] = { @@ -178,10 +176,9 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("charset", charset, - 1, /* dumpable flag */ - mark_charset, print_charset, 0, - 0, 0, charset_description, Lisp_Charset); +DEFINE_DUMPABLE_LISP_OBJECT ("charset", charset, + mark_charset, print_charset, 0, + 0, 0, charset_description, Lisp_Charset); /* Make a new charset. */ /* #### SJT Should generic properties be allowed? */ static Lisp_Object @@ -196,8 +193,8 @@ if (!overwrite) { - cs = ALLOC_LCRECORD_TYPE (Lisp_Charset, &lrecord_charset); - obj = wrap_charset (cs); + obj = ALLOC_NORMAL_LISP_OBJECT (charset); + cs = XCHARSET (obj); if (final) { @@ -991,58 +988,25 @@ struct charset_stats { - int from_unicode; - int to_unicode; - int other; + struct usage_stats u; + Bytecount from_unicode; + Bytecount to_unicode; }; static void compute_charset_usage (Lisp_Object charset, struct charset_stats *stats, - struct overhead_stats *ovstats) + struct usage_stats *ustats) { - struct Lisp_Charset *c = XCHARSET (charset); - xzero (*stats); - stats->other += LISPOBJ_STORAGE_SIZE (c, sizeof (*c), ovstats); - stats->from_unicode += compute_from_unicode_table_size (charset, ovstats); - stats->to_unicode += compute_to_unicode_table_size (charset, ovstats); + stats->from_unicode += compute_from_unicode_table_size (charset, ustats); + stats->to_unicode += compute_to_unicode_table_size (charset, ustats); } -DEFUN ("charset-memory-usage", Fcharset_memory_usage, 1, 1, 0, /* -Return stats about the memory usage of charset CHARSET. -The values returned are in the form of an alist of usage types and -byte counts. The byte counts attempt to encompass all the memory used -by the charset (separate from the memory logically associated with a -charset or frame), including internal structures and any malloc() -overhead associated with them. In practice, the byte counts are -underestimated for various reasons, e.g. because certain memory usage -is very hard to determine \(e.g. the amount of memory used inside the -Xt library or inside the X server). +static void +charset_memory_usage (Lisp_Object charset, struct generic_usage_stats *gustats) +{ + struct charset_stats *stats = (struct charset_stats *) gustats; -Multiple slices of the total memory usage may be returned, separated -by a nil. Each slice represents a particular view of the memory, a -particular way of partitioning it into groups. Within a slice, there -is no overlap between the groups of memory, and each slice collectively -represents all the memory concerned. -*/ - (charset)) -{ - struct charset_stats stats; - struct overhead_stats ovstats; - Lisp_Object val = Qnil; - - charset = Fget_charset (charset); - xzero (ovstats); - compute_charset_usage (charset, &stats, &ovstats); - - val = acons (Qfrom_unicode, make_int (stats.from_unicode), val); - val = acons (Qto_unicode, make_int (stats.to_unicode), val); - val = Fcons (Qnil, val); - val = acons (Qactually_requested, make_int (ovstats.was_requested), val); - val = acons (Qmalloc_overhead, make_int (ovstats.malloc_overhead), val); - val = acons (Qgap_overhead, make_int (ovstats.gap_overhead), val); - val = acons (Qdynarr_overhead, make_int (ovstats.dynarr_overhead), val); - - return Fnreverse (val); + compute_charset_usage (charset, stats, &stats->u); } #endif /* MEMORY_USAGE_STATS */ @@ -1053,9 +1017,17 @@ /************************************************************************/ void +mule_charset_objects_create (void) +{ +#ifdef MEMORY_USAGE_STATS + OBJECT_HAS_METHOD (charset, memory_usage); +#endif +} + +void syms_of_mule_charset (void) { - INIT_LRECORD_IMPLEMENTATION (charset); + INIT_LISP_OBJECT (charset); DEFSUBR (Fcharsetp); DEFSUBR (Ffind_charset); @@ -1076,10 +1048,6 @@ DEFSUBR (Fset_charset_registries); DEFSUBR (Fcharsets_in_region); -#ifdef MEMORY_USAGE_STATS - DEFSUBR (Fcharset_memory_usage); -#endif - DEFSYMBOL (Qcharsetp); DEFSYMBOL (Qregistries); DEFSYMBOL (Qfinal); @@ -1128,6 +1096,11 @@ { int i, j, k; +#ifdef MEMORY_USAGE_STATS + OBJECT_HAS_PROPERTY + (charset, memusage_stats_list, list2 (Qfrom_unicode, Qto_unicode)); +#endif /* MEMORY_USAGE_STATS */ + chlook = xnew_and_zero (struct charset_lookup); /* zero for Purify. */ dump_add_root_block_ptr (&chlook, &charset_lookup_description); @@ -1146,7 +1119,7 @@ staticpro (&Vcharset_hash_table); Vcharset_hash_table = - make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, Qeq); } void diff -r 861f2601a38b -r 1f0b15040456 src/mule-coding.c --- a/src/mule-coding.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/mule-coding.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* Conversion functions for I18N encodings, but not Unicode (in separate file). Copyright (C) 1991, 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2000, 2001, 2002 Ben Wing. + Copyright (C) 2000, 2001, 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.3. Not in FSF. */ @@ -2545,7 +2543,7 @@ if (EQ (charset, Vcharset_control_1)) { if (XCODING_SYSTEM_ISO2022_ESCAPE_QUOTED (codesys) - && fit_to_be_escape_quoted (c)) + && fit_to_be_escape_quoted (c - 0x20)) Dynarr_add (dst, ISO_CODE_ESC); /* you asked for it ... */ Dynarr_add (dst, c - 0x20); @@ -2839,14 +2837,15 @@ return 1; } +#ifdef ENABLE_COMPOSITE_CHARS +#define USED_IF_COMPOSITE_CHARS(x) x +#else +#define USED_IF_COMPOSITE_CHARS(x) UNUSED (x) +#endif + static void -iso2022_finalize_coding_stream ( -#ifdef ENABLE_COMPOSITE_CHARS - struct coding_stream *str -#else - struct coding_stream *UNUSED (str) -#endif - ) +iso2022_finalize_coding_stream (struct coding_stream * + USED_IF_COMPOSITE_CHARS (str)) { #ifdef ENABLE_COMPOSITE_CHARS struct iso2022_coding_stream *data = @@ -3247,7 +3246,10 @@ { struct iso2022_detector *data = DETECTION_STATE_DATA (st, iso2022); if (data->iso) - xfree (data->iso); + { + xfree (data->iso); + data->iso = 0; + } } @@ -3966,9 +3968,9 @@ void vars_of_mule_coding (void) { - /* This needs to be HASH_TABLE_EQ, there's a corner case where - HASH_TABLE_EQUAL won't work. */ + /* This needs to be Qeq, there's a corner case where + Qequal won't work. */ Vfixed_width_query_ranges_cache - = make_lisp_hash_table (32, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ); + = make_lisp_hash_table (32, HASH_TABLE_KEY_WEAK, Qeq); staticpro (&Vfixed_width_query_ranges_cache); } diff -r 861f2601a38b -r 1f0b15040456 src/mule-wnnfns.c --- a/src/mule-wnnfns.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/mule-wnnfns.c Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,14 @@ /* -*- coding: utf-8 -*- Copyright (C) 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. + Copyright (C) 2005, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Mule 2.3. Not in FSF. */ @@ -267,11 +266,11 @@ #include "lisp.h" #include "buffer.h" +#include "charset.h" #include "window.h" #include "sysdep.h" #include "wnn/commonhd.h" -#include "charset.h" #include "wnn/jllib.h" #include "wnn/cplib.h" @@ -286,13 +285,13 @@ #define WNNSERVER_K 3 int check_wnn_server_type (void); -void w2m (w_char *wp, unsigned char *mp, unsigned char lb); -void m2w (unsigned char *mp, w_char *wp); +void w2m (w_char *wp, Ibyte *mp, Lisp_Object charset); +void m2w (Ibyte *mp, w_char *wp); void w2y (w_char *w); -void c2m (unsigned char *cp, unsigned char *mp, unsigned char lb); +void c2m (UExtbyte *cp, Ibyte *mp, Lisp_Object charset); static void puts2 (char *s); static int dai_end (int no, int server); -static int yes_or_no (unsigned char *s); +static int yes_or_no (UExtbyte *s); /* Why doesn't wnn have a prototype for these? */ typedef unsigned int letter; @@ -303,8 +302,7 @@ static struct wnn_env *wnnfns_env_norm[NSERVER]; static struct wnn_env *wnnfns_env_rev[NSERVER]; static int wnnfns_norm; -static unsigned char lb_wnn_server_type[NSERVER] = -{LEADING_BYTE_JAPANESE_JISX0208, LEADING_BYTE_CHINESE_GB2312, LEADING_BYTE_THAI_TIS620, LEADING_BYTE_KOREAN_KSC5601}; +static Lisp_Object charset_wnn_server_type[NSERVER]; /* Lisp Variables and Constants Definition */ Lisp_Object Qjserver; @@ -321,7 +319,7 @@ Lisp_Object Vcwnn_zhuyin; Lisp_Object Vwnnenv_sticky; Lisp_Object Vwnn_uniq_level; -Fixnum lb_sisheng; +Lisp_Object Qchinese_sisheng; /* Lisp functions definition */ @@ -332,12 +330,10 @@ */ (hname, lname)) { - char *envname; - char *langname; - char *hostname; + Extbyte *envname; + Ascbyte *langname; + Extbyte *hostname; int snum; - int size; - CHECK_STRING (lname); snum = check_wnn_server_type (); switch (snum) @@ -360,35 +356,31 @@ default: return Qnil; } - size = XSTRING_LENGTH (lname) > 1024 ? 1026 : XSTRING_LENGTH (lname) + 2; - /* !!#### */ - envname = (char *) ALLOCA (size); - strncpy (envname, (char *) XSTRING_DATA (lname), size-2); - envname[size-2] = '\0'; + /* #### This is extremely stupid. I'm sure these alloca() copies are + unnecessary, but the old code went out of its way to do this. --ben */ + CHECK_STRING (lname); + EXTBYTE_STRING_TO_ALLOCA (LISP_STRING_TO_EXTERNAL (lname, Qnative), + envname); if (NILP (hname)) hostname = ""; else { CHECK_STRING (hname); - size = XSTRING_LENGTH(hname) > 1024 ? 1025 : XSTRING_LENGTH(hname) + 1; - - hostname = (char *) ALLOCA (size); - strncpy (hostname, (char *) XSTRING_DATA (hname), size-1); - hostname[size-1] = '\0'; + EXTBYTE_STRING_TO_ALLOCA (LISP_STRING_TO_EXTERNAL (hname, Qnative), + hostname); } - CHECK_STRING (lname); /* 97/4/16 jhod@po.iijnet.or.jp * libwnn uses SIGALRM, so we need to stop and start interrupts. */ - stop_interrupts(); + stop_interrupts (); if (!(wnnfns_buf[snum] = jl_open_lang (envname, hostname, langname, 0, 0, 0, EGG_TIMEOUT))) { - start_interrupts(); + start_interrupts (); return Qnil; } if (!jl_isconnect (wnnfns_buf[snum])) { - start_interrupts(); + start_interrupts (); return Qnil; } wnnfns_env_norm[snum] = jl_env_get (wnnfns_buf[snum]); @@ -398,12 +390,12 @@ if (!(wnnfns_env_rev[snum] = jl_connect_lang (envname, hostname, langname, 0, 0, 0, EGG_TIMEOUT))) { - start_interrupts(); + start_interrupts (); return Qnil; } /* if (Vwnnenv_sticky == Qt) jl_env_sticky_e (wnnfns_env_rev[snum]); else jl_env_un_sticky_e (wnnfns_env_rev[snum]);*/ - start_interrupts(); + start_interrupts (); return Qt; } @@ -455,14 +447,16 @@ GCPRO1 (*args); gcpro1.nvars = nargs; if (jl_dic_add (wnnfns_buf[snum], - XSTRING_DATA (args[0]), - XSTRING_DATA (args[1]), + LISP_STRING_TO_EXTERNAL (args[0], Qfile_name), + LISP_STRING_TO_EXTERNAL (args[1], Qfile_name), wnnfns_norm ? WNN_DIC_ADD_NOR : WNN_DIC_ADD_REV, XINT (args[2]), NILP (args[3]) ? WNN_DIC_RDONLY : WNN_DIC_RW, NILP (args[4]) ? WNN_DIC_RDONLY : WNN_DIC_RW, - NILP (args[5]) ? 0 : XSTRING_DATA (args[5]), - NILP (args[6]) ? 0 : XSTRING_DATA (args[6]), + NILP (args[5]) ? 0 : + LISP_STRING_TO_EXTERNAL (args[5], Qfile_name), + NILP (args[6]) ? 0 : + LISP_STRING_TO_EXTERNAL (args[6], Qfile_name), yes_or_no, puts2 ) < 0) { @@ -495,13 +489,13 @@ { WNN_DIC_INFO *dicinfo; int cnt, i; - unsigned char comment[1024]; + Ibyte comment[1024]; Lisp_Object val; int snum; - unsigned char lb; + Lisp_Object charset; if ((snum = check_wnn_server_type ()) == -1) return Qnil; - lb = lb_wnn_server_type[snum]; + charset = charset_wnn_server_type[snum]; if (!wnnfns_buf[snum]) return Qnil; #ifdef WNN6 if((cnt = jl_fi_dic_list (wnnfns_buf[snum], 0x3f, &dicinfo)) < 0) @@ -513,14 +507,11 @@ for (i = 0, dicinfo += cnt; i < cnt; i++) { dicinfo--; - w2m (dicinfo->comment, comment, lb); - /* #### The following has not been Mule-ized!! - fname and comment must be ASCII strings! */ + w2m (dicinfo->comment, comment, charset); val = Fcons (Fcons (make_int (dicinfo->dic_no), - list4 (make_string ((Ibyte *) (dicinfo->fname), - strlen (dicinfo->fname)), - make_string (comment, strlen ((char *) comment)), + list4 (build_extstring (dicinfo->fname, Qfile_name), + build_istring (comment), make_int (dicinfo->gosuu), make_int (dicinfo->nice))), val); } @@ -630,17 +621,17 @@ */ (kouhoNo)) { - unsigned char kanji_buf[256]; + Ibyte kanji_buf[256]; w_char wbuf[256]; int snum; - unsigned char lb; + Lisp_Object charset; CHECK_INT (kouhoNo); if ((snum = check_wnn_server_type ()) == -1) return Qnil; - lb = lb_wnn_server_type[snum]; + charset = charset_wnn_server_type[snum]; if (!wnnfns_buf[snum]) return Qnil; jl_get_zenkouho_kanji (wnnfns_buf[snum], XINT (kouhoNo), wbuf); - w2m (wbuf, kanji_buf, lb); - return make_string (kanji_buf, strlen ((char *) kanji_buf)); + w2m (wbuf, kanji_buf, charset); + return build_istring (kanji_buf); } DEFUN ("wnn-server-zenkouho-bun", Fwnn_zenkouho_bun, 0, 0, 0, /* @@ -739,14 +730,14 @@ (bunNo)) { Lisp_Object val; - unsigned char cbuf[512]; + Ibyte cbuf[512]; w_char wbuf[256]; int bun_no, yomilen, jirilen, i; int snum; - unsigned char lb; + Lisp_Object charset; CHECK_INT (bunNo); if ((snum = check_wnn_server_type ()) == -1) return Qnil; - lb = lb_wnn_server_type[snum]; + charset = charset_wnn_server_type[snum]; if (!wnnfns_buf[snum]) return Qnil; bun_no = XINT (bunNo); val = Qnil; @@ -762,11 +753,11 @@ jirilen = wnnfns_buf[snum]->bun[bun_no]->jirilen; for (i = yomilen; i >= jirilen; i--) wbuf[i+1] = wbuf[i]; wbuf[jirilen] = '+'; - w2m (wbuf, cbuf, lb); - val = Fcons (make_string (cbuf, strlen ((char *) cbuf)), val); + w2m (wbuf, cbuf, charset); + val = Fcons (build_istring (cbuf), val); jl_get_kanji (wnnfns_buf[snum], bun_no, bun_no + 1, wbuf); - w2m (wbuf, cbuf, lb); - return Fcons (make_string (cbuf, strlen ((char *) cbuf)), val); + w2m (wbuf, cbuf, charset); + return Fcons (build_istring (cbuf), val); } @@ -787,20 +778,19 @@ (bunNo)) { int no; - unsigned char kanji_buf[256]; + Ibyte kanji_buf[256]; w_char wbuf[256]; int kanji_len; int snum; - unsigned char lb; + Lisp_Object charset; CHECK_INT (bunNo); if ((snum = check_wnn_server_type ()) == -1) return Qnil; - lb = lb_wnn_server_type[snum]; + charset = charset_wnn_server_type[snum]; if (!wnnfns_buf[snum]) return Qnil; no = XINT (bunNo); kanji_len = jl_get_kanji (wnnfns_buf[snum], no, no + 1, wbuf); - w2m (wbuf, kanji_buf, lb); - return Fcons (make_string (kanji_buf, strlen ((char *) kanji_buf)), - make_int (kanji_len)); + w2m (wbuf, kanji_buf, charset); + return Fcons (build_istring (kanji_buf), make_int (kanji_len)); } DEFUN ("wnn-server-bunsetu-yomi", Fwnn_bunsetu_yomi, 1, 1, 0, /* @@ -809,20 +799,19 @@ (bunNo)) { int no; - unsigned char yomi_buf[256]; + Ibyte yomi_buf[256]; w_char wbuf[256]; int yomi_len; int snum; - unsigned char lb; + Lisp_Object charset; CHECK_INT (bunNo); if ((snum = check_wnn_server_type ()) == -1) return Qnil; - lb = lb_wnn_server_type[snum]; + charset = charset_wnn_server_type[snum]; if (!wnnfns_buf[snum]) return Qnil; no = XINT (bunNo); yomi_len = jl_get_yomi (wnnfns_buf[snum], no, no + 1, wbuf); - w2m (wbuf, yomi_buf, lb); - return Fcons (make_string (yomi_buf, strlen ((char *) yomi_buf)), - make_int (yomi_len)); + w2m (wbuf, yomi_buf, charset); + return Fcons (build_istring (yomi_buf), make_int (yomi_len)); } DEFUN ("wnn-server-bunsetu-suu", Fwnn_bunsetu_suu, 0, 0, 0, /* @@ -925,13 +914,13 @@ { Lisp_Object val; struct wnn_jdata *info_buf; - unsigned char cbuf[512]; + Ibyte cbuf[512]; int snum; - unsigned char lb; + Lisp_Object charset; CHECK_INT (no); CHECK_INT (serial); if ((snum = check_wnn_server_type ()) == -1) return Qnil; - lb = lb_wnn_server_type[snum]; + charset = charset_wnn_server_type[snum]; if (!wnnfns_buf[snum]) return Qnil; if ((info_buf = jl_word_info (wnnfns_buf[snum], XINT (no), XINT (serial))) != NULL) @@ -943,12 +932,12 @@ val = Qnil; val = Fcons (make_int (info_buf->hinshi), val); val = Fcons (make_int (info_buf->hindo), val); - w2m (info_buf->com, cbuf, lb); - val = Fcons (make_string (cbuf, strlen ((char *) cbuf)), val); - w2m (info_buf->kanji, cbuf, lb); - val = Fcons (make_string (cbuf, strlen ((char *) cbuf)), val); - w2m (info_buf->yomi, cbuf, lb); - val = Fcons (make_string (cbuf, strlen ((char *) cbuf)), val); + w2m (info_buf->com, cbuf, charset); + val = Fcons (build_istring (cbuf), val); + w2m (info_buf->kanji, cbuf, charset); + val = Fcons (build_istring (cbuf), val); + w2m (info_buf->yomi, cbuf, charset); + val = Fcons (build_istring (cbuf), val); return val; } } @@ -984,13 +973,13 @@ Lisp_Object val; struct wnn_jdata *wordinfo; int i, count; - w_char wbuf[256]; - unsigned char kanji_buf[256]; + w_char wbuf[256]; + Ibyte kanji_buf[256]; int snum; - unsigned char lb; + Lisp_Object charset; CHECK_STRING (yomi); if ((snum = check_wnn_server_type ()) == -1) return Qnil; - lb = lb_wnn_server_type[snum]; + charset = charset_wnn_server_type[snum]; if (!wnnfns_buf[snum]) return Qnil; m2w (XSTRING_DATA (yomi), wbuf); if (snum == WNNSERVER_C) @@ -1002,8 +991,8 @@ for (i = 0, wordinfo += count; i < count; i++) { wordinfo--; - w2m (wordinfo->kanji, kanji_buf, lb); - val = Fcons (Fcons (make_string (kanji_buf, strlen ((char *) kanji_buf)), + w2m (wordinfo->kanji, kanji_buf, charset); + val = Fcons (Fcons (build_istring (kanji_buf), list4 (make_int (wordinfo->hinshi), make_int (wordinfo->hindo), make_int (wordinfo->dic_no), @@ -1134,14 +1123,14 @@ */ ()) { - unsigned char mbuf[256]; - char *msgp; - int snum; - unsigned char lb; - char langname[32]; + Ibyte mbuf[256]; + char *msgp; + int snum; + Lisp_Object charset; + char langname[32]; /* CHECK_INT (errno);*/ if ((snum = check_wnn_server_type ()) == -1) return Qnil; - lb = lb_wnn_server_type[snum]; + charset = charset_wnn_server_type[snum]; switch (snum) { case WNNSERVER_J: @@ -1162,8 +1151,8 @@ if (!wnnfns_buf[snum]) return Qnil; /* msgp = msg_get (wnn_msg_cat, XINT (errno), 0, 0);*/ msgp = wnn_perror_lang (langname); - c2m ((unsigned char *) msgp, mbuf, lb); - return make_string (mbuf, strlen ((char *) mbuf)); + c2m ((UExtbyte *) msgp, mbuf, charset); + return build_istring (mbuf); } @@ -1176,7 +1165,8 @@ CHECK_STRING (file); if ((snum = check_wnn_server_type ()) == -1) return Qnil; if (!wnnfns_buf[snum]) return Qnil; - if (jl_fuzokugo_set (wnnfns_buf[snum], XSTRING_DATA (file)) < 0) + if (jl_fuzokugo_set (wnnfns_buf[snum], + LISP_STRING_TO_EXTERNAL (file, Qfile_name)) < 0) return Qnil; return Qt; } @@ -1191,7 +1181,7 @@ if ((snum = check_wnn_server_type ()) == -1) return Qnil; if (!wnnfns_buf[snum]) return Qnil; if (jl_fuzokugo_get (wnnfns_buf[snum], fname) < 0) return Qnil; - return make_string ((Ibyte *) fname, strlen (fname)); + return build_extstring (fname, Qfile_name); } @@ -1237,15 +1227,15 @@ { int cnt; Lisp_Object val; - w_char wbuf[256]; - w_char **area; - unsigned char cbuf[512]; + w_char wbuf[256]; + w_char **area; + Ibyte cbuf[512]; int snum; - unsigned char lb; + Lisp_Object charset; CHECK_INT (dicno); CHECK_STRING (name); if ((snum = check_wnn_server_type ()) == -1) return Qnil; - lb = lb_wnn_server_type[snum]; + charset = charset_wnn_server_type[snum]; if (!wnnfns_buf[snum]) return Qnil; m2w (XSTRING_DATA (name), wbuf); if ((cnt = jl_hinsi_list (wnnfns_buf[snum], XINT (dicno), wbuf, &area)) < 0) @@ -1255,8 +1245,8 @@ for (area += cnt; cnt > 0; cnt--) { area--; - w2m (*area, cbuf, lb); - val = Fcons (make_string (cbuf, strlen ((char *) cbuf)), val); + w2m (*area, cbuf, charset); + val = Fcons (build_istring (cbuf), val); } return val; } @@ -1266,17 +1256,17 @@ */ (no)) { - unsigned char name[256]; - w_char *wname; - int snum; - unsigned char lb; + Ibyte name[256]; + w_char *wname; + int snum; + Lisp_Object charset; CHECK_INT (no); if ((snum = check_wnn_server_type ()) == -1) return Qnil; - lb = lb_wnn_server_type[snum]; + charset = charset_wnn_server_type[snum]; if (!wnnfns_buf[snum]) return Qnil; if ((wname = jl_hinsi_name (wnnfns_buf[snum], XINT (no))) == 0) return Qnil; - w2m (wname, name, lb); - return make_string (name, strlen ((char *) name)); + w2m (wname, name, charset); + return build_istring (name); } #ifdef WNN6 DEFUN ("wnn-server-fisys-dict-add", Fwnn_fisys_dict_add, 3, MANY, 0, /* @@ -1290,24 +1280,26 @@ int snum; CHECK_STRING (args[0]); CHECK_STRING (args[1]); - if (! NILP (args[3])) CHECK_STRING (args[3]); + if (!NILP (args[3])) CHECK_STRING (args[3]); if ((snum = check_wnn_server_type()) == -1) return Qnil; - if(!wnnfns_buf[snum]) return Qnil; + if (!wnnfns_buf[snum]) return Qnil; GCPRO1 (*args); gcpro1.nvars = nargs; - if(jl_fi_dic_add(wnnfns_buf[snum], - XSTRING_DATA (args[0]), - XSTRING_DATA (args[1]), - WNN_FI_SYSTEM_DICT, - WNN_DIC_RDONLY, - NILP (args[2]) ? WNN_DIC_RDONLY : WNN_DIC_RW, - 0, - NILP (args[3]) ? 0 : XSTRING_DATA (args[3]), - yes_or_no, - puts2 ) < 0) { - UNGCPRO; - return Qnil; - } + if (jl_fi_dic_add (wnnfns_buf[snum], + LISP_STRING_TO_EXTERNAL (args[0], Qfile_name), + LISP_STRING_TO_EXTERNAL (args[1], Qfile_name), + WNN_FI_SYSTEM_DICT, + WNN_DIC_RDONLY, + NILP (args[2]) ? WNN_DIC_RDONLY : WNN_DIC_RW, + 0, + NILP (args[3]) ? 0 : + LISP_STRING_TO_EXTERNAL (args[3], Qfile_name), + yes_or_no, + puts2) < 0) + { + UNGCPRO; + return Qnil; + } UNGCPRO; return Qt; } @@ -1323,25 +1315,28 @@ int snum; CHECK_STRING (args[0]); CHECK_STRING (args[1]); - if (! NILP (args[4])) CHECK_STRING (args[4]); - if (! NILP (args[5])) CHECK_STRING (args[5]); + if (!NILP (args[4])) CHECK_STRING (args[4]); + if (!NILP (args[5])) CHECK_STRING (args[5]); if ((snum = check_wnn_server_type()) == -1) return Qnil; - if(!wnnfns_buf[snum]) return Qnil; + if (!wnnfns_buf[snum]) return Qnil; GCPRO1 (*args); gcpro1.nvars = nargs; - if(jl_fi_dic_add(wnnfns_buf[snum], - XSTRING_DATA (args[0]), - XSTRING_DATA (args[1]), - WNN_FI_USER_DICT, - NILP (args[2]) ? WNN_DIC_RDONLY : WNN_DIC_RW, - NILP (args[3]) ? WNN_DIC_RDONLY : WNN_DIC_RW, - NILP (args[4]) ? 0 : XSTRING_DATA (args[4]), - NILP (args[5]) ? 0 : XSTRING_DATA (args[5]), - yes_or_no, - puts2 ) < 0) { - UNGCPRO; - return Qnil; - } + if (jl_fi_dic_add (wnnfns_buf[snum], + LISP_STRING_TO_EXTERNAL (args[0], Qfile_name), + LISP_STRING_TO_EXTERNAL (args[1], Qfile_name), + WNN_FI_USER_DICT, + NILP (args[2]) ? WNN_DIC_RDONLY : WNN_DIC_RW, + NILP (args[3]) ? WNN_DIC_RDONLY : WNN_DIC_RW, + NILP (args[4]) ? 0 : + LISP_STRING_TO_EXTERNAL (args[4], Qfile_name), + NILP (args[5]) ? 0 : + LISP_STRING_TO_EXTERNAL (args[5], Qfile_name), + yes_or_no, + puts2) < 0) + { + UNGCPRO; + return Qnil; + } UNGCPRO; return Qt; } @@ -1370,37 +1365,47 @@ else cur_env = wnnfns_env_rev[snum]; dic_no = js_get_autolearning_dic(cur_env, WNN_MUHENKAN_LEARNING); - if (dic_no == WNN_NO_LEARNING) { - if((dic_no = jl_dic_add(wnnfns_buf[snum], - XSTRING_DATA (args[0]), - 0, - wnnfns_norm ? WNN_DIC_ADD_NOR : WNN_DIC_ADD_REV, - XINT(args[1]), - WNN_DIC_RW, WNN_DIC_RW, - NILP (args[3]) ? 0 : XSTRING_DATA (args[3]), - 0, - yes_or_no, - puts2)) < 0) { + if (dic_no == WNN_NO_LEARNING) + { + if ((dic_no = jl_dic_add (wnnfns_buf[snum], + LISP_STRING_TO_EXTERNAL (args[0], + Qfile_name), + 0, + wnnfns_norm ? WNN_DIC_ADD_NOR : + WNN_DIC_ADD_REV, + XINT (args[1]), + WNN_DIC_RW, WNN_DIC_RW, + NILP (args[3]) ? 0 : + LISP_STRING_TO_EXTERNAL (args[3], + Qfile_name), + 0, + yes_or_no, + puts2)) < 0) + { UNGCPRO; return Qnil; - } - js_set_autolearning_dic(cur_env, WNN_MUHENKAN_LEARNING, dic_no); - } - if(!js_is_loaded_temporary_dic(cur_env)) { - if(js_temporary_dic_add(cur_env, - wnnfns_norm ? WNN_DIC_ADD_NOR : WNN_DIC_ADD_REV) < 0) { + } + js_set_autolearning_dic (cur_env, WNN_MUHENKAN_LEARNING, dic_no); + } + if (!js_is_loaded_temporary_dic (cur_env)) + { + if (js_temporary_dic_add (cur_env, + wnnfns_norm ? WNN_DIC_ADD_NOR : + WNN_DIC_ADD_REV) < 0) + { UNGCPRO; return Qnil; - } - } + } + } vmask |= WNN_ENV_MUHENKAN_LEARN_MASK; henv.muhenkan_flag = NILP (args[2]) ? WNN_DIC_RDONLY : WNN_DIC_RW; - if(jl_set_henkan_env(wnnfns_buf[snum], - vmask, - &henv) < 0) { + if (jl_set_henkan_env (wnnfns_buf[snum], + vmask, + &henv) < 0) + { UNGCPRO; return Qnil; - } + } UNGCPRO; return Qt; } @@ -1429,37 +1434,47 @@ else cur_env = wnnfns_env_rev[snum]; dic_no = js_get_autolearning_dic(cur_env, WNN_BUNSETSUGIRI_LEARNING); - if (dic_no == WNN_NO_LEARNING) { - if((dic_no = jl_dic_add(wnnfns_buf[snum], - XSTRING_DATA (args[0]), - 0, - wnnfns_norm ? WNN_DIC_ADD_NOR : WNN_DIC_ADD_REV, - XINT(args[1]), - WNN_DIC_RW, WNN_DIC_RW, - NILP (args[3]) ? 0 : XSTRING_DATA (args[3]), - 0, - yes_or_no, - puts2)) < 0) { + if (dic_no == WNN_NO_LEARNING) + { + if ((dic_no = jl_dic_add (wnnfns_buf[snum], + LISP_STRING_TO_EXTERNAL (args[0], + Qfile_name), + 0, + wnnfns_norm ? WNN_DIC_ADD_NOR : + WNN_DIC_ADD_REV, + XINT(args[1]), + WNN_DIC_RW, WNN_DIC_RW, + NILP (args[3]) ? 0 : + LISP_STRING_TO_EXTERNAL (args[3], + Qfile_name), + 0, + yes_or_no, + puts2)) < 0) + { UNGCPRO; return Qnil; - } - js_set_autolearning_dic(cur_env, WNN_BUNSETSUGIRI_LEARNING, dic_no); - } - if(!js_is_loaded_temporary_dic(cur_env)) { - if(js_temporary_dic_add(cur_env, - wnnfns_norm ? WNN_DIC_ADD_NOR : WNN_DIC_ADD_REV) < 0) { + } + js_set_autolearning_dic (cur_env, WNN_BUNSETSUGIRI_LEARNING, dic_no); + } + if (!js_is_loaded_temporary_dic (cur_env)) + { + if (js_temporary_dic_add (cur_env, + wnnfns_norm ? WNN_DIC_ADD_NOR : + WNN_DIC_ADD_REV) < 0) + { UNGCPRO; return Qnil; - } - } + } + } vmask |= WNN_ENV_BUNSETSUGIRI_LEARN_MASK; henv.bunsetsugiri_flag = NILP (args[2]) ? WNN_DIC_RDONLY : WNN_DIC_RW; - if(jl_set_henkan_env(wnnfns_buf[snum], - vmask, - &henv) < 0) { + if (jl_set_henkan_env (wnnfns_buf[snum], + vmask, + &henv) < 0) + { UNGCPRO; return Qnil; - } + } UNGCPRO; return Qt; } @@ -1886,14 +1901,16 @@ wnnfns_env_norm[i] = (struct wnn_env *) 0; wnnfns_env_rev[i] = (struct wnn_env *) 0; } + + charset_wnn_server_type[0] = Vcharset_japanese_jisx0208; + charset_wnn_server_type[1] = Vcharset_chinese_gb2312; + charset_wnn_server_type[2] = Vcharset_thai_tis620; + charset_wnn_server_type[3] = Vcharset_korean_ksc5601; } void vars_of_mule_wnn (void) { - DEFVAR_INT ("lb-sisheng", &lb_sisheng /* -Leading character for Sisheng. -*/ ); DEFVAR_LISP ("wnn-server-type", &Vwnn_server_type /* *jserver, cserver .. */ ); @@ -1911,13 +1928,18 @@ Vcwnn_zhuyin = Qnil; Vwnnenv_sticky = Qnil; + DEFSYMBOL (Qchinese_sisheng); + Vwnn_uniq_level = Qwnn_uniq; Fprovide (intern ("wnn")); } +/* Convert from the wide-char format expected for wnn to the XEmacs string + format. */ + void -w2m (w_char *wp, unsigned char *mp, unsigned char lb) +w2m (w_char *wp, Ibyte *mp, Lisp_Object charset) { w_char wc; w_char pzy[10]; @@ -1937,84 +1959,81 @@ for (i = 0; i < len; i++) { if (pzy[i] & 0x80) - { - *mp++ = PRE_LEADING_BYTE_PRIVATE_1; /* #### Not sure about this one... */ - *mp++ = lb_sisheng; - } - *mp++ = pzy[i]; + mp += charset_codepoint_to_itext + (Fget_charset (Qchinese_sisheng), 0, pzy[i] & 0x7f, mp, + CONVERR_USE_PRIVATE); + else + /* @@#### Correct? */ + mp += charset_codepoint_to_itext + (Vcharset_ascii, 0, pzy[i] & 0x7f, mp, + CONVERR_USE_PRIVATE); } } else - { - *mp++ = LEADING_BYTE_KATAKANA_JISX0201; - *mp++ = (wc & 0xff); - } + mp += charset_codepoint_to_itext (Vcharset_katakana_jisx0201, + 0, wc & 0x7f, mp, + CONVERR_USE_PRIVATE); break; case 0x8080: - *mp++ = lb; - *mp++ = (wc & 0xff00) >> 8; - *mp++ = wc & 0x00ff; + mp += charset_codepoint_to_itext (charset, (wc & 0x7f00) >> 8, + wc & 0x007f, mp, + CONVERR_USE_PRIVATE); break; case 0x8000: - if (lb == LEADING_BYTE_JAPANESE_JISX0208) - *mp++ = LEADING_BYTE_JAPANESE_JISX0212; - else if (lb == LEADING_BYTE_CHINESE_BIG5_1) - *mp++ = LEADING_BYTE_CHINESE_BIG5_2; - else - *mp++ = lb; - *mp++ = (wc & 0xff00) >> 8; - *mp++ = (wc & 0x00ff) | 0x80; - break; + { + Lisp_Object newchar = charset; + if (EQ (charset, Vcharset_japanese_jisx0208)) + newchar = Vcharset_japanese_jisx0212; +#ifndef UNICODE_INTERNAL + /* @@#### Something very strange about this */ + else if (EQ (charset, Vcharset_chinese_big5_1)) + newchar = Vcharset_chinese_big5_2; +#endif /* not UNICODE_INTERNAL */ + mp += charset_codepoint_to_itext (newchar, (wc & 0x7f00) >> 8, + wc & 0x007f, mp, + CONVERR_USE_PRIVATE); + break; + } default: - *mp++ = wc & 0x00ff; + mp += set_itext_ichar (mp, wc & 0x00ff); break; } } *mp = 0; } +/* Convert XEmacs string format to the wide-char format expected for wnn. */ void -m2w (unsigned char *mp, w_char *wp) +m2w (Ibyte *mp, w_char *wp) { - int ch; - - while ((ch = *mp++) != 0) + while (*mp) { - if (ibyte_leading_byte_p (ch)) - { - switch (ch) - { - case LEADING_BYTE_KATAKANA_JISX0201: - *wp++ = *mp++; break; - case LEADING_BYTE_LATIN_JISX0201: - *wp++ = *mp++ & 0x7F; break; - case LEADING_BYTE_JAPANESE_JISX0208_1978: - case LEADING_BYTE_CHINESE_GB2312: - case LEADING_BYTE_JAPANESE_JISX0208: - case LEADING_BYTE_KOREAN_KSC5601: - /* case LEADING_BYTE_TW: */ - ch = *mp++; - *wp++ = (ch << 8) | *mp++; - break; - case LEADING_BYTE_JAPANESE_JISX0212: - ch = *mp++; - *wp++ = (ch << 8) | (*mp++ & 0x7f); - break; - case PRE_LEADING_BYTE_PRIVATE_1: /* #### Not sure about this one... */ - ch = *mp++; - if (ch == lb_sisheng) - *wp++ = 0x8e80 | *mp++; - else - mp++; - break; - default: /* ignore this character */ - mp += rep_bytes_by_first_byte(ch) - 1; - } - } - else - { - *wp++ = ch; - } + Lisp_Object charset; + int c1, c2; + int ch; + + /* @@#### current_buffer dependency */ + buffer_itext_to_charset_codepoint (mp, current_buffer, + &charset, &c1, &c2, CONVERR_FAIL); + INC_IBYTEPTR (mp); + if (EQ (charset, Vcharset_ascii) || + EQ (charset, Vcharset_latin_jisx0201) || + EQ (charset, Vcharset_katakana_jisx0201)) + ch = c2; + else if (EQ (charset, Vcharset_japanese_jisx0208) || + EQ (charset, Vcharset_japanese_jisx0208_1978) || + EQ (charset, Vcharset_chinese_gb2312) || + EQ (charset, Vcharset_korean_ksc5601) + /* || other 2-byte charsets??? */ + ) + ch = ((c1 | 0x80) << 8) + (c2 | 0x80); + else if (EQ (charset, Vcharset_japanese_jisx0212)) + ch = ((c1 | 0x80) << 8) + c2; + else if (EQ (charset, Fget_charset (Qchinese_sisheng))) + ch = 0x8e80 | c2; + else /* Ignore character */ + continue; + *wp++ = (w_char) ch; } *wp = 0; } @@ -2051,18 +2070,26 @@ } } +/* Converts text in the multi-byte locale-specific format returned by some + WNN functions into XEmacs-internal. This format appears to be a simple + MBCS encoding with a single locale, and we could use probably existing + coding systems to handle it. */ + void -c2m (unsigned char *cp, unsigned char *mp, unsigned char lb) +c2m (UExtbyte *cp, Ibyte *mp, Lisp_Object charset) { - unsigned char ch; + UExtbyte ch; while ((ch = *cp) != 0) { if (ch & 0x80) { - *mp++ = lb; - *mp++ = *cp++; + mp += charset_codepoint_to_itext (charset, cp[0] & 0x7f, + cp[1] & 0x7f, mp, + CONVERR_USE_PRIVATE); + cp += 2; } - *mp++ = *cp++; + else + *mp++ = *cp++; /* Guaranteed ASCII */ } *mp = 0; } @@ -2076,18 +2103,18 @@ } static int -yes_or_no (unsigned char *s) +yes_or_no (UExtbyte *s) { - unsigned char mbuf[512]; - unsigned char lb; + Ibyte mbuf[512]; + Lisp_Object charset; int len; int snum; if ((snum = check_wnn_server_type ()) == -1) return 0; - lb = lb_wnn_server_type[snum]; + charset = charset_wnn_server_type[snum]; /* if no message found, create file without query */ /* if (wnn_msg_cat->msg_bd == 0) return 1;*/ if (*s == 0) return 1; - c2m (s, mbuf, lb); + c2m (s, mbuf, charset); /* truncate "(Y/N)" */ for (len = 0; (mbuf[len]) && (len < 512); len++); for (; (mbuf[len] != '(') && (len > 0); len--); @@ -2097,7 +2124,7 @@ str = make_string (mbuf, len); GCPRO1 (str); - yes = call1(Qyes_or_no_p, str); + yes = call1 (Qyes_or_no_p, str); UNGCPRO; if (NILP (yes)) return 0; else return (1); @@ -2105,23 +2132,16 @@ } static void -puts2 (char *s) +puts2 (char *UNUSED (s)) { #if 0 /* jhod: We don't really need this echoed... */ -#if 0 - Lisp_Object args[1]; - char mbuf[512]; - unsigned char lb; - extern Lisp_Object Fmessage (); + Ibyte mbuf[512]; + Lisp_Object charset; int snum; if ((snum = check_wnn_server_type ()) == -1) return; - lb = lb_wnn_server_type[snum]; - c2m (s, mbuf, lb); - args[0] = make_string (mbuf, strlen (mbuf)); - Fmessage (1, args); -#else - message("%s",s); -#endif + charset = charset_wnn_server_type[snum]; + c2m (s, mbuf, charset); + message ("%s", mbuf); #endif } diff -r 861f2601a38b -r 1f0b15040456 src/native-gtk-toolbar.c --- a/src/native-gtk-toolbar.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/native-gtk-toolbar.c Sun May 01 18:44:03 2011 +0100 @@ -1,12 +1,13 @@ /* toolbar implementation -- GTK interface. Copyright (C) 2000 Aaron Lehmann + Copyright (C) 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -25,36 +24,15 @@ #include "console-gtk.h" #include "glyphs-gtk.h" -#include "objects-gtk.h" +#include "fontcolor-gtk.h" #include "faces.h" #include "frame.h" #include "toolbar.h" #include "window.h" -#define SET_TOOLBAR_WAS_VISIBLE_FLAG(frame, pos, flag) \ - do { \ - switch (pos) \ - { \ - case TOP_TOOLBAR: \ - (frame)->top_toolbar_was_visible = flag; \ - break; \ - case BOTTOM_TOOLBAR: \ - (frame)->bottom_toolbar_was_visible = flag; \ - break; \ - case LEFT_TOOLBAR: \ - (frame)->left_toolbar_was_visible = flag; \ - break; \ - case RIGHT_TOOLBAR: \ - (frame)->right_toolbar_was_visible = flag; \ - break; \ - default: \ - ABORT (); \ - } \ - } while (0) - static void -gtk_clear_toolbar (struct frame *f, enum toolbar_pos pos); +gtk_clear_toolbar (struct frame *f, enum edge_pos pos); static void gtk_toolbar_callback (GtkWidget *UNUSED (w), gpointer user_data) @@ -66,7 +44,7 @@ static void -gtk_output_toolbar (struct frame *f, enum toolbar_pos pos) +gtk_output_toolbar (struct frame *f, enum edge_pos pos) { GtkWidget *toolbar; Lisp_Object button, window, glyph, instance; @@ -114,7 +92,7 @@ { gtk_clear_toolbar (f, pos); FRAME_GTK_TOOLBAR_WIDGET (f)[pos] = toolbar = - gtk_toolbar_new (((pos == TOP_TOOLBAR) || (pos == BOTTOM_TOOLBAR)) ? + gtk_toolbar_new (((pos == TOP_EDGE) || (pos == BOTTOM_EDGE)) ? GTK_ORIENTATION_HORIZONTAL : GTK_ORIENTATION_VERTICAL, GTK_TOOLBAR_BOTH); } @@ -193,7 +171,7 @@ } static void -gtk_clear_toolbar (struct frame *f, enum toolbar_pos pos) +gtk_clear_toolbar (struct frame *f, enum edge_pos pos) { FRAME_GTK_TOOLBAR_CHECKSUM (f, pos) = 0; SET_TOOLBAR_WAS_VISIBLE_FLAG (f, pos, 0); @@ -204,25 +182,15 @@ static void gtk_output_frame_toolbars (struct frame *f) { - if (FRAME_REAL_TOP_TOOLBAR_VISIBLE (f)) - gtk_output_toolbar (f, TOP_TOOLBAR); - else if (f->top_toolbar_was_visible) - gtk_clear_toolbar (f, TOP_TOOLBAR); - - if (FRAME_REAL_BOTTOM_TOOLBAR_VISIBLE (f)) - gtk_output_toolbar (f, BOTTOM_TOOLBAR); - else if (f->bottom_toolbar_was_visible) - gtk_clear_toolbar (f, LEFT_TOOLBAR); + enum edge_pos pos; - if (FRAME_REAL_LEFT_TOOLBAR_VISIBLE (f)) - gtk_output_toolbar (f, LEFT_TOOLBAR); - else if (f->left_toolbar_was_visible) - gtk_clear_toolbar (f, LEFT_TOOLBAR); - - if (FRAME_REAL_RIGHT_TOOLBAR_VISIBLE (f)) - gtk_output_toolbar (f, RIGHT_TOOLBAR); - else if (f->right_toolbar_was_visible) - gtk_clear_toolbar (f, RIGHT_TOOLBAR); + EDGE_POS_LOOP (pos) + { + if (FRAME_REAL_TOOLBAR_VISIBLE (f, pos)) + gtk_output_toolbar (f, pos); + else if (f->toolbar_was_visible[pos]) + gtk_clear_toolbar (f, pos); + } } static void diff -r 861f2601a38b -r 1f0b15040456 src/ndir.h --- a/src/ndir.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/ndir.h Sun May 01 18:44:03 2011 +0100 @@ -2,10 +2,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -13,9 +13,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ diff -r 861f2601a38b -r 1f0b15040456 src/nt.c --- a/src/nt.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/nt.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,11 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to the Free -Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -02111-1307, USA. - -*/ +along with XEmacs. If not, see . */ /* Authorship: @@ -1640,7 +1636,7 @@ != INVALID_HANDLE_VALUE) { /* This is more accurate in terms of getting the correct number - of links, but is quite slow (it is noticable when Emacs is + of links, but is quite slow (it is noticeable when Emacs is making a list of file name completions). */ BY_HANDLE_FILE_INFORMATION info; diff -r 861f2601a38b -r 1f0b15040456 src/ntheap.c --- a/src/ntheap.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/ntheap.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,10 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to the Free -Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -02111-1307, USA. - +along with XEmacs. If not, see . Geoff Voelker (voelker@cs.washington.edu) 7-29-94 */ /* Adapted for XEmacs by David Hobley */ @@ -245,7 +242,7 @@ VirtualQuery (base, &info, sizeof (info)); if (info.State != MEM_FREE) { - /* Oops, something has already reserved or commited it, nothing + /* Oops, something has already reserved or committed it, nothing we can do but exit */ Extbyte buf[256]; sprintf (buf, @@ -254,7 +251,7 @@ "(BaseAddress = 0x%lx, AllocationBase = 0x%lx, " "Size = 0x%lx, State = %s, Type = %s)", info.BaseAddress, info.AllocationBase, info.RegionSize, - info.State == MEM_COMMIT ? "COMMITED" : "RESERVED", + info.State == MEM_COMMIT ? "COMMITTED" : "RESERVED", info.Type == MEM_IMAGE ? "IMAGE" : info.Type == MEM_MAPPED ? "MAPPED" : "PRIVATE"); MessageBoxA (NULL, buf, "XEmacs", MB_OK | MB_ICONSTOP); diff -r 861f2601a38b -r 1f0b15040456 src/ntplay.c --- a/src/ntplay.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/ntplay.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to the Free -Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -02111-1307, USA.*/ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/number-gmp.c --- a/src/number-gmp.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/number-gmp.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin St - Fifth Floor, -Boston, MA 02111-1301, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/number-gmp.h --- a/src/number-gmp.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/number-gmp.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin St - Fifth Floor, -Boston, MA 02111-1301, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/number-mp.c --- a/src/number-mp.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/number-mp.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin St - Fifth Floor, -Boston, MA 02111-1301, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/number-mp.h --- a/src/number-mp.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/number-mp.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin St - Fifth Floor, -Boston, MA 02111-1301, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/number.c --- a/src/number.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/number.c Sun May 01 18:44:03 2011 +0100 @@ -1,12 +1,13 @@ /* Numeric types for XEmacs. Copyright (C) 2004 Jerry James. + Copyright (C) 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin St - Fifth Floor, -Boston, MA 02111-1301, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -60,17 +59,15 @@ #ifdef NEW_GC static void -bignum_finalize (void *header, int for_disksave) +bignum_finalize (Lisp_Object obj) { - if (!for_disksave) - { - struct Lisp_Bignum *num = (struct Lisp_Bignum *) header; - bignum_fini (num->data); - } + struct Lisp_Bignum *num = XBIGNUM (obj); + /* #### WARNING: It would be better to put some sort of check to make + sure this doesn't happen more than once, just in case --- + e.g. checking if it's zero before finalizing and then setting it to + zero after finalizing. */ + bignum_fini (num->data); } -#define BIGNUM_FINALIZE bignum_finalize -#else -#define BIGNUM_FINALIZE 0 #endif static int @@ -81,9 +78,16 @@ } static Hashcode -bignum_hash (Lisp_Object obj, int UNUSED (depth)) +bignum_hash (Lisp_Object obj, int UNUSED (depth), Boolint equalp) { - return bignum_hashcode (XBIGNUM_DATA (obj)); + if (equalp) + { + return FLOAT_HASHCODE_FROM_DOUBLE (bignum_to_double (XBIGNUM_DATA (obj))); + } + else + { + return bignum_hashcode (XBIGNUM_DATA (obj)); + } } static void @@ -122,11 +126,10 @@ { XD_END } }; -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bignum", bignum, 1, 0, bignum_print, - BIGNUM_FINALIZE, bignum_equal, - bignum_hash, bignum_description, - Lisp_Bignum); - +DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("bignum", bignum, 0, bignum_print, + IF_NEW_GC (bignum_finalize), + bignum_equal, bignum_hash, + bignum_description, Lisp_Bignum); #endif /* HAVE_BIGNUM */ Lisp_Object Qbignump; @@ -153,18 +156,16 @@ #ifdef NEW_GC static void -ratio_finalize (void *header, int for_disksave) +ratio_finalize (Lisp_Object obj) { - if (!for_disksave) - { - struct Lisp_Ratio *num = (struct Lisp_Ratio *) header; - ratio_fini (num->data); - } + struct Lisp_Ratio *num = XRATIO (obj); + /* #### WARNING: It would be better to put some sort of check to make + sure this doesn't happen more than once, just in case --- + e.g. checking if it's zero before finalizing and then setting it to + zero after finalizing. */ + ratio_fini (num->data); } -#define RATIO_FINALIZE ratio_finalize -#else -#define RATIO_FINALIZE 0 -#endif +#endif /* not NEW_GC */ static int ratio_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth), @@ -174,9 +175,16 @@ } static Hashcode -ratio_hash (Lisp_Object obj, int UNUSED (depth)) +ratio_hash (Lisp_Object obj, int UNUSED (depth), Boolint equalp) { - return ratio_hashcode (XRATIO_DATA (obj)); + if (equalp) + { + return FLOAT_HASHCODE_FROM_DOUBLE (ratio_to_double (XRATIO_DATA (obj))); + } + else + { + return ratio_hashcode (XRATIO_DATA (obj)); + } } static const struct memory_description ratio_description[] = { @@ -184,9 +192,10 @@ { XD_END } }; -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("ratio", ratio, 0, 0, ratio_print, - RATIO_FINALIZE, ratio_equal, ratio_hash, - ratio_description, Lisp_Ratio); +DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("ratio", ratio, 0, ratio_print, + IF_NEW_GC (ratio_finalize), + ratio_equal, ratio_hash, + ratio_description, Lisp_Ratio); #endif /* HAVE_RATIO */ @@ -258,18 +267,16 @@ #ifdef NEW_GC static void -bigfloat_finalize (void *header, int for_disksave) +bigfloat_finalize (Lisp_Object obj) { - if (!for_disksave) - { - struct Lisp_Bigfloat *num = (struct Lisp_Bigfloat *) header; - bigfloat_fini (num->bf); - } + struct Lisp_Bigfloat *num = XBIGFLOAT (obj); + /* #### WARNING: It would be better to put some sort of check to make + sure this doesn't happen more than once, just in case --- + e.g. checking if it's zero before finalizing and then setting it to + zero after finalizing. */ + bigfloat_fini (num->bf); } -#define BIGFLOAT_FINALIZE bigfloat_finalize -#else -#define BIGFLOAT_FINALIZE 0 -#endif +#endif /* not NEW_GC */ static int bigfloat_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth), @@ -279,9 +286,17 @@ } static Hashcode -bigfloat_hash (Lisp_Object obj, int UNUSED (depth)) +bigfloat_hash (Lisp_Object obj, int UNUSED (depth), Boolint equalp) { - return bigfloat_hashcode (XBIGFLOAT_DATA (obj)); + if (equalp) + { + return + FLOAT_HASHCODE_FROM_DOUBLE (bigfloat_to_double (XBIGFLOAT_DATA (obj))); + } + else + { + return bigfloat_hashcode (XBIGFLOAT_DATA (obj)); + } } static const struct memory_description bigfloat_description[] = { @@ -289,10 +304,11 @@ { XD_END } }; -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bigfloat", bigfloat, 1, 0, - bigfloat_print, BIGFLOAT_FINALIZE, - bigfloat_equal, bigfloat_hash, - bigfloat_description, Lisp_Bigfloat); +DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("bigfloat", bigfloat, 0, + bigfloat_print, + IF_NEW_GC (bigfloat_finalize), + bigfloat_equal, bigfloat_hash, + bigfloat_description, Lisp_Bigfloat); #endif /* HAVE_BIGFLOAT */ @@ -762,13 +778,13 @@ syms_of_number (void) { #ifdef HAVE_BIGNUM - INIT_LRECORD_IMPLEMENTATION (bignum); + INIT_LISP_OBJECT (bignum); #endif #ifdef HAVE_RATIO - INIT_LRECORD_IMPLEMENTATION (ratio); + INIT_LISP_OBJECT (ratio); #endif #ifdef HAVE_BIGFLOAT - INIT_LRECORD_IMPLEMENTATION (bigfloat); + INIT_LISP_OBJECT (bigfloat); #endif /* Type predicates */ diff -r 861f2601a38b -r 1f0b15040456 src/number.h --- a/src/number.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/number.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin St - Fifth Floor, -Boston, MA 02111-1301, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -71,12 +69,12 @@ struct Lisp_Bignum { - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; bignum data; }; typedef struct Lisp_Bignum Lisp_Bignum; -DECLARE_LRECORD (bignum, Lisp_Bignum); +DECLARE_LISP_OBJECT (bignum, Lisp_Bignum); #define XBIGNUM(x) XRECORD (x, bignum, Lisp_Bignum) #define wrap_bignum(p) wrap_record (p, bignum) #define BIGNUMP(x) RECORDP (x, bignum) @@ -153,18 +151,52 @@ EXFUN (Fevenp, 1); EXFUN (Foddp, 1); +/* There are varying mathematical definitions of what a natural number is, + differing about whether 0 is inside or outside the set. The Oxford + English Dictionary, second edition, does say that they are whole numbers, + not fractional, but it doesn't give a bound, and gives a quotation + talking about the natural numbers from 1 to 100. Since 100 is certainly + *not* the upper bound on natural numbers, we can't take 1 as the lower + bound from that example. The Real Academia Española's dictionary, not of + English but certainly sharing the western academic tradition, says of + "número natural": + + 1. m. Mat. Cada uno de los elementos de la sucesión 0, 1, 2, 3... + + that is, "each of the elements of the succession 0, 1, 2, 3 ...". The + various Wikipedia articles in languages I can read agree. It's + reasonable to call this macro and the associated Lisp function + NATNUMP. */ + +#ifdef HAVE_BIGNUM +#define NATNUMP(x) ((INTP (x) && XINT (x) >= 0) || \ + (BIGNUMP (x) && bignum_sign (XBIGNUM_DATA (x)) >= 0)) +#else +#define NATNUMP(x) (INTP (x) && XINT (x) >= 0) +#endif + +#define CHECK_NATNUM(x) do { \ + if (!NATNUMP (x)) \ + dead_wrong_type_argument (Qnatnump, x); \ +} while (0) + +#define CONCHECK_NATNUM(x) do { \ + if (!NATNUMP (x)) \ + x = wrong_type_argument (Qnatnump, x); \ +} while (0) + /********************************** Ratios **********************************/ #ifdef HAVE_RATIO struct Lisp_Ratio { - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; ratio data; }; typedef struct Lisp_Ratio Lisp_Ratio; -DECLARE_LRECORD (ratio, Lisp_Ratio); +DECLARE_LISP_OBJECT (ratio, Lisp_Ratio); #define XRATIO(x) XRECORD (x, ratio, Lisp_Ratio) #define wrap_ratio(p) wrap_record (p, ratio) #define RATIOP(x) RECORDP (x, ratio) @@ -233,12 +265,12 @@ #ifdef HAVE_BIGFLOAT struct Lisp_Bigfloat { - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; bigfloat bf; }; typedef struct Lisp_Bigfloat Lisp_Bigfloat; -DECLARE_LRECORD (bigfloat, Lisp_Bigfloat); +DECLARE_LISP_OBJECT (bigfloat, Lisp_Bigfloat); #define XBIGFLOAT(x) XRECORD (x, bigfloat, Lisp_Bigfloat) #define wrap_bigfloat(p) wrap_record (p, bigfloat) #define BIGFLOATP(x) RECORDP (x, bigfloat) diff -r 861f2601a38b -r 1f0b15040456 src/objects-gtk-impl.h --- a/src/objects-gtk-impl.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,64 +0,0 @@ -/* Gtk-specific Lisp objects. - Copyright (C) 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996 Ben Wing. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ -/* Gtk version by William Perry */ - -#ifndef _XEMACS_OBJECTS_GTK_IMPL_H_ -#define _XEMACS_OBJECTS_GTK_IMPL_H_ - -#include "objects-impl.h" -#include "objects-gtk.h" - -#ifdef HAVE_GTK - -/***************************************************************************** - Color-Instance - ****************************************************************************/ - -struct gtk_color_instance_data -{ - GdkColor *color; - char dealloc_on_gc; -}; - -#define GTK_COLOR_INSTANCE_DATA(c) ((struct gtk_color_instance_data *) (c)->data) -#define COLOR_INSTANCE_GTK_COLOR(c) (GTK_COLOR_INSTANCE_DATA (c)->color) -#define XCOLOR_INSTANCE_GTK_COLOR(c) COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (c)) -#define COLOR_INSTANCE_GTK_DEALLOC(c) (GTK_COLOR_INSTANCE_DATA (c)->dealloc_on_gc) - -/***************************************************************************** - Font-Instance - ****************************************************************************/ - -struct gtk_font_instance_data -{ - /* Gtk-specific information */ - GdkFont *font; -}; - -#define GTK_FONT_INSTANCE_DATA(f) ((struct gtk_font_instance_data *) (f)->data) -#define FONT_INSTANCE_GTK_FONT(f) (GTK_FONT_INSTANCE_DATA (f)->font) -#define XFONT_INSTANCE_GTK_FONT(c) FONT_INSTANCE_GTK_FONT (XFONT_INSTANCE (c)) - -#endif /* HAVE_GTK */ -#endif /* _XEMACS_OBJECTS_GTK_IMPL_H_ */ diff -r 861f2601a38b -r 1f0b15040456 src/objects-gtk.c --- a/src/objects-gtk.c Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,511 +0,0 @@ -/* X-specific Lisp objects. - Copyright (C) 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995 Tinker Systems. - Copyright (C) 1995, 1996, 2002 Ben Wing. - Copyright (C) 1995 Sun Microsystems, Inc. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* Authors: Jamie Zawinski, Chuck Thompson, Ben Wing */ -/* Gtk version by William Perry */ - -#include -#include "lisp.h" - -#include "buffer.h" -#include "charset.h" -#include "device-impl.h" -#include "insdel.h" - -#include "console-gtk-impl.h" -#include "objects-gtk-impl.h" - -/* sigh */ -#include "sysgdkx.h" - -/* XListFonts doesn't allocate memory unconditionally based on this. (For - XFree86 in 2005, at least. */ -#define MAX_FONT_COUNT INT_MAX - -#ifdef DEBUG_XEMACS -Fixnum debug_x_objects; -#endif /* DEBUG_XEMACS */ - - -/************************************************************************/ -/* color instances */ -/************************************************************************/ - -/* Replacement for XAllocColor() that tries to return the nearest - available color if the colormap is full. Original was from FSFmacs, - but rewritten by Jareth Hein 97/11/25 - Modified by Lee Kindness 31/08/99 to handle previous - total failure which was due to a read/write colorcell being the nearest - match - tries the next nearest... - - Gdk takes care of all this behind the scenes, so we don't need to - worry about it. - - Return value is 1 for normal success, 2 for nearest color success, - 3 for Non-deallocable sucess. */ -int -allocate_nearest_color (GdkColormap *colormap, GdkVisual *UNUSED (visual), - GdkColor *color_def) -{ - int rc; - - rc = gdk_colormap_alloc_color (colormap, color_def, FALSE, TRUE); - - if (rc == TRUE) - return (1); - - return (0); -} - -int -gtk_parse_nearest_color (struct device *d, GdkColor *color, Ibyte *name, - Bytecount len, Error_Behavior errb) -{ - GdkColormap *cmap; - GdkVisual *visual; - int result; - - cmap = DEVICE_GTK_COLORMAP(d); - visual = DEVICE_GTK_VISUAL (d); - - xzero (*color); - { - const Extbyte *extname; - Bytecount extnamelen; - - TO_EXTERNAL_FORMAT (DATA, (name, len), ALLOCA, (extname, extnamelen), Qbinary); - - result = gdk_color_parse (extname, color); - } - - if (result == FALSE) - { - maybe_invalid_argument ("unrecognized color", make_string (name, len), - Qcolor, errb); - return 0; - } - result = allocate_nearest_color (cmap, visual, color); - if (!result) - { - maybe_signal_error (Qgui_error, "couldn't allocate color", - make_string (name, len), Qcolor, errb); - return 0; - } - - return result; -} - -static int -gtk_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name, - Lisp_Object device, Error_Behavior errb) -{ - GdkColor color; - int result; - - result = gtk_parse_nearest_color (XDEVICE (device), &color, - XSTRING_DATA (name), - XSTRING_LENGTH (name), - errb); - - if (!result) - return 0; - - /* Don't allocate the data until we're sure that we will succeed, - or the finalize method may get fucked. */ - c->data = xnew (struct gtk_color_instance_data); - if (result == 3) - COLOR_INSTANCE_GTK_DEALLOC (c) = 0; - else - COLOR_INSTANCE_GTK_DEALLOC (c) = 1; - COLOR_INSTANCE_GTK_COLOR (c) = gdk_color_copy (&color); - return 1; -} - -static void -gtk_print_color_instance (struct Lisp_Color_Instance *c, - Lisp_Object printcharfun, - int UNUSED (escapeflag)) -{ - GdkColor *color = COLOR_INSTANCE_GTK_COLOR (c); - write_fmt_string (printcharfun, " %ld=(%X,%X,%X)", - color->pixel, color->red, color->green, color->blue); -} - -static void -gtk_finalize_color_instance (struct Lisp_Color_Instance *c) -{ - if (c->data) - { - if (DEVICE_LIVE_P (XDEVICE (c->device))) - { - if (COLOR_INSTANCE_GTK_DEALLOC (c)) - { - gdk_colormap_free_colors (DEVICE_GTK_COLORMAP (XDEVICE (c->device)), - COLOR_INSTANCE_GTK_COLOR (c), 1); - } - gdk_color_free (COLOR_INSTANCE_GTK_COLOR (c)); - } - xfree (c->data); - c->data = 0; - } -} - -/* Color instances are equal if they resolve to the same color on the - screen (have the same RGB values). I imagine that - "same RGB values" == "same cell in the colormap." Arguably we should - be comparing their names or pixel values instead. */ - -static int -gtk_color_instance_equal (struct Lisp_Color_Instance *c1, - struct Lisp_Color_Instance *c2, - int UNUSED (depth)) -{ - return (gdk_color_equal (COLOR_INSTANCE_GTK_COLOR (c1), - COLOR_INSTANCE_GTK_COLOR (c2))); -} - -static Hashcode -gtk_color_instance_hash (struct Lisp_Color_Instance *c, int UNUSED (depth)) -{ - return (gdk_color_hash (COLOR_INSTANCE_GTK_COLOR (c), NULL)); -} - -static Lisp_Object -gtk_color_instance_rgb_components (struct Lisp_Color_Instance *c) -{ - GdkColor *color = COLOR_INSTANCE_GTK_COLOR (c); - return (list3 (make_int (color->red), - make_int (color->green), - make_int (color->blue))); -} - -static int -gtk_valid_color_name_p (struct device *UNUSED (d), Lisp_Object color) -{ - GdkColor c; - const char *extname; - - extname = LISP_STRING_TO_EXTERNAL (color, Qctext); - - if (gdk_color_parse (extname, &c) != TRUE) - return(0); - return (1); -} - -static Lisp_Object -gtk_color_list (void) -{ - /* #### BILL!!! - Is this correct? */ - return call0 (intern ("x-color-list-internal")); -} - - -/************************************************************************/ -/* font instances */ -/************************************************************************/ - -static int -gtk_initialize_font_instance (struct Lisp_Font_Instance *f, - Lisp_Object UNUSED (name), - Lisp_Object UNUSED (device), Error_Behavior errb) -{ - GdkFont *gf; - XFontStruct *xf; - const char *extname; - - extname = LISP_STRING_TO_EXTERNAL (f->name, Qctext); - - gf = gdk_font_load (extname); - - if (!gf) - { - maybe_signal_error (Qgui_error, "couldn't load font", f->name, - Qfont, errb); - return 0; - } - - xf = (XFontStruct*) GDK_FONT_XFONT (gf); - - /* Don't allocate the data until we're sure that we will succeed, - or the finalize method may get fucked. */ - f->data = xnew (struct gtk_font_instance_data); - FONT_INSTANCE_GTK_FONT (f) = gf; - f->ascent = gf->ascent; - f->descent = gf->descent; - f->height = gf->ascent + gf->descent; - - /* Now lets figure out the width of the font */ - { - /* following change suggested by Ted Phelps */ - unsigned int def_char = 'n'; /*xf->default_char;*/ - unsigned int byte1, byte2; - - once_more: - byte1 = def_char >> 8; - byte2 = def_char & 0xFF; - - if (xf->per_char) - { - /* Old versions of the R5 font server have garbage (>63k) as - def_char. 'n' might not be a valid character. */ - if (byte1 < xf->min_byte1 || - byte1 > xf->max_byte1 || - byte2 < xf->min_char_or_byte2 || - byte2 > xf->max_char_or_byte2) - f->width = 0; - else - f->width = xf->per_char[(byte1 - xf->min_byte1) * - (xf->max_char_or_byte2 - - xf->min_char_or_byte2 + 1) + - (byte2 - xf->min_char_or_byte2)].width; - } - else - f->width = xf->max_bounds.width; - - /* Some fonts have a default char whose width is 0. This is no good. - If that's the case, first try 'n' as the default char, and if n has - 0 width too (unlikely) then just use the max width. */ - if (f->width == 0) - { - if (def_char == xf->default_char) - f->width = xf->max_bounds.width; - else - { - def_char = xf->default_char; - goto once_more; - } - } - } - - /* If all characters don't exist then there could potentially be - 0-width characters lurking out there. Not setting this flag - trips an optimization that would make them appear to have width - to redisplay. This is bad. So we set it if not all characters - have the same width or if not all characters are defined. - */ - /* #### This sucks. There is a measurable performance increase - when using proportional width fonts if this flag is not set. - Unfortunately so many of the fucking X fonts are not fully - defined that we could almost just get rid of this damn flag and - make it an assertion. */ - f->proportional_p = (xf->min_bounds.width != xf->max_bounds.width || - (/* x_handle_non_fully_specified_fonts */ 0 && - !xf->all_chars_exist)); -#if 0 - f->width = gdk_char_width (gf, 'n'); - f->proportional_p = (gdk_char_width (gf, '|') != gdk_char_width (gf, 'W')) ? 1 : 0; -#endif - return 1; -} - -static void -gtk_print_font_instance (struct Lisp_Font_Instance *f, - Lisp_Object printcharfun, - int UNUSED (escapeflag)) -{ - write_fmt_string (printcharfun, " 0x%lx", - (unsigned long) gdk_font_id (FONT_INSTANCE_GTK_FONT (f))); -} - -static void -gtk_finalize_font_instance (struct Lisp_Font_Instance *f) -{ - if (f->data) - { - if (DEVICE_LIVE_P (XDEVICE (f->device))) - { - gdk_font_unref (FONT_INSTANCE_GTK_FONT (f)); - } - xfree (f->data); - f->data = 0; - } -} - -/* Forward declarations for X specific functions at the end of the file */ -Lisp_Object __get_gtk_font_truename (GdkFont *gdk_font, int expandp); -static Lisp_Object __gtk_font_list_internal (const char *pattern); - -static Lisp_Object -gtk_font_instance_truename (struct Lisp_Font_Instance *f, - Error_Behavior UNUSED (errb)) -{ - if (NILP (FONT_INSTANCE_TRUENAME (f))) - { - FONT_INSTANCE_TRUENAME (f) = __get_gtk_font_truename (FONT_INSTANCE_GTK_FONT (f), 1); - - if (NILP (FONT_INSTANCE_TRUENAME (f))) - { - /* Ok, just this once, return the font name as the truename. - (This is only used by Fequal() right now.) */ - return f->name; - } - } - return (FONT_INSTANCE_TRUENAME (f)); -} - -static Lisp_Object -gtk_font_instance_properties (struct Lisp_Font_Instance *UNUSED (f)) -{ - Lisp_Object result = Qnil; - - /* #### BILL!!! */ - /* There seems to be no way to get this information under Gtk */ - return result; -} - -static Lisp_Object -gtk_font_list (Lisp_Object pattern, Lisp_Object UNUSED (device), - Lisp_Object UNUSED (maxnumber)) -{ - const char *patternext; - - patternext = LISP_STRING_TO_EXTERNAL (pattern, Qbinary); - - return (__gtk_font_list_internal (patternext)); -} - -/* Include the charset support, shared, for the moment, with X11. */ -#define THIS_IS_GTK -#include "objects-xlike-inc.c" - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_objects_gtk (void) -{ -} - -void -console_type_create_objects_gtk (void) -{ - /* object methods */ - - CONSOLE_HAS_METHOD (gtk, initialize_color_instance); - CONSOLE_HAS_METHOD (gtk, print_color_instance); - CONSOLE_HAS_METHOD (gtk, finalize_color_instance); - CONSOLE_HAS_METHOD (gtk, color_instance_equal); - CONSOLE_HAS_METHOD (gtk, color_instance_hash); - CONSOLE_HAS_METHOD (gtk, color_instance_rgb_components); - CONSOLE_HAS_METHOD (gtk, valid_color_name_p); - CONSOLE_HAS_METHOD (gtk, color_list); - - CONSOLE_HAS_METHOD (gtk, initialize_font_instance); - CONSOLE_HAS_METHOD (gtk, print_font_instance); - CONSOLE_HAS_METHOD (gtk, finalize_font_instance); - CONSOLE_HAS_METHOD (gtk, font_instance_truename); - CONSOLE_HAS_METHOD (gtk, font_instance_properties); - CONSOLE_HAS_METHOD (gtk, font_list); -#ifdef MULE - CONSOLE_HAS_METHOD (gtk, find_charset_font); - CONSOLE_HAS_METHOD (gtk, font_spec_matches_charset); -#endif -} - -void -vars_of_objects_gtk (void) -{ -#ifdef DEBUG_XEMACS - DEFVAR_INT ("debug-x-objects", &debug_x_objects /* -If non-zero, display debug information about X objects -*/ ); - debug_x_objects = 0; -#endif -} - -static int -valid_font_name_p (Display *dpy, char *name) -{ - /* Maybe this should be implemented by callign XLoadFont and trapping - the error. That would be a lot of work, and wasteful as hell, but - might be more correct. - */ - int nnames = 0; - char **names = 0; - if (! name) - return 0; - names = XListFonts (dpy, name, 1, &nnames); - if (names) - XFreeFontNames (names); - return (nnames != 0); -} - -Lisp_Object -__get_gtk_font_truename (GdkFont *gdk_font, int expandp) -{ - Display *dpy = GDK_FONT_XDISPLAY (gdk_font); - GSList *names = ((GdkFontPrivate *) gdk_font)->names; - Lisp_Object font_name = Qnil; - - while (names) - { - if (names->data) - { - if (valid_font_name_p (dpy, (char*) names->data)) - { - if (!expandp) - { - /* They want the wildcarded version */ - font_name = build_cistring ((char*) names->data); - } - else - { - /* Need to expand out */ - int nnames = 0; - char **x_font_names = 0; - - x_font_names = XListFonts (dpy, (char*) names->data, 1, &nnames); - if (x_font_names) - { - font_name = build_cistring (x_font_names[0]); - XFreeFontNames (x_font_names); - } - } - break; - } - } - names = names->next; - } - return (font_name); -} - -static Lisp_Object __gtk_font_list_internal (const char *pattern) -{ - char **names; - int count = 0; - Lisp_Object result = Qnil; - - names = XListFonts (GDK_DISPLAY (), pattern, MAX_FONT_COUNT, &count); - while (count--) - result = Fcons (build_extstring (names [count], Qbinary), result); - if (names) - XFreeFontNames (names); - - return result; -} diff -r 861f2601a38b -r 1f0b15040456 src/objects-gtk.h --- a/src/objects-gtk.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,47 +0,0 @@ -/* Gtk-specific Lisp objects. - Copyright (C) 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996 Ben Wing. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ -/* Gtk version by William Perry */ - -#ifndef _XEMACS_OBJECTS_GTK_H_ -#define _XEMACS_OBJECTS_GTK_H_ - -#include "objects.h" - -#ifdef HAVE_GTK - -/***************************************************************************** - Color-Instance - ****************************************************************************/ - -int allocate_nearest_color (GdkColormap *screen_colormap, GdkVisual *visual, - GdkColor *color_def); -int gtk_parse_nearest_color (struct device *d, GdkColor *color, Ibyte *name, - Bytecount len, Error_Behavior errb); - -/***************************************************************************** - Font-Instance - ****************************************************************************/ - -#endif /* HAVE_GTK */ -#endif /* _XEMACS_OBJECTS_GTK_H_ */ diff -r 861f2601a38b -r 1f0b15040456 src/objects-impl.h --- a/src/objects-impl.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,167 +0,0 @@ -/* Generic object functions -- header implementation. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2002 Ben Wing. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -#ifndef INCLUDED_objects_impl_h_ -#define INCLUDED_objects_impl_h_ - -#include "specifier.h" -#include "objects.h" - -/***************************************************************************** - * Color Specifier Object * - *****************************************************************************/ - -struct color_specifier -{ - Lisp_Object face; /* face this is attached to, or nil */ - Lisp_Object face_property; /* property of that face */ -}; - -#define COLOR_SPECIFIER_DATA(g) SPECIFIER_TYPE_DATA (g, color) -#define COLOR_SPECIFIER_FACE(g) (COLOR_SPECIFIER_DATA (g)->face) -#define COLOR_SPECIFIER_FACE_PROPERTY(g) \ - (COLOR_SPECIFIER_DATA (g)->face_property) - -DECLARE_SPECIFIER_TYPE (color); -#define XCOLOR_SPECIFIER(x) XSPECIFIER_TYPE (x, color) -#define COLOR_SPECIFIERP(x) SPECIFIER_TYPEP (x, color) -#define CHECK_COLOR_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, color) -#define CONCHECK_COLOR_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, color) - -/***************************************************************************** - * Font Specifier Object * - *****************************************************************************/ - -struct font_specifier -{ - Lisp_Object face; /* face this is attached to, or nil */ - Lisp_Object face_property; /* property of that face */ -}; - -#define FONT_SPECIFIER_DATA(g) SPECIFIER_TYPE_DATA (g, font) -#define FONT_SPECIFIER_FACE(g) (FONT_SPECIFIER_DATA (g)->face) -#define FONT_SPECIFIER_FACE_PROPERTY(g) \ - (FONT_SPECIFIER_DATA (g)->face_property) - -DECLARE_SPECIFIER_TYPE (font); -#define XFONT_SPECIFIER(x) XSPECIFIER_TYPE (x, font) -#define FONT_SPECIFIERP(x) SPECIFIER_TYPEP (x, font) -#define CHECK_FONT_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, font) -#define CONCHECK_FONT_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, font) - -/***************************************************************************** - * Face Boolean Specifier Object * - *****************************************************************************/ - -struct face_boolean_specifier -{ - Lisp_Object face; /* face this is attached to, or nil */ - Lisp_Object face_property; /* property of that face */ -}; - -#define FACE_BOOLEAN_SPECIFIER_DATA(g) SPECIFIER_TYPE_DATA (g, face_boolean) -#define FACE_BOOLEAN_SPECIFIER_FACE(g) (FACE_BOOLEAN_SPECIFIER_DATA (g)->face) -#define FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY(g) \ - (FACE_BOOLEAN_SPECIFIER_DATA (g)->face_property) - -DECLARE_SPECIFIER_TYPE (face_boolean); -extern Lisp_Object Qface_boolean; -#define XFACE_BOOLEAN_SPECIFIER(x) XSPECIFIER_TYPE (x, face_boolean) -#define FACE_BOOLEAN_SPECIFIERP(x) SPECIFIER_TYPEP (x, face_boolean) -#define CHECK_FACE_BOOLEAN_SPECIFIER(x) \ - CHECK_SPECIFIER_TYPE (x, face_boolean) -#define CONCHECK_FACE_BOOLEAN_SPECIFIER(x) \ - CONCHECK_SPECIFIER_TYPE (x, face_boolean) - -/**************************************************************************** - * Color Instance Object * - ****************************************************************************/ - -struct Lisp_Color_Instance -{ - struct LCRECORD_HEADER header; - Lisp_Object name; - Lisp_Object device; - - /* See comment in struct console about console variants. */ - enum console_variant color_instance_type; - - /* console-type-specific data */ - void *data; -}; - -#define COLOR_INSTANCE_NAME(c) ((c)->name) -#define COLOR_INSTANCE_DEVICE(c) ((c)->device) - -/**************************************************************************** - * Font Instance Object * - ****************************************************************************/ - -struct Lisp_Font_Instance -{ - struct LCRECORD_HEADER header; - Lisp_Object name; /* the instantiator used to create the font instance */ - Lisp_Object truename; /* used by the device-specific methods; we need to - call them to get the truename (#### in reality, - they all probably just store the truename here - if they know it, and nil otherwise; we should - check this and enforce it as a general policy - X and GTK do this, except that when they don't - know they return NAME and don't update TRUENAME. - MS Windows initializes TRUENAME when the font is - initialized. TTY doesn't do truename.) */ - Lisp_Object device; - Lisp_Object charset; /* Mule charset, or whatever */ - - /* See comment in struct console about console variants. */ - enum console_variant font_instance_type; - - unsigned short ascent; /* extracted from `font', or made up */ - unsigned short descent; - unsigned short width; - unsigned short height; - int proportional_p; - - /* console-type-specific data */ - void *data; -}; - -#define FONT_INSTANCE_NAME(f) ((f)->name) -#define FONT_INSTANCE_TRUENAME(f) ((f)->truename) -#define FONT_INSTANCE_CHARSET(f) ((f)->charset) -#define FONT_INSTANCE_DEVICE(f) ((f)->device) -#define FONT_INSTANCE_ASCENT(f) ((f)->ascent) -#define FONT_INSTANCE_DESCENT(f) ((f)->descent) -#define FONT_INSTANCE_WIDTH(f) ((f)->width) -#define FONT_INSTANCE_HEIGHT(f) ((f)->height) - -#define XFONT_INSTANCE_NAME(f) FONT_INSTANCE_NAME (XFONT_INSTANCE (f)) -#define XFONT_INSTANCE_TRUENAME(f) FONT_INSTANCE_TRUENAME (XFONT_INSTANCE (f)) -#define XFONT_INSTANCE_CHARSET(f) FONT_INSTANCE_CHARSET (XFONT_INSTANCE (f)) -#define XFONT_INSTANCE_DEVICE(f) FONT_INSTANCE_DEVICE (XFONT_INSTANCE (f)) -#define XFONT_INSTANCE_ASCENT(f) FONT_INSTANCE_ASCENT (XFONT_INSTANCE (f)) -#define XFONT_INSTANCE_DESCENT(f) FONT_INSTANCE_DESCENT (XFONT_INSTANCE (f)) -#define XFONT_INSTANCE_WIDTH(f) FONT_INSTANCE_WIDTH (XFONT_INSTANCE (f)) -#define XFONT_INSTANCE_HEIGHT(f) FONT_INSTANCE_HEIGHT (XFONT_INSTANCE (f)) - -#endif /* INCLUDED_objects_impl_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/objects-msw-impl.h --- a/src/objects-msw-impl.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,75 +0,0 @@ -/* mswindows-specific Lisp objects -- header implementation. - Copyright (C) 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2002 Ben Wing. - Copyright (C) 1997, Jonathan Harris. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* Authorship: - - Ultimately based on FSF. - Rewritten by Ben Wing. - Rewritten for mswindows by Jonathan Harris, November 1997 for 21.0. - */ - - -#ifndef INCLUDED_objects_msw_impl_h_ -#define INCLUDED_objects_msw_impl_h_ - -#include "objects-impl.h" -#include "objects-msw.h" - -struct mswindows_color_instance_data -{ - COLORREF color; -}; - -#define MSWINDOWS_COLOR_INSTANCE_DATA(c) \ - ((struct mswindows_color_instance_data *) (c)->data) -#define COLOR_INSTANCE_MSWINDOWS_COLOR(c) \ - (MSWINDOWS_COLOR_INSTANCE_DATA (c)->color) - -/* The four HFONTS are for the 4 (underlined, strikethrough) - combinations. Only the one at index 0, neither underlined nor - struk through is created with the font instance. Other fonts are - created as necessary during redisplay, using the one at index 0 - as prototype */ -#define MSWINDOWS_NUM_FONT_VARIANTS 4 -struct mswindows_font_instance_data -{ - HFONT hfont [MSWINDOWS_NUM_FONT_VARIANTS]; -}; - -#define MSWINDOWS_FONT_INSTANCE_DATA(c) \ - ((struct mswindows_font_instance_data *) (c)->data) - -#define FONT_INSTANCE_MSWINDOWS_HFONT_I(c,i) \ - (MSWINDOWS_FONT_INSTANCE_DATA(c)->hfont[(i)]) - -#define FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT(c,under,strike) \ - FONT_INSTANCE_MSWINDOWS_HFONT_I (c, (!!(strike)<<1)|!!(under)) - -/* If font creation during redisplay fails, then the following - value is used to prevent future attempts to create this font. - Redisplay uses the "main" font when encounters this value */ -#define MSWINDOWS_BAD_HFONT ((HFONT)INVALID_HANDLE_VALUE) - -#endif /* INCLUDED_objects_msw_impl_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/objects-msw.c --- a/src/objects-msw.c Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2341 +0,0 @@ -/* mswindows-specific Lisp objects. - Copyright (C) 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995 Tinker Systems. - Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004, 2005, 2010 Ben Wing. - Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1997 Jonathan Harris. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* Authorship: - - This file created by Jonathan Harris, November 1997 for 21.0; based - heavily on objects-x.c (see authorship there). Much further work - by Ben Wing. - */ - -/* This function Mule-ized by Ben Wing, 3-24-02. */ - -/* TODO: palette handling */ - -#include -#include "lisp.h" - -#include "console-msw-impl.h" -#include "objects-msw-impl.h" - -#include "buffer.h" -#include "charset.h" -#include "device-impl.h" -#include "elhash.h" -#include "insdel.h" -#include "opaque.h" - -typedef struct colormap_t -{ - const Ascbyte *name; - COLORREF colorref; -} colormap_t; - -/* Colors from X11R6 "XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp" */ -/* MSWindows tends to round up the numbers in its palette, ie where X uses - * 127, MSWindows uses 128. Colors commented as "Adjusted" are tweaked to - * match the Windows standard palette to increase the likelihood of - * mswindows_color_to_string() finding a named match. - */ -static const colormap_t mswindows_X_color_map[] = -{ - {"white" , PALETTERGB (255, 255, 255) }, - {"black" , PALETTERGB (0, 0, 0) }, - {"snow" , PALETTERGB (255, 250, 250) }, - {"GhostWhite" , PALETTERGB (248, 248, 255) }, - {"WhiteSmoke" , PALETTERGB (245, 245, 245) }, - {"gainsboro" , PALETTERGB (220, 220, 220) }, - {"FloralWhite" , PALETTERGB (255, 250, 240) }, - {"OldLace" , PALETTERGB (253, 245, 230) }, - {"linen" , PALETTERGB (250, 240, 230) }, - {"AntiqueWhite" , PALETTERGB (250, 235, 215) }, - {"PapayaWhip" , PALETTERGB (255, 239, 213) }, - {"BlanchedAlmond" , PALETTERGB (255, 235, 205) }, - {"bisque" , PALETTERGB (255, 228, 196) }, - {"PeachPuff" , PALETTERGB (255, 218, 185) }, - {"NavajoWhite" , PALETTERGB (255, 222, 173) }, - {"moccasin" , PALETTERGB (255, 228, 181) }, - {"cornsilk" , PALETTERGB (255, 248, 220) }, - {"ivory" , PALETTERGB (255, 255, 240) }, - {"LemonChiffon" , PALETTERGB (255, 250, 205) }, - {"seashell" , PALETTERGB (255, 245, 238) }, - {"honeydew" , PALETTERGB (240, 255, 240) }, - {"MintCream" , PALETTERGB (245, 255, 250) }, - {"azure" , PALETTERGB (240, 255, 255) }, - {"AliceBlue" , PALETTERGB (240, 248, 255) }, - {"lavender" , PALETTERGB (230, 230, 250) }, - {"LavenderBlush" , PALETTERGB (255, 240, 245) }, - {"MistyRose" , PALETTERGB (255, 228, 225) }, - {"DarkSlateGray" , PALETTERGB (47, 79, 79) }, - {"DarkSlateGrey" , PALETTERGB (47, 79, 79) }, - {"DimGray" , PALETTERGB (105, 105, 105) }, - {"DimGrey" , PALETTERGB (105, 105, 105) }, - {"SlateGray" , PALETTERGB (112, 128, 144) }, - {"SlateGrey" , PALETTERGB (112, 128, 144) }, - {"LightSlateGray" , PALETTERGB (119, 136, 153) }, - {"LightSlateGrey" , PALETTERGB (119, 136, 153) }, - {"gray" , PALETTERGB (190, 190, 190) }, - {"grey" , PALETTERGB (190, 190, 190) }, - {"LightGrey" , PALETTERGB (211, 211, 211) }, - {"LightGray" , PALETTERGB (211, 211, 211) }, - {"MidnightBlue" , PALETTERGB (25, 25, 112) }, - {"navy" , PALETTERGB (0, 0, 128) }, - {"NavyBlue" , PALETTERGB (0, 0, 128) }, - {"CornflowerBlue" , PALETTERGB (100, 149, 237) }, - {"DarkSlateBlue" , PALETTERGB (72, 61, 139) }, - {"SlateBlue" , PALETTERGB (106, 90, 205) }, - {"MediumSlateBlue" , PALETTERGB (123, 104, 238) }, - {"LightSlateBlue" , PALETTERGB (132, 112, 255) }, - {"MediumBlue" , PALETTERGB (0, 0, 205) }, - {"RoyalBlue" , PALETTERGB (65, 105, 225) }, - {"blue" , PALETTERGB (0, 0, 255) }, - {"DodgerBlue" , PALETTERGB (30, 144, 255) }, - {"DeepSkyBlue" , PALETTERGB (0, 191, 255) }, - {"SkyBlue" , PALETTERGB (135, 206, 235) }, - {"LightSkyBlue" , PALETTERGB (135, 206, 250) }, - {"SteelBlue" , PALETTERGB (70, 130, 180) }, - {"LightSteelBlue" , PALETTERGB (176, 196, 222) }, - {"LightBlue" , PALETTERGB (173, 216, 230) }, - {"PowderBlue" , PALETTERGB (176, 224, 230) }, - {"PaleTurquoise" , PALETTERGB (175, 238, 238) }, - {"DarkTurquoise" , PALETTERGB (0, 206, 209) }, - {"MediumTurquoise" , PALETTERGB (72, 209, 204) }, - {"turquoise" , PALETTERGB (64, 224, 208) }, - {"cyan" , PALETTERGB (0, 255, 255) }, - {"LightCyan" , PALETTERGB (224, 255, 255) }, - {"CadetBlue" , PALETTERGB (95, 158, 160) }, - {"MediumAquamarine" , PALETTERGB (102, 205, 170) }, - {"aquamarine" , PALETTERGB (127, 255, 212) }, - {"DarkGreen" , PALETTERGB (0, 128, 0) }, /* Adjusted */ - {"DarkOliveGreen" , PALETTERGB (85, 107, 47) }, - {"DarkSeaGreen" , PALETTERGB (143, 188, 143) }, - {"SeaGreen" , PALETTERGB (46, 139, 87) }, - {"MediumSeaGreen" , PALETTERGB (60, 179, 113) }, - {"LightSeaGreen" , PALETTERGB (32, 178, 170) }, - {"PaleGreen" , PALETTERGB (152, 251, 152) }, - {"SpringGreen" , PALETTERGB (0, 255, 127) }, - {"LawnGreen" , PALETTERGB (124, 252, 0) }, - {"green" , PALETTERGB (0, 255, 0) }, - {"chartreuse" , PALETTERGB (127, 255, 0) }, - {"MediumSpringGreen" , PALETTERGB (0, 250, 154) }, - {"GreenYellow" , PALETTERGB (173, 255, 47) }, - {"LimeGreen" , PALETTERGB (50, 205, 50) }, - {"YellowGreen" , PALETTERGB (154, 205, 50) }, - {"ForestGreen" , PALETTERGB (34, 139, 34) }, - {"OliveDrab" , PALETTERGB (107, 142, 35) }, - {"DarkKhaki" , PALETTERGB (189, 183, 107) }, - {"khaki" , PALETTERGB (240, 230, 140) }, - {"PaleGoldenrod" , PALETTERGB (238, 232, 170) }, - {"LightGoldenrodYellow", PALETTERGB (250, 250, 210) }, - {"LightYellow" , PALETTERGB (255, 255, 224) }, - {"LightYellow" , PALETTERGB (255, 255, 225) }, /* Adjusted */ - {"yellow" , PALETTERGB (255, 255, 0) }, - {"gold" , PALETTERGB (255, 215, 0) }, - {"LightGoldenrod" , PALETTERGB (238, 221, 130) }, - {"goldenrod" , PALETTERGB (218, 165, 32) }, - {"DarkGoldenrod" , PALETTERGB (184, 134, 11) }, - {"RosyBrown" , PALETTERGB (188, 143, 143) }, - {"IndianRed" , PALETTERGB (205, 92, 92) }, - {"SaddleBrown" , PALETTERGB (139, 69, 19) }, - {"sienna" , PALETTERGB (160, 82, 45) }, - {"peru" , PALETTERGB (205, 133, 63) }, - {"burlywood" , PALETTERGB (222, 184, 135) }, - {"beige" , PALETTERGB (245, 245, 220) }, - {"wheat" , PALETTERGB (245, 222, 179) }, - {"SandyBrown" , PALETTERGB (244, 164, 96) }, - {"tan" , PALETTERGB (210, 180, 140) }, - {"chocolate" , PALETTERGB (210, 105, 30) }, - {"firebrick" , PALETTERGB (178, 34, 34) }, - {"brown" , PALETTERGB (165, 42, 42) }, - {"DarkSalmon" , PALETTERGB (233, 150, 122) }, - {"salmon" , PALETTERGB (250, 128, 114) }, - {"LightSalmon" , PALETTERGB (255, 160, 122) }, - {"orange" , PALETTERGB (255, 165, 0) }, - {"DarkOrange" , PALETTERGB (255, 140, 0) }, - {"coral" , PALETTERGB (255, 127, 80) }, - {"LightCoral" , PALETTERGB (240, 128, 128) }, - {"tomato" , PALETTERGB (255, 99, 71) }, - {"OrangeRed" , PALETTERGB (255, 69, 0) }, - {"red" , PALETTERGB (255, 0, 0) }, - {"HotPink" , PALETTERGB (255, 105, 180) }, - {"DeepPink" , PALETTERGB (255, 20, 147) }, - {"pink" , PALETTERGB (255, 192, 203) }, - {"LightPink" , PALETTERGB (255, 182, 193) }, - {"PaleVioletRed" , PALETTERGB (219, 112, 147) }, - {"maroon" , PALETTERGB (176, 48, 96) }, - {"MediumVioletRed" , PALETTERGB (199, 21, 133) }, - {"VioletRed" , PALETTERGB (208, 32, 144) }, - {"magenta" , PALETTERGB (255, 0, 255) }, - {"violet" , PALETTERGB (238, 130, 238) }, - {"plum" , PALETTERGB (221, 160, 221) }, - {"orchid" , PALETTERGB (218, 112, 214) }, - {"MediumOrchid" , PALETTERGB (186, 85, 211) }, - {"DarkOrchid" , PALETTERGB (153, 50, 204) }, - {"DarkViolet" , PALETTERGB (148, 0, 211) }, - {"BlueViolet" , PALETTERGB (138, 43, 226) }, - {"purple" , PALETTERGB (160, 32, 240) }, - {"MediumPurple" , PALETTERGB (147, 112, 219) }, - {"thistle" , PALETTERGB (216, 191, 216) }, - {"snow1" , PALETTERGB (255, 250, 250) }, - {"snow2" , PALETTERGB (238, 233, 233) }, - {"snow3" , PALETTERGB (205, 201, 201) }, - {"snow4" , PALETTERGB (139, 137, 137) }, - {"seashell1" , PALETTERGB (255, 245, 238) }, - {"seashell2" , PALETTERGB (238, 229, 222) }, - {"seashell3" , PALETTERGB (205, 197, 191) }, - {"seashell4" , PALETTERGB (139, 134, 130) }, - {"AntiqueWhite1" , PALETTERGB (255, 239, 219) }, - {"AntiqueWhite2" , PALETTERGB (238, 223, 204) }, - {"AntiqueWhite3" , PALETTERGB (205, 192, 176) }, - {"AntiqueWhite4" , PALETTERGB (139, 131, 120) }, - {"bisque1" , PALETTERGB (255, 228, 196) }, - {"bisque2" , PALETTERGB (238, 213, 183) }, - {"bisque3" , PALETTERGB (205, 183, 158) }, - {"bisque4" , PALETTERGB (139, 125, 107) }, - {"PeachPuff1" , PALETTERGB (255, 218, 185) }, - {"PeachPuff2" , PALETTERGB (238, 203, 173) }, - {"PeachPuff3" , PALETTERGB (205, 175, 149) }, - {"PeachPuff4" , PALETTERGB (139, 119, 101) }, - {"NavajoWhite1" , PALETTERGB (255, 222, 173) }, - {"NavajoWhite2" , PALETTERGB (238, 207, 161) }, - {"NavajoWhite3" , PALETTERGB (205, 179, 139) }, - {"NavajoWhite4" , PALETTERGB (139, 121, 94) }, - {"LemonChiffon1" , PALETTERGB (255, 250, 205) }, - {"LemonChiffon2" , PALETTERGB (238, 233, 191) }, - {"LemonChiffon3" , PALETTERGB (205, 201, 165) }, - {"LemonChiffon4" , PALETTERGB (139, 137, 112) }, - {"cornsilk1" , PALETTERGB (255, 248, 220) }, - {"cornsilk2" , PALETTERGB (238, 232, 205) }, - {"cornsilk3" , PALETTERGB (205, 200, 177) }, - {"cornsilk4" , PALETTERGB (139, 136, 120) }, - {"ivory1" , PALETTERGB (255, 255, 240) }, - {"ivory2" , PALETTERGB (240, 240, 208) }, /* Adjusted */ - {"ivory3" , PALETTERGB (205, 205, 193) }, - {"ivory4" , PALETTERGB (139, 139, 131) }, - {"honeydew1" , PALETTERGB (240, 255, 240) }, - {"honeydew2" , PALETTERGB (224, 238, 224) }, - {"honeydew3" , PALETTERGB (193, 205, 193) }, - {"honeydew4" , PALETTERGB (131, 139, 131) }, - {"LavenderBlush1" , PALETTERGB (255, 240, 245) }, - {"LavenderBlush2" , PALETTERGB (238, 224, 229) }, - {"LavenderBlush3" , PALETTERGB (205, 193, 197) }, - {"LavenderBlush4" , PALETTERGB (139, 131, 134) }, - {"MistyRose1" , PALETTERGB (255, 228, 225) }, - {"MistyRose2" , PALETTERGB (238, 213, 210) }, - {"MistyRose3" , PALETTERGB (205, 183, 181) }, - {"MistyRose4" , PALETTERGB (139, 125, 123) }, - {"azure1" , PALETTERGB (240, 255, 255) }, - {"azure2" , PALETTERGB (224, 238, 238) }, - {"azure3" , PALETTERGB (193, 205, 205) }, - {"azure4" , PALETTERGB (131, 139, 139) }, - {"SlateBlue1" , PALETTERGB (131, 111, 255) }, - {"SlateBlue2" , PALETTERGB (122, 103, 238) }, - {"SlateBlue3" , PALETTERGB (105, 89, 205) }, - {"SlateBlue4" , PALETTERGB (71, 60, 139) }, - {"RoyalBlue1" , PALETTERGB (72, 118, 255) }, - {"RoyalBlue2" , PALETTERGB (67, 110, 238) }, - {"RoyalBlue3" , PALETTERGB (58, 95, 205) }, - {"RoyalBlue4" , PALETTERGB (39, 64, 139) }, - {"blue1" , PALETTERGB (0, 0, 255) }, - {"blue2" , PALETTERGB (0, 0, 238) }, - {"blue3" , PALETTERGB (0, 0, 205) }, - {"blue4" , PALETTERGB (0, 0, 139) }, - {"DodgerBlue1" , PALETTERGB (30, 144, 255) }, - {"DodgerBlue2" , PALETTERGB (28, 134, 238) }, - {"DodgerBlue3" , PALETTERGB (24, 116, 205) }, - {"DodgerBlue4" , PALETTERGB (16, 78, 139) }, - {"SteelBlue1" , PALETTERGB (99, 184, 255) }, - {"SteelBlue2" , PALETTERGB (92, 172, 238) }, - {"SteelBlue3" , PALETTERGB (79, 148, 205) }, - {"SteelBlue4" , PALETTERGB (54, 100, 139) }, - {"DeepSkyBlue1" , PALETTERGB (0, 191, 255) }, - {"DeepSkyBlue2" , PALETTERGB (0, 178, 238) }, - {"DeepSkyBlue3" , PALETTERGB (0, 154, 205) }, - {"DeepSkyBlue4" , PALETTERGB (0, 104, 139) }, - {"SkyBlue1" , PALETTERGB (135, 206, 255) }, - {"SkyBlue2" , PALETTERGB (126, 192, 238) }, - {"SkyBlue3" , PALETTERGB (108, 166, 205) }, - {"SkyBlue4" , PALETTERGB (74, 112, 139) }, - {"LightSkyBlue1" , PALETTERGB (176, 226, 255) }, - {"LightSkyBlue2" , PALETTERGB (164, 211, 238) }, - {"LightSkyBlue3" , PALETTERGB (141, 182, 205) }, - {"LightSkyBlue4" , PALETTERGB (96, 123, 139) }, - {"SlateGray1" , PALETTERGB (198, 226, 255) }, - {"SlateGray2" , PALETTERGB (185, 211, 238) }, - {"SlateGray3" , PALETTERGB (159, 182, 205) }, - {"SlateGray4" , PALETTERGB (108, 123, 139) }, - {"LightSteelBlue1" , PALETTERGB (202, 225, 255) }, - {"LightSteelBlue2" , PALETTERGB (188, 210, 238) }, - {"LightSteelBlue3" , PALETTERGB (162, 181, 205) }, - {"LightSteelBlue4" , PALETTERGB (110, 123, 139) }, - {"LightBlue1" , PALETTERGB (191, 239, 255) }, - {"LightBlue2" , PALETTERGB (178, 223, 238) }, - {"LightBlue3" , PALETTERGB (154, 192, 205) }, - {"LightBlue4" , PALETTERGB (104, 131, 139) }, - {"LightCyan1" , PALETTERGB (224, 255, 255) }, - {"LightCyan2" , PALETTERGB (209, 238, 238) }, - {"LightCyan3" , PALETTERGB (180, 205, 205) }, - {"LightCyan4" , PALETTERGB (122, 139, 139) }, - {"PaleTurquoise1" , PALETTERGB (187, 255, 255) }, - {"PaleTurquoise2" , PALETTERGB (174, 238, 238) }, - {"PaleTurquoise3" , PALETTERGB (150, 205, 205) }, - {"PaleTurquoise4" , PALETTERGB (102, 139, 139) }, - {"CadetBlue1" , PALETTERGB (152, 245, 255) }, - {"CadetBlue2" , PALETTERGB (144, 220, 240) }, /* Adjusted */ - {"CadetBlue3" , PALETTERGB (122, 197, 205) }, - {"CadetBlue4" , PALETTERGB (83, 134, 139) }, - {"turquoise1" , PALETTERGB (0, 245, 255) }, - {"turquoise2" , PALETTERGB (0, 229, 238) }, - {"turquoise3" , PALETTERGB (0, 197, 205) }, - {"turquoise4" , PALETTERGB (0, 134, 139) }, - {"cyan1" , PALETTERGB (0, 255, 255) }, - {"cyan2" , PALETTERGB (0, 238, 238) }, - {"cyan3" , PALETTERGB (0, 205, 205) }, - {"cyan4" , PALETTERGB (0, 139, 139) }, - {"DarkSlateGray1" , PALETTERGB (151, 255, 255) }, - {"DarkSlateGray2" , PALETTERGB (141, 238, 238) }, - {"DarkSlateGray3" , PALETTERGB (121, 205, 205) }, - {"DarkSlateGray4" , PALETTERGB (82, 139, 139) }, - {"aquamarine1" , PALETTERGB (127, 255, 212) }, - {"aquamarine2" , PALETTERGB (118, 238, 198) }, - {"aquamarine3" , PALETTERGB (102, 205, 170) }, - {"aquamarine4" , PALETTERGB (69, 139, 116) }, - {"DarkSeaGreen1" , PALETTERGB (193, 255, 193) }, - {"DarkSeaGreen2" , PALETTERGB (180, 238, 180) }, - {"DarkSeaGreen3" , PALETTERGB (155, 205, 155) }, - {"DarkSeaGreen4" , PALETTERGB (105, 139, 105) }, - {"SeaGreen1" , PALETTERGB (84, 255, 159) }, - {"SeaGreen2" , PALETTERGB (78, 238, 148) }, - {"SeaGreen3" , PALETTERGB (67, 205, 128) }, - {"SeaGreen4" , PALETTERGB (46, 139, 87) }, - {"PaleGreen1" , PALETTERGB (154, 255, 154) }, - {"PaleGreen2" , PALETTERGB (144, 238, 144) }, - {"PaleGreen3" , PALETTERGB (124, 205, 124) }, - {"PaleGreen4" , PALETTERGB (84, 139, 84) }, - {"SpringGreen1" , PALETTERGB (0, 255, 127) }, - {"SpringGreen2" , PALETTERGB (0, 238, 118) }, - {"SpringGreen3" , PALETTERGB (0, 205, 102) }, - {"SpringGreen4" , PALETTERGB (0, 139, 69) }, - {"green1" , PALETTERGB (0, 255, 0) }, - {"green2" , PALETTERGB (0, 238, 0) }, - {"green3" , PALETTERGB (0, 205, 0) }, - {"green4" , PALETTERGB (0, 139, 0) }, - {"chartreuse1" , PALETTERGB (127, 255, 0) }, - {"chartreuse2" , PALETTERGB (118, 238, 0) }, - {"chartreuse3" , PALETTERGB (102, 205, 0) }, - {"chartreuse4" , PALETTERGB (69, 139, 0) }, - {"OliveDrab1" , PALETTERGB (192, 255, 62) }, - {"OliveDrab2" , PALETTERGB (179, 238, 58) }, - {"OliveDrab3" , PALETTERGB (154, 205, 50) }, - {"OliveDrab4" , PALETTERGB (105, 139, 34) }, - {"DarkOliveGreen1" , PALETTERGB (202, 255, 112) }, - {"DarkOliveGreen2" , PALETTERGB (188, 238, 104) }, - {"DarkOliveGreen3" , PALETTERGB (162, 205, 90) }, - {"DarkOliveGreen4" , PALETTERGB (110, 139, 61) }, - {"khaki1" , PALETTERGB (255, 246, 143) }, - {"khaki2" , PALETTERGB (238, 230, 133) }, - {"khaki3" , PALETTERGB (205, 198, 115) }, - {"khaki4" , PALETTERGB (139, 134, 78) }, - {"LightGoldenrod1" , PALETTERGB (255, 236, 139) }, - {"LightGoldenrod2" , PALETTERGB (238, 220, 130) }, - {"LightGoldenrod3" , PALETTERGB (205, 190, 112) }, - {"LightGoldenrod4" , PALETTERGB (139, 129, 76) }, - {"LightYellow1" , PALETTERGB (255, 255, 224) }, - {"LightYellow2" , PALETTERGB (238, 238, 209) }, - {"LightYellow3" , PALETTERGB (205, 205, 180) }, - {"LightYellow4" , PALETTERGB (139, 139, 122) }, - {"yellow1" , PALETTERGB (255, 255, 0) }, - {"yellow2" , PALETTERGB (238, 238, 0) }, - {"yellow3" , PALETTERGB (205, 205, 0) }, - {"yellow4" , PALETTERGB (139, 139, 0) }, - {"gold1" , PALETTERGB (255, 215, 0) }, - {"gold2" , PALETTERGB (238, 201, 0) }, - {"gold3" , PALETTERGB (205, 173, 0) }, - {"gold4" , PALETTERGB (139, 117, 0) }, - {"goldenrod1" , PALETTERGB (255, 193, 37) }, - {"goldenrod2" , PALETTERGB (238, 180, 34) }, - {"goldenrod3" , PALETTERGB (205, 155, 29) }, - {"goldenrod4" , PALETTERGB (139, 105, 20) }, - {"DarkGoldenrod1" , PALETTERGB (255, 185, 15) }, - {"DarkGoldenrod2" , PALETTERGB (238, 173, 14) }, - {"DarkGoldenrod3" , PALETTERGB (205, 149, 12) }, - {"DarkGoldenrod4" , PALETTERGB (139, 101, 8) }, - {"RosyBrown1" , PALETTERGB (255, 193, 193) }, - {"RosyBrown2" , PALETTERGB (238, 180, 180) }, - {"RosyBrown3" , PALETTERGB (205, 155, 155) }, - {"RosyBrown4" , PALETTERGB (139, 105, 105) }, - {"IndianRed1" , PALETTERGB (255, 106, 106) }, - {"IndianRed2" , PALETTERGB (238, 99, 99) }, - {"IndianRed3" , PALETTERGB (205, 85, 85) }, - {"IndianRed4" , PALETTERGB (139, 58, 58) }, - {"sienna1" , PALETTERGB (255, 130, 71) }, - {"sienna2" , PALETTERGB (238, 121, 66) }, - {"sienna3" , PALETTERGB (205, 104, 57) }, - {"sienna4" , PALETTERGB (139, 71, 38) }, - {"burlywood1" , PALETTERGB (255, 211, 155) }, - {"burlywood2" , PALETTERGB (238, 197, 145) }, - {"burlywood3" , PALETTERGB (205, 170, 125) }, - {"burlywood4" , PALETTERGB (139, 115, 85) }, - {"wheat1" , PALETTERGB (255, 231, 186) }, - {"wheat2" , PALETTERGB (238, 216, 174) }, - {"wheat3" , PALETTERGB (205, 186, 150) }, - {"wheat4" , PALETTERGB (139, 126, 102) }, - {"tan1" , PALETTERGB (255, 165, 79) }, - {"tan2" , PALETTERGB (238, 154, 73) }, - {"tan3" , PALETTERGB (205, 133, 63) }, - {"tan4" , PALETTERGB (139, 90, 43) }, - {"chocolate1" , PALETTERGB (255, 127, 36) }, - {"chocolate2" , PALETTERGB (238, 118, 33) }, - {"chocolate3" , PALETTERGB (205, 102, 29) }, - {"chocolate4" , PALETTERGB (139, 69, 19) }, - {"firebrick1" , PALETTERGB (255, 48, 48) }, - {"firebrick2" , PALETTERGB (238, 44, 44) }, - {"firebrick3" , PALETTERGB (205, 38, 38) }, - {"firebrick4" , PALETTERGB (139, 26, 26) }, - {"brown1" , PALETTERGB (255, 64, 64) }, - {"brown2" , PALETTERGB (238, 59, 59) }, - {"brown3" , PALETTERGB (205, 51, 51) }, - {"brown4" , PALETTERGB (139, 35, 35) }, - {"salmon1" , PALETTERGB (255, 140, 105) }, - {"salmon2" , PALETTERGB (238, 130, 98) }, - {"salmon3" , PALETTERGB (205, 112, 84) }, - {"salmon4" , PALETTERGB (139, 76, 57) }, - {"LightSalmon1" , PALETTERGB (255, 160, 122) }, - {"LightSalmon2" , PALETTERGB (238, 149, 114) }, - {"LightSalmon3" , PALETTERGB (205, 129, 98) }, - {"LightSalmon4" , PALETTERGB (139, 87, 66) }, - {"orange1" , PALETTERGB (255, 165, 0) }, - {"orange2" , PALETTERGB (238, 154, 0) }, - {"orange3" , PALETTERGB (205, 133, 0) }, - {"orange4" , PALETTERGB (139, 90, 0) }, - {"DarkOrange1" , PALETTERGB (255, 127, 0) }, - {"DarkOrange2" , PALETTERGB (238, 118, 0) }, - {"DarkOrange3" , PALETTERGB (205, 102, 0) }, - {"DarkOrange4" , PALETTERGB (139, 69, 0) }, - {"coral1" , PALETTERGB (255, 114, 86) }, - {"coral2" , PALETTERGB (238, 106, 80) }, - {"coral3" , PALETTERGB (205, 91, 69) }, - {"coral4" , PALETTERGB (139, 62, 47) }, - {"tomato1" , PALETTERGB (255, 99, 71) }, - {"tomato2" , PALETTERGB (238, 92, 66) }, - {"tomato3" , PALETTERGB (205, 79, 57) }, - {"tomato4" , PALETTERGB (139, 54, 38) }, - {"OrangeRed1" , PALETTERGB (255, 69, 0) }, - {"OrangeRed2" , PALETTERGB (238, 64, 0) }, - {"OrangeRed3" , PALETTERGB (205, 55, 0) }, - {"OrangeRed4" , PALETTERGB (139, 37, 0) }, - {"red1" , PALETTERGB (255, 0, 0) }, - {"red2" , PALETTERGB (238, 0, 0) }, - {"red3" , PALETTERGB (205, 0, 0) }, - {"red4" , PALETTERGB (139, 0, 0) }, - {"DeepPink1" , PALETTERGB (255, 20, 147) }, - {"DeepPink2" , PALETTERGB (238, 18, 137) }, - {"DeepPink3" , PALETTERGB (205, 16, 118) }, - {"DeepPink4" , PALETTERGB (139, 10, 80) }, - {"HotPink1" , PALETTERGB (255, 110, 180) }, - {"HotPink2" , PALETTERGB (238, 106, 167) }, - {"HotPink3" , PALETTERGB (205, 96, 144) }, - {"HotPink4" , PALETTERGB (139, 58, 98) }, - {"pink1" , PALETTERGB (255, 181, 197) }, - {"pink2" , PALETTERGB (238, 169, 184) }, - {"pink3" , PALETTERGB (205, 145, 158) }, - {"pink4" , PALETTERGB (139, 99, 108) }, - {"LightPink1" , PALETTERGB (255, 174, 185) }, - {"LightPink2" , PALETTERGB (238, 162, 173) }, - {"LightPink3" , PALETTERGB (205, 140, 149) }, - {"LightPink4" , PALETTERGB (139, 95, 101) }, - {"PaleVioletRed1" , PALETTERGB (255, 130, 171) }, - {"PaleVioletRed2" , PALETTERGB (238, 121, 159) }, - {"PaleVioletRed3" , PALETTERGB (205, 104, 137) }, - {"PaleVioletRed4" , PALETTERGB (139, 71, 93) }, - {"maroon1" , PALETTERGB (255, 52, 179) }, - {"maroon2" , PALETTERGB (238, 48, 167) }, - {"maroon3" , PALETTERGB (205, 41, 144) }, - {"maroon4" , PALETTERGB (139, 28, 98) }, - {"VioletRed1" , PALETTERGB (255, 62, 150) }, - {"VioletRed2" , PALETTERGB (238, 58, 140) }, - {"VioletRed3" , PALETTERGB (205, 50, 120) }, - {"VioletRed4" , PALETTERGB (139, 34, 82) }, - {"magenta1" , PALETTERGB (255, 0, 255) }, - {"magenta2" , PALETTERGB (238, 0, 238) }, - {"magenta3" , PALETTERGB (205, 0, 205) }, - {"magenta4" , PALETTERGB (139, 0, 139) }, - {"orchid1" , PALETTERGB (255, 131, 250) }, - {"orchid2" , PALETTERGB (238, 122, 233) }, - {"orchid3" , PALETTERGB (205, 105, 201) }, - {"orchid4" , PALETTERGB (139, 71, 137) }, - {"plum1" , PALETTERGB (255, 187, 255) }, - {"plum2" , PALETTERGB (238, 174, 238) }, - {"plum3" , PALETTERGB (205, 150, 205) }, - {"plum4" , PALETTERGB (139, 102, 139) }, - {"MediumOrchid1" , PALETTERGB (224, 102, 255) }, - {"MediumOrchid2" , PALETTERGB (209, 95, 238) }, - {"MediumOrchid3" , PALETTERGB (180, 82, 205) }, - {"MediumOrchid4" , PALETTERGB (122, 55, 139) }, - {"DarkOrchid1" , PALETTERGB (191, 62, 255) }, - {"DarkOrchid2" , PALETTERGB (178, 58, 238) }, - {"DarkOrchid3" , PALETTERGB (154, 50, 205) }, - {"DarkOrchid4" , PALETTERGB (104, 34, 139) }, - {"purple1" , PALETTERGB (155, 48, 255) }, - {"purple2" , PALETTERGB (145, 44, 238) }, - {"purple3" , PALETTERGB (125, 38, 205) }, - {"purple4" , PALETTERGB (85, 26, 139) }, - {"MediumPurple1" , PALETTERGB (171, 130, 255) }, - {"MediumPurple2" , PALETTERGB (159, 121, 238) }, - {"MediumPurple3" , PALETTERGB (137, 104, 205) }, - {"MediumPurple4" , PALETTERGB (93, 71, 139) }, - {"thistle1" , PALETTERGB (255, 225, 255) }, - {"thistle2" , PALETTERGB (238, 210, 238) }, - {"thistle3" , PALETTERGB (205, 181, 205) }, - {"thistle4" , PALETTERGB (139, 123, 139) }, - {"gray0" , PALETTERGB (0, 0, 0) }, - {"grey0" , PALETTERGB (0, 0, 0) }, - {"gray1" , PALETTERGB (3, 3, 3) }, - {"grey1" , PALETTERGB (3, 3, 3) }, - {"gray2" , PALETTERGB (5, 5, 5) }, - {"grey2" , PALETTERGB (5, 5, 5) }, - {"gray3" , PALETTERGB (8, 8, 8) }, - {"grey3" , PALETTERGB (8, 8, 8) }, - {"gray4" , PALETTERGB (10, 10, 10) }, - {"grey4" , PALETTERGB (10, 10, 10) }, - {"gray5" , PALETTERGB (13, 13, 13) }, - {"grey5" , PALETTERGB (13, 13, 13) }, - {"gray6" , PALETTERGB (15, 15, 15) }, - {"grey6" , PALETTERGB (15, 15, 15) }, - {"gray7" , PALETTERGB (18, 18, 18) }, - {"grey7" , PALETTERGB (18, 18, 18) }, - {"gray8" , PALETTERGB (20, 20, 20) }, - {"grey8" , PALETTERGB (20, 20, 20) }, - {"gray9" , PALETTERGB (23, 23, 23) }, - {"grey9" , PALETTERGB (23, 23, 23) }, - {"gray10" , PALETTERGB (26, 26, 26) }, - {"grey10" , PALETTERGB (26, 26, 26) }, - {"gray11" , PALETTERGB (28, 28, 28) }, - {"grey11" , PALETTERGB (28, 28, 28) }, - {"gray12" , PALETTERGB (31, 31, 31) }, - {"grey12" , PALETTERGB (31, 31, 31) }, - {"gray13" , PALETTERGB (33, 33, 33) }, - {"grey13" , PALETTERGB (33, 33, 33) }, - {"gray14" , PALETTERGB (36, 36, 36) }, - {"grey14" , PALETTERGB (36, 36, 36) }, - {"gray15" , PALETTERGB (38, 38, 38) }, - {"grey15" , PALETTERGB (38, 38, 38) }, - {"gray16" , PALETTERGB (41, 41, 41) }, - {"grey16" , PALETTERGB (41, 41, 41) }, - {"gray17" , PALETTERGB (43, 43, 43) }, - {"grey17" , PALETTERGB (43, 43, 43) }, - {"gray18" , PALETTERGB (46, 46, 46) }, - {"grey18" , PALETTERGB (46, 46, 46) }, - {"gray19" , PALETTERGB (48, 48, 48) }, - {"grey19" , PALETTERGB (48, 48, 48) }, - {"gray20" , PALETTERGB (51, 51, 51) }, - {"grey20" , PALETTERGB (51, 51, 51) }, - {"gray21" , PALETTERGB (54, 54, 54) }, - {"grey21" , PALETTERGB (54, 54, 54) }, - {"gray22" , PALETTERGB (56, 56, 56) }, - {"grey22" , PALETTERGB (56, 56, 56) }, - {"gray23" , PALETTERGB (59, 59, 59) }, - {"grey23" , PALETTERGB (59, 59, 59) }, - {"gray24" , PALETTERGB (61, 61, 61) }, - {"grey24" , PALETTERGB (61, 61, 61) }, - {"gray25" , PALETTERGB (64, 64, 64) }, - {"grey25" , PALETTERGB (64, 64, 64) }, - {"gray26" , PALETTERGB (66, 66, 66) }, - {"grey26" , PALETTERGB (66, 66, 66) }, - {"gray27" , PALETTERGB (69, 69, 69) }, - {"grey27" , PALETTERGB (69, 69, 69) }, - {"gray28" , PALETTERGB (71, 71, 71) }, - {"grey28" , PALETTERGB (71, 71, 71) }, - {"gray29" , PALETTERGB (74, 74, 74) }, - {"grey29" , PALETTERGB (74, 74, 74) }, - {"gray30" , PALETTERGB (77, 77, 77) }, - {"grey30" , PALETTERGB (77, 77, 77) }, - {"gray31" , PALETTERGB (79, 79, 79) }, - {"grey31" , PALETTERGB (79, 79, 79) }, - {"gray32" , PALETTERGB (82, 82, 82) }, - {"grey32" , PALETTERGB (82, 82, 82) }, - {"gray33" , PALETTERGB (84, 84, 84) }, - {"grey33" , PALETTERGB (84, 84, 84) }, - {"gray34" , PALETTERGB (87, 87, 87) }, - {"grey34" , PALETTERGB (87, 87, 87) }, - {"gray35" , PALETTERGB (89, 89, 89) }, - {"grey35" , PALETTERGB (89, 89, 89) }, - {"gray36" , PALETTERGB (92, 92, 92) }, - {"grey36" , PALETTERGB (92, 92, 92) }, - {"gray37" , PALETTERGB (94, 94, 94) }, - {"grey37" , PALETTERGB (94, 94, 94) }, - {"gray38" , PALETTERGB (97, 97, 97) }, - {"grey38" , PALETTERGB (97, 97, 97) }, - {"gray39" , PALETTERGB (99, 99, 99) }, - {"grey39" , PALETTERGB (99, 99, 99) }, - {"gray40" , PALETTERGB (102, 102, 102) }, - {"grey40" , PALETTERGB (102, 102, 102) }, - {"gray41" , PALETTERGB (105, 105, 105) }, - {"grey41" , PALETTERGB (105, 105, 105) }, - {"gray42" , PALETTERGB (107, 107, 107) }, - {"grey42" , PALETTERGB (107, 107, 107) }, - {"gray43" , PALETTERGB (110, 110, 110) }, - {"grey43" , PALETTERGB (110, 110, 110) }, - {"gray44" , PALETTERGB (112, 112, 112) }, - {"grey44" , PALETTERGB (112, 112, 112) }, - {"gray45" , PALETTERGB (115, 115, 115) }, - {"grey45" , PALETTERGB (115, 115, 115) }, - {"gray46" , PALETTERGB (117, 117, 117) }, - {"grey46" , PALETTERGB (117, 117, 117) }, - {"gray47" , PALETTERGB (120, 120, 120) }, - {"grey47" , PALETTERGB (120, 120, 120) }, - {"gray48" , PALETTERGB (122, 122, 122) }, - {"grey48" , PALETTERGB (122, 122, 122) }, - {"gray49" , PALETTERGB (125, 125, 125) }, - {"grey49" , PALETTERGB (125, 125, 125) }, - {"gray50" , PALETTERGB (128, 128, 128) }, /* Adjusted */ - {"grey50" , PALETTERGB (128, 128, 128) }, /* Adjusted */ - {"gray51" , PALETTERGB (130, 130, 130) }, - {"grey51" , PALETTERGB (130, 130, 130) }, - {"gray52" , PALETTERGB (133, 133, 133) }, - {"grey52" , PALETTERGB (133, 133, 133) }, - {"gray53" , PALETTERGB (135, 135, 135) }, - {"grey53" , PALETTERGB (135, 135, 135) }, - {"gray54" , PALETTERGB (138, 138, 138) }, - {"grey54" , PALETTERGB (138, 138, 138) }, - {"gray55" , PALETTERGB (140, 140, 140) }, - {"grey55" , PALETTERGB (140, 140, 140) }, - {"gray56" , PALETTERGB (143, 143, 143) }, - {"grey56" , PALETTERGB (143, 143, 143) }, - {"gray57" , PALETTERGB (145, 145, 145) }, - {"grey57" , PALETTERGB (145, 145, 145) }, - {"gray58" , PALETTERGB (148, 148, 148) }, - {"grey58" , PALETTERGB (148, 148, 148) }, - {"gray59" , PALETTERGB (150, 150, 150) }, - {"grey59" , PALETTERGB (150, 150, 150) }, - {"gray60" , PALETTERGB (153, 153, 153) }, - {"grey60" , PALETTERGB (153, 153, 153) }, - {"gray61" , PALETTERGB (156, 156, 156) }, - {"grey61" , PALETTERGB (156, 156, 156) }, - {"gray62" , PALETTERGB (158, 158, 158) }, - {"grey62" , PALETTERGB (158, 158, 158) }, - {"gray63" , PALETTERGB (161, 161, 161) }, - {"grey63" , PALETTERGB (161, 161, 161) }, - {"gray64" , PALETTERGB (163, 163, 163) }, - {"grey64" , PALETTERGB (163, 163, 163) }, - {"gray65" , PALETTERGB (166, 166, 166) }, - {"grey65" , PALETTERGB (166, 166, 166) }, - {"gray66" , PALETTERGB (168, 168, 168) }, - {"grey66" , PALETTERGB (168, 168, 168) }, - {"gray67" , PALETTERGB (171, 171, 171) }, - {"grey67" , PALETTERGB (171, 171, 171) }, - {"gray68" , PALETTERGB (173, 173, 173) }, - {"grey68" , PALETTERGB (173, 173, 173) }, - {"gray69" , PALETTERGB (176, 176, 176) }, - {"grey69" , PALETTERGB (176, 176, 176) }, - {"gray70" , PALETTERGB (179, 179, 179) }, - {"grey70" , PALETTERGB (179, 179, 179) }, - {"gray71" , PALETTERGB (181, 181, 181) }, - {"grey71" , PALETTERGB (181, 181, 181) }, - {"gray72" , PALETTERGB (184, 184, 184) }, - {"grey72" , PALETTERGB (184, 184, 184) }, - {"gray73" , PALETTERGB (186, 186, 186) }, - {"grey73" , PALETTERGB (186, 186, 186) }, - {"gray74" , PALETTERGB (189, 189, 189) }, - {"grey74" , PALETTERGB (189, 189, 189) }, - {"gray75" , PALETTERGB (192, 192, 192) }, /* Adjusted */ - {"grey75" , PALETTERGB (192, 192, 192) }, /* Adjusted */ - {"gray76" , PALETTERGB (194, 194, 194) }, - {"grey76" , PALETTERGB (194, 194, 194) }, - {"gray77" , PALETTERGB (196, 196, 196) }, - {"grey77" , PALETTERGB (196, 196, 196) }, - {"gray78" , PALETTERGB (199, 199, 199) }, - {"grey78" , PALETTERGB (199, 199, 199) }, - {"gray79" , PALETTERGB (201, 201, 201) }, - {"grey79" , PALETTERGB (201, 201, 201) }, - {"gray80" , PALETTERGB (204, 204, 204) }, - {"grey80" , PALETTERGB (204, 204, 204) }, - {"gray81" , PALETTERGB (207, 207, 207) }, - {"grey81" , PALETTERGB (207, 207, 207) }, - {"gray82" , PALETTERGB (209, 209, 209) }, - {"grey82" , PALETTERGB (209, 209, 209) }, - {"gray83" , PALETTERGB (212, 212, 212) }, - {"grey83" , PALETTERGB (212, 212, 212) }, - {"gray84" , PALETTERGB (214, 214, 214) }, - {"grey84" , PALETTERGB (214, 214, 214) }, - {"gray85" , PALETTERGB (217, 217, 217) }, - {"grey85" , PALETTERGB (217, 217, 217) }, - {"gray86" , PALETTERGB (219, 219, 219) }, - {"grey86" , PALETTERGB (219, 219, 219) }, - {"gray87" , PALETTERGB (222, 222, 222) }, - {"grey87" , PALETTERGB (222, 222, 222) }, - {"gray88" , PALETTERGB (224, 224, 224) }, - {"grey88" , PALETTERGB (224, 224, 224) }, - {"gray89" , PALETTERGB (227, 227, 227) }, - {"grey89" , PALETTERGB (227, 227, 227) }, - {"gray90" , PALETTERGB (229, 229, 229) }, - {"grey90" , PALETTERGB (229, 229, 229) }, - {"gray91" , PALETTERGB (232, 232, 232) }, - {"grey91" , PALETTERGB (232, 232, 232) }, - {"gray92" , PALETTERGB (235, 235, 235) }, - {"grey92" , PALETTERGB (235, 235, 235) }, - {"gray93" , PALETTERGB (237, 237, 237) }, - {"grey93" , PALETTERGB (237, 237, 237) }, - {"gray94" , PALETTERGB (240, 240, 240) }, - {"grey94" , PALETTERGB (240, 240, 240) }, - {"gray95" , PALETTERGB (242, 242, 242) }, - {"grey95" , PALETTERGB (242, 242, 242) }, - {"gray96" , PALETTERGB (245, 245, 245) }, - {"grey96" , PALETTERGB (245, 245, 245) }, - {"gray97" , PALETTERGB (247, 247, 247) }, - {"grey97" , PALETTERGB (247, 247, 247) }, - {"gray98" , PALETTERGB (250, 250, 250) }, - {"grey98" , PALETTERGB (250, 250, 250) }, - {"gray99" , PALETTERGB (252, 252, 252) }, - {"grey99" , PALETTERGB (252, 252, 252) }, - {"gray100" , PALETTERGB (255, 255, 255) }, - {"grey100" , PALETTERGB (255, 255, 255) }, - {"DarkGrey" , PALETTERGB (169, 169, 169) }, - {"DarkGray" , PALETTERGB (169, 169, 169) }, - {"DarkBlue" , PALETTERGB (0, 0, 128) }, /* Adjusted == Navy */ - {"DarkCyan" , PALETTERGB (0, 128, 128) }, /* Adjusted */ - {"DarkMagenta" , PALETTERGB (128, 0, 128) }, /* Adjusted */ - {"DarkRed" , PALETTERGB (128, 0, 0) }, /* Adjusted */ - {"LightGreen" , PALETTERGB (144, 238, 144) }, - /* Added to match values in the default Windows palette: */ - {"DarkYellow" , PALETTERGB (128, 128, 0) }, - {"PaleYellow" , PALETTERGB (255, 255, 128) } -}; - - -typedef struct fontmap_t -{ - const Ascbyte *name; - int value; -} fontmap_t; - -/* Default weight first, preferred names listed before synonyms */ -static const fontmap_t fontweight_map[] = -{ - {"Regular" , FW_REGULAR}, /* The standard font weight */ - {"Thin" , FW_THIN}, - {"Extra Light" , FW_EXTRALIGHT}, - {"Ultra Light" , FW_ULTRALIGHT}, - {"Light" , FW_LIGHT}, - {"Normal" , FW_NORMAL}, - {"Medium" , FW_MEDIUM}, - {"Semi Bold" , FW_SEMIBOLD}, - {"Demi Bold" , FW_DEMIBOLD}, - {"Bold" , FW_BOLD}, /* The standard bold font weight */ - {"Extra Bold" , FW_EXTRABOLD}, - {"Ultra Bold" , FW_ULTRABOLD}, - {"Heavy" , FW_HEAVY}, - {"Black" , FW_BLACK} -}; - -/* Default charset must be listed first, no synonyms allowed because these - * names are matched against the names reported by win32 by match_font() */ -static const fontmap_t charset_map[] = -{ - {"Western" , ANSI_CHARSET}, /* Latin 1 */ - {"Central European" , EASTEUROPE_CHARSET}, - {"Cyrillic" , RUSSIAN_CHARSET}, - {"Greek" , GREEK_CHARSET}, - {"Turkish" , TURKISH_CHARSET}, - {"Hebrew" , HEBREW_CHARSET}, - {"Arabic" , ARABIC_CHARSET}, - {"Baltic" , BALTIC_CHARSET}, - {"Viet Nam" , VIETNAMESE_CHARSET}, - {"Thai" , THAI_CHARSET}, - {"Japanese" , SHIFTJIS_CHARSET}, - {"Korean" , HANGEUL_CHARSET}, - {"Simplified Chinese" , GB2312_CHARSET}, - {"Traditional Chinese", CHINESEBIG5_CHARSET}, - - {"Symbol" , SYMBOL_CHARSET}, - {"Mac" , MAC_CHARSET}, - {"Korean Johab" , JOHAB_CHARSET}, - {"OEM/DOS" , OEM_CHARSET} -}; - -#ifdef MULE - -typedef struct unicode_subrange_raw_t -{ - int subrange_bit; - int start; /* first Unicode codepoint */ - int end; /* last Unicode codepoint */ -} unicode_subrange_raw_t; - -/* This table comes from MSDN, Unicode Subset Bitfields [Platform SDK - Documentation, Base Services, International Features, Unicode and - Character Sets, Unicode and Character Set Reference, Unicode and - Character Set Constants]. We preprocess it at startup time into an - array of unicode_subrange_t. - */ - -static const unicode_subrange_raw_t unicode_subrange_raw_map[] = -{ - {0, 0x0020, 0x007e}, /* Basic Latin */ - {1, 0x00a0, 0x00ff}, /* Latin-1 Supplement */ - {2, 0x0100, 0x017f}, /* Latin Extended-A */ - {3, 0x0180, 0x024f}, /* Latin Extended-B */ - {4, 0x0250, 0x02af}, /* IPA Extensions */ - {5, 0x02b0, 0x02ff}, /* Spacing Modifier Letters */ - {6, 0x0300, 0x036f}, /* Combining Diacritical Marks */ - {7, 0x0370, 0x03ff}, /* Basic Greek */ - /* 8 Reserved */ - {9, 0x0400, 0x04ff}, /* Cyrillic */ - {10, 0x0530, 0x058f}, /* Armenian */ - {11, 0x0590, 0x05ff}, /* Basic Hebrew */ - /* 12 Reserved */ - {13, 0x0600, 0x06ff}, /* Basic Arabic */ - /* 14 Reserved */ - {15, 0x0900, 0x097f}, /* Devanagari */ - {16, 0x0980, 0x09ff}, /* Bengali */ - {17, 0x0a00, 0x0a7f}, /* Gurmukhi */ - {18, 0x0a80, 0x0aff}, /* Gujarati */ - {19, 0x0b00, 0x0b7f}, /* Oriya */ - {20, 0x0b80, 0x0bff}, /* Tamil */ - {21, 0x0c00, 0x0c7f}, /* Telugu */ - {22, 0x0c80, 0x0cff}, /* Kannada */ - {23, 0x0d00, 0x0d7f}, /* Malayalam */ - {24, 0x0e00, 0x0e7f}, /* Thai */ - {25, 0x0e80, 0x0eff}, /* Lao */ - {26, 0x10a0, 0x10ff}, /* Basic Georgian */ - /* 27 Reserved */ - {28, 0x1100, 0x11ff}, /* Hangul Jamo */ - {29, 0x1e00, 0x1eff}, /* Latin Extended Additional */ - {30, 0x1f00, 0x1fff}, /* Greek Extended */ - {31, 0x2000, 0x206f}, /* General Punctuation */ - {32, 0x2070, 0x209f}, /* Subscripts and Superscripts */ - {33, 0x20a0, 0x20cf}, /* Currency Symbols */ - {34, 0x20d0, 0x20ff}, /* Combining Diacritical Marks for Symbols */ - {35, 0x2100, 0x214f}, /* Letter-like Symbols */ - {36, 0x2150, 0x218f}, /* Number Forms */ - {37, 0x2190, 0x21ff}, /* Arrows */ - {38, 0x2200, 0x22ff}, /* Mathematical Operators */ - {39, 0x2300, 0x23ff}, /* Miscellaneous Technical */ - {40, 0x2400, 0x243f}, /* Control Pictures */ - {41, 0x2440, 0x245f}, /* Optical Character Recognition */ - {42, 0x2460, 0x24ff}, /* Enclosed Alphanumerics */ - {43, 0x2500, 0x257f}, /* Box Drawing */ - {44, 0x2580, 0x259f}, /* Block Elements */ - {45, 0x25a0, 0x25ff}, /* Geometric Shapes */ - {46, 0x2600, 0x26ff}, /* Miscellaneous Symbols */ - {47, 0x2700, 0x27bf}, /* Dingbats */ - {48, 0x3000, 0x303f}, /* Chinese, Japanese, and Korean (CJK) Symbols and Punctuation */ - {49, 0x3040, 0x309f}, /* Hiragana */ - {50, 0x30a0, 0x30ff}, /* Katakana */ - {51, 0x3100, 0x312f}, /* Bopomofo */ - {51, 0x31a0, 0x31bf}, /* Extended Bopomofo */ - {52, 0x3130, 0x318f}, /* Hangul Compatibility Jamo */ - {53, 0x3190, 0x319f}, /* CJK Miscellaneous */ - {54, 0x3200, 0x32ff}, /* Enclosed CJK Letters and Months */ - {55, 0x3300, 0x33ff}, /* CJK Compatibility */ - {56, 0xac00, 0xd7a3}, /* Hangul */ - {57, 0xd800, 0xdfff}, /* Surrogates. Note that setting this bit implies that there is at least one codepoint beyond the Basic Multilingual Plane that is supported by this font. */ - /* 58 Reserved */ - {59, 0x4e00, 0x9fff}, /* CJK Unified Ideographs */ - {59, 0x2e80, 0x2eff}, /* CJK Radicals Supplement */ - {59, 0x2f00, 0x2fdf}, /* Kangxi Radicals */ - {59, 0x2ff0, 0x2fff}, /* Ideographic Description */ - {59, 0x3400, 0x4dbf}, /* CJK Unified Ideograph Extension A */ - {60, 0xe000, 0xf8ff}, /* Private Use Area */ - {61, 0xf900, 0xfaff}, /* CJK Compatibility Ideographs */ - {62, 0xfb00, 0xfb4f}, /* Alphabetic Presentation Forms */ - {63, 0xfb50, 0xfdff}, /* Arabic Presentation Forms-A */ - {64, 0xfe20, 0xfe2f}, /* Combining Half Marks */ - {65, 0xfe30, 0xfe4f}, /* CJK Compatibility Forms */ - {66, 0xfe50, 0xfe6f}, /* Small Form Variants */ - {67, 0xfe70, 0xfefe}, /* Arabic Presentation Forms-B */ - {68, 0xff00, 0xffef}, /* Halfwidth and Fullwidth Forms */ - {69, 0xfff0, 0xfffd}, /* Specials */ - {70, 0x0f00, 0x0fcf}, /* Tibetan */ - {71, 0x0700, 0x074f}, /* Syriac */ - {72, 0x0780, 0x07bf}, /* Thaana */ - {73, 0x0d80, 0x0dff}, /* Sinhala */ - {74, 0x1000, 0x109f}, /* Myanmar */ - {75, 0x1200, 0x12bf}, /* Ethiopic */ - {76, 0x13a0, 0x13ff}, /* Cherokee */ - {77, 0x1400, 0x14df}, /* Canadian Aboriginal Syllabics */ - {78, 0x1680, 0x169f}, /* Ogham */ - {79, 0x16a0, 0x16ff}, /* Runic */ - {80, 0x1780, 0x17ff}, /* Khmer */ - {81, 0x1800, 0x18af}, /* Mongolian */ - {82, 0x2800, 0x28ff}, /* Braille */ - {83, 0xa000, 0xa48c}, /* Yi, Yi Radicals */ - /* 84-122 Reserved */ - /* 123 Windows 2000/XP: Layout progress: horizontal from right to left */ - /* 124 Windows 2000/XP: Layout progress: vertical before horizontal */ - /* 125 Windows 2000/XP: Layout progress: vertical bottom to top */ - /* 126 Reserved; must be 0 */ - /* 127 Reserved; must be 1 */ -}; - -typedef struct unicode_subrange_t -{ - int no_subranges; - const unicode_subrange_raw_t *subranges; -} unicode_subrange_t; - -unicode_subrange_t *unicode_subrange_table; - -/* Hash table mapping font specs (strings) to font signature data - (FONTSIGNATURE structures stored in opaques), as determined by - GetTextCharsetInfo(). I presume this is somewhat expensive because it - involves creating a font object. At the very least, with no hashing, it - definitely took awhile (a few seconds) when encountering characters from - charsets needing stage 2 processing. */ -Lisp_Object Vfont_signature_data; - -#endif /* MULE */ - - -/************************************************************************/ -/* helpers */ -/************************************************************************/ - -static int -hexval (Ibyte c) -{ - /* assumes ASCII and isxdigit (c) */ - if (c >= 'a') - return c - 'a' + 10; - else if (c >= 'A') - return c - 'A' + 10; - else - return c - '0'; -} - -COLORREF -mswindows_string_to_color (const Ibyte *name) -{ - int i; - - if (*name == '#') - { - /* numeric names look like "#RRGGBB", "#RRRGGGBBB" or "#RRRRGGGGBBBB" - or "rgb:rrrr/gggg/bbbb" */ - unsigned int r, g, b; - - for (i = 1; i < qxestrlen (name); i++) - { - if (!byte_ascii_p (name[i]) || !isxdigit ((int) name[i])) - return (COLORREF) -1; - } - if (qxestrlen (name) == 7) - { - r = hexval (name[1]) * 16 + hexval (name[2]); - g = hexval (name[3]) * 16 + hexval (name[4]); - b = hexval (name[5]) * 16 + hexval (name[6]); - return (PALETTERGB (r, g, b)); - } - else if (qxestrlen (name) == 10) - { - r = hexval (name[1]) * 16 + hexval (name[2]); - g = hexval (name[4]) * 16 + hexval (name[5]); - b = hexval (name[7]) * 16 + hexval (name[8]); - return (PALETTERGB (r, g, b)); - } - else if (qxestrlen (name) == 13) - { - r = hexval (name[1]) * 16 + hexval (name[2]); - g = hexval (name[5]) * 16 + hexval (name[6]); - b = hexval (name[9]) * 16 + hexval (name[10]); - return (PALETTERGB (r, g, b)); - } - } - else if (!qxestrncmp_ascii (name, "rgb:", 4)) - { - unsigned int r, g, b; - - if (sscanf ((CIbyte *) name, "rgb:%04x/%04x/%04x", &r, &g, &b) == 3) - { - int len = qxestrlen (name); - if (len == 18) - { - r /= 257; - g /= 257; - b /= 257; - } - else if (len == 15) - { - r /= 17; - g /= 17; - b /= 17; - } - return (PALETTERGB (r, g, b)); - } - else - return (COLORREF) -1; - } - else if (*name) /* Can't be an empty string */ - { - Ibyte *nospaces = alloca_ibytes (qxestrlen (name) + 1); - Ibyte *c = nospaces; - while (*name) - if (*name != ' ') - *c++ = *name++; - else - name++; - *c = '\0'; - - for (i = 0; i < countof (mswindows_X_color_map); i++) - if (!qxestrcasecmp_ascii (nospaces, mswindows_X_color_map[i].name)) - return (mswindows_X_color_map[i].colorref); - } - return (COLORREF) -1; -} - -Lisp_Object -mswindows_color_to_string (COLORREF color) -{ - int i; - Ascbyte buf[8]; - COLORREF pcolor = PALETTERGB (GetRValue (color), GetGValue (color), - GetBValue (color)); - - for (i = 0; i < countof (mswindows_X_color_map); i++) - if (pcolor == (mswindows_X_color_map[i].colorref)) - return build_ascstring (mswindows_X_color_map[i].name); - - sprintf (buf, "#%02X%02X%02X", - GetRValue (color), GetGValue (color), GetBValue (color)); - return build_ascstring (buf); -} - -/* - * Returns non-zero if the two supplied font patterns match. - * If they match and fontname is not NULL, copies the logical OR of the - * patterns to fontname (which is assumed to be at least MSW_FONTSIZE in size). - * - * The patterns 'match' iff for each field that is not blank in either pattern, - * the corresponding field in the other pattern is either identical or blank. - */ -static int -match_font (Ibyte *pattern1, Ibyte *pattern2, - Ibyte *fontname) -{ - Ibyte *c1 = pattern1, *c2 = pattern2, *e1 = 0, *e2 = 0; - int i; - - if (fontname) - fontname[0] = '\0'; - - for (i = 0; i < 5; i++) - { - if (c1 && (e1 = qxestrchr (c1, ':'))) - *(e1) = '\0'; - if (c2 && (e2 = qxestrchr (c2, ':'))) - *(e2) = '\0'; - - if (c1 && c1[0] != '\0') - { - if (c2 && c2[0] != '\0' && qxestrcasecmp (c1, c2)) - { - if (e1) *e1 = ':'; - if (e2) *e2 = ':'; - return 0; - } - else if (fontname) - qxestrcat_ascii (qxestrcat (fontname, c1), ":"); - } - else if (fontname) - { - if (c2 && c2[0] != '\0') - qxestrcat_ascii (qxestrcat (fontname, c2), ":"); - else - qxestrcat_ascii (fontname, ":"); - } - - if (e1) *(e1++) = ':'; - if (e2) *(e2++) = ':'; - c1 = e1; - c2 = e2; - } - - if (fontname) - fontname[qxestrlen (fontname) - 1] = '\0'; /* Trim trailing ':' */ - return 1; -} - - -/************************************************************************/ -/* exports */ -/************************************************************************/ - -struct font_enum_t -{ - HDC hdc; - Lisp_Object list; -}; - -static int CALLBACK -font_enum_callback_2 (ENUMLOGFONTEXW *lpelfe, NEWTEXTMETRICEXW *lpntme, - int FontType, struct font_enum_t *font_enum) -{ - Ibyte fontname[MSW_FONTSIZE * 2 * MAX_ICHAR_LEN]; /* should be enough :)*/ - Lisp_Object fontname_lispstr; - int i; - Ibyte *facename; - - /* - * The enumerated font weights are not to be trusted because: - * a) lpelfe->elfStyle is only filled in for TrueType fonts. - * b) Not all Bold and Italic styles of all fonts (including some Vector, - * Truetype and Raster fonts) are enumerated. - * I guess that fonts for which Bold and Italic styles are generated - * 'on-the-fly' are not enumerated. It would be overly restrictive to - * disallow Bold And Italic weights for these fonts, so we just leave - * weights unspecified. This means that we have to weed out duplicates of - * those fonts that do get enumerated with different weights. - */ - facename = TSTR_TO_ITEXT (lpelfe->elfLogFont.lfFaceName); - if (itext_ichar (facename) == '@') - /* This is a font for writing vertically. We ignore it. */ - return 1; - - if (FontType == 0 /*vector*/ || FontType & TRUETYPE_FONTTYPE) - /* Scalable, so leave pointsize blank */ - qxesprintf (fontname, "%s::::", facename); - else - /* Formula for pointsize->height from LOGFONT docs in Platform SDK */ - qxesprintf (fontname, "%s::%d::", facename, - MulDiv (lpntme->ntmTm.tmHeight - - lpntme->ntmTm.tmInternalLeading, - 72, GetDeviceCaps (font_enum->hdc, LOGPIXELSY))); - - /* - * The enumerated font character set strings are not to be trusted because - * lpelfe->elfScript is returned in the host language and not in English. - * We can't know a priori the translations of "Western", "Central European" - * etc into the host language, so we must use English. The same argument - * applies to the font weight string when matching fonts. - */ - for (i = 0; i < countof (charset_map); i++) - if (lpelfe->elfLogFont.lfCharSet == charset_map[i].value) - { - qxestrcat_ascii (fontname, charset_map[i].name); - break; - } - if (i == countof (charset_map)) - return 1; - - /* Add the font name to the list if not already there */ - fontname_lispstr = build_istring (fontname); - if (NILP (Fassoc (fontname_lispstr, font_enum->list))) - font_enum->list = - Fcons (Fcons (fontname_lispstr, - /* TMPF_FIXED_PITCH is backwards from what you expect! - If set, it means NOT fixed pitch. */ - (lpntme->ntmTm.tmPitchAndFamily & TMPF_FIXED_PITCH) ? - Qnil : Qt), - font_enum->list); - - return 1; -} - -static int CALLBACK -font_enum_callback_1 (ENUMLOGFONTEXW *lpelfe, - NEWTEXTMETRICEXW *UNUSED (lpntme), - int UNUSED (FontType), struct font_enum_t *font_enum) -{ - /* This function gets called once per facename per character set. - * We call a second callback to enumerate the fonts in each facename */ - return qxeEnumFontFamiliesEx (font_enum->hdc, &lpelfe->elfLogFont, - (FONTENUMPROCW) font_enum_callback_2, - (LPARAM) font_enum, 0); -} - -/* Function for sorting lists of fonts as obtained from - mswindows_enumerate_fonts(). These come in a known format: - "family::::charset" for TrueType fonts, "family::size::charset" - otherwise. */ - -static int -sort_font_list_function (Lisp_Object obj1, Lisp_Object obj2, - Lisp_Object UNUSED (pred)) -{ - Ibyte *font1, *font2; - Ibyte *c1, *c2; - int t1, t2; - - /* - 1. fixed over proportional. - 2. Western over other charsets. - 3. TrueType over non-TrueType. - 4. Within non-TrueType, sizes closer to 10pt over sizes farther from 10pt. - 5. Courier New over other families. - */ - - /* The sort function should return > 0 if OBJ1 < OBJ2, < 0 otherwise. - NOTE: This is backwards from the way qsort() works. */ - - t1 = !NILP (XCDR (obj1)); - t2 = !NILP (XCDR (obj2)); - - if (t1 && !t2) - return 1; - if (t2 && !t1) - return -1; - - font1 = XSTRING_DATA (XCAR (obj1)); - font2 = XSTRING_DATA (XCAR (obj2)); - - c1 = qxestrrchr (font1, ':'); - c2 = qxestrrchr (font2, ':'); - - t1 = !qxestrcasecmp_ascii (c1 + 1, "western"); - t2 = !qxestrcasecmp_ascii (c2 + 1, "western"); - - if (t1 && !t2) - return 1; - if (t2 && !t1) - return -1; - - c1 -= 2; - c2 -= 2; - t1 = *c1 == ':'; - t2 = *c2 == ':'; - - if (t1 && !t2) - return 1; - if (t2 && !t1) - return -1; - - if (!t1 && !t2) - { - while (isdigit (*c1)) - c1--; - while (isdigit (*c2)) - c2--; - - t1 = qxeatoi (c1 + 1) - 10; - t2 = qxeatoi (c2 + 1) - 10; - - if (abs (t1) < abs (t2)) - return 1; - else if (abs (t2) < abs (t1)) - return -1; - else if (t1 < t2) - /* Prefer a smaller font over a larger one just as far away - because the smaller one won't upset the total line height if it's - just a few chars. */ - return 1; - } - - t1 = !qxestrncasecmp_ascii (font1, "courier new:", 12); - t2 = !qxestrncasecmp_ascii (font2, "courier new:", 12); - - if (t1 && !t2) - return 1; - if (t2 && !t1) - return -1; - - return -1; -} - -/* - * Enumerate the available on the HDC fonts and return a list of string - * font names. - */ -Lisp_Object -mswindows_enumerate_fonts (HDC hdc) -{ - /* This cannot GC */ - LOGFONTW logfont; - struct font_enum_t font_enum; - - assert (hdc != NULL); - logfont.lfCharSet = DEFAULT_CHARSET; - logfont.lfFaceName[0] = '\0'; - logfont.lfPitchAndFamily = DEFAULT_PITCH; - font_enum.hdc = hdc; - font_enum.list = Qnil; - /* EnumFontFamilies seems to enumerate only one charset per font, which - is not what we want. We aren't supporting NT 3.5x, so no need to - worry about this not existing. */ - qxeEnumFontFamiliesEx (hdc, &logfont, (FONTENUMPROCW) font_enum_callback_1, - (LPARAM) (&font_enum), 0); - - return list_sort (font_enum.list, Qnil, sort_font_list_function); -} - -static HFONT -mswindows_create_font_variant (Lisp_Font_Instance *f, - int under, int strike) -{ - /* Cannot GC */ - LOGFONTW lf; - HFONT hfont; - - assert (FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, under, strike) == NULL); - - if (qxeGetObject (FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, 0, 0), - sizeof (lf), (void *) &lf) == 0) - { - hfont = MSWINDOWS_BAD_HFONT; - } - else - { - lf.lfUnderline = under; - lf.lfStrikeOut = strike; - - hfont = qxeCreateFontIndirect (&lf); - if (hfont == NULL) - hfont = MSWINDOWS_BAD_HFONT; - } - - FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, under, strike) = hfont; - return hfont; -} - -HFONT -mswindows_get_hfont (Lisp_Font_Instance *f, - int under, int strike) -{ - /* Cannot GC */ - HFONT hfont = FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, under, strike); - - if (hfont == NULL) - hfont = mswindows_create_font_variant (f, under, strike); - - /* If strikeout/underline variant of the font could not be - created, then use the base version of the font */ - if (hfont == MSWINDOWS_BAD_HFONT) - hfont = FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, 0, 0); - - assert (hfont != NULL && hfont != MSWINDOWS_BAD_HFONT); - - return hfont; -} - -/************************************************************************/ -/* methods */ -/************************************************************************/ - -static int -mswindows_initialize_color_instance (Lisp_Color_Instance *c, Lisp_Object name, - Lisp_Object UNUSED (device), - Error_Behavior errb) -{ - COLORREF color; - - color = mswindows_string_to_color (XSTRING_DATA (name)); - if (color != (COLORREF) -1) - { - c->data = xnew (struct mswindows_color_instance_data); - COLOR_INSTANCE_MSWINDOWS_COLOR (c) = color; - return 1; - } - maybe_signal_error (Qinvalid_constant, - "Unrecognized color", name, Qcolor, errb); - return(0); -} - -#if 0 -static void -mswindows_mark_color_instance (Lisp_Color_Instance *c) -{ -} -#endif - -static void -mswindows_print_color_instance (Lisp_Color_Instance *c, - Lisp_Object printcharfun, - int UNUSED (escapeflag)) -{ - COLORREF color = COLOR_INSTANCE_MSWINDOWS_COLOR (c); - write_fmt_string (printcharfun, - " %06ld=(%04X,%04X,%04X)", color & 0xffffff, - GetRValue (color) * 257, GetGValue (color) * 257, - GetBValue (color) * 257); -} - -static void -mswindows_finalize_color_instance (Lisp_Color_Instance *c) -{ - if (c->data) - { - xfree (c->data); - c->data = 0; - } -} - -static int -mswindows_color_instance_equal (Lisp_Color_Instance *c1, - Lisp_Color_Instance *c2, - int UNUSED (depth)) -{ - return (COLOR_INSTANCE_MSWINDOWS_COLOR (c1) == - COLOR_INSTANCE_MSWINDOWS_COLOR (c2)); -} - -static Hashcode -mswindows_color_instance_hash (Lisp_Color_Instance *c, int UNUSED (depth)) -{ - return (unsigned long) COLOR_INSTANCE_MSWINDOWS_COLOR (c); -} - -static Lisp_Object -mswindows_color_instance_rgb_components (Lisp_Color_Instance *c) -{ - COLORREF color = COLOR_INSTANCE_MSWINDOWS_COLOR (c); - return list3 (make_int (GetRValue (color) * 257), - make_int (GetGValue (color) * 257), - make_int (GetBValue (color) * 257)); -} - -static int -mswindows_valid_color_name_p (struct device *UNUSED (d), Lisp_Object color) -{ - return (mswindows_string_to_color (XSTRING_DATA (color)) != (COLORREF) -1); -} - - - -static void -mswindows_finalize_font_instance (Lisp_Font_Instance *f); - -/* Parse the font spec in NAMESTR. Maybe issue errors, according to ERRB; - NAME_FOR_ERRORS is the Lisp string to use when issuing errors. Store - the five parts of the font spec into the given strings, which should be - declared as - - Ibyte fontname[LF_FACESIZE], weight[LF_FACESIZE], points[8]; - Ibyte effects[LF_FACESIZE], charset[LF_FACESIZE]; - - If LOGFONT is given, store the necessary information in LOGFONT to - create a font object. If LOGFONT is given, HDC must also be given; - else, NULL can be given for both. - - Return 1 if ok, 0 if error. - */ -static int -parse_font_spec (const Ibyte *namestr, - HDC hdc, - Lisp_Object name_for_errors, - Error_Behavior errb, - LOGFONTW *logfont, - Ibyte *fontname, - Ibyte *weight, - Ibyte *points, - Ibyte *effects, - Ibyte *charset) -{ - int fields, i; - int pt; - Ibyte *style; - Ibyte *c; - - /* - * mswindows fonts look like: - * fontname[:[weight ][style][:pointsize[:effects]]][:charset] - * The font name field shouldn't be empty. - * - * ie: - * Lucida Console:Regular:10 - * minimal: - * Courier New - * maximal: - * Courier New:Bold Italic:10:underline strikeout:western - */ - - fontname[0] = 0; - weight[0] = 0; - points[0] = 0; - effects[0] = 0; - charset[0] = 0; - - if (logfont) - xzero (*logfont); - - fields = sscanf ((CIbyte *) namestr, "%31[^:]:%31[^:]:%7[^:]:%31[^:]:%31s", - fontname, weight, points, effects, charset); - - /* This function is implemented in a fairly ad-hoc manner. - * The general idea is to validate and canonicalize each of the above fields - * at the same time as we build up the win32 LOGFONT structure. This enables - * us to use match_font() on a canonicalized font string to check the - * availability of the requested font */ - - if (fields < 0) - { - maybe_signal_error (Qinvalid_argument, "Invalid font", name_for_errors, - Qfont, errb); - return 0; - } - - if (fields > 0 && qxestrlen (fontname)) - { - Extbyte *extfontname; - - extfontname = ITEXT_TO_TSTR (fontname); - if (logfont) - { - qxetcsncpy ((Extbyte *) logfont->lfFaceName, extfontname, - LF_FACESIZE - 1); - logfont->lfFaceName[LF_FACESIZE - 1] = 0; - } - } - - /* weight */ - if (fields < 2) - qxestrcpy_ascii (weight, fontweight_map[0].name); - - /* Maybe split weight into weight and style */ - if ((c = qxestrchr (weight, ' '))) - { - *c = '\0'; - style = c + 1; - } - else - style = NULL; - - for (i = 0; i < countof (fontweight_map); i++) - if (!qxestrcasecmp_ascii (weight, fontweight_map[i].name)) - { - if (logfont) - logfont->lfWeight = fontweight_map[i].value; - break; - } - if (i == countof (fontweight_map)) /* No matching weight */ - { - if (!style) - { - if (logfont) - logfont->lfWeight = FW_REGULAR; - style = weight; /* May have specified style without weight */ - } - else - { - maybe_signal_error (Qinvalid_constant, "Invalid font weight", - name_for_errors, Qfont, errb); - return 0; - } - } - - if (style) - { - /* #### what about oblique? */ - if (qxestrcasecmp_ascii (style, "italic") == 0) - { - if (logfont) - logfont->lfItalic = TRUE; - } - else - { - maybe_signal_error (Qinvalid_constant, - "Invalid font weight or style", - name_for_errors, Qfont, errb); - return 0; - } - - /* Glue weight and style together again */ - if (weight != style) - *c = ' '; - } - else if (logfont) - logfont->lfItalic = FALSE; - - if (fields < 3 || !qxestrcmp_ascii (points, "")) - ; - else if (points[0] == '0' || - qxestrspn (points, "0123456789") < qxestrlen (points)) - { - maybe_signal_error (Qinvalid_argument, "Invalid font pointsize", - name_for_errors, Qfont, errb); - return 0; - } - else - { - pt = qxeatoi (points); - - if (logfont) - { - /* Formula for pointsize->height from LOGFONT docs in MSVC5 Platform - SDK */ - logfont->lfHeight = -MulDiv (pt, GetDeviceCaps (hdc, LOGPIXELSY), - 72); - logfont->lfWidth = 0; - } - } - - /* Effects */ - if (logfont) - { - logfont->lfUnderline = FALSE; - logfont->lfStrikeOut = FALSE; - } - - if (fields >= 4 && effects[0] != '\0') - { - Ibyte *effects2; - int underline = FALSE, strikeout = FALSE; - - /* Maybe split effects into effects and effects2 */ - if ((c = qxestrchr (effects, ' '))) - { - *c = '\0'; - effects2 = c + 1; - } - else - effects2 = NULL; - - if (qxestrcasecmp_ascii (effects, "underline") == 0) - underline = TRUE; - else if (qxestrcasecmp_ascii (effects, "strikeout") == 0) - strikeout = TRUE; - else - { - maybe_signal_error (Qinvalid_constant, "Invalid font effect", - name_for_errors, Qfont, errb); - return 0; - } - - if (effects2 && effects2[0] != '\0') - { - if (qxestrcasecmp_ascii (effects2, "underline") == 0) - underline = TRUE; - else if (qxestrcasecmp_ascii (effects2, "strikeout") == 0) - strikeout = TRUE; - else - { - maybe_signal_error (Qinvalid_constant, "Invalid font effect", - name_for_errors, Qfont, errb); - return 0; - } - } - - /* Regenerate sanitized effects string */ - if (underline) - { - if (strikeout) - qxestrcpy_ascii (effects, "underline strikeout"); - else - qxestrcpy_ascii (effects, "underline"); - } - else if (strikeout) - qxestrcpy_ascii (effects, "strikeout"); - - if (logfont) - { - logfont->lfUnderline = underline; - logfont->lfStrikeOut = strikeout; - } - } - - /* Charset */ - /* charset can be specified even if earlier fields haven't been */ - if (fields < 5) - { - if ((c = qxestrchr (namestr, ':')) && (c = qxestrchr (c + 1, ':')) && - (c = qxestrchr (c + 1, ':')) && (c = qxestrchr (c + 1, ':'))) - { - qxestrncpy (charset, c + 1, LF_FACESIZE); - charset[LF_FACESIZE - 1] = '\0'; - } - } - - /* NOTE: If you give a blank charset spec, we will normally not get here - under Mule unless we explicitly call `make-font-instance'! This is - because the C code instantiates fonts using particular charsets, by - way of specifier_matching_instance(). Before instantiating the font, - font_instantiate() calls the devmeth find_matching_font(), which gets - a truename font spec with the registry (i.e. the charset spec) filled - in appropriately to the charset. */ - if (!qxestrcmp_ascii (charset, "")) - ; - else - { - for (i = 0; i < countof (charset_map); i++) - if (!qxestrcasecmp_ascii (charset, charset_map[i].name)) - { - if (logfont) - logfont->lfCharSet = charset_map[i].value; - break; - } - - if (i == countof (charset_map)) /* No matching charset */ - { - maybe_signal_error (Qinvalid_argument, "Invalid charset", - name_for_errors, Qfont, errb); - return 0; - } - } - - if (logfont) - { - /* Misc crud */ -#if 1 - logfont->lfOutPrecision = OUT_DEFAULT_PRECIS; - logfont->lfClipPrecision = CLIP_DEFAULT_PRECIS; - logfont->lfQuality = DEFAULT_QUALITY; -#else - logfont->lfOutPrecision = OUT_STROKE_PRECIS; - logfont->lfClipPrecision = CLIP_STROKE_PRECIS; - logfont->lfQuality = PROOF_QUALITY; -#endif - /* Default to monospaced if the specified fontname doesn't exist. */ - logfont->lfPitchAndFamily = FF_MODERN; - } - - return 1; -} - -/* - mswindows fonts look like: - [fontname[:style[:pointsize[:effects]]]][:charset] - A maximal mswindows font spec looks like: - Courier New:Bold Italic:10:underline strikeout:Western - - A missing weight/style field is the same as Regular, and a missing - effects field is left alone, and means no effects; but a missing - fontname, pointsize or charset field means any will do. We prefer - Courier New, 10, Western. See sort function above. */ - -static HFONT -create_hfont_from_font_spec (const Ibyte *namestr, - HDC hdc, - Lisp_Object name_for_errors, - Lisp_Object device_font_list, - Error_Behavior errb, - Lisp_Object *truename_ret) -{ - LOGFONTW logfont; - HFONT hfont; - Ibyte fontname[LF_FACESIZE], weight[LF_FACESIZE], points[8]; - Ibyte effects[LF_FACESIZE], charset[LF_FACESIZE]; - Ibyte truename[MSW_FONTSIZE]; - Ibyte truername[MSW_FONTSIZE]; - - /* Windows will silently substitute a default font if the fontname - specifies a non-existent font. This is bad for screen fonts because - it doesn't allow higher-level code to see the error and to act - appropriately. For instance complex_vars_of_faces() sets up a - fallback list of fonts for the default face. Instead, we look at all - the possibilities and pick one that works, handling missing pointsize - and charset fields appropriately. - - For printer fonts, we used to go ahead and let Windows choose the - font, and for those devices, then, DEVICE_FONT_LIST would be nil. - However, this causes problems with the font-matching code below, which - needs a list of fonts so it can pick the right one for Mule. - - Thus, the code below to handle a nil DEVICE_FONT_LIST is not currently - used. */ - - if (!NILP (device_font_list)) - { - Lisp_Object fonttail = Qnil; - - if (!parse_font_spec (namestr, 0, name_for_errors, - errb, 0, fontname, weight, points, - effects, charset)) - return 0; - - /* The fonts in the device font list always specify fontname and - charset, but often times not the size; so if we don't have the - size specified either, do a round with size 10 so we'll always end - up with a size in the truename (if we fail this one but succeed - the next one, we'll have chosen a non-TrueType font, and in those - cases the size is specified in the font list item. */ - - if (!points[0]) - { - qxesprintf (truename, "%s:%s:10:%s:%s", - fontname, weight, effects, charset); - - LIST_LOOP (fonttail, device_font_list) - { - if (match_font (XSTRING_DATA (XCAR (XCAR (fonttail))), - truename, truername)) - break; - } - } - - if (NILP (fonttail)) - { - qxesprintf (truename, "%s:%s:%s:%s:%s", - fontname, weight, points, effects, charset); - - LIST_LOOP (fonttail, device_font_list) - { - if (match_font (XSTRING_DATA (XCAR (XCAR (fonttail))), - truename, truername)) - break; - } - } - - if (NILP (fonttail)) - { - maybe_signal_error (Qinvalid_argument, "No matching font", - name_for_errors, Qfont, errb); - return 0; - } - - if (!parse_font_spec (truername, hdc, name_for_errors, - ERROR_ME_DEBUG_WARN, &logfont, fontname, weight, - points, effects, charset)) - signal_error (Qinternal_error, "Bad value in device font list?", - build_istring (truername)); - } - else if (!parse_font_spec (namestr, hdc, name_for_errors, - errb, &logfont, fontname, weight, points, - effects, charset)) - return 0; - - if ((hfont = qxeCreateFontIndirect (&logfont)) == NULL) - { - maybe_signal_error (Qgui_error, "Couldn't create font", - name_for_errors, Qfont, errb); - return 0; - } - - /* #### Truename will not have all its fields filled in when we have no - list of fonts. Doesn't really matter now, since we always have one. - See above. */ - qxesprintf (truename, "%s:%s:%s:%s:%s", fontname, weight, - points, effects, charset); - - *truename_ret = build_istring (truename); - return hfont; -} - -/* - * This is a work horse for both mswindows_initialize_font_instance and - * msprinter_initialize_font_instance. - */ -static int -initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name, - Lisp_Object device_font_list, HDC hdc, - Error_Behavior errb) -{ - HFONT hfont, hfont2; - TEXTMETRICW metrics; - Ibyte *namestr = XSTRING_DATA (name); - Lisp_Object truename; - - hfont = create_hfont_from_font_spec (namestr, hdc, name, device_font_list, - errb, &truename); - if (!hfont) - return 0; - f->truename = truename; - f->data = xnew_and_zero (struct mswindows_font_instance_data); - FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, 0, 0) = hfont; - - /* Some underlined fonts have the descent of one pixel more than their - non-underlined counterparts. Font variants though are assumed to have - identical metrics. So get the font metrics from the underlined variant - of the font */ - hfont2 = mswindows_create_font_variant (f, 1, 0); - if (hfont2 != MSWINDOWS_BAD_HFONT) - hfont = hfont2; - - hfont2 = (HFONT) SelectObject (hdc, hfont); - if (!hfont2) - { - mswindows_finalize_font_instance (f); - maybe_signal_error (Qgui_error, "Couldn't map font", name, Qfont, errb); - return 0; - } - qxeGetTextMetrics (hdc, &metrics); - SelectObject (hdc, hfont2); - - f->width = (unsigned short) metrics.tmAveCharWidth; - f->height = (unsigned short) metrics.tmHeight; - f->ascent = (unsigned short) metrics.tmAscent; - f->descent = (unsigned short) metrics.tmDescent; - f->proportional_p = (metrics.tmPitchAndFamily & TMPF_FIXED_PITCH); - - return 1; -} - -static int -mswindows_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name, - Lisp_Object device, Error_Behavior errb) -{ - HDC hdc = CreateCompatibleDC (NULL); - Lisp_Object font_list = DEVICE_MSWINDOWS_FONTLIST (XDEVICE (device)); - int res = initialize_font_instance (f, name, font_list, hdc, errb); - DeleteDC (hdc); - return res; -} - -static int -msprinter_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name, - Lisp_Object device, Error_Behavior errb) -{ - HDC hdc = DEVICE_MSPRINTER_HDC (XDEVICE (device)); - Lisp_Object font_list = DEVICE_MSPRINTER_FONTLIST (XDEVICE (device)); - return initialize_font_instance (f, name, font_list, hdc, errb); -} - -static void -mswindows_finalize_font_instance (Lisp_Font_Instance *f) -{ - int i; - - if (f->data) - { - for (i = 0; i < MSWINDOWS_NUM_FONT_VARIANTS; i++) - { - if (FONT_INSTANCE_MSWINDOWS_HFONT_I (f, i) != NULL - && FONT_INSTANCE_MSWINDOWS_HFONT_I (f, i) != MSWINDOWS_BAD_HFONT) - DeleteObject (FONT_INSTANCE_MSWINDOWS_HFONT_I (f, i)); - } - - xfree (f->data); - f->data = 0; - } -} - -#if 0 -static void -mswindows_mark_font_instance (Lisp_Font_Instance *f) -{ -} -#endif - -static void -mswindows_print_font_instance (Lisp_Font_Instance *f, - Lisp_Object printcharfun, - int UNUSED (escapeflag)) -{ - write_fmt_string (printcharfun, " 0x%lx", - (unsigned long) - FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, 0, 0)); - -} - -static Lisp_Object -mswindows_font_list (Lisp_Object pattern, Lisp_Object device, - Lisp_Object UNUSED (maxnumber)) -{ - struct device *d = XDEVICE (device); - Lisp_Object font_list = Qnil, fonttail, result = Qnil; - - if (DEVICE_MSWINDOWS_P (d)) - font_list = DEVICE_MSWINDOWS_FONTLIST (d); - else if (DEVICE_MSPRINTER_P (d)) - font_list = DEVICE_MSPRINTER_FONTLIST (d); - else - ABORT (); - - LIST_LOOP (fonttail, font_list) - { - Ibyte fontname[MSW_FONTSIZE]; - - if (match_font (XSTRING_DATA (XCAR (XCAR (fonttail))), - XSTRING_DATA (pattern), - fontname)) - result = Fcons (build_istring (fontname), result); - } - - return Fnreverse (result); -} - -static Lisp_Object -mswindows_font_instance_truename (Lisp_Font_Instance *f, - Error_Behavior UNUSED (errb)) -{ - return f->truename; -} - -#ifdef MULE - -static int -mswindows_font_spec_matches_charset_stage_1 (struct device *UNUSED (d), - Lisp_Object charset, - const Ibyte *nonreloc, - Lisp_Object reloc, - Bytecount offset, - Bytecount length) -{ - int i; - Lisp_Object charset_registry; - const Ibyte *font_charset; - const Ibyte *the_nonreloc = nonreloc; - const Ibyte *c; - Bytecount the_length = length; - - if (NILP (charset)) - return 1; - - if (!the_nonreloc) - the_nonreloc = XSTRING_DATA (reloc); - fixup_internal_substring (nonreloc, reloc, offset, &the_length); - the_nonreloc += offset; - - c = the_nonreloc; - for (i = 0; i < 4; i++) - { - Ibyte *newc = (Ibyte *) memchr (c, ':', the_length); - if (!newc) - break; - newc++; - the_length -= (newc - c); - c = newc; - } - - if (i < 4) - return 0; - - font_charset = c; - - /* For border-glyph use */ - if (!qxestrcasecmp_ascii (font_charset, "symbol")) - font_charset = (const Ibyte *) "western"; - - /* Get code page for the charset */ - charset_registry = Fmswindows_charset_registry (charset); - if (!STRINGP (charset_registry)) - return 0; - - return !qxestrcasecmp (XSTRING_DATA (charset_registry), font_charset); -} - -/* - -#### The following comment is old and probably not applicable any longer. - -1. handle standard mapping and inheritance vectors properly in Face-frob-property. -2. finish impl of mswindows-charset-registry. -3. see if everything works under fixup, now that i copied the stuff over. -4. consider generalizing Face-frob-property to frob-specifier. -5. maybe extract some of the flets out of Face-frob-property as useful specifier frobbing. -6. eventually this stuff's got to be checked in!!!! -*/ - -static int -mswindows_font_spec_matches_charset_stage_2 (struct device *d, - Lisp_Object charset, - const Ibyte *nonreloc, - Lisp_Object reloc, - Bytecount offset, - Bytecount length) -{ - const Ibyte *the_nonreloc = nonreloc; - FONTSIGNATURE fs; - FONTSIGNATURE *fsp = &fs; - struct gcpro gcpro1; - Lisp_Object fontsig; - Bytecount the_length = length; - int i; - - if (NILP (charset)) - return 1; - - if (!the_nonreloc) - the_nonreloc = XSTRING_DATA (reloc); - fixup_internal_substring (nonreloc, reloc, offset, &the_length); - the_nonreloc += offset; - - /* Get the list of Unicode subranges corresponding to the font. This - is contained inside of FONTSIGNATURE data, obtained by calling - GetTextCharsetInfo on a font object, which we need to create from the - spec. See if the FONTSIGNATURE data is already cached. If not, get - it and cache it. */ - if (!STRINGP (reloc) || the_nonreloc != XSTRING_DATA (reloc)) - reloc = build_istring (the_nonreloc); - GCPRO1 (reloc); - fontsig = Fgethash (reloc, Vfont_signature_data, Qunbound); - - if (!UNBOUNDP (fontsig)) - { - fsp = (FONTSIGNATURE *) XOPAQUE_DATA (fontsig); - UNGCPRO; - } - else - { - HDC hdc = CreateCompatibleDC (NULL); - Lisp_Object font_list = Qnil, truename; - HFONT hfont; - - if (DEVICE_TYPE_P (d, mswindows)) - { - font_list = DEVICE_MSWINDOWS_FONTLIST (d); - } - else if (DEVICE_TYPE_P (d, msprinter)) - { - font_list = DEVICE_MSPRINTER_FONTLIST (d); - } - else - { - assert(0); - } - - hfont = create_hfont_from_font_spec (the_nonreloc, hdc, Qnil, - font_list, - ERROR_ME_DEBUG_WARN, - &truename); - - if (!hfont || !(hfont = (HFONT) SelectObject (hdc, hfont))) - { - nope: - DeleteDC (hdc); - UNGCPRO; - return 0; - } - - if (GetTextCharsetInfo (hdc, &fs, 0) == DEFAULT_CHARSET) - { - SelectObject (hdc, hfont); - goto nope; - } - SelectObject (hdc, hfont); - DeleteDC (hdc); - Fputhash (reloc, make_opaque (&fs, sizeof (fs)), Vfont_signature_data); - UNGCPRO; - } - - { - int lowlim, highlim; - int dim, j, cp = -1; - - /* Try to find a Unicode char in the charset. #### This is somewhat - bogus. See below. - - #### Cache me baby!!!!!!!!!!!!! - */ - get_charset_limits (charset, &lowlim, &highlim); - dim = XCHARSET_DIMENSION (charset); - - if (dim == 1) - { - for (i = lowlim; i <= highlim; i++) - if ((cp = ichar_to_unicode (make_ichar (charset, i, 0))) >= 0) - break; - } - else - { - for (i = lowlim; i <= highlim; i++) - for (j = lowlim; j <= highlim; j++) - if ((cp = ichar_to_unicode (make_ichar (charset, i, j))) >= 0) - break; - } - - if (cp < 0) - return 0; - - /* Check to see, for each subrange supported by the font, - whether the Unicode char is within that subrange. If any match, - the font supports the char (whereby, the charset, bogusly). */ - - for (i = 0; i < 128; i++) - { - if (fsp->fsUsb[i >> 5] & (1 << (i & 32))) - { - for (j = 0; j < unicode_subrange_table[i].no_subranges; j++) - if (cp >= unicode_subrange_table[i].subranges[j].start && - cp <= unicode_subrange_table[i].subranges[j].end) - return 1; - } - } - - return 0; - } -} - -/* - Given a truename font spec, does it match CHARSET? - - We try two stages: - - -- First see if the charset corresponds to one of the predefined Windows - charsets; if so, we see if the registry (that's the last element of the - font spec) is that same charset. If so, this means that the font is - specifically designed for the charset, and we prefer it. - - -- However, there are only a limited number of defined Windows charsets, - and new ones aren't being defined; so if we fail the first stage, we find - a character from the charset with a Unicode equivalent, and see if the - font can display this character. we do that by retrieving the Unicode - ranges that the font supports, to see if the character comes from that - subrange. - - #### Note: We really want to be doing all these checks at the character - level, not the charset level. There's no guarantee that a charset covers - a single Unicode range. Furthermore, this is extremely wasteful. We - should be doing this when we're about to redisplay and already have the - Unicode codepoints in hand. -*/ - -static int -mswindows_font_spec_matches_charset (struct device *d, Lisp_Object charset, - const Ibyte *nonreloc, - Lisp_Object reloc, - Bytecount offset, Bytecount length, - enum font_specifier_matchspec_stages stage) -{ - return stage == STAGE_FINAL ? - mswindows_font_spec_matches_charset_stage_2 (d, charset, nonreloc, - reloc, offset, length) - : mswindows_font_spec_matches_charset_stage_1 (d, charset, nonreloc, - reloc, offset, length); -} - - -/* Find a font spec that matches font spec FONT and also matches - (the registry of) CHARSET. */ - -static Lisp_Object -mswindows_find_charset_font (Lisp_Object device, Lisp_Object font, - Lisp_Object charset, - enum font_specifier_matchspec_stages stage) -{ - Lisp_Object fontlist, fonttail; - - /* If FONT specifies a particular charset, this will only list fonts with - that charset; otherwise, it will list fonts with all charsets. */ - fontlist = mswindows_font_list (font, device, Qnil); - - if (stage == STAGE_INITIAL) - { - LIST_LOOP (fonttail, fontlist) - { - if (mswindows_font_spec_matches_charset_stage_1 - (XDEVICE (device), charset, 0, XCAR (fonttail), 0, -1)) - return XCAR (fonttail); - } - } - else - { - LIST_LOOP (fonttail, fontlist) - { - if (mswindows_font_spec_matches_charset_stage_2 - (XDEVICE (device), charset, 0, XCAR (fonttail), 0, -1)) - return XCAR (fonttail); - } - } - - return Qnil; -} - -#endif /* MULE */ - - -/************************************************************************/ -/* non-methods */ -/************************************************************************/ - -static Lisp_Object -mswindows_color_list (void) -{ - Lisp_Object result = Qnil; - int i; - - for (i = 0; i < countof (mswindows_X_color_map); i++) - result = Fcons (build_ascstring (mswindows_X_color_map[i].name), result); - - return Fnreverse (result); -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_objects_mswindows (void) -{ -} - -void -console_type_create_objects_mswindows (void) -{ - /* object methods */ - CONSOLE_HAS_METHOD (mswindows, initialize_color_instance); -/* CONSOLE_HAS_METHOD (mswindows, mark_color_instance); */ - CONSOLE_HAS_METHOD (mswindows, print_color_instance); - CONSOLE_HAS_METHOD (mswindows, finalize_color_instance); - CONSOLE_HAS_METHOD (mswindows, color_instance_equal); - CONSOLE_HAS_METHOD (mswindows, color_instance_hash); - CONSOLE_HAS_METHOD (mswindows, color_instance_rgb_components); - CONSOLE_HAS_METHOD (mswindows, valid_color_name_p); - CONSOLE_HAS_METHOD (mswindows, color_list); - - CONSOLE_HAS_METHOD (mswindows, initialize_font_instance); -/* CONSOLE_HAS_METHOD (mswindows, mark_font_instance); */ - CONSOLE_HAS_METHOD (mswindows, print_font_instance); - CONSOLE_HAS_METHOD (mswindows, finalize_font_instance); - CONSOLE_HAS_METHOD (mswindows, font_instance_truename); - CONSOLE_HAS_METHOD (mswindows, font_list); -#ifdef MULE - CONSOLE_HAS_METHOD (mswindows, font_spec_matches_charset); - CONSOLE_HAS_METHOD (mswindows, find_charset_font); -#endif - - /* Printer methods - delegate most to windows methods, - since graphical objects behave the same way. */ - - CONSOLE_INHERITS_METHOD (msprinter, mswindows, initialize_color_instance); -/* CONSOLE_INHERITS_METHOD (msprinter, mswindows, mark_color_instance); */ - CONSOLE_INHERITS_METHOD (msprinter, mswindows, print_color_instance); - CONSOLE_INHERITS_METHOD (msprinter, mswindows, finalize_color_instance); - CONSOLE_INHERITS_METHOD (msprinter, mswindows, color_instance_equal); - CONSOLE_INHERITS_METHOD (msprinter, mswindows, color_instance_hash); - CONSOLE_INHERITS_METHOD (msprinter, mswindows, color_instance_rgb_components); - CONSOLE_INHERITS_METHOD (msprinter, mswindows, valid_color_name_p); - CONSOLE_INHERITS_METHOD (msprinter, mswindows, color_list); - - CONSOLE_HAS_METHOD (msprinter, initialize_font_instance); -/* CONSOLE_INHERITS_METHOD (msprinter, mswindows, mark_font_instance); */ - CONSOLE_INHERITS_METHOD (msprinter, mswindows, print_font_instance); - CONSOLE_INHERITS_METHOD (msprinter, mswindows, finalize_font_instance); - CONSOLE_INHERITS_METHOD (msprinter, mswindows, font_instance_truename); - CONSOLE_INHERITS_METHOD (msprinter, mswindows, font_list); -#ifdef MULE - CONSOLE_INHERITS_METHOD (msprinter, mswindows, font_spec_matches_charset); - CONSOLE_INHERITS_METHOD (msprinter, mswindows, find_charset_font); -#endif -} - -void -reinit_vars_of_object_mswindows (void) -{ -#ifdef MULE - int i; - - unicode_subrange_table = xnew_array_and_zero (unicode_subrange_t, 128); - for (i = 0; i < countof (unicode_subrange_raw_map); i++) - { - const unicode_subrange_raw_t *el = &unicode_subrange_raw_map[i]; - if (unicode_subrange_table[el->subrange_bit].subranges == 0) - unicode_subrange_table[el->subrange_bit].subranges = el; - unicode_subrange_table[el->subrange_bit].no_subranges++; - } - - Fclrhash (Vfont_signature_data); -#endif /* MULE */ -} - -void -vars_of_objects_mswindows (void) -{ -#ifdef MULE - Vfont_signature_data = - make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); - staticpro (&Vfont_signature_data); -#endif /* MULE */ -} diff -r 861f2601a38b -r 1f0b15040456 src/objects-msw.h --- a/src/objects-msw.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,42 +0,0 @@ -/* mswindows-specific Lisp objects. - Copyright (C) 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2002 Ben Wing. - Copyright (C) 1997, Jonathan Harris. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* Authorship: - - Ultimately based on FSF. - Rewritten by Ben Wing. - Rewritten for mswindows by Jonathan Harris, November 1997 for 21.0. - */ - - -#ifndef INCLUDED_objects_msw_h_ -#define INCLUDED_objects_msw_h_ - -#include "objects.h" - -HFONT mswindows_get_hfont (Lisp_Font_Instance *f, int under, int strike); -Lisp_Object mswindows_color_to_string (COLORREF color); - -#endif /* INCLUDED_objects_msw_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/objects-tty-impl.h --- a/src/objects-tty-impl.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,82 +0,0 @@ -/* TTY-specific Lisp objects. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995 Ben Wing - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -#ifndef INCLUDED_objects_tty_impl_h_ -#define INCLUDED_objects_tty_impl_h_ - -#include "objects-impl.h" -#include "objects-tty.h" - -struct tty_color_instance_data -{ -#ifdef NEW_GC - struct lrecord_header header; -#endif /* NEW_GC */ - Lisp_Object symbol; /* so we don't have to constantly call Fintern() */ -}; - -#ifdef NEW_GC -DECLARE_LRECORD (tty_color_instance_data, struct tty_color_instance_data); -#define XTTY_COLOR_INSTANCE_DATA(x) \ - XRECORD (x, tty_color_instance_data, struct tty_color_instance_data) -#define wrap_tty_color_instance_data(p) \ - wrap_record (p, tty_color_instance_data) -#define TTY_COLOR_INSTANCE_DATAP(x) RECORDP (x, tty_color_instance_data) -#define CHECK_TTY_COLOR_INSTANCE_DATA(x) \ - CHECK_RECORD (x, tty_color_instance_data) -#define CONCHECK_TTY_COLOR_INSTANCE_DATA(x) \ - CONCHECK_RECORD (x, tty_color_instance_data) -#endif /* NEW_GC */ - -#define TTY_COLOR_INSTANCE_DATA(c) \ - ((struct tty_color_instance_data *) (c)->data) - -#define COLOR_INSTANCE_TTY_SYMBOL(c) (TTY_COLOR_INSTANCE_DATA (c)->symbol) - -struct tty_font_instance_data -{ -#ifdef NEW_GC - struct lrecord_header header; -#endif /* NEW_GC */ - Lisp_Object charset; -}; - -#ifdef NEW_GC -DECLARE_LRECORD (tty_font_instance_data, struct tty_font_instance_data); -#define XTTY_FONT_INSTANCE_DATA(x) \ - XRECORD (x, tty_font_instance_data, struct tty_font_instance_data) -#define wrap_tty_font_instance_data(p) \ - wrap_record (p, tty_font_instance_data) -#define TTY_FONT_INSTANCE_DATAP(x) RECORDP (x, tty_font_instance_data) -#define CHECK_TTY_FONT_INSTANCE_DATA(x) \ - CHECK_RECORD (x, tty_font_instance_data) -#define CONCHECK_TTY_FONT_INSTANCE_DATA(x) \ - CONCHECK_RECORD (x, tty_font_instance_data) -#endif /* NEW_GC */ - -#define TTY_FONT_INSTANCE_DATA(c) \ - ((struct tty_font_instance_data *) (c)->data) - -#define FONT_INSTANCE_TTY_CHARSET(c) (TTY_FONT_INSTANCE_DATA (c)->charset) - -#endif /* INCLUDED_objects_tty_impl_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/objects-tty.c --- a/src/objects-tty.c Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,456 +0,0 @@ -/* TTY-specific Lisp objects. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2001, 2002, 2010 Ben Wing. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -#include -#include "lisp.h" - -#include "console-tty-impl.h" -#include "insdel.h" -#include "objects-tty-impl.h" -#include "device.h" -#include "charset.h" - -#ifdef NEW_GC -# define UNUSED_IF_NEW_GC(decl) UNUSED (decl) -#else -# define UNUSED_IF_NEW_GC(decl) decl -#endif - -/* An alist mapping from color names to a cons of (FG-STRING, BG-STRING). */ -Lisp_Object Vtty_color_alist; -#if 0 /* This stuff doesn't quite work yet */ -Lisp_Object Vtty_dynamic_color_fg; -Lisp_Object Vtty_dynamic_color_bg; -#endif - -static const struct memory_description tty_color_instance_data_description_1 [] = { - { XD_LISP_OBJECT, offsetof (struct tty_color_instance_data, symbol) }, - { XD_END } -}; - -#ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("tty-color-instance-data", - tty_color_instance_data, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - tty_color_instance_data_description_1, - struct tty_color_instance_data); -#else /* not NEW_GC */ -const struct sized_memory_description tty_color_instance_data_description = { - sizeof (struct tty_color_instance_data), tty_color_instance_data_description_1 -}; -#endif /* not NEW_GC */ - -static const struct memory_description tty_font_instance_data_description_1 [] = { - { XD_LISP_OBJECT, offsetof (struct tty_font_instance_data, charset) }, - { XD_END } -}; - -#ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("tty-font-instance-data", - tty_font_instance_data, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - tty_font_instance_data_description_1, - struct tty_font_instance_data); -#else /* not NEW_GC */ -const struct sized_memory_description tty_font_instance_data_description = { - sizeof (struct tty_font_instance_data), tty_font_instance_data_description_1 -}; -#endif /* not NEW_GC */ - -DEFUN ("register-tty-color", Fregister_tty_color, 3, 3, 0, /* -Register COLOR as a recognized TTY color. -COLOR should be a string. -Strings FG-STRING and BG-STRING should specify the escape sequences to - set the foreground and background to the given color, respectively. -*/ - (color, fg_string, bg_string)) -{ - CHECK_STRING (color); - CHECK_STRING (fg_string); - CHECK_STRING (bg_string); - - color = Fintern (color, Qnil); - Vtty_color_alist = Fremassq (color, Vtty_color_alist); - Vtty_color_alist = Fcons (Fcons (color, Fcons (fg_string, bg_string)), - Vtty_color_alist); - - return Qnil; -} - -DEFUN ("unregister-tty-color", Funregister_tty_color, 1, 1, 0, /* -Unregister COLOR as a recognized TTY color. -*/ - (color)) -{ - CHECK_STRING (color); - - color = Fintern (color, Qnil); - Vtty_color_alist = Fremassq (color, Vtty_color_alist); - return Qnil; -} - -DEFUN ("find-tty-color", Ffind_tty_color, 1, 1, 0, /* -Look up COLOR in the list of registered TTY colors. -If it is found, return a list (FG-STRING BG-STRING) of the escape -sequences used to set the foreground and background to the color, respectively. -If it is not found, return nil. -*/ - (color)) -{ - Lisp_Object result; - - CHECK_STRING (color); - - result = Fassq (Fintern (color, Qnil), Vtty_color_alist); - if (!NILP (result)) - return list2 (Fcar (Fcdr (result)), Fcdr (Fcdr (result))); - else - return Qnil; -} - -static Lisp_Object -tty_color_list (void) -{ - Lisp_Object result = Qnil; - Lisp_Object rest; - - LIST_LOOP (rest, Vtty_color_alist) - { - result = Fcons (Fsymbol_name (XCAR (XCAR (rest))), result); - } - - return Fnreverse (result); -} - -#if 0 - -/* This approach is too simplistic. The problem is that the - dynamic color settings apply to *all* text in the default color, - not just the text output after the escape sequence has been given. */ - -DEFUN ("set-tty-dynamic-color-specs", Fset_tty_dynamic_color_specs, 2, 2, 0, /* -Set the dynamic color specifications for TTY's. -FG and BG should be either nil or vaguely printf-like strings, -where each occurrence of %s is replaced with the color name and each -occurrence of %% is replaced with a single % character. -*/ - (fg, bg)) -{ - if (!NILP (fg)) - CHECK_STRING (fg); - if (!NILP (bg)) - CHECK_STRING (bg); - - Vtty_dynamic_color_fg = fg; - Vtty_dynamic_color_bg = bg; - - return Qnil; -} - -DEFUN ("tty-dynamic-color-specs", Ftty_dynamic_color_specs, 0, 0, 0, /* -Return the dynamic color specifications for TTY's as a list of (FG BG). -See `set-tty-dynamic-color-specs'. -*/ - ()) -{ - return list2 (Vtty_dynamic_color_fg, Vtty_dynamic_color_bg); -} - -#endif /* 0 */ - -static int -tty_initialize_color_instance (Lisp_Color_Instance *c, Lisp_Object name, - Lisp_Object UNUSED (device), - Error_Behavior UNUSED (errb)) -{ - Lisp_Object result; - - name = Fintern (name, Qnil); - result = assq_no_quit (name, Vtty_color_alist); - - if (NILP (result)) - { -#if 0 - if (!STRINGP (Vtty_dynamic_color_fg) - && !STRINGP (Vtty_dynamic_color_bg)) -#endif - return 0; - } - - /* Don't allocate the data until we're sure that we will succeed. */ -#ifdef NEW_GC - c->data = alloc_lrecord_type (struct tty_color_instance_data, - &lrecord_tty_color_instance_data); -#else /* not NEW_GC */ - c->data = xnew (struct tty_color_instance_data); -#endif /* not NEW_GC */ - COLOR_INSTANCE_TTY_SYMBOL (c) = name; - - return 1; -} - -static void -tty_mark_color_instance (Lisp_Color_Instance *c) -{ - mark_object (COLOR_INSTANCE_TTY_SYMBOL (c)); -} - -static void -tty_print_color_instance (Lisp_Color_Instance *UNUSED (c), - Lisp_Object UNUSED (printcharfun), - int UNUSED (escapeflag)) -{ -} - -static void -tty_finalize_color_instance (Lisp_Color_Instance *UNUSED_IF_NEW_GC (c)) -{ -#ifndef NEW_GC - if (c->data) - xfree (c->data); -#endif /* not NEW_GC */ -} - -static int -tty_color_instance_equal (Lisp_Color_Instance *c1, - Lisp_Color_Instance *c2, - int UNUSED (depth)) -{ - return (EQ (COLOR_INSTANCE_TTY_SYMBOL (c1), - COLOR_INSTANCE_TTY_SYMBOL (c2))); -} - -static Hashcode -tty_color_instance_hash (Lisp_Color_Instance *c, int UNUSED (depth)) -{ - return LISP_HASH (COLOR_INSTANCE_TTY_SYMBOL (c)); -} - -static int -tty_valid_color_name_p (struct device *UNUSED (d), Lisp_Object color) -{ - return (!NILP (assoc_no_quit (Fintern (color, Qnil), Vtty_color_alist))); -#if 0 - || STRINGP (Vtty_dynamic_color_fg) - || STRINGP (Vtty_dynamic_color_bg) -#endif -} - - -static int -tty_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name, - Lisp_Object UNUSED (device), - Error_Behavior UNUSED (errb)) -{ - Ibyte *str = XSTRING_DATA (name); - Lisp_Object charset = Qnil; - - if (qxestrncmp_ascii (str, "normal", 6)) - return 0; - str += 6; - if (*str) - { -#ifdef MULE - if (*str != '/') - return 0; - str++; - charset = Ffind_charset (intern_istring (str)); - if (NILP (charset)) - return 0; -#else - return 0; -#endif - } - - /* Don't allocate the data until we're sure that we will succeed. */ -#ifdef NEW_GC - f->data = alloc_lrecord_type (struct tty_font_instance_data, - &lrecord_tty_font_instance_data); -#else /* not NEW_GC */ - f->data = xnew (struct tty_font_instance_data); -#endif /* not NEW_GC */ - FONT_INSTANCE_TTY_CHARSET (f) = charset; -#ifdef MULE - if (CHARSETP (charset)) - f->width = XCHARSET_COLUMNS (charset); - else -#endif - f->width = 1; - - f->proportional_p = 0; - f->ascent = f->height = 1; - f->descent = 0; - - return 1; -} - -static void -tty_mark_font_instance (Lisp_Font_Instance *f) -{ - mark_object (FONT_INSTANCE_TTY_CHARSET (f)); -} - -static void -tty_print_font_instance (Lisp_Font_Instance *UNUSED (f), - Lisp_Object UNUSED (printcharfun), - int UNUSED (escapeflag)) -{ -} - -static void -tty_finalize_font_instance (Lisp_Font_Instance *UNUSED_IF_NEW_GC (f)) -{ -#ifndef NEW_GC - if (f->data) - xfree (f->data); -#endif /* not NEW_GC */ -} - -static Lisp_Object -tty_font_list (Lisp_Object UNUSED (pattern), Lisp_Object UNUSED (device), - Lisp_Object UNUSED (maxnumber)) -{ - return list1 (build_ascstring ("normal")); -} - -#ifdef MULE - -static int -tty_font_spec_matches_charset (struct device *UNUSED (d), Lisp_Object charset, - const Ibyte *nonreloc, Lisp_Object reloc, - Bytecount offset, Bytecount length, - enum font_specifier_matchspec_stages stage) -{ - const Ibyte *the_nonreloc = nonreloc; - - if (stage == STAGE_FINAL) - return 0; - - if (!the_nonreloc) - the_nonreloc = XSTRING_DATA (reloc); - fixup_internal_substring (nonreloc, reloc, offset, &length); - the_nonreloc += offset; - - if (NILP (charset)) - return !memchr (the_nonreloc, '/', length); - the_nonreloc = (const Ibyte *) memchr (the_nonreloc, '/', length); - if (!the_nonreloc) - return 0; - the_nonreloc++; - { - Lisp_Object s = symbol_name (XSYMBOL (XCHARSET_NAME (charset))); - return !qxestrcmp (the_nonreloc, XSTRING_DATA (s)); - } -} - -/* find a font spec that matches font spec FONT and also matches - (the registry of) CHARSET. */ -static Lisp_Object -tty_find_charset_font (Lisp_Object device, Lisp_Object font, - Lisp_Object charset, - enum font_specifier_matchspec_stages stage) -{ - Ibyte *fontname = XSTRING_DATA (font); - - if (stage == STAGE_FINAL) - return Qnil; - - if (strchr ((const char *) fontname, '/')) - { - if (tty_font_spec_matches_charset (XDEVICE (device), charset, 0, - font, 0, -1, STAGE_INITIAL)) - return font; - return Qnil; - } - - if (NILP (charset)) - return font; - - return concat3 (font, build_ascstring ("/"), - Fsymbol_name (XCHARSET_NAME (charset))); -} - -#endif /* MULE */ - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_objects_tty (void) -{ -#ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (tty_color_instance_data); - INIT_LRECORD_IMPLEMENTATION (tty_font_instance_data); -#endif /* NEW_GC */ - - DEFSUBR (Fregister_tty_color); - DEFSUBR (Funregister_tty_color); - DEFSUBR (Ffind_tty_color); -#if 0 - DEFSUBR (Fset_tty_dynamic_color_specs); - DEFSUBR (Ftty_dynamic_color_specs); -#endif -} - -void -console_type_create_objects_tty (void) -{ - /* object methods */ - CONSOLE_HAS_METHOD (tty, initialize_color_instance); - CONSOLE_HAS_METHOD (tty, mark_color_instance); - CONSOLE_HAS_METHOD (tty, print_color_instance); - CONSOLE_HAS_METHOD (tty, finalize_color_instance); - CONSOLE_HAS_METHOD (tty, color_instance_equal); - CONSOLE_HAS_METHOD (tty, color_instance_hash); - CONSOLE_HAS_METHOD (tty, valid_color_name_p); - CONSOLE_HAS_METHOD (tty, color_list); - - CONSOLE_HAS_METHOD (tty, initialize_font_instance); - CONSOLE_HAS_METHOD (tty, mark_font_instance); - CONSOLE_HAS_METHOD (tty, print_font_instance); - CONSOLE_HAS_METHOD (tty, finalize_font_instance); - CONSOLE_HAS_METHOD (tty, font_list); -#ifdef MULE - CONSOLE_HAS_METHOD (tty, font_spec_matches_charset); - CONSOLE_HAS_METHOD (tty, find_charset_font); -#endif -} - -void -vars_of_objects_tty (void) -{ - staticpro (&Vtty_color_alist); - Vtty_color_alist = Qnil; - -#if 0 - staticpro (&Vtty_dynamic_color_fg); - Vtty_dynamic_color_fg = Qnil; - - staticpro (&Vtty_dynamic_color_bg); - Vtty_dynamic_color_bg = Qnil; -#endif -} diff -r 861f2601a38b -r 1f0b15040456 src/objects-tty.h --- a/src/objects-tty.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,32 +0,0 @@ -/* TTY-specific Lisp objects. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995 Ben Wing - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -#ifndef INCLUDED_objects_tty_h_ -#define INCLUDED_objects_tty_h_ - -#include "objects.h" - -extern Lisp_Object Vtty_color_alist, Vtty_dynamic_color_bg; -extern Lisp_Object Vtty_dynamic_color_fg; - -#endif /* INCLUDED_objects_tty_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/objects-x-impl.h --- a/src/objects-x-impl.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,88 +0,0 @@ -/* X-specific Lisp objects. - Copyright (C) 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2002 Ben Wing. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* This file Mule-ized (more like Mule-verified) by Ben Wing, 7-10-00. */ - -#ifndef INCLUDED_objects_x_impl_h_ -#define INCLUDED_objects_x_impl_h_ - -#include "objects-impl.h" -#include "objects-x.h" -#ifdef HAVE_XFT -/* for resource name definitions, etc */ -#include "../lwlib/lwlib-fonts.h" -#endif - -#ifdef HAVE_X_WINDOWS - -/***************************************************************************** - Color-Instance - ****************************************************************************/ - -struct x_color_instance_data -{ - XColor color; - /* Yes, it looks crazy to have both the XColor and the XftColor, but - pragmatically both are used. */ -#ifdef HAVE_XFT - XftColor xftColor; -#endif - char dealloc_on_gc; -}; - -#define X_COLOR_INSTANCE_DATA(c) ((struct x_color_instance_data *) (c)->data) -#define COLOR_INSTANCE_X_COLOR(c) (X_COLOR_INSTANCE_DATA (c)->color) -#define XCOLOR_INSTANCE_X_COLOR(c) COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (c)) -#ifdef HAVE_XFT -#define COLOR_INSTANCE_X_XFTCOLOR(c) (X_COLOR_INSTANCE_DATA (c)->xftColor) -#endif -#define COLOR_INSTANCE_X_DEALLOC(c) (X_COLOR_INSTANCE_DATA (c)->dealloc_on_gc) - -/***************************************************************************** - Font-Instance - ****************************************************************************/ - -struct x_font_instance_data -{ - /* X-specific information */ - /* Yes, it looks crazy to have both the XFontStruct and the XftFont, but - pragmatically both are used (lwlib delegates labels to the widget sets, - which internally use XFontStructs). */ - XFontStruct * font; -#ifdef HAVE_XFT - XftFont *xftFont; -#endif - -}; - -#define X_FONT_INSTANCE_DATA(f) ((struct x_font_instance_data *) (f)->data) -#define FONT_INSTANCE_X_FONT(f) (X_FONT_INSTANCE_DATA (f)->font) -#define XFONT_INSTANCE_X_FONT(c) FONT_INSTANCE_X_FONT (XFONT_INSTANCE (c)) -#ifdef HAVE_XFT -#define FONT_INSTANCE_X_XFTFONT(f) (X_FONT_INSTANCE_DATA (f)->xftFont) -#endif - -#endif /* HAVE_X_WINDOWS */ - -#endif /* INCLUDED_objects_x_impl_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/objects-x.c --- a/src/objects-x.c Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,988 +0,0 @@ -/* X-specific Lisp objects. - Copyright (C) 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995 Tinker Systems. - Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004 Ben Wing. - Copyright (C) 1995 Sun Microsystems, Inc. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* Authors: Jamie Zawinski, Chuck Thompson, Ben Wing */ - -/* This file Mule-ized by Ben Wing, 7-10-00. */ - -#include -#include "lisp.h" - -#include "charset.h" -#include "device-impl.h" -#include "insdel.h" - -#include "console-x-impl.h" -#include "objects-x-impl.h" -#include "elhash.h" - -#ifdef HAVE_XFT -#include "font-mgr.h" -#endif - -int x_handle_non_fully_specified_fonts; - -#ifdef DEBUG_XEMACS -Fixnum debug_x_objects; -#endif /* DEBUG_XEMACS */ - - -/************************************************************************/ -/* color instances */ -/************************************************************************/ - -static int -x_parse_nearest_color (struct device *d, XColor *color, Lisp_Object name, - Error_Behavior errb) -{ - Display *dpy = DEVICE_X_DISPLAY (d); - Colormap cmap = DEVICE_X_COLORMAP (d); - Visual *visual = DEVICE_X_VISUAL (d); - int result; - - xzero (*color); - { - const Extbyte *extname; - - extname = LISP_STRING_TO_EXTERNAL (name, Qx_color_name_encoding); - result = XParseColor (dpy, cmap, extname, color); - } - if (!result) - { - maybe_signal_error (Qgui_error, "Unrecognized color", - name, Qcolor, errb); - return 0; - } - result = x_allocate_nearest_color (dpy, cmap, visual, color); - if (!result) - { - maybe_signal_error (Qgui_error, "Couldn't allocate color", - name, Qcolor, errb); - return 0; - } - - return result; -} - -static int -x_initialize_color_instance (Lisp_Color_Instance *c, Lisp_Object name, - Lisp_Object device, Error_Behavior errb) -{ - XColor color; -#ifdef HAVE_XFT - XftColor xftColor; -#endif - int result; - - result = x_parse_nearest_color (XDEVICE (device), &color, name, errb); - - if (!result) - return 0; - - /* Don't allocate the data until we're sure that we will succeed, - or the finalize method may get fucked. */ - c->data = xnew (struct x_color_instance_data); - if (result == 3) - COLOR_INSTANCE_X_DEALLOC (c) = 0; - else - COLOR_INSTANCE_X_DEALLOC (c) = 1; - COLOR_INSTANCE_X_COLOR (c) = color; - -#ifdef HAVE_XFT - xftColor.pixel = color.pixel; - xftColor.color.red = color.red; - xftColor.color.green = color.green; - xftColor.color.blue = color.blue; - xftColor.color.alpha = 0xffff; - - COLOR_INSTANCE_X_XFTCOLOR (c) = xftColor; -#endif - - return 1; -} - -static void -x_print_color_instance (Lisp_Color_Instance *c, - Lisp_Object printcharfun, - int UNUSED (escapeflag)) -{ - XColor color = COLOR_INSTANCE_X_COLOR (c); - write_fmt_string (printcharfun, " %ld=(%X,%X,%X)", - color.pixel, color.red, color.green, color.blue); -} - -static void -x_finalize_color_instance (Lisp_Color_Instance *c) -{ - if (c->data) - { - if (DEVICE_LIVE_P (XDEVICE (c->device))) - { - if (COLOR_INSTANCE_X_DEALLOC (c)) - { - XFreeColors (DEVICE_X_DISPLAY (XDEVICE (c->device)), - DEVICE_X_COLORMAP (XDEVICE (c->device)), - &COLOR_INSTANCE_X_COLOR (c).pixel, 1, 0); - } - } - xfree (c->data); - c->data = 0; - } -} - -/* Color instances are equal if they resolve to the same color on the - screen (have the same RGB values). I imagine that - "same RGB values" == "same cell in the colormap." Arguably we should - be comparing their names or pixel values instead. */ - -static int -x_color_instance_equal (Lisp_Color_Instance *c1, - Lisp_Color_Instance *c2, - int UNUSED (depth)) -{ - XColor color1 = COLOR_INSTANCE_X_COLOR (c1); - XColor color2 = COLOR_INSTANCE_X_COLOR (c2); - return ((color1.red == color2.red) && - (color1.green == color2.green) && - (color1.blue == color2.blue)); -} - -static Hashcode -x_color_instance_hash (Lisp_Color_Instance *c, int UNUSED (depth)) -{ - XColor color = COLOR_INSTANCE_X_COLOR (c); - return HASH3 (color.red, color.green, color.blue); -} - -static Lisp_Object -x_color_instance_rgb_components (Lisp_Color_Instance *c) -{ - XColor color = COLOR_INSTANCE_X_COLOR (c); - return (list3 (make_int (color.red), - make_int (color.green), - make_int (color.blue))); -} - -static int -x_valid_color_name_p (struct device *d, Lisp_Object color) -{ - XColor c; - Display *dpy = DEVICE_X_DISPLAY (d); - Colormap cmap = DEVICE_X_COLORMAP (d); - const Extbyte *extname; - - extname = LISP_STRING_TO_EXTERNAL (color, Qx_color_name_encoding); - - return XParseColor (dpy, cmap, extname, &c); -} - -static Lisp_Object -x_color_list (void) -{ - return call0 (intern ("x-color-list-internal")); -} - - -/************************************************************************/ -/* font instances */ -/************************************************************************/ - - -static int -x_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object UNUSED (name), - Lisp_Object device, Error_Behavior errb) -{ - Display *dpy = DEVICE_X_DISPLAY (XDEVICE (device)); - Extbyte *extname; - XFontStruct *fs = NULL; /* _F_ont _S_truct */ -#ifdef HAVE_XFT - XftFont *rf = NULL; /* _R_ender _F_ont (X Render extension) */ -#else -#define rf (0) -#endif - -#ifdef HAVE_XFT - DEBUG_XFT1 (2, "attempting to initialize font spec %s\n", - XSTRING_DATA(f->name)); - /* #### serialize (optimize) these later... */ - /* #### This function really needs to go away. - The problem is that the fontconfig/Xft functions work much too hard - to ensure that something is returned; but that something need not be - at all close to what we asked for. */ - extname = LISP_STRING_TO_EXTERNAL (f->name, Qfc_font_name_encoding); - rf = xft_open_font_by_name (dpy, extname); -#endif - extname = LISP_STRING_TO_EXTERNAL (f->name, Qx_font_name_encoding); - /* With XFree86 4.0's fonts, XListFonts returns an entry for - -isas-fangsong ti-medium-r-normal--16-160-72-72-c-160-gb2312.1980-0 but - an XLoadQueryFont on the corresponding XLFD returns NULL. - - XListFonts is not trustworthy (of course, this is news to exactly - no-one used to reading XEmacs source.) */ - fs = XLoadQueryFont (dpy, extname); - - if (!fs && !rf) - { - /* #### should this refer to X and/or Xft? */ - maybe_signal_error (Qgui_error, "Couldn't load font", f->name, - Qfont, errb); - return 0; - } - - if (rf && fs) - { - XFreeFont (dpy, fs); - fs = NULL; /* we don' need no steenkin' X font */ - } - - if (fs && !fs->max_bounds.width) - { - /* yes, this has been known to happen. */ - XFreeFont (dpy, fs); - fs = NULL; - maybe_signal_error (Qgui_error, "X font is too small", f->name, Qfont, - errb); - return 0; - } - - /* Now that we're sure that we will succeed, we can allocate data without - fear that the finalize method may get fucked. */ - f->data = xnew (struct x_font_instance_data); - -#ifdef HAVE_XFT - FONT_INSTANCE_X_XFTFONT (f) = rf; - if (rf) - /* Have an Xft font, initialize font info from it. */ - { - DEBUG_XFT4 (2, "pre-initial ascent %d descent %d width %d height %d\n", - f->ascent, f->descent, f->width, f->height); - - /* #### This shit is just plain wrong unless we have a character cell - font. It really hoses us on large repertoire Unicode fonts with - "double-width" characters. */ - f->ascent = rf->ascent; - f->descent = rf->descent; - { - /* This is an approximation that AFAIK only gets used to compute - cell size for estimating window dimensions. The test_string8 - is an ASCII string whose characters should approximate the - distribution of widths expected in real text. */ - static const FcChar8 test_string8[] = "Mmneei"; - static const int len = sizeof (test_string8) - 1; - XGlyphInfo glyphinfo; - - XftTextExtents8 (dpy, rf, test_string8, len, &glyphinfo); - /* #### maybe should be glyphinfo.xOff - glyphinfo.x? */ - f->width = (2*glyphinfo.width + len)/(2*len); - } - f->height = rf->height; - f->proportional_p = 1; /* we can't recognize monospaced fonts! */ - - /* #### This message appears wa-a-ay too often! - We probably need to cache truenames or something? - Even if Xft does it for us, we cons too many font instances. */ - DEBUG_XFT4 (0, - "initialized metrics ascent %d descent %d width %d height %d\n", - f->ascent, f->descent, f->width, f->height); - } - else - { - DEBUG_XFT1 (0, "couldn't initialize Xft font %s\n", - XSTRING_DATA(f->name)); - } -#endif - - FONT_INSTANCE_X_FONT (f) = fs; - if (fs) - /* Have to use a core font, initialize font info from it. */ - { - f->ascent = fs->ascent; - f->descent = fs->descent; - f->height = fs->ascent + fs->descent; - { - /* following change suggested by Ted Phelps */ - int def_char = 'n'; /*fs->default_char;*/ - int byte1, byte2; - - once_more: - byte1 = def_char >> 8; - byte2 = def_char & 0xFF; - - if (fs->per_char) - { - /* Old versions of the R5 font server have garbage (>63k) as - def_char. 'n' might not be a valid character. */ - if (byte1 < (int) fs->min_byte1 || - byte1 > (int) fs->max_byte1 || - byte2 < (int) fs->min_char_or_byte2 || - byte2 > (int) fs->max_char_or_byte2) - f->width = 0; - else - f->width = fs->per_char[(byte1 - fs->min_byte1) * - (fs->max_char_or_byte2 - - fs->min_char_or_byte2 + 1) + - (byte2 - fs->min_char_or_byte2)].width; - } - else - f->width = fs->max_bounds.width; - - /* Some fonts have a default char whose width is 0. This is no good. - If that's the case, first try 'n' as the default char, and if n has - 0 width too (unlikely) then just use the max width. */ - if (f->width == 0) - { - if (def_char == (int) fs->default_char) - f->width = fs->max_bounds.width; - else - { - def_char = fs->default_char; - goto once_more; - } - } - } - - /* If all characters don't exist then there could potentially be - 0-width characters lurking out there. Not setting this flag - trips an optimization that would make them appear to have width - to redisplay. This is bad. So we set it if not all characters - have the same width or if not all characters are defined. */ - /* #### This sucks. There is a measurable performance increase - when using proportional width fonts if this flag is not set. - Unfortunately so many of the fucking X fonts are not fully - defined that we could almost just get rid of this damn flag and - make it an assertion. */ - f->proportional_p = (fs->min_bounds.width != fs->max_bounds.width || - (x_handle_non_fully_specified_fonts && - !fs->all_chars_exist)); - } - -#ifdef HAVE_XFT - if (debug_xft > 0) - { - int n = 3, d = 5; - /* check for weirdness */ - if (n * f->height < d * f->width) - stderr_out ("font %s: width:height is %d:%d, larger than %d:%d\n", - XSTRING_DATA(f->name), f->width, f->height, n, d); - if (f->height <= 0 || f->width <= 0) - stderr_out ("bogus dimensions of font %s: width = %d, height = %d\n", - XSTRING_DATA(f->name), f->width, f->height); - stderr_out ("initialized font %s\n", XSTRING_DATA(f->name)); - } -#else -#undef rf -#endif - - return 1; -} - -static void -x_print_font_instance (Lisp_Font_Instance *f, - Lisp_Object printcharfun, - int UNUSED (escapeflag)) -{ - /* We should print information here about initial vs. final stages; we - can't rely on the device charset stage cache for that, - unfortunately. */ - if (FONT_INSTANCE_X_FONT (f)) - write_fmt_string (printcharfun, " font id: 0x%lx,", - (unsigned long) FONT_INSTANCE_X_FONT (f)->fid); - -#ifdef HAVE_XFT - /* #### What should we do here? For now, print the address. */ - if (FONT_INSTANCE_X_XFTFONT (f)) - write_fmt_string (printcharfun, " xft font: 0x%lx", - (unsigned long) FONT_INSTANCE_X_XFTFONT (f)); -#endif -} - -static void -x_finalize_font_instance (Lisp_Font_Instance *f) -{ - -#ifdef HAVE_XFT - DEBUG_XFT1 (0, "finalizing %s\n", (STRINGP (f->name) - ? (char *) XSTRING_DATA (f->name) - : "(unnamed font)")); -#endif - - if (f->data) - { - if (DEVICE_LIVE_P (XDEVICE (f->device))) - { - Display *dpy = DEVICE_X_DISPLAY (XDEVICE (f->device)); - - if (FONT_INSTANCE_X_FONT (f)) - XFreeFont (dpy, FONT_INSTANCE_X_FONT (f)); -#ifdef HAVE_XFT - if (FONT_INSTANCE_X_XFTFONT (f)) - XftFontClose (dpy, FONT_INSTANCE_X_XFTFONT (f)); -#endif - } - xfree (f->data); - f->data = 0; - } -} - -/* Determining the truename of a font is hard. (Big surprise.) - - This is not true for fontconfig. Each font has a (nearly) canonical - representation up to permutation of the order of properties. It is - possible to construct a name which exactly identifies the properties of - the current font. However, it is theoretically possible that there exists - another font with a super set of those properties that would happen to get - selected. -- sjt - - By "truename" we mean an XLFD-form name which contains no wildcards, yet - which resolves to *exactly* the same font as the one which we already have - the (probably wildcarded) name and `XFontStruct' of. - - One might think that the first font returned by XListFonts would be the one - that XOpenFont would pick. Apparently this is the case on some servers, - but not on others. It would seem not to be specified. - - The MIT R5 server sometimes appears to be picking the lexicographically - smallest font which matches the name (thus picking "adobe" fonts before - "bitstream" fonts even if the bitstream fonts are earlier in the path, and - also picking 100dpi adobe fonts over 75dpi adobe fonts even though the - 75dpi are in the path earlier) but sometimes appears to be doing something - else entirely (for example, removing the bitstream fonts from the path will - cause the 75dpi adobe fonts to be used instead of the 100dpi, even though - their relative positions in the path (and their names!) have not changed). - - The documentation for XSetFontPath() seems to indicate that the order of - entries in the font path means something, but it's pretty noncommittal about - it, and the spirit of the law is apparently not being obeyed... - - All the fonts I've seen have a property named `FONT' which contains the - truename of the font. However, there are two problems with using this: the - first is that the X Protocol Document is quite explicit that all properties - are optional, so we can't depend on it being there. The second is that - it's conceivable that this alleged truename isn't actually accessible as a - font, due to some difference of opinion between the font designers and - whoever installed the font on the system. - - So, our first attempt is to look for a FONT property, and then verify that - the name there is a valid name by running XListFonts on it. There's still - the potential that this could be true but we could still be being lied to, - but that seems pretty remote. - - Late breaking news: I've gotten reports that SunOS 4.1.3U1 - with OpenWound 3.0 has a font whose truename is really - "-Adobe-Courier-Medium-R-Normal--12-120-75-75-M-70-ISO8859-1" - but whose FONT property contains "Courier". - - So we disbelieve the FONT property unless it begins with a dash and - is more than 30 characters long. X Windows: The defacto substandard. - X Windows: Complex nonsolutions to simple nonproblems. X Windows: - Live the nightmare. - - If the FONT property doesn't exist, then we try and construct an XLFD name - out of the other font properties (FOUNDRY, FAMILY_NAME, WEIGHT_NAME, etc). - This is necessary at least for some versions of OpenWound. But who knows - what the future will bring. - - If that doesn't work, then we use XListFonts and either take the first font - (which I think is the most sensible thing) or we find the lexicographically - least, depending on whether the preprocessor constant `XOPENFONT_SORTS' is - defined. This sucks because the two behaviors are a property of the server - being used, not the architecture on which emacs has been compiled. Also, - as I described above, sorting isn't ALWAYS what the server does. Really it - does something seemingly random. There is no reliable way to win if the - FONT property isn't present. - - Another possibility which I haven't bothered to implement would be to map - over all of the matching fonts and find the first one that has the same - character metrics as the font we already have loaded. Even if this didn't - return exactly the same font, it would at least return one whose characters - were the same sizes, which would probably be good enough. - - More late-breaking news: on RS/6000 AIX 3.2.4, the expression - XLoadQueryFont (dpy, "-*-Fixed-Medium-R-*-*-*-130-75-75-*-*-ISO8859-1") - actually returns the font - -Misc-Fixed-Medium-R-Normal--13-120-75-75-C-80-ISO8859-1 - which is crazy, because that font doesn't even match that pattern! It is - also not included in the output produced by `xlsfonts' with that pattern. - - So this is yet another example of XListFonts() and XOpenFont() using - completely different algorithms. This, however, is a goofier example of - this bug, because in this case, it's not just the search order that is - different -- the sets don't even intersect. - - If anyone has any better ideas how to do this, or any insights on what it is - that the various servers are actually doing, please let me know! -- jwz. */ - -static int -valid_x_font_name_p (Display *dpy, Extbyte *name) -{ - /* Maybe this should be implemented by calling XLoadFont and trapping - the error. That would be a lot of work, and wasteful as hell, but - might be more correct. - */ - int nnames = 0; - Extbyte **names = 0; - if (! name) - return 0; - names = XListFonts (dpy, name, 1, &nnames); - if (names) - XFreeFontNames (names); - return (nnames != 0); -} - -static Extbyte * -truename_via_FONT_prop (Display *dpy, XFontStruct *font) -{ - unsigned long value = 0; - Extbyte *result = 0; - if (XGetFontProperty (font, XA_FONT, &value)) - result = XGetAtomName (dpy, value); - /* result is now 0, or the string value of the FONT property. */ - if (result) - { - /* Verify that result is an XLFD name (roughly...) */ - if (result [0] != '-' || strlen (result) < 30) - { - XFree (result); - result = 0; - } - } - return result; /* this must be freed by caller if non-0 */ -} - -static Extbyte * -truename_via_random_props (Display *dpy, XFontStruct *font) -{ - struct device *d = get_device_from_display (dpy); - unsigned long value = 0; - Extbyte *foundry, *family, *weight, *slant, *setwidth, *add_style; - unsigned long pixel, point, res_x, res_y; - Extbyte *spacing; - unsigned long avg_width; - Extbyte *registry, *encoding; - Extbyte composed_name [2048]; - int ok = 0; - Extbyte *result; - -#define get_string(atom,var) \ - if (XGetFontProperty (font, (atom), &value)) \ - var = XGetAtomName (dpy, value); \ - else { \ - var = 0; \ - goto FAIL; } -#define get_number(atom,var) \ - if (!XGetFontProperty (font, (atom), &var) || \ - var > 999) \ - goto FAIL; - - foundry = family = weight = slant = setwidth = 0; - add_style = spacing = registry = encoding = 0; - - get_string (DEVICE_XATOM_FOUNDRY (d), foundry); - get_string (DEVICE_XATOM_FAMILY_NAME (d), family); - get_string (DEVICE_XATOM_WEIGHT_NAME (d), weight); - get_string (DEVICE_XATOM_SLANT (d), slant); - get_string (DEVICE_XATOM_SETWIDTH_NAME (d), setwidth); - get_string (DEVICE_XATOM_ADD_STYLE_NAME (d), add_style); - get_number (DEVICE_XATOM_PIXEL_SIZE (d), pixel); - get_number (DEVICE_XATOM_POINT_SIZE (d), point); - get_number (DEVICE_XATOM_RESOLUTION_X (d), res_x); - get_number (DEVICE_XATOM_RESOLUTION_Y (d), res_y); - get_string (DEVICE_XATOM_SPACING (d), spacing); - get_number (DEVICE_XATOM_AVERAGE_WIDTH (d), avg_width); - get_string (DEVICE_XATOM_CHARSET_REGISTRY (d), registry); - get_string (DEVICE_XATOM_CHARSET_ENCODING (d), encoding); -#undef get_number -#undef get_string - - sprintf (composed_name, - "-%s-%s-%s-%s-%s-%s-%ld-%ld-%ld-%ld-%s-%ld-%s-%s", - foundry, family, weight, slant, setwidth, add_style, pixel, - point, res_x, res_y, spacing, avg_width, registry, encoding); - ok = 1; - - FAIL: - if (ok) - { - int L = strlen (composed_name) + 1; - result = xnew_extbytes (L); - strncpy (result, composed_name, L); - } - else - result = 0; - - if (foundry) XFree (foundry); - if (family) XFree (family); - if (weight) XFree (weight); - if (slant) XFree (slant); - if (setwidth) XFree (setwidth); - if (add_style) XFree (add_style); - if (spacing) XFree (spacing); - if (registry) XFree (registry); - if (encoding) XFree (encoding); - - return result; -} - -/* XListFonts doesn't allocate memory unconditionally based on this. (For - XFree86 in 2005, at least. */ -#define MAX_FONT_COUNT INT_MAX - -static Extbyte * -truename_via_XListFonts (Display *dpy, Extbyte *font_name) -{ - Extbyte *result = 0; - Extbyte **names; - int count = 0; - -#ifndef XOPENFONT_SORTS - /* In a sensible world, the first font returned by XListFonts() - would be the font that XOpenFont() would use. */ - names = XListFonts (dpy, font_name, 1, &count); - if (count) result = names [0]; -#else - /* But the world I live in is much more perverse. */ - names = XListFonts (dpy, font_name, MAX_FONT_COUNT, &count); - /* Find the lexicographic minimum of names[]. - (#### Should we be comparing case-insensitively?) */ - while (count--) - /* [[ !!#### Not Mule-friendly ]] - Doesn't matter, XLFDs are HPC (old) or Latin1 (modern). If they - aren't, who knows what they are? -- sjt */ - if (result == 0 || (strcmp (result, names [count]) < 0)) - result = names [count]; -#endif - - if (result) - result = xstrdup (result); - if (names) - XFreeFontNames (names); - - return result; /* this must be freed by caller if non-0 */ -} - -static Lisp_Object -x_font_truename (Display *dpy, Extbyte *name, XFontStruct *font) -{ - Extbyte *truename_FONT = 0; - Extbyte *truename_random = 0; - Extbyte *truename = 0; - - /* The search order is: - - if FONT property exists, and is a valid name, return it. - - if the other props exist, and add up to a valid name, return it. - - if we find a matching name with XListFonts, return it. - - if FONT property exists, return it regardless. - - if other props exist, return the resultant name regardless. - - else return 0. - */ - - truename = truename_FONT = truename_via_FONT_prop (dpy, font); - if (truename && !valid_x_font_name_p (dpy, truename)) - truename = 0; - if (!truename) - truename = truename_random = truename_via_random_props (dpy, font); - if (truename && !valid_x_font_name_p (dpy, truename)) - truename = 0; - if (!truename && name) - truename = truename_via_XListFonts (dpy, name); - - if (!truename) - { - /* Gag - we weren't able to find a seemingly-valid truename. - Well, maybe we're on one of those braindead systems where - XListFonts() and XLoadFont() are in violent disagreement. - If we were able to compute a truename, try using that even - if evidence suggests that it's not a valid name - because - maybe it is, really, and that's better than nothing. - X Windows: You'll envy the dead. - */ - if (truename_FONT) - truename = truename_FONT; - else if (truename_random) - truename = truename_random; - } - - /* One or both of these are not being used - free them. */ - if (truename_FONT && truename_FONT != truename) - XFree (truename_FONT); - if (truename_random && truename_random != truename) - XFree (truename_random); - - if (truename) - { - Lisp_Object result = build_extstring (truename, Qx_font_name_encoding); - XFree (truename); - return result; - } - else - return Qnil; -} - -static Lisp_Object -x_font_instance_truename (Lisp_Font_Instance *f, Error_Behavior errb) -{ - struct device *d = XDEVICE (f->device); - Display *dpy = DEVICE_X_DISPLAY (d); - Extbyte *nameext; - - /* #### restructure this so that we return a valid truename at the end, - and otherwise only return when we return something desperate that - doesn't get stored for future use. */ - -#ifdef HAVE_XFT - /* First, try an Xft font. */ - if (NILP (FONT_INSTANCE_TRUENAME (f)) && FONT_INSTANCE_X_XFTFONT (f)) - { - /* The font is already open, we just unparse. */ - FcChar8 *res = FcNameUnparse (FONT_INSTANCE_X_XFTFONT (f)->pattern); - if (! FONT_INSTANCE_X_XFTFONT (f)->pattern) - { - maybe_signal_error (Qgui_error, - "Xft font present but lacks pattern", - wrap_font_instance(f), Qfont, errb); - } - if (res) - { - FONT_INSTANCE_TRUENAME (f) = - build_extstring ((Extbyte *) res, Qfc_font_name_encoding); - free (res); - return FONT_INSTANCE_TRUENAME (f); - } - else - { - maybe_signal_error (Qgui_error, - "Couldn't unparse Xft font to truename", - wrap_font_instance(f), Qfont, errb); - /* used to return Qnil here */ - } - } -#endif /* HAVE_XFT */ - - /* OK, fall back to core font. */ - if (NILP (FONT_INSTANCE_TRUENAME (f)) - && FONT_INSTANCE_X_FONT (f)) - { - nameext = LISP_STRING_TO_EXTERNAL (f->name, Qx_font_name_encoding); - FONT_INSTANCE_TRUENAME (f) = - x_font_truename (dpy, nameext, FONT_INSTANCE_X_FONT (f)); - } - - if (NILP (FONT_INSTANCE_TRUENAME (f))) - { - /* Urk, no luck. Whine about our bad luck and exit. */ - Lisp_Object font_instance = wrap_font_instance (f); - - - maybe_signal_error (Qgui_error, "Couldn't determine font truename", - font_instance, Qfont, errb); - /* Ok, just this once, return the font name as the truename. - (This is only used by Fequal() right now.) */ - return f->name; - } - - /* Return what we found. */ - return FONT_INSTANCE_TRUENAME (f); -} - -static Lisp_Object -x_font_instance_properties (Lisp_Font_Instance *f) -{ - struct device *d = XDEVICE (f->device); - int i; - Lisp_Object result = Qnil; - Display *dpy = DEVICE_X_DISPLAY (d); - XFontProp *props = NULL; - - /* #### really should hack Xft fonts, too - Strategy: fontconfig must have an iterator for this purpose. */ - if (! FONT_INSTANCE_X_FONT (f)) return result; - - props = FONT_INSTANCE_X_FONT (f)->properties; - for (i = FONT_INSTANCE_X_FONT (f)->n_properties - 1; i >= 0; i--) - { - Lisp_Object name, value; - Atom atom = props [i].name; - Ibyte *name_str = 0; - Bytecount name_len; - Extbyte *namestrext = XGetAtomName (dpy, atom); - - if (namestrext) - TO_INTERNAL_FORMAT (C_STRING, namestrext, - ALLOCA, (name_str, name_len), - Qx_atom_name_encoding); - - name = (name_str ? intern_istring (name_str) : Qnil); - if (name_str && - (atom == XA_FONT || - atom == DEVICE_XATOM_FOUNDRY (d) || - atom == DEVICE_XATOM_FAMILY_NAME (d) || - atom == DEVICE_XATOM_WEIGHT_NAME (d) || - atom == DEVICE_XATOM_SLANT (d) || - atom == DEVICE_XATOM_SETWIDTH_NAME (d) || - atom == DEVICE_XATOM_ADD_STYLE_NAME (d) || - atom == DEVICE_XATOM_SPACING (d) || - atom == DEVICE_XATOM_CHARSET_REGISTRY (d) || - atom == DEVICE_XATOM_CHARSET_ENCODING (d) || - !qxestrcmp_ascii (name_str, "CHARSET_COLLECTIONS") || - !qxestrcmp_ascii (name_str, "FONTNAME_REGISTRY") || - !qxestrcmp_ascii (name_str, "CLASSIFICATION") || - !qxestrcmp_ascii (name_str, "COPYRIGHT") || - !qxestrcmp_ascii (name_str, "DEVICE_FONT_NAME") || - !qxestrcmp_ascii (name_str, "FULL_NAME") || - !qxestrcmp_ascii (name_str, "MONOSPACED") || - !qxestrcmp_ascii (name_str, "QUALITY") || - !qxestrcmp_ascii (name_str, "RELATIVE_SET") || - !qxestrcmp_ascii (name_str, "RELATIVE_WEIGHT") || - !qxestrcmp_ascii (name_str, "STYLE"))) - { - Extbyte *val_str = XGetAtomName (dpy, props [i].card32); - - value = (val_str ? build_extstring (val_str, Qx_atom_name_encoding) - : Qnil); - } - else - value = make_int (props [i].card32); - if (namestrext) XFree (namestrext); - result = Fcons (Fcons (name, value), result); - } - return result; -} - -static Lisp_Object -x_font_list (Lisp_Object pattern, Lisp_Object device, Lisp_Object maxnumber) -{ - Extbyte **names; - int count = 0; - int max_number = MAX_FONT_COUNT; - Lisp_Object result = Qnil; - const Extbyte *patternext; - - patternext = LISP_STRING_TO_EXTERNAL (pattern, Qx_font_name_encoding); - - if (!NILP(maxnumber) && INTP(maxnumber)) - { - max_number = XINT(maxnumber); - } - - names = XListFonts (DEVICE_X_DISPLAY (XDEVICE (device)), - patternext, max_number, &count); - while (count--) - result = Fcons (build_extstring (names[count], Qx_font_name_encoding), - result); - if (names) - XFreeFontNames (names); - return result; -} - -/* Include the charset support, shared, for the moment, with GTK. */ -#define THIS_IS_X -#include "objects-xlike-inc.c" - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_objects_x (void) -{ -} - -void -console_type_create_objects_x (void) -{ - /* object methods */ - - CONSOLE_HAS_METHOD (x, initialize_color_instance); - CONSOLE_HAS_METHOD (x, print_color_instance); - CONSOLE_HAS_METHOD (x, finalize_color_instance); - CONSOLE_HAS_METHOD (x, color_instance_equal); - CONSOLE_HAS_METHOD (x, color_instance_hash); - CONSOLE_HAS_METHOD (x, color_instance_rgb_components); - CONSOLE_HAS_METHOD (x, valid_color_name_p); - CONSOLE_HAS_METHOD (x, color_list); - - CONSOLE_HAS_METHOD (x, initialize_font_instance); - CONSOLE_HAS_METHOD (x, print_font_instance); - CONSOLE_HAS_METHOD (x, finalize_font_instance); - CONSOLE_HAS_METHOD (x, font_instance_truename); - CONSOLE_HAS_METHOD (x, font_instance_properties); - CONSOLE_HAS_METHOD (x, font_list); -#ifdef MULE - CONSOLE_HAS_METHOD (x, find_charset_font); - CONSOLE_HAS_METHOD (x, font_spec_matches_charset); -#endif -} - -void -vars_of_objects_x (void) -{ -#ifdef DEBUG_XEMACS - DEFVAR_INT ("debug-x-objects", &debug_x_objects /* -If non-zero, display debug information about X objects -*/ ); - debug_x_objects = 0; -#endif - - DEFVAR_BOOL ("x-handle-non-fully-specified-fonts", - &x_handle_non_fully_specified_fonts /* -If this is true then fonts which do not have all characters specified -will be considered to be proportional width even if they are actually -fixed-width. If this is not done then characters which are supposed to -have 0 width may appear to actually have some width. - -Note: While setting this to t guarantees correct output in all -circumstances, it also causes a noticeable performance hit when using -fixed-width fonts. Since most people don't use characters which could -cause problems this is set to nil by default. -*/ ); - x_handle_non_fully_specified_fonts = 0; - -#ifdef HAVE_XFT - Fprovide (intern ("xft-fonts")); -#endif -} - -void -Xatoms_of_objects_x (struct device *d) -{ - Display *D = DEVICE_X_DISPLAY (d); - - DEVICE_XATOM_FOUNDRY (d) = XInternAtom (D, "FOUNDRY", False); - DEVICE_XATOM_FAMILY_NAME (d) = XInternAtom (D, "FAMILY_NAME", False); - DEVICE_XATOM_WEIGHT_NAME (d) = XInternAtom (D, "WEIGHT_NAME", False); - DEVICE_XATOM_SLANT (d) = XInternAtom (D, "SLANT", False); - DEVICE_XATOM_SETWIDTH_NAME (d) = XInternAtom (D, "SETWIDTH_NAME", False); - DEVICE_XATOM_ADD_STYLE_NAME (d) = XInternAtom (D, "ADD_STYLE_NAME", False); - DEVICE_XATOM_PIXEL_SIZE (d) = XInternAtom (D, "PIXEL_SIZE", False); - DEVICE_XATOM_POINT_SIZE (d) = XInternAtom (D, "POINT_SIZE", False); - DEVICE_XATOM_RESOLUTION_X (d) = XInternAtom (D, "RESOLUTION_X", False); - DEVICE_XATOM_RESOLUTION_Y (d) = XInternAtom (D, "RESOLUTION_Y", False); - DEVICE_XATOM_SPACING (d) = XInternAtom (D, "SPACING", False); - DEVICE_XATOM_AVERAGE_WIDTH (d) = XInternAtom (D, "AVERAGE_WIDTH", False); - DEVICE_XATOM_CHARSET_REGISTRY(d) = XInternAtom (D, "CHARSET_REGISTRY",False); - DEVICE_XATOM_CHARSET_ENCODING(d) = XInternAtom (D, "CHARSET_ENCODING",False); -} diff -r 861f2601a38b -r 1f0b15040456 src/objects-x.h --- a/src/objects-x.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,43 +0,0 @@ -/* X-specific Lisp objects. - Copyright (C) 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2002 Ben Wing. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* This file Mule-ized (more like Mule-verified) by Ben Wing, 7-10-00. */ - -#ifndef INCLUDED_objects_x_h_ -#define INCLUDED_objects_x_h_ - -#include "objects.h" -#include "../lwlib/lwlib-colors.h" /* for x_allocate_nearest_color */ - -#ifdef HAVE_X_WINDOWS - -#ifdef HAVE_XFT -EXFUN (Ffc_font_real_pattern, 2); -#endif - -/* Lisp_Object Fxlfd_font_name_p; */ - -#endif /* HAVE_X_WINDOWS */ - -#endif /* INCLUDED_objects_x_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/objects-xlike-inc.c --- a/src/objects-xlike-inc.c Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,878 +0,0 @@ -/* Common code between X and GTK -- fonts and colors. - Copyright (C) 1991-5, 1997 Free Software Foundation, Inc. - Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1996, 2001, 2002, 2003, 2010 Ben Wing. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* Before including this file, you need to define either THIS_IS_X or - THIS_IS_GTK. */ - -/* See comment at top of console-xlike-inc.h for an explanation of - how this file works. */ - -/* Pango is ready for prime-time now, as far as I understand it. The GTK - people should be using that. Oh well. (Aidan Kehoe, Sat Nov 4 12:41:12 - CET 2006) */ - -#include "console-xlike-inc.h" - -#if defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901) - -#ifdef DEBUG_XEMACS -# define DEBUG_OBJECTS(FORMAT, ...) \ - do { if (debug_x_objects) stderr_out(FORMAT, __VA_ARGS__); } while (0) -#else /* DEBUG_XEMACS */ -# define DEBUG_OBJECTS(format, ...) -#endif /* DEBUG_XEMACS */ - -#elif defined(__GNUC__) - -#ifdef DEBUG_XEMACS -# define DEBUG_OBJECTS(format, args...) \ - do { if (debug_x_objects) stderr_out(format, args ); } while (0) -#else /* DEBUG_XEMACS */ -# define DEBUG_OBJECTS(format, args...) -#endif /* DEBUG_XEMACS */ - -#else /* defined(__STDC_VERSION__) [...] */ -# define DEBUG_OBJECTS (void) -#endif - -#ifdef MULE - -/* For some code it's reasonable to have only one copy and conditionalize - at run-time. For other code it isn't. */ - -static int -count_hyphens(const Ibyte *str, Bytecount length, Ibyte **last_hyphen) -{ - int hyphen_count = 0; - const Ibyte *hyphening = str; - const Ibyte *new_hyphening; - - for (hyphen_count = 0; - NULL != (new_hyphening = (Ibyte *) memchr((const void *)hyphening, '-', length)); - hyphen_count++) - { - ++new_hyphening; - length -= new_hyphening - hyphening; - hyphening = new_hyphening; - } - - if (NULL != last_hyphen) - { - *last_hyphen = (Ibyte *)hyphening; - } - - return hyphen_count; -} - -static int -XFUN (font_spec_matches_charset) (struct device * USED_IF_XFT (d), - Lisp_Object charset, - const Ibyte *nonreloc, Lisp_Object reloc, - Bytecount offset, Bytecount length, - enum font_specifier_matchspec_stages stage) -{ - Lisp_Object registries = Qnil; - long i, registries_len; - const Ibyte *the_nonreloc; - Bytecount the_length; - - the_nonreloc = nonreloc; - the_length = length; - - if (!the_nonreloc) - the_nonreloc = XSTRING_DATA (reloc); - fixup_internal_substring (nonreloc, reloc, offset, &the_length); - the_nonreloc += offset; - -#ifdef USE_XFT - if (stage == STAGE_FINAL) - { - Display *dpy = DEVICE_X_DISPLAY (d); - Extbyte *extname; - XftFont *rf; - const Ibyte *the_nonreloc; - - if (!NILP(reloc)) - { - the_nonreloc = XSTRING_DATA (reloc); - extname = LISP_STRING_TO_EXTERNAL (reloc, Qx_font_name_encoding); - rf = xft_open_font_by_name (dpy, extname); - return 0; /* #### maybe this will compile and run ;) */ - /* Jesus, Stephen, what the fuck? */ - } - } -#endif - - /* Hmm, this smells bad. */ - if (NILP (charset)) - return 1; - - /* Hack! Short font names don't have the registry in them, - so we just assume the user knows what they're doing in the - case of ASCII. For other charsets, you gotta give the - long form; sorry buster. - #### FMH: this screws fontconfig/Xft? - STRATEGY: use fontconfig's ability to hack languages and character - sets (lang and charset properties). - #### Maybe we can use the fontconfig model to eliminate the difference - between faces and fonts? No - it looks like that would be an abuse - (fontconfig doesn't know about colors, although Xft does). - */ - if (EQ (charset, Vcharset_ascii) && - (!memchr (the_nonreloc, '*', the_length)) - && (5 > (count_hyphens(the_nonreloc, the_length, NULL)))) - { - return 1; - } - - if (STAGE_FINAL == stage) - { - registries = Qunicode_registries; - } - else if (STAGE_INITIAL == stage) - { - registries = XCHARSET_REGISTRIES (charset); - if (NILP(registries)) - { - return 0; - } - } - else assert(0); - - CHECK_VECTOR (registries); - registries_len = XVECTOR_LENGTH(registries); - - for (i = 0; i < registries_len; ++i) - { - if (!(STRINGP(XVECTOR_DATA(registries)[i])) - || (XSTRING_LENGTH(XVECTOR_DATA(registries)[i]) > the_length)) - { - continue; - } - - /* Check if the font spec ends in the registry specified. X11 says - this comparison is case insensitive: XLFD, section 3.11: - - "Alphabetic case distinctions are allowed but are for human - readability concerns only. Conforming X servers will perform - matching on font name query or open requests independent of case." */ - if (0 == qxestrcasecmp(XSTRING_DATA(XVECTOR_DATA(registries)[i]), - the_nonreloc + (the_length - - XSTRING_LENGTH - (XVECTOR_DATA(registries)[i])))) - { - return 1; - } - } - return 0; -} - -static Lisp_Object -xlistfonts_checking_charset (Lisp_Object device, const Extbyte *xlfd, - Lisp_Object charset, - enum font_specifier_matchspec_stages stage) -{ - Extbyte **names; - Lisp_Object result = Qnil; - int count = 0, i; - DECLARE_EISTRING(ei_single_result); - - names = XListFonts (GET_XLIKE_DISPLAY (XDEVICE (device)), - xlfd, MAX_FONT_COUNT, &count); - - for (i = 0; i < count; ++i) - { - eireset(ei_single_result); - eicpy_ext(ei_single_result, names[i], Qx_font_name_encoding); - - if (DEVMETH_OR_GIVEN(XDEVICE (device), font_spec_matches_charset, - (XDEVICE (device), charset, - eidata(ei_single_result), Qnil, 0, - -1, stage), 0)) - { - result = eimake_string(ei_single_result); - DEBUG_OBJECTS ("in xlistfonts_checking_charset, returning %s\n", - eidata(ei_single_result)); - break; - } - } - - if (names) - { - XFreeFontNames (names); - } - - return result; -} - -#ifdef USE_XFT -/* #### debug functions: find a better place for us */ -const char *FcResultToString (FcResult r); -const char * -FcResultToString (FcResult r) -{ - static char buffer[256]; - switch (r) - { - case FcResultMatch: - return "FcResultMatch"; - case FcResultNoMatch: - return "FcResultNoMatch"; - case FcResultTypeMismatch: - return "FcResultTypeMismatch"; - case FcResultNoId: - return "FcResultNoId"; - default: - snprintf (buffer, 255, "FcResultUndocumentedValue (%d)", r); - return buffer; - } -} - -const char *FcTypeOfValueToString (FcValue v); -const char * -FcTypeOfValueToString (FcValue v) -{ - static char buffer[256]; - switch (v.type) - { - case FcTypeMatrix: - return "FcTypeMatrix"; - case FcTypeString: - return "FcTypeString"; - case FcTypeVoid: - return "FcTypeVoid"; - case FcTypeDouble: - return "FcTypeDouble"; - case FcTypeInteger: - return "FcTypeInteger"; - case FcTypeBool: - return "FcTypeBool"; - case FcTypeCharSet: - return "FcTypeCharSet"; - case FcTypeLangSet: - return "FcTypeLangSet"; - /* #### There is no union member of this type, but there are void* and - FcPattern* members, as of fontconfig.h FC_VERSION 10002 */ - case FcTypeFTFace: - return "FcTypeFTFace"; - default: - snprintf (buffer, 255, "FcTypeUndocumentedType (%d)", v.type); - return buffer; - } -} - -static FcCharSet * -mule_to_fc_charset (Lisp_Object cs) -{ - int ucode, i, j; - FcCharSet *fccs; - - CHECK_CHARSET (cs); - fccs = FcCharSetCreate (); - /* #### do we also need to deal with 94 vs. 96 charsets? - ie, how are SP and DEL treated in ASCII? non-graphic should return -1 */ - if (1 == XCHARSET_DIMENSION (cs)) - /* Unicode tables are indexed by offsets from ASCII SP, not by ASCII */ - for (i = 0; i < 96; i++) - { - ucode = ((int *) XCHARSET_TO_UNICODE_TABLE (cs))[i]; - if (ucode >= 0) - /* #### should check for allocation failure */ - FcCharSetAddChar (fccs, (FcChar32) ucode); - } - else if (2 == XCHARSET_DIMENSION (cs)) - /* Unicode tables are indexed by offsets from ASCII SP, not by ASCII */ - for (i = 0; i < 96; i++) - for (j = 0; j < 96; j++) - { - ucode = ((int **) XCHARSET_TO_UNICODE_TABLE (cs))[i][j]; - if (ucode >= 0) - /* #### should check for allocation failure */ - FcCharSetAddChar (fccs, (FcChar32) ucode); - } - else - { - FcCharSetDestroy (fccs); - fccs = NULL; - } - return fccs; -} - -struct charset_reporter { - Lisp_Object *charset; - /* This is a debug facility, require ASCII. */ - const Ascbyte *language; /* ASCII, please */ - /* Technically this is FcChar8, but fsckin' GCC 4 bitches. - RFC 3066 is a combination of ISO 639 and ISO 3166. */ - const Ascbyte *rfc3066; /* ASCII, please */ -}; - -static struct charset_reporter charset_table[] = - { - /* #### It's my branch, my favorite charsets get checked first! - That's a joke, Son. - Ie, I don't know what I'm doing, so my charsets first is as good as - any other arbitrary order. If you have a better idea, speak up! */ - { &Vcharset_ascii, "English", "en" }, - { &Vcharset_japanese_jisx0208, "Japanese", "ja" }, - { &Vcharset_japanese_jisx0212, "Japanese", "ja" }, - { &Vcharset_katakana_jisx0201, "Japanese", "ja" }, - { &Vcharset_latin_jisx0201, "Japanese", "ja" }, - { &Vcharset_japanese_jisx0208_1978, "Japanese", "ja" }, - { &Vcharset_greek_iso8859_7, "Greek", "el" }, - /* #### all the Chinese need checking - Damn the blood-sucking ISO anyway. */ - { &Vcharset_chinese_gb2312, "simplified Chinese", "zh-cn" }, - { &Vcharset_korean_ksc5601, "Korean", "ko" }, - { &Vcharset_chinese_cns11643_1, "traditional Chinese", "zh-tw" }, - { &Vcharset_chinese_cns11643_2, "traditional Chinese", "zh-tw" }, - /* #### not obvious how to handle these - We could (for experimental purposes) make the last element into - an array of ISO 639 codes, and check for all of them. If a font - provides some but not others, warn. */ - { &Vcharset_latin_iso8859_1, NULL, NULL }, - { &Vcharset_latin_iso8859_2, NULL, NULL }, - { &Vcharset_latin_iso8859_3, NULL, NULL }, - { &Vcharset_latin_iso8859_4, NULL, NULL }, - { &Vcharset_latin_iso8859_9, NULL, NULL }, - { &Vcharset_latin_iso8859_15, NULL, NULL }, - { &Vcharset_thai_tis620, "Thai", "th" }, - /* We don't have an arabic charset. bidi issues, I guess? */ - /* { &Vcharset_arabic_iso8859_6, "Arabic", "ar" }, */ - { &Vcharset_hebrew_iso8859_8, "Hebrew", "he" }, - /* #### probably close enough for Ukraine? */ - { &Vcharset_cyrillic_iso8859_5, "Russian", "ru" }, - /* #### these probably are not quite right */ - { &Vcharset_chinese_big5_1, "traditional Chinese", "zh-tw" }, - { &Vcharset_chinese_big5_2, "traditional Chinese", "zh-tw" }, - { NULL, NULL, NULL } - }; - -/* Choose appropriate font name for debug messages. - Use only in the top half of next function (enforced with #undef). */ -#define DECLARE_DEBUG_FONTNAME(__xemacs_name) \ - Eistring *__xemacs_name; \ - do \ - { \ - __xemacs_name = debug_xft > 2 ? eistr_fullname \ - : debug_xft > 1 ? eistr_longname \ - : eistr_shortname; \ - } while (0) - -static Lisp_Object -xft_find_charset_font (Lisp_Object font, Lisp_Object charset, - enum font_specifier_matchspec_stages stage) -{ - const Extbyte *patternext; - Lisp_Object result = Qnil; - - /* #### with Xft need to handle second stage here -- sjt - Hm. Or maybe not. That would be cool. :-) */ - if (stage == STAGE_FINAL) - return Qnil; - - /* Fontconfig converts all FreeType names to UTF-8 before passing them - back to callers---see fcfreetype.c (FcFreeTypeQuery). - I don't believe this is documented. */ - - DEBUG_XFT1 (1, "confirming charset for font instance %s\n", - XSTRING_DATA(font)); - - /* #### this looks like a fair amount of work, but the basic design - has never been rethought, and it should be - - what really should happen here is that we use FcFontSort (FcFontList?) - to get a list of matching fonts, then pick the first (best) one that - gives language or repertoire coverage. - */ - - FcInit (); /* No-op if already initialized. - In fontconfig 2.3.2, this cannot return - failure, but that looks like a bug. We - check for it with FcGetCurrentConfig(), - which *can* fail. */ - if (!FcConfigGetCurrent()) - stderr_out ("Failed fontconfig initialization\n"); - else - { - FcPattern *fontxft; /* long-lived, freed at end of this block */ - FcResult fcresult; - FcConfig *fcc; - const Ascbyte *lang = "en"; - FcCharSet *fccs = NULL; - DECLARE_EISTRING (eistr_shortname); /* user-friendly nickname */ - DECLARE_EISTRING (eistr_longname); /* omit FC_LANG and FC_CHARSET */ - DECLARE_EISTRING (eistr_fullname); /* everything */ - - patternext = LISP_STRING_TO_EXTERNAL (font, Qfc_font_name_encoding); - fcc = FcConfigGetCurrent (); - - /* parse the name, do the substitutions, and match the font */ - - { - FcPattern *p = FcNameParse ((FcChar8 *) patternext); - PRINT_XFT_PATTERN (3, "FcNameParse'ed name is %s\n", p); - /* #### Next two return FcBool, but what does the return mean? */ - /* The order is correct according the fontconfig docs. */ - FcConfigSubstitute (fcc, p, FcMatchPattern); - PRINT_XFT_PATTERN (2, "FcConfigSubstitute'ed name is %s\n", p); - FcDefaultSubstitute (p); - PRINT_XFT_PATTERN (3, "FcDefaultSubstitute'ed name is %s\n", p); - /* #### check fcresult of following match? */ - fcresult = FcResultMatch; - fontxft = FcFontMatch (fcc, p, &fcresult); - switch (fcresult) - { - /* case FcResultOutOfMemory: */ - case FcResultNoMatch: - case FcResultTypeMismatch: - case FcResultNoId: - break; - case FcResultMatch: - /* this prints the long fontconfig name */ - PRINT_XFT_PATTERN (1, "FcFontMatch'ed name is %s\n", fontxft); - break; - } - FcPatternDestroy (p); - } - - /* heuristic to give reasonable-length names for debug reports - - I considered #ifdef SUPPORT_FULL_FONTCONFIG_NAME etc but that's - pointless. We're just going to remove this code once the font/ - face refactoring is done, but until then it could be very useful. - */ - { - FcPattern *p = FcFontRenderPrepare (fcc, fontxft, fontxft); - Extbyte *name; - - /* full name, including language coverage and repertoire */ - name = (Extbyte *) FcNameUnparse (p); - eicpy_ext (eistr_fullname, - (name ? name : "NOT FOUND"), - Qfc_font_name_encoding); - if (name) free (name); - - /* long name, omitting coverage and repertoire, plus a number - of rarely useful properties */ - FcPatternDel (p, FC_CHARSET); - FcPatternDel (p, FC_LANG); -#ifdef FC_WIDTH - FcPatternDel (p, FC_WIDTH); -#endif - FcPatternDel (p, FC_SPACING); - FcPatternDel (p, FC_HINTING); - FcPatternDel (p, FC_VERTICAL_LAYOUT); - FcPatternDel (p, FC_AUTOHINT); - FcPatternDel (p, FC_GLOBAL_ADVANCE); - FcPatternDel (p, FC_INDEX); - FcPatternDel (p, FC_SCALE); - FcPatternDel (p, FC_FONTVERSION); - name = (Extbyte *) FcNameUnparse (p); - eicpy_ext (eistr_longname, - (name ? name : "NOT FOUND"), - Qfc_font_name_encoding); - if (name) free (name); - - /* nickname, just family and size, but - "family" names usually have style, slant, and weight */ - FcPatternDel (p, FC_FOUNDRY); - FcPatternDel (p, FC_STYLE); - FcPatternDel (p, FC_SLANT); - FcPatternDel (p, FC_WEIGHT); - FcPatternDel (p, FC_PIXEL_SIZE); - FcPatternDel (p, FC_OUTLINE); - FcPatternDel (p, FC_SCALABLE); - FcPatternDel (p, FC_DPI); - name = (Extbyte *) FcNameUnparse (p); - eicpy_ext (eistr_shortname, - (name ? name : "NOT FOUND"), - Qfc_font_name_encoding); - if (name) free (name); - - FcPatternDestroy (p); - } - - /* The language approach may better in the long run, but we can't use - it based on Mule charsets; fontconfig doesn't provide a way to test - for unions of languages, etc. That will require support from the - text module. - - Optimization: cache the generated FcCharSet in the Mule charset. - Don't forget to destroy it if the Mule charset gets deallocated. */ - - { - /* This block possibly should be a function, but it generates - multiple values. I find the "pass an address to return the - value in" idiom opaque, so prefer a block. */ - struct charset_reporter *cr; - for (cr = charset_table; - cr->charset && !EQ (*(cr->charset), charset); - cr++) - ; - - if (cr->rfc3066) - { - DECLARE_DEBUG_FONTNAME (name); - CHECKING_LANG (0, eidata(name), cr->language); - lang = cr->rfc3066; - } - else if (cr->charset) - { - /* what the hey, build 'em on the fly */ - /* #### in the case of error this could return NULL! */ - fccs = mule_to_fc_charset (charset); - /* #### Bad idea here */ - lang = (const Ascbyte *) XSTRING_DATA (XSYMBOL (XCHARSET_NAME - (charset))->name); - } - else - { - /* OK, we fell off the end of the table */ - warn_when_safe_lispobj (intern ("xft"), intern ("alert"), - list2 (build_ascstring ("unchecked charset"), - charset)); - /* default to "en" - #### THIS IS WRONG, WRONG, WRONG!! - It is why we never fall through to XLFD-checking. */ - } - - ASSERT_ASCTEXT_ASCII (lang); - - if (fccs) - { - /* check for character set coverage */ - int i = 0; - FcCharSet *v; - FcResult r = FcPatternGetCharSet (fontxft, FC_CHARSET, i, &v); - - if (r == FcResultTypeMismatch) - { - DEBUG_XFT0 (0, "Unexpected type return in charset value\n"); - result = Qnil; - } - else if (r == FcResultMatch && FcCharSetIsSubset (fccs, v)) - { - /* The full pattern with the bitmap coverage is massively - unwieldy, but the shorter names are just *wrong*. We - should have the full thing internally as truename, and - filter stuff the client doesn't want to see on output. - Should we just store it into the truename right here? */ - DECLARE_DEBUG_FONTNAME (name); - DEBUG_XFT2 (0, "Xft font %s supports %s\n", - eidata(name), lang); -#ifdef RETURN_LONG_FONTCONFIG_NAMES - result = eimake_string(eistr_fullname); -#else - result = eimake_string(eistr_longname); -#endif - } - else - { - DECLARE_DEBUG_FONTNAME (name); - DEBUG_XFT2 (0, "Xft font %s doesn't support %s\n", - eidata(name), lang); - result = Qnil; - } - - /* clean up */ - FcCharSetDestroy (fccs); - } - else - { - /* check for language coverage */ - int i = 0; - FcValue v; - /* the main event */ - FcResult r = FcPatternGet (fontxft, FC_LANG, i, &v); - - if (r == FcResultMatch) - { - if (v.type != FcTypeLangSet) /* excessive paranoia */ - { - ASSERT_ASCTEXT_ASCII(FcTypeOfValueToString(v)); - /* Urk! Fall back and punt to core font. */ - DEBUG_XFT1 (0, "Unexpected type of lang value (%s)\n", - FcTypeOfValueToString (v)); - result = Qnil; - } - else if (FcLangSetHasLang (v.u.l, (FcChar8 *) lang) - != FcLangDifferentLang) - { - DECLARE_DEBUG_FONTNAME (name); - DEBUG_XFT2 (0, "Xft font %s supports %s\n", - eidata(name), lang); -#ifdef RETURN_LONG_FONTCONFIG_NAMES - result = eimake_string(eistr_fullname); -#else - result = eimake_string(eistr_longname); -#endif - } - else - { - DECLARE_DEBUG_FONTNAME (name); - DEBUG_XFT2 (0, "Xft font %s doesn't support %s\n", - eidata(name), lang); - result = Qnil; - } - } - else - { - ASSERT_ASCTEXT_ASCII(FcResultToString(r)); - DEBUG_XFT1 (0, "Getting lang: unexpected result=%s\n", - FcResultToString (r)); - result = Qnil; - } - } - - /* clean up and maybe return */ - FcPatternDestroy (fontxft); - if (!UNBOUNDP (result)) - return result; - } - } - return Qnil; -} -#undef DECLARE_DEBUG_FONTNAME - -#endif /* USE_XFT */ - -/* find a font spec that matches font spec FONT and also matches - (the registry of) CHARSET. */ -static Lisp_Object -XFUN (find_charset_font) (Lisp_Object device, Lisp_Object font, - Lisp_Object charset, - enum font_specifier_matchspec_stages stage) -{ - Lisp_Object result = Qnil, registries = Qnil; - int j, hyphen_count, registries_len = 0; - Ibyte *hyphening, *new_hyphening; - Bytecount xlfd_length; - - DECLARE_EISTRING(ei_xlfd_without_registry); - DECLARE_EISTRING(ei_xlfd); - -#ifdef USE_XFT - result = xft_find_charset_font(font, charset, stage); - if (!NILP(result)) - { - return result; - } -#endif - - switch (stage) - { - case STAGE_INITIAL: - { - if (!(NILP(XCHARSET_REGISTRIES(charset))) - && VECTORP(XCHARSET_REGISTRIES(charset))) - { - registries_len = XVECTOR_LENGTH(XCHARSET_REGISTRIES(charset)); - registries = XCHARSET_REGISTRIES(charset); - } - break; - } - case STAGE_FINAL: - { - registries_len = 1; - registries = Qunicode_registries; - break; - } - default: - { - assert(0); - break; - } - } - - eicpy_lstr(ei_xlfd, font); - hyphening = eidata(ei_xlfd); - xlfd_length = eilen(ei_xlfd); - - /* Count the hyphens in the string, moving new_hyphening to just after the - last one. */ - hyphen_count = count_hyphens(hyphening, xlfd_length, &new_hyphening); - - if (0 == registries_len || (5 > hyphen_count && - !(1 == xlfd_length && '*' == *hyphening))) - { - /* No proper XLFD specified, or we can't modify the pattern to change - the registry and encoding to match what we want, or we have no - information on the registry needed. */ - eito_external(ei_xlfd, Qx_font_name_encoding); - DEBUG_OBJECTS ("about to xlistfonts_checking_charset, XLFD %s\n", - eidata(ei_xlfd)); - result = xlistfonts_checking_charset (device, eiextdata(ei_xlfd), - charset, stage); - /* No need to loop through the available registries; return - immediately. */ - return result; - } - else if (1 == xlfd_length && '*' == *hyphening) - { - /* It's a single asterisk. We can add the registry directly to the - end. */ - eicpy_ch(ei_xlfd_without_registry, '*'); - } - else - { - /* It's a fully-specified XLFD. Work out where the registry and - encoding are, and initialise ei_xlfd_without_registry to the string - without them. */ - - /* count_hyphens has set new_hyphening to just after the last - hyphen. Move back to just after the hyphen before it. */ - - for (new_hyphening -= 2; new_hyphening > hyphening - && '-' != *new_hyphening; --new_hyphening) - ; - ++new_hyphening; - - eicpy_ei(ei_xlfd_without_registry, ei_xlfd); - - /* Manipulate ei_xlfd_without_registry, using the information about - ei_xlfd, to which it's identical. */ - eidel(ei_xlfd_without_registry, new_hyphening - hyphening, -1, - eilen(ei_xlfd) - (new_hyphening - hyphening), -1); - - } - - /* Now, loop through the registries and encodings defined for this - charset, doing an XListFonts each time with the pattern modified to - specify the regisry and encoding. This avoids huge amounts of IPC and - duplicated searching; now we use the searching the X server was doing - anyway, where before the X server did its search, transferred huge - amounts of data, and then we proceeded to do a regexp search on that - data. */ - for (j = 0; j < registries_len && NILP(result); ++j) - { - eireset(ei_xlfd); - eicpy_ei(ei_xlfd, ei_xlfd_without_registry); - - eicat_lstr(ei_xlfd, XVECTOR_DATA(registries)[j]); - - eito_external(ei_xlfd, Qx_font_name_encoding); - - DEBUG_OBJECTS ("about to xlistfonts_checking_charset, XLFD %s\n", - eidata(ei_xlfd)); - result = xlistfonts_checking_charset (device, eiextdata(ei_xlfd), - charset, stage); - } - - /* In the event that the charset is ASCII and we haven't matched - anything up to now, even with a pattern of "*", add "iso8859-1" - to the charset's registry and try again. Not returning a result - for ASCII means our frame geometry calculations are - inconsistent, and that we may crash. */ - - if (1 == xlfd_length && EQ(charset, Vcharset_ascii) && NILP(result) - && ('*' == eigetch(ei_xlfd_without_registry, 0))) - - { - int have_latin1 = 0; - - /* Set this to, for example, is08859-1 if you want to see the - error behaviour. */ - -#define FALLBACK_ASCII_REGISTRY "iso8859-1" - - for (j = 0; j < registries_len; ++j) - { - if (0 == qxestrcasecmp(XSTRING_DATA(XVECTOR_DATA(registries)[j]), - (Ibyte *) FALLBACK_ASCII_REGISTRY)) - { - have_latin1 = 1; - break; - } - } - - if (!have_latin1) - { - Lisp_Object new_registries = make_vector(registries_len + 1, Qnil); - - XVECTOR_DATA(new_registries)[0] - = build_ascstring(FALLBACK_ASCII_REGISTRY); - - memcpy(XVECTOR_DATA(new_registries) + 1, - XVECTOR_DATA(registries), - sizeof XVECTOR_DATA(registries)[0] * - XVECTOR_LENGTH(registries)); - - /* Calling set_charset_registries instead of overwriting the - value directly, to allow the charset font caches to be - invalidated and a change to the default face to be - noted. */ - set_charset_registries(charset, new_registries); - - warn_when_safe (Qface, Qwarning, - "Your ASCII charset registries contain nothing " - "sensible. Adding `" FALLBACK_ASCII_REGISTRY "'."); - - /* And recurse. */ - result = - DEVMETH_OR_GIVEN (XDEVICE (device), find_charset_font, - (device, font, charset, stage), - result); - } - else - { - DECLARE_EISTRING (ei_connection_name); - - /* We preserve a copy of the connection name for the error message - after the device is deleted. */ - eicpy_lstr (ei_connection_name, - DEVICE_CONNECTION (XDEVICE(device))); - - stderr_out ("Cannot find a font for ASCII, deleting device on %s\n", - eidata (ei_connection_name)); - - io_error_delete_device (device); - - /* Do a normal warning in the event that we have other, non-X - frames available. (If we don't, io_error_delete_device will - have exited.) */ - warn_when_safe - (Qface, Qerror, - "Cannot find a font for ASCII, deleting device on %s.\n" - "\n" - "Your X server fonts appear to be inconsistent; fix them, or\n" - "the next frame you create on that DISPLAY will crash this\n" - "XEmacs. At a minimum, provide one font with an XLFD ending\n" - "in `" FALLBACK_ASCII_REGISTRY "', so we can work out what size\n" - "a frame should be. ", - eidata (ei_connection_name)); - } - - } - - /* This function used to return the font spec, in the case where a font - didn't exist on the X server but it did match the charset. We're not - doing that any more, because none of the other platform code does, and - the old behaviour was badly-judged in other respects, so I don't trust - the original author to have had a good reason for it. */ - - return result; -} - -#endif /* MULE */ diff -r 861f2601a38b -r 1f0b15040456 src/objects.c --- a/src/objects.c Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1330 +0,0 @@ -/* Generic Objects and Functions. - Copyright (C) 1995 Free Software Foundation, Inc. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2002, 2004, 2005, 2010 Ben Wing. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -#include -#include "lisp.h" - -#include "buffer.h" -#include "device-impl.h" -#include "elhash.h" -#include "faces.h" -#include "frame.h" -#include "glyphs.h" -#include "objects-impl.h" -#include "specifier.h" -#include "window.h" - -#ifdef HAVE_TTY -#include "console-tty.h" -#endif - -/* Objects that are substituted when an instantiation fails. - If we leave in the Qunbound value, we will probably get crashes. */ -Lisp_Object Vthe_null_color_instance, Vthe_null_font_instance; - -/* Author: Ben Wing; some earlier code from Chuck Thompson, Jamie - Zawinski. */ - -DOESNT_RETURN -finalose (void *ptr) -{ - Lisp_Object obj = wrap_pointer_1 (ptr); - - invalid_operation - ("Can't dump an emacs containing window system objects", obj); -} - - -/**************************************************************************** - * Color-Instance Object * - ****************************************************************************/ - -Lisp_Object Qcolor_instancep; - -static const struct memory_description color_instance_data_description_1 []= { -#ifdef HAVE_TTY -#ifdef NEW_GC - { XD_LISP_OBJECT, tty_console }, -#else /* not NEW_GC */ - { XD_BLOCK_PTR, tty_console, 1, { &tty_color_instance_data_description } }, -#endif /* not NEW_GC */ -#endif - { XD_END } -}; - -static const struct sized_memory_description color_instance_data_description = { - sizeof (void *), color_instance_data_description_1 -}; - -static const struct memory_description color_instance_description[] = { - { XD_INT, offsetof (Lisp_Color_Instance, color_instance_type) }, - { XD_LISP_OBJECT, offsetof (Lisp_Color_Instance, name)}, - { XD_LISP_OBJECT, offsetof (Lisp_Color_Instance, device)}, - { XD_UNION, offsetof (Lisp_Color_Instance, data), - XD_INDIRECT (0, 0), { &color_instance_data_description } }, - {XD_END} -}; - -static Lisp_Object -mark_color_instance (Lisp_Object obj) -{ - Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); - mark_object (c->name); - if (!NILP (c->device)) /* Vthe_null_color_instance */ - MAYBE_DEVMETH (XDEVICE (c->device), mark_color_instance, (c)); - - return c->device; -} - -static void -print_color_instance (Lisp_Object obj, Lisp_Object printcharfun, - int escapeflag) -{ - Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); - if (print_readably) - printing_unreadable_lcrecord (obj, 0); - write_fmt_string_lisp (printcharfun, "#name); - write_fmt_string_lisp (printcharfun, " on %s", 1, c->device); - if (!NILP (c->device)) /* Vthe_null_color_instance */ - MAYBE_DEVMETH (XDEVICE (c->device), print_color_instance, - (c, printcharfun, escapeflag)); - write_fmt_string (printcharfun, " 0x%x>", c->header.uid); -} - -static void -finalize_color_instance (void *header, int for_disksave) -{ - Lisp_Color_Instance *c = (Lisp_Color_Instance *) header; - - if (!NILP (c->device)) - { - if (for_disksave) finalose (c); - MAYBE_DEVMETH (XDEVICE (c->device), finalize_color_instance, (c)); - } -} - -static int -color_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, - int UNUSED (foldcase)) -{ - Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1); - Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (obj2); - - return (c1 == c2) || - (EQ (c1->device, c2->device) && - DEVICEP (c1->device) && - HAS_DEVMETH_P (XDEVICE (c1->device), color_instance_equal) && - DEVMETH (XDEVICE (c1->device), color_instance_equal, (c1, c2, depth))); -} - -static Hashcode -color_instance_hash (Lisp_Object obj, int depth) -{ - Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); - struct device *d = DEVICEP (c->device) ? XDEVICE (c->device) : 0; - - return HASH2 ((Hashcode) d, - !d ? LISP_HASH (obj) - : DEVMETH_OR_GIVEN (d, color_instance_hash, (c, depth), - LISP_HASH (obj))); -} - -DEFINE_LRECORD_IMPLEMENTATION ("color-instance", color_instance, - 0, /*dumpable-flag*/ - mark_color_instance, print_color_instance, - finalize_color_instance, color_instance_equal, - color_instance_hash, - color_instance_description, - Lisp_Color_Instance); - -DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /* -Return a new `color-instance' object named NAME (a string). - -Optional argument DEVICE specifies the device this object applies to -and defaults to the selected device. - -An error is signaled if the color is unknown or cannot be allocated; -however, if optional argument NOERROR is non-nil, nil is simply -returned in this case. (And if NOERROR is other than t, a warning may -be issued.) - -The returned object is a normal, first-class lisp object. The way you -`deallocate' the color is the way you deallocate any other lisp object: -you drop all pointers to it and allow it to be garbage collected. When -these objects are GCed, the underlying window-system data (e.g. X object) -is deallocated as well. -*/ - (name, device, noerror)) -{ - Lisp_Color_Instance *c; - int retval; - - CHECK_STRING (name); - device = wrap_device (decode_device (device)); - - c = ALLOC_LCRECORD_TYPE (Lisp_Color_Instance, &lrecord_color_instance); - c->name = name; - c->device = device; - c->data = 0; - c->color_instance_type = get_console_variant (XDEVICE_TYPE (c->device)); - - retval = MAYBE_INT_DEVMETH (XDEVICE (device), initialize_color_instance, - (c, name, device, - decode_error_behavior_flag (noerror))); - if (!retval) - return Qnil; - - return wrap_color_instance (c); -} - -DEFUN ("color-instance-p", Fcolor_instance_p, 1, 1, 0, /* -Return non-nil if OBJECT is a color instance. -*/ - (object)) -{ - return COLOR_INSTANCEP (object) ? Qt : Qnil; -} - -DEFUN ("color-instance-name", Fcolor_instance_name, 1, 1, 0, /* -Return the name used to allocate COLOR-INSTANCE. -*/ - (color_instance)) -{ - CHECK_COLOR_INSTANCE (color_instance); - return XCOLOR_INSTANCE (color_instance)->name; -} - -DEFUN ("color-instance-rgb-components", Fcolor_instance_rgb_components, 1, 1, 0, /* -Return a three element list containing the red, green, and blue -color components of COLOR-INSTANCE, or nil if unknown. -Component values range from 0 to 65535. -*/ - (color_instance)) -{ - Lisp_Color_Instance *c; - - CHECK_COLOR_INSTANCE (color_instance); - c = XCOLOR_INSTANCE (color_instance); - - if (NILP (c->device)) - return Qnil; - - return MAYBE_LISP_DEVMETH (XDEVICE (c->device), - color_instance_rgb_components, - (c)); -} - -DEFUN ("valid-color-name-p", Fvalid_color_name_p, 1, 2, 0, /* -Return true if COLOR names a valid color for the current device. - -Valid color names for X are listed in the file /usr/lib/X11/rgb.txt, or -whatever the equivalent is on your system. - -Valid color names for TTY are those which have an ISO 6429 (ANSI) sequence. -In addition to being a color this may be one of a number of attributes -such as `blink'. -*/ - (color, device)) -{ - struct device *d = decode_device (device); - - CHECK_STRING (color); - return MAYBE_INT_DEVMETH (d, valid_color_name_p, (d, color)) ? Qt : Qnil; -} - -DEFUN ("color-list", Fcolor_list, 0, 1, 0, /* -Return a list of color names. -DEVICE specifies which device to return names for, and defaults to the -currently selected device. -*/ - (device)) -{ - device = wrap_device (decode_device (device)); - - return MAYBE_LISP_DEVMETH (XDEVICE (device), color_list, ()); -} - - -/*************************************************************************** - * Font-Instance Object * - ***************************************************************************/ - -Lisp_Object Qfont_instancep; - -static Lisp_Object font_instance_truename_internal (Lisp_Object xfont, - Error_Behavior errb); - -static const struct memory_description font_instance_data_description_1 []= { -#ifdef HAVE_TTY -#ifdef NEW_GC - { XD_LISP_OBJECT, tty_console }, -#else /* not NEW_GC */ - { XD_BLOCK_PTR, tty_console, 1, { &tty_font_instance_data_description } }, -#endif /* not NEW_GC */ -#endif - { XD_END } -}; - -static const struct sized_memory_description font_instance_data_description = { - sizeof (void *), font_instance_data_description_1 -}; - -static const struct memory_description font_instance_description[] = { - { XD_INT, offsetof (Lisp_Font_Instance, font_instance_type) }, - { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, name)}, - { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, truename)}, - { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, device)}, - { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, charset)}, - { XD_UNION, offsetof (Lisp_Font_Instance, data), - XD_INDIRECT (0, 0), { &font_instance_data_description } }, - { XD_END } -}; - - -static Lisp_Object -mark_font_instance (Lisp_Object obj) -{ - Lisp_Font_Instance *f = XFONT_INSTANCE (obj); - - mark_object (f->name); - mark_object (f->truename); - if (!NILP (f->device)) /* Vthe_null_font_instance */ - MAYBE_DEVMETH (XDEVICE (f->device), mark_font_instance, (f)); - - return f->device; -} - -static void -print_font_instance (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) -{ - Lisp_Font_Instance *f = XFONT_INSTANCE (obj); - if (print_readably) - printing_unreadable_lcrecord (obj, 0); - write_fmt_string_lisp (printcharfun, "#name); - write_fmt_string_lisp (printcharfun, " on %s", 1, f->device); - if (!NILP (f->device)) - { - MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance, - (f, printcharfun, escapeflag)); - - } - write_fmt_string (printcharfun, " 0x%x>", f->header.uid); -} - -static void -finalize_font_instance (void *header, int for_disksave) -{ - Lisp_Font_Instance *f = (Lisp_Font_Instance *) header; - - if (!NILP (f->device)) - { - if (for_disksave) finalose (f); - MAYBE_DEVMETH (XDEVICE (f->device), finalize_font_instance, (f)); - } -} - -/* Fonts are equal if they resolve to the same name. - Since we call `font-truename' to do this, and since font-truename is lazy, - this means the `equal' could cause XListFonts to be run the first time. - */ -static int -font_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, - int UNUSED (foldcase)) -{ - /* #### should this be moved into a device method? */ - return internal_equal (font_instance_truename_internal - (obj1, ERROR_ME_DEBUG_WARN), - font_instance_truename_internal - (obj2, ERROR_ME_DEBUG_WARN), - depth + 1); -} - -static Hashcode -font_instance_hash (Lisp_Object obj, int depth) -{ - return internal_hash (font_instance_truename_internal - (obj, ERROR_ME_DEBUG_WARN), - depth + 1); -} - -DEFINE_LRECORD_IMPLEMENTATION ("font-instance", font_instance, - 0, /*dumpable-flag*/ - mark_font_instance, print_font_instance, - finalize_font_instance, font_instance_equal, - font_instance_hash, font_instance_description, - Lisp_Font_Instance); - - -/* #### Why is this exposed to Lisp? Used in: -x-frob-font-size, gtk-font-menu-load-font, x-font-menu-load-font-xft, -x-font-menu-load-font-core, mswindows-font-menu-load-font, -mswindows-frob-font-style-and-sizify, mswindows-frob-font-size. */ -DEFUN ("make-font-instance", Fmake_font_instance, 1, 4, 0, /* -Return a new `font-instance' object named NAME. -DEVICE specifies the device this object applies to and defaults to the -selected device. An error is signalled if the font is unknown or cannot -be allocated; however, if NOERROR is non-nil, nil is simply returned in -this case. CHARSET is used internally. #### make helper function? - -The returned object is a normal, first-class lisp object. The way you -`deallocate' the font is the way you deallocate any other lisp object: -you drop all pointers to it and allow it to be garbage collected. When -these objects are GCed, the underlying GUI data is deallocated as well. -*/ - (name, device, noerror, charset)) -{ - Lisp_Font_Instance *f; - int retval = 0; - Error_Behavior errb = decode_error_behavior_flag (noerror); - - if (ERRB_EQ (errb, ERROR_ME)) - CHECK_STRING (name); - else if (!STRINGP (name)) - return Qnil; - - device = wrap_device (decode_device (device)); - - f = ALLOC_LCRECORD_TYPE (Lisp_Font_Instance, &lrecord_font_instance); - f->name = name; - f->truename = Qnil; - f->device = device; - - f->data = 0; - f->font_instance_type = get_console_variant (XDEVICE_TYPE (f->device)); - - /* Stick some default values here ... */ - f->ascent = f->height = 1; - f->descent = 0; - f->width = 1; - f->charset = charset; - f->proportional_p = 0; - - retval = MAYBE_INT_DEVMETH (XDEVICE (device), initialize_font_instance, - (f, name, device, errb)); - - if (!retval) - return Qnil; - - return wrap_font_instance (f); -} - -DEFUN ("font-instance-p", Ffont_instance_p, 1, 1, 0, /* -Return non-nil if OBJECT is a font instance. -*/ - (object)) -{ - return FONT_INSTANCEP (object) ? Qt : Qnil; -} - -DEFUN ("font-instance-name", Ffont_instance_name, 1, 1, 0, /* -Return the name used to allocate FONT-INSTANCE. -*/ - (font_instance)) -{ - CHECK_FONT_INSTANCE (font_instance); - return XFONT_INSTANCE (font_instance)->name; -} - -DEFUN ("font-instance-ascent", Ffont_instance_ascent, 1, 1, 0, /* -Return the ascent in pixels of FONT-INSTANCE. -The returned value is the maximum ascent for all characters in the font, -where a character's ascent is the number of pixels above (and including) -the baseline. -*/ - (font_instance)) -{ - CHECK_FONT_INSTANCE (font_instance); - return make_int (XFONT_INSTANCE (font_instance)->ascent); -} - -DEFUN ("font-instance-descent", Ffont_instance_descent, 1, 1, 0, /* -Return the descent in pixels of FONT-INSTANCE. -The returned value is the maximum descent for all characters in the font, -where a character's descent is the number of pixels below the baseline. -\(Many characters to do not have any descent. Typical characters with a -descent are lowercase p and lowercase g.) -*/ - (font_instance)) -{ - CHECK_FONT_INSTANCE (font_instance); - return make_int (XFONT_INSTANCE (font_instance)->descent); -} - -DEFUN ("font-instance-width", Ffont_instance_width, 1, 1, 0, /* -Return the width in pixels of FONT-INSTANCE. -The returned value is the average width for all characters in the font. -*/ - (font_instance)) -{ - CHECK_FONT_INSTANCE (font_instance); - return make_int (XFONT_INSTANCE (font_instance)->width); -} - -DEFUN ("font-instance-proportional-p", Ffont_instance_proportional_p, 1, 1, 0, /* -Return whether FONT-INSTANCE is proportional. -This means that different characters in the font have different widths. -*/ - (font_instance)) -{ - CHECK_FONT_INSTANCE (font_instance); - return XFONT_INSTANCE (font_instance)->proportional_p ? Qt : Qnil; -} - -static Lisp_Object -font_instance_truename_internal (Lisp_Object font_instance, - Error_Behavior errb) -{ - Lisp_Font_Instance *f = XFONT_INSTANCE (font_instance); - - if (NILP (f->device)) - { - maybe_signal_error (Qgui_error, - "can't determine truename: " - "no device for font instance", - font_instance, Qfont, errb); - return Qnil; - } - - return DEVMETH_OR_GIVEN (XDEVICE (f->device), - font_instance_truename, (f, errb), f->name); -} - -DEFUN ("font-instance-truename", Ffont_instance_truename, 1, 1, 0, /* -Return the canonical name of FONT-INSTANCE. -Font names are patterns which may match any number of fonts, of which -the first found is used. This returns an unambiguous name for that font -\(but not necessarily its only unambiguous name). -*/ - (font_instance)) -{ - CHECK_FONT_INSTANCE (font_instance); - return font_instance_truename_internal (font_instance, ERROR_ME); -} - -DEFUN ("font-instance-charset", Ffont_instance_charset, 1, 1, 0, /* -Return the Mule charset that FONT-INSTANCE was allocated to handle. -*/ - (font_instance)) -{ - CHECK_FONT_INSTANCE (font_instance); - return XFONT_INSTANCE (font_instance)->charset; -} - -DEFUN ("font-instance-properties", Ffont_instance_properties, 1, 1, 0, /* -Return the properties (an alist or nil) of FONT-INSTANCE. -*/ - (font_instance)) -{ - Lisp_Font_Instance *f; - - CHECK_FONT_INSTANCE (font_instance); - f = XFONT_INSTANCE (font_instance); - - if (NILP (f->device)) - return Qnil; - - return MAYBE_LISP_DEVMETH (XDEVICE (f->device), - font_instance_properties, (f)); -} - -DEFUN ("font-list", Ffont_list, 1, 3, 0, /* -Return a list of font names matching the given pattern. -DEVICE specifies which device to search for names, and defaults to the -currently selected device. -*/ - (pattern, device, maxnumber)) -{ - CHECK_STRING (pattern); - device = wrap_device (decode_device (device)); - - return MAYBE_LISP_DEVMETH (XDEVICE (device), font_list, (pattern, device, - maxnumber)); -} - - -/**************************************************************************** - Color Object - ***************************************************************************/ - -static const struct memory_description color_specifier_description[] = { - { XD_LISP_OBJECT, offsetof (struct color_specifier, face) }, - { XD_LISP_OBJECT, offsetof (struct color_specifier, face_property) }, - { XD_END } -}; - -DEFINE_SPECIFIER_TYPE_WITH_DATA (color); -/* Qcolor defined in general.c */ - -static void -color_create (Lisp_Object obj) -{ - Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); - - COLOR_SPECIFIER_FACE (color) = Qnil; - COLOR_SPECIFIER_FACE_PROPERTY (color) = Qnil; -} - -static void -color_mark (Lisp_Object obj) -{ - Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); - - mark_object (COLOR_SPECIFIER_FACE (color)); - mark_object (COLOR_SPECIFIER_FACE_PROPERTY (color)); -} - -/* No equal or hash methods; ignore the face the color is based off - of for `equal' */ - -static Lisp_Object -color_instantiate (Lisp_Object specifier, Lisp_Object UNUSED (matchspec), - Lisp_Object domain, Lisp_Object instantiator, - Lisp_Object depth, int no_fallback) -{ - /* When called, we're inside of call_with_suspended_errors(), - so we can freely error. */ - Lisp_Object device = DOMAIN_DEVICE (domain); - struct device *d = XDEVICE (device); - - if (COLOR_INSTANCEP (instantiator)) - { - /* If we are on the same device then we're done. Otherwise change - the instantiator to the name used to generate the pixel and let the - STRINGP case deal with it. */ - if (NILP (device) /* Vthe_null_color_instance */ - || EQ (device, XCOLOR_INSTANCE (instantiator)->device)) - return instantiator; - else - instantiator = Fcolor_instance_name (instantiator); - } - - if (STRINGP (instantiator)) - { - /* First, look to see if we can retrieve a cached value. */ - Lisp_Object instance = - Fgethash (instantiator, d->color_instance_cache, Qunbound); - /* Otherwise, make a new one. */ - if (UNBOUNDP (instance)) - { - /* make sure we cache the failures, too. */ - instance = Fmake_color_instance (instantiator, device, Qt); - Fputhash (instantiator, instance, d->color_instance_cache); - } - - return NILP (instance) ? Qunbound : instance; - } - else if (VECTORP (instantiator)) - { - switch (XVECTOR_LENGTH (instantiator)) - { - case 0: - if (DEVICE_TTY_P (d)) - return Vthe_null_color_instance; - else - gui_error ("Color instantiator [] only valid on TTY's", - device); - - case 1: - if (NILP (COLOR_SPECIFIER_FACE (XCOLOR_SPECIFIER (specifier)))) - gui_error ("Color specifier not attached to a face", - instantiator); - return (FACE_PROPERTY_INSTANCE_1 - (Fget_face (XVECTOR_DATA (instantiator)[0]), - COLOR_SPECIFIER_FACE_PROPERTY - (XCOLOR_SPECIFIER (specifier)), - domain, ERROR_ME, no_fallback, depth)); - - case 2: - return (FACE_PROPERTY_INSTANCE_1 - (Fget_face (XVECTOR_DATA (instantiator)[0]), - XVECTOR_DATA (instantiator)[1], domain, ERROR_ME, - no_fallback, depth)); - - default: - ABORT (); - } - } - else if (NILP (instantiator)) - { - if (DEVICE_TTY_P (d)) - return Vthe_null_color_instance; - else - gui_error ("Color instantiator [] only valid on TTY's", - device); - } - else - ABORT (); /* The spec validation routines are screwed up. */ - - return Qunbound; -} - -static void -color_validate (Lisp_Object instantiator) -{ - if (COLOR_INSTANCEP (instantiator) || STRINGP (instantiator)) - return; - if (VECTORP (instantiator)) - { - if (XVECTOR_LENGTH (instantiator) > 2) - sferror ("Inheritance vector must be of size 0 - 2", - instantiator); - else if (XVECTOR_LENGTH (instantiator) > 0) - { - Lisp_Object face = XVECTOR_DATA (instantiator)[0]; - - Fget_face (face); - if (XVECTOR_LENGTH (instantiator) == 2) - { - Lisp_Object field = XVECTOR_DATA (instantiator)[1]; - if (!EQ (field, Qforeground) && !EQ (field, Qbackground)) - invalid_constant - ("Inheritance field must be `foreground' or `background'", - field); - } - } - } - else - invalid_argument ("Invalid color instantiator", instantiator); -} - -static void -color_after_change (Lisp_Object specifier, Lisp_Object locale) -{ - Lisp_Object face = COLOR_SPECIFIER_FACE (XCOLOR_SPECIFIER (specifier)); - Lisp_Object property = - COLOR_SPECIFIER_FACE_PROPERTY (XCOLOR_SPECIFIER (specifier)); - if (!NILP (face)) - { - face_property_was_changed (face, property, locale); - if (BUFFERP (locale)) - XBUFFER (locale)->buffer_local_face_property = 1; - } -} - -void -set_color_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property) -{ - Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); - - COLOR_SPECIFIER_FACE (color) = face; - COLOR_SPECIFIER_FACE_PROPERTY (color) = property; -} - -DEFUN ("color-specifier-p", Fcolor_specifier_p, 1, 1, 0, /* -Return t if OBJECT is a color specifier. - -See `make-color-specifier' for a description of possible color instantiators. -*/ - (object)) -{ - return COLOR_SPECIFIERP (object) ? Qt : Qnil; -} - - -/**************************************************************************** - Font Object - ***************************************************************************/ - -static const struct memory_description font_specifier_description[] = { - { XD_LISP_OBJECT, offsetof (struct font_specifier, face) }, - { XD_LISP_OBJECT, offsetof (struct font_specifier, face_property) }, - { XD_END } -}; - -DEFINE_SPECIFIER_TYPE_WITH_DATA (font); -/* Qfont defined in general.c */ - -static void -font_create (Lisp_Object obj) -{ - Lisp_Specifier *font = XFONT_SPECIFIER (obj); - - FONT_SPECIFIER_FACE (font) = Qnil; - FONT_SPECIFIER_FACE_PROPERTY (font) = Qnil; -} - -static void -font_mark (Lisp_Object obj) -{ - Lisp_Specifier *font = XFONT_SPECIFIER (obj); - - mark_object (FONT_SPECIFIER_FACE (font)); - mark_object (FONT_SPECIFIER_FACE_PROPERTY (font)); -} - -/* No equal or hash methods; ignore the face the font is based off - of for `equal' */ - -#ifdef MULE - -/* Given a truename font spec (i.e. the font spec should have its registry - field filled in), does it support displaying characters from CHARSET? */ - -static int -font_spec_matches_charset (struct device *d, Lisp_Object charset, - const Ibyte *nonreloc, Lisp_Object reloc, - Bytecount offset, Bytecount length, - enum font_specifier_matchspec_stages stage) -{ - return DEVMETH_OR_GIVEN (d, font_spec_matches_charset, - (d, charset, nonreloc, reloc, offset, length, - stage), - 1); -} - -static void -font_validate_matchspec (Lisp_Object matchspec) -{ - CHECK_CONS (matchspec); - Fget_charset (XCAR (matchspec)); - - do - { - if (EQ(XCDR(matchspec), Qinitial)) - { - break; - } - if (EQ(XCDR(matchspec), Qfinal)) - { - break; - } - - invalid_argument("Invalid font matchspec stage", - XCDR(matchspec)); - } while (0); -} - -void -initialize_charset_font_caches (struct device *d) -{ - /* Note that the following tables are bi-level. */ - d->charset_font_cache_stage_1 = - make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); - d->charset_font_cache_stage_2 = - make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); -} - -void -invalidate_charset_font_caches (Lisp_Object charset) -{ - /* Invalidate font cache entries for charset on all devices. */ - Lisp_Object devcons, concons, hash_table; - DEVICE_LOOP_NO_BREAK (devcons, concons) - { - struct device *d = XDEVICE (XCAR (devcons)); - hash_table = Fgethash (charset, d->charset_font_cache_stage_1, - Qunbound); - if (!UNBOUNDP (hash_table)) - Fclrhash (hash_table); - hash_table = Fgethash (charset, d->charset_font_cache_stage_2, - Qunbound); - if (!UNBOUNDP (hash_table)) - Fclrhash (hash_table); - } -} - -#endif /* MULE */ - -/* It's a little non-obvious what's going on here. Specifically: - - MATCHSPEC is a somewhat bogus way in the specifier mechanism of passing - in additional information needed to instantiate some object. For fonts, - it's a cons of (CHARSET . SECOND-STAGE-P). SECOND-STAGE-P, if set, - means "try harder to find an appropriate font" and is a very bogus way - of dealing with the fact that it may not be possible to may a charset - directly onto a font; it's used esp. under Windows. @@#### We need to - change this so that MATCHSPEC is just a character. - - When redisplay is building up its structure, and needs font info, it - calls functions in faces.c such as ensure_face_cachel_complete() (map - fonts needed for a string of text) or - ensure_face_cachel_contains_charset() (map fonts needed for a charset - derived from a single character). The former function calls the latter; - the latter calls face_property_matching_instance(); this constructs the - MATCHSPEC and calls specifier_instance_no_quit() twice (first stage and - second stage, updating MATCHSPEC appropriately). That function, in - turn, looks up the appropriate specifier method to do the instantiation, - which, lo and behold, is this function here (because we set it in - initialization using `SPECIFIER_HAS_METHOD (font, instantiate);'). We - in turn call the device method `find_charset_font', which maps to - mswindows_find_charset_font(), x_find_charset_font(), or similar, in - objects-msw.c or the like. - - --ben */ - -static Lisp_Object -font_instantiate (Lisp_Object UNUSED (specifier), - Lisp_Object USED_IF_MULE (matchspec), - Lisp_Object domain, Lisp_Object instantiator, - Lisp_Object depth, int no_fallback) -{ - /* When called, we're inside of call_with_suspended_errors(), - so we can freely error. */ - Lisp_Object device = DOMAIN_DEVICE (domain); - struct device *d = XDEVICE (device); - Lisp_Object instance; - Lisp_Object charset = Qnil; -#ifdef MULE - enum font_specifier_matchspec_stages stage = STAGE_INITIAL; - - if (!UNBOUNDP (matchspec)) - { - charset = Fget_charset (XCAR (matchspec)); - -#define FROB(new_stage, enumstage) \ - if (EQ(Q##new_stage, XCDR(matchspec))) \ - { \ - stage = enumstage; \ - } - - FROB (initial, STAGE_INITIAL) - else FROB (final, STAGE_FINAL) - else assert(0); - -#undef FROB - - } -#endif - - if (FONT_INSTANCEP (instantiator)) - { - if (NILP (device) - || EQ (device, XFONT_INSTANCE (instantiator)->device)) - { -#ifdef MULE - if (font_spec_matches_charset (d, charset, 0, - Ffont_instance_truename - (instantiator), - 0, -1, stage)) -#endif - return instantiator; - } - instantiator = Ffont_instance_name (instantiator); - } - - if (STRINGP (instantiator)) - { -#ifdef MULE - /* #### rename these caches. */ - Lisp_Object cache = stage == STAGE_FINAL ? - d->charset_font_cache_stage_2 : - d->charset_font_cache_stage_1; -#else - Lisp_Object cache = d->font_instance_cache; -#endif - -#ifdef MULE - if (!NILP (charset)) - { - /* The instantiator is a font spec that could match many - different fonts. We need to find one of those fonts - whose registry matches the registry of the charset in - MATCHSPEC. This is potentially a very slow operation, - as it involves doing an XListFonts() or equivalent to - iterate over all possible fonts, and a regexp match - on each one. So we cache the results. */ - Lisp_Object matching_font = Qunbound; - Lisp_Object hash_table = Fgethash (charset, cache, Qunbound); - if (UNBOUNDP (hash_table)) - { - /* need to make a sub hash table. */ - hash_table = make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, - HASH_TABLE_EQUAL); - Fputhash (charset, hash_table, cache); - } - else - matching_font = Fgethash (instantiator, hash_table, Qunbound); - - if (UNBOUNDP (matching_font)) - { - /* make sure we cache the failures, too. */ - matching_font = - DEVMETH_OR_GIVEN (d, find_charset_font, - (device, instantiator, charset, stage), - instantiator); - Fputhash (instantiator, matching_font, hash_table); - } - if (NILP (matching_font)) - return Qunbound; - instantiator = matching_font; - } -#endif /* MULE */ - - /* First, look to see if we can retrieve a cached value. */ - instance = Fgethash (instantiator, cache, Qunbound); - /* Otherwise, make a new one. */ - if (UNBOUNDP (instance)) - { - /* make sure we cache the failures, too. */ - instance = Fmake_font_instance (instantiator, device, Qt, charset); - Fputhash (instantiator, instance, cache); - } - - return NILP (instance) ? Qunbound : instance; - } - else if (VECTORP (instantiator)) - { - Lisp_Object match_inst = Qunbound; - assert (XVECTOR_LENGTH (instantiator) == 1); - - match_inst = face_property_matching_instance - (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont, - charset, domain, ERROR_ME, no_fallback, depth, STAGE_INITIAL); - - if (UNBOUNDP(match_inst)) - { - match_inst = face_property_matching_instance - (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont, - charset, domain, ERROR_ME, no_fallback, depth, STAGE_FINAL); - } - - return match_inst; - - } - else if (NILP (instantiator)) - return Qunbound; - else - ABORT (); /* Eh? */ - - return Qunbound; -} - -static void -font_validate (Lisp_Object instantiator) -{ - if (FONT_INSTANCEP (instantiator) || STRINGP (instantiator)) - return; - if (VECTORP (instantiator)) - { - if (XVECTOR_LENGTH (instantiator) != 1) - { - sferror - ("Vector length must be one for font inheritance", instantiator); - } - Fget_face (XVECTOR_DATA (instantiator)[0]); - } - else - invalid_argument ("Must be string, vector, or font-instance", - instantiator); -} - -static void -font_after_change (Lisp_Object specifier, Lisp_Object locale) -{ - Lisp_Object face = FONT_SPECIFIER_FACE (XFONT_SPECIFIER (specifier)); - Lisp_Object property = - FONT_SPECIFIER_FACE_PROPERTY (XFONT_SPECIFIER (specifier)); - if (!NILP (face)) - { - face_property_was_changed (face, property, locale); - if (BUFFERP (locale)) - XBUFFER (locale)->buffer_local_face_property = 1; - } -} - -void -set_font_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property) -{ - Lisp_Specifier *font = XFONT_SPECIFIER (obj); - - FONT_SPECIFIER_FACE (font) = face; - FONT_SPECIFIER_FACE_PROPERTY (font) = property; -} - -DEFUN ("font-specifier-p", Ffont_specifier_p, 1, 1, 0, /* -Return non-nil if OBJECT is a font specifier. - -See `make-font-specifier' for a description of possible font instantiators. -*/ - (object)) -{ - return FONT_SPECIFIERP (object) ? Qt : Qnil; -} - - -/***************************************************************************** - Face Boolean Object - ****************************************************************************/ - -static const struct memory_description face_boolean_specifier_description[] = { - { XD_LISP_OBJECT, offsetof (struct face_boolean_specifier, face) }, - { XD_LISP_OBJECT, offsetof (struct face_boolean_specifier, face_property) }, - { XD_END } -}; - -DEFINE_SPECIFIER_TYPE_WITH_DATA (face_boolean); -Lisp_Object Qface_boolean; - -static void -face_boolean_create (Lisp_Object obj) -{ - Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); - - FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = Qnil; - FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = Qnil; -} - -static void -face_boolean_mark (Lisp_Object obj) -{ - Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); - - mark_object (FACE_BOOLEAN_SPECIFIER_FACE (face_boolean)); - mark_object (FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean)); -} - -/* No equal or hash methods; ignore the face the face-boolean is based off - of for `equal' */ - -static Lisp_Object -face_boolean_instantiate (Lisp_Object specifier, - Lisp_Object UNUSED (matchspec), - Lisp_Object domain, Lisp_Object instantiator, - Lisp_Object depth, int no_fallback) -{ - /* When called, we're inside of call_with_suspended_errors(), - so we can freely error. */ - if (NILP (instantiator) || EQ (instantiator, Qt)) - return instantiator; - else if (VECTORP (instantiator)) - { - Lisp_Object retval; - Lisp_Object prop; - int instantiator_len = XVECTOR_LENGTH (instantiator); - - assert (instantiator_len >= 1 && instantiator_len <= 3); - if (instantiator_len > 1) - prop = XVECTOR_DATA (instantiator)[1]; - else - { - if (NILP (FACE_BOOLEAN_SPECIFIER_FACE - (XFACE_BOOLEAN_SPECIFIER (specifier)))) - gui_error - ("Face-boolean specifier not attached to a face", instantiator); - prop = FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY - (XFACE_BOOLEAN_SPECIFIER (specifier)); - } - - retval = (FACE_PROPERTY_INSTANCE_1 - (Fget_face (XVECTOR_DATA (instantiator)[0]), - prop, domain, ERROR_ME, no_fallback, depth)); - - if (instantiator_len == 3 && !NILP (XVECTOR_DATA (instantiator)[2])) - retval = NILP (retval) ? Qt : Qnil; - - return retval; - } - else - ABORT (); /* Eh? */ - - return Qunbound; -} - -static void -face_boolean_validate (Lisp_Object instantiator) -{ - if (NILP (instantiator) || EQ (instantiator, Qt)) - return; - else if (VECTORP (instantiator) && - (XVECTOR_LENGTH (instantiator) >= 1 && - XVECTOR_LENGTH (instantiator) <= 3)) - { - Lisp_Object face = XVECTOR_DATA (instantiator)[0]; - - Fget_face (face); - - if (XVECTOR_LENGTH (instantiator) > 1) - { - Lisp_Object field = XVECTOR_DATA (instantiator)[1]; - if (!EQ (field, Qunderline) - && !EQ (field, Qstrikethru) - && !EQ (field, Qhighlight) - && !EQ (field, Qdim) - && !EQ (field, Qblinking) - && !EQ (field, Qreverse)) - invalid_constant ("Invalid face-boolean inheritance field", - field); - } - } - else if (VECTORP (instantiator)) - sferror ("Wrong length for face-boolean inheritance spec", - instantiator); - else - invalid_argument ("Face-boolean instantiator must be nil, t, or vector", - instantiator); -} - -static void -face_boolean_after_change (Lisp_Object specifier, Lisp_Object locale) -{ - Lisp_Object face = - FACE_BOOLEAN_SPECIFIER_FACE (XFACE_BOOLEAN_SPECIFIER (specifier)); - Lisp_Object property = - FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (XFACE_BOOLEAN_SPECIFIER (specifier)); - if (!NILP (face)) - { - face_property_was_changed (face, property, locale); - if (BUFFERP (locale)) - XBUFFER (locale)->buffer_local_face_property = 1; - } -} - -void -set_face_boolean_attached_to (Lisp_Object obj, Lisp_Object face, - Lisp_Object property) -{ - Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); - - FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = face; - FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = property; -} - -DEFUN ("face-boolean-specifier-p", Fface_boolean_specifier_p, 1, 1, 0, /* -Return non-nil if OBJECT is a face-boolean specifier. - -See `make-face-boolean-specifier' for a description of possible -face-boolean instantiators. -*/ - (object)) -{ - return FACE_BOOLEAN_SPECIFIERP (object) ? Qt : Qnil; -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_objects (void) -{ - INIT_LRECORD_IMPLEMENTATION (color_instance); - INIT_LRECORD_IMPLEMENTATION (font_instance); - - DEFSUBR (Fcolor_specifier_p); - DEFSUBR (Ffont_specifier_p); - DEFSUBR (Fface_boolean_specifier_p); - - DEFSYMBOL_MULTIWORD_PREDICATE (Qcolor_instancep); - DEFSUBR (Fmake_color_instance); - DEFSUBR (Fcolor_instance_p); - DEFSUBR (Fcolor_instance_name); - DEFSUBR (Fcolor_instance_rgb_components); - DEFSUBR (Fvalid_color_name_p); - DEFSUBR (Fcolor_list); - - DEFSYMBOL_MULTIWORD_PREDICATE (Qfont_instancep); - DEFSUBR (Fmake_font_instance); - DEFSUBR (Ffont_instance_p); - DEFSUBR (Ffont_instance_name); - DEFSUBR (Ffont_instance_ascent); - DEFSUBR (Ffont_instance_descent); - DEFSUBR (Ffont_instance_width); - DEFSUBR (Ffont_instance_charset); - DEFSUBR (Ffont_instance_proportional_p); - DEFSUBR (Ffont_instance_truename); - DEFSUBR (Ffont_instance_properties); - DEFSUBR (Ffont_list); - - /* Qcolor, Qfont defined in general.c */ - DEFSYMBOL (Qface_boolean); -} - -void -specifier_type_create_objects (void) -{ - INITIALIZE_SPECIFIER_TYPE_WITH_DATA (color, "color", "color-specifier-p"); - INITIALIZE_SPECIFIER_TYPE_WITH_DATA (font, "font", "font-specifier-p"); - INITIALIZE_SPECIFIER_TYPE_WITH_DATA (face_boolean, "face-boolean", - "face-boolean-specifier-p"); - - SPECIFIER_HAS_METHOD (color, instantiate); - SPECIFIER_HAS_METHOD (font, instantiate); - SPECIFIER_HAS_METHOD (face_boolean, instantiate); - - SPECIFIER_HAS_METHOD (color, validate); - SPECIFIER_HAS_METHOD (font, validate); - SPECIFIER_HAS_METHOD (face_boolean, validate); - - SPECIFIER_HAS_METHOD (color, create); - SPECIFIER_HAS_METHOD (font, create); - SPECIFIER_HAS_METHOD (face_boolean, create); - - SPECIFIER_HAS_METHOD (color, mark); - SPECIFIER_HAS_METHOD (font, mark); - SPECIFIER_HAS_METHOD (face_boolean, mark); - - SPECIFIER_HAS_METHOD (color, after_change); - SPECIFIER_HAS_METHOD (font, after_change); - SPECIFIER_HAS_METHOD (face_boolean, after_change); - -#ifdef MULE - SPECIFIER_HAS_METHOD (font, validate_matchspec); -#endif -} - -void -reinit_specifier_type_create_objects (void) -{ - REINITIALIZE_SPECIFIER_TYPE (color); - REINITIALIZE_SPECIFIER_TYPE (font); - REINITIALIZE_SPECIFIER_TYPE (face_boolean); -} - -void -reinit_vars_of_objects (void) -{ - staticpro_nodump (&Vthe_null_color_instance); - { - Lisp_Color_Instance *c = - ALLOC_LCRECORD_TYPE (Lisp_Color_Instance, &lrecord_color_instance); - c->name = Qnil; - c->device = Qnil; - c->data = 0; - - Vthe_null_color_instance = wrap_color_instance (c); - } - - staticpro_nodump (&Vthe_null_font_instance); - { - Lisp_Font_Instance *f = - ALLOC_LCRECORD_TYPE (Lisp_Font_Instance, &lrecord_font_instance); - f->name = Qnil; - f->truename = Qnil; - f->device = Qnil; - f->data = 0; - - f->ascent = f->height = 0; - f->descent = 0; - f->width = 0; - f->proportional_p = 0; - - Vthe_null_font_instance = wrap_font_instance (f); - } -} - -void -vars_of_objects (void) -{ -} diff -r 861f2601a38b -r 1f0b15040456 src/objects.h --- a/src/objects.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,79 +0,0 @@ -/* Generic object functions -- interface. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2002 Ben Wing. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -#ifndef INCLUDED_objects_h_ -#define INCLUDED_objects_h_ - -DECLARE_DOESNT_RETURN (finalose (void *ptr)); - -/**************************************************************************** - * Color Instance Object * - ****************************************************************************/ - -DECLARE_LRECORD (color_instance, Lisp_Color_Instance); -#define XCOLOR_INSTANCE(x) XRECORD (x, color_instance, Lisp_Color_Instance) -#define wrap_color_instance(p) wrap_record (p, color_instance) -#define COLOR_INSTANCEP(x) RECORDP (x, color_instance) -#define CHECK_COLOR_INSTANCE(x) CHECK_RECORD (x, color_instance) -#define CONCHECK_COLOR_INSTANCE(x) CONCHECK_RECORD (x, color_instance) - -EXFUN (Fmake_color_instance, 3); - -extern Lisp_Object Vthe_null_color_instance; - -void set_color_attached_to (Lisp_Object obj, Lisp_Object face, - Lisp_Object property); - -/**************************************************************************** - * Font Instance Object * - ****************************************************************************/ - -void initialize_charset_font_caches (struct device *d); -void invalidate_charset_font_caches (Lisp_Object charset); - -DECLARE_LRECORD (font_instance, Lisp_Font_Instance); -#define XFONT_INSTANCE(x) XRECORD (x, font_instance, Lisp_Font_Instance) -#define wrap_font_instance(p) wrap_record (p, font_instance) -#define FONT_INSTANCEP(x) RECORDP (x, font_instance) -#define CHECK_FONT_INSTANCE(x) CHECK_RECORD (x, font_instance) -#define CONCHECK_FONT_INSTANCE(x) CONCHECK_RECORD (x, font_instance) - -EXFUN (Fmake_font_instance, 4); -EXFUN (Ffont_instance_name, 1); -EXFUN (Ffont_instance_p, 1); -EXFUN (Ffont_instance_truename, 1); -EXFUN (Ffont_instance_charset, 1); - -extern Lisp_Object Vthe_null_font_instance; - -void set_font_attached_to (Lisp_Object obj, Lisp_Object face, - Lisp_Object property); - -/***************************************************************************** - * Face Boolean Specifier Object * - *****************************************************************************/ - -void set_face_boolean_attached_to (Lisp_Object obj, Lisp_Object face, - Lisp_Object property); - -#endif /* INCLUDED_objects_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/opaque.c --- a/src/opaque.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/opaque.c Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,13 @@ /* Opaque Lisp objects. Copyright (C) 1993, 1994, 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 1996, 2002 Ben Wing. + Copyright (C) 1995, 1996, 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -51,8 +49,8 @@ write_fmt_string (printcharfun, - "#", - (long)(p->size), (unsigned long) p); + "#", + (long)(p->size), LISP_OBJECT_UID (obj)); } inline static Bytecount @@ -62,9 +60,9 @@ } static Bytecount -sizeof_opaque (const void *header) +sizeof_opaque (Lisp_Object obj) { - return aligned_sizeof_opaque (((const Lisp_Opaque *) header)->size); + return aligned_sizeof_opaque (XOPAQUE (obj)->size); } /* Return an opaque object of size SIZE. @@ -74,8 +72,9 @@ Lisp_Object make_opaque (const void *data, Bytecount size) { - Lisp_Opaque *p = (Lisp_Opaque *) - BASIC_ALLOC_LCRECORD (aligned_sizeof_opaque (size), &lrecord_opaque); + Lisp_Object obj = + ALLOC_SIZED_LISP_OBJECT (aligned_sizeof_opaque (size), opaque); + Lisp_Opaque *p = XOPAQUE (obj); p->size = size; if (data == OPAQUE_CLEAR) @@ -85,9 +84,7 @@ else memcpy (p->data, data, size); - { - return wrap_opaque (p); - } + return obj; } /* This will not work correctly for opaques with subobjects! */ @@ -104,7 +101,7 @@ /* This will not work correctly for opaques with subobjects! */ static Hashcode -hash_opaque (Lisp_Object obj, int UNUSED (depth)) +hash_opaque (Lisp_Object obj, int UNUSED (depth), int UNUSED (equalp)) { if (XOPAQUE_SIZE (obj) == sizeof (unsigned long)) return *((Hashcode *) XOPAQUE_DATA (obj)); @@ -116,12 +113,11 @@ { XD_END } }; -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("opaque", opaque, - 1, /*dumpable-flag*/ - 0, print_opaque, 0, - equal_opaque, hash_opaque, - opaque_description, - sizeof_opaque, Lisp_Opaque); +DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("opaque", opaque, + 0, print_opaque, 0, + equal_opaque, hash_opaque, + opaque_description, + sizeof_opaque, Lisp_Opaque); /* stuff to handle opaque pointers */ @@ -134,8 +130,8 @@ write_fmt_string (printcharfun, - "#", - (long)(p->ptr), (unsigned long) p); + "#", + (long)(p->ptr), LISP_OBJECT_UID (obj)); } static int @@ -146,7 +142,7 @@ } static Hashcode -hash_opaque_ptr (Lisp_Object obj, int UNUSED (depth)) +hash_opaque_ptr (Lisp_Object obj, int UNUSED (depth), int UNUSED (equalp)) { return (Hashcode) XOPAQUE_PTR (obj)->ptr; } @@ -155,19 +151,16 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("opaque-ptr", opaque_ptr, - 0, /*dumpable-flag*/ - 0, print_opaque_ptr, 0, - equal_opaque_ptr, hash_opaque_ptr, - opaque_ptr_description, Lisp_Opaque_Ptr); +DEFINE_NODUMP_LISP_OBJECT ("opaque-ptr", opaque_ptr, + 0, print_opaque_ptr, 0, + equal_opaque_ptr, hash_opaque_ptr, + opaque_ptr_description, Lisp_Opaque_Ptr); Lisp_Object make_opaque_ptr (void *val) { #ifdef NEW_GC - Lisp_Object res = - wrap_pointer_1 (alloc_lrecord_type (Lisp_Opaque_Ptr, - &lrecord_opaque_ptr)); + Lisp_Object res = ALLOC_NORMAL_LISP_OBJECT (opaque_ptr); #else /* not NEW_GC */ Lisp_Object res = alloc_managed_lcrecord (Vopaque_ptr_free_list); #endif /* not NEW_GC */ @@ -182,7 +175,7 @@ free_opaque_ptr (Lisp_Object ptr) { #ifdef NEW_GC - free_lrecord (ptr); + free_normal_lisp_object (ptr); #else /* not NEW_GC */ free_managed_lcrecord (Vopaque_ptr_free_list, ptr); #endif /* not NEW_GC */ @@ -201,8 +194,8 @@ void init_opaque_once_early (void) { - INIT_LRECORD_IMPLEMENTATION (opaque); - INIT_LRECORD_IMPLEMENTATION (opaque_ptr); + INIT_LISP_OBJECT (opaque); + INIT_LISP_OBJECT (opaque_ptr); #ifndef NEW_GC reinit_opaque_early (); diff -r 861f2601a38b -r 1f0b15040456 src/opaque.h --- a/src/opaque.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/opaque.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -28,12 +26,12 @@ typedef struct Lisp_Opaque { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; Bytecount size; max_align_t data[1]; } Lisp_Opaque; -DECLARE_LRECORD (opaque, Lisp_Opaque); +DECLARE_LISP_OBJECT (opaque, Lisp_Opaque); #define XOPAQUE(x) XRECORD (x, opaque, Lisp_Opaque) #define wrap_opaque(p) wrap_record (p, opaque) #define OPAQUEP(x) RECORDP (x, opaque) @@ -54,11 +52,11 @@ typedef struct Lisp_Opaque_Ptr { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; void *ptr; } Lisp_Opaque_Ptr; -DECLARE_LRECORD (opaque_ptr, Lisp_Opaque_Ptr); +DECLARE_LISP_OBJECT (opaque_ptr, Lisp_Opaque_Ptr); #define XOPAQUE_PTR(x) XRECORD (x, opaque_ptr, Lisp_Opaque_Ptr) #define wrap_opaque_ptr(p) wrap_record (p, opaque_ptr) #define OPAQUE_PTRP(x) RECORDP (x, opaque_ptr) diff -r 861f2601a38b -r 1f0b15040456 src/pre-crt0.c --- a/src/pre-crt0.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/pre-crt0.c Sun May 01 18:44:03 2011 +0100 @@ -1,9 +1,9 @@ /* This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -11,9 +11,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ diff -r 861f2601a38b -r 1f0b15040456 src/print.c --- a/src/print.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/print.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not synched with FSF. */ @@ -1339,6 +1337,12 @@ } } } + + if (!seen_high_order) + { + *p++ = '0'; + } + *p = '\0'; } @@ -1415,7 +1419,7 @@ if (EQ (obj, tortoise) && len > 0) { if (print_readably) - printing_unreadable_object ("circular list"); + printing_unreadable_object_fmt ("circular list"); else write_ascstring (printcharfun, "... "); break; @@ -1523,7 +1527,7 @@ } DOESNT_RETURN -printing_unreadable_object (const Ascbyte *fmt, ...) +printing_unreadable_object_fmt (const Ascbyte *fmt, ...) { Lisp_Object obj; va_list args; @@ -1537,70 +1541,48 @@ } DOESNT_RETURN -printing_unreadable_lcrecord (Lisp_Object obj, const Ibyte *name) +printing_unreadable_lisp_object (Lisp_Object obj, const Ibyte *name) { - struct LCRECORD_HEADER *header = (struct LCRECORD_HEADER *) XPNTR (obj); - -#ifndef NEW_GC - /* This must be a real lcrecord */ - assert (!LHEADER_IMPLEMENTATION (&header->lheader)->basic_p); -#endif + struct lrecord_header *header = (struct lrecord_header *) XPNTR (obj); + const struct lrecord_implementation *imp = + XRECORD_LHEADER_IMPLEMENTATION (obj); if (name) - printing_unreadable_object - ("#<%s %s 0x%x>", -#ifdef NEW_GC - LHEADER_IMPLEMENTATION (header)->name, -#else /* not NEW_GC */ - LHEADER_IMPLEMENTATION (&header->lheader)->name, -#endif /* not NEW_GC */ - name, - header->uid); + printing_unreadable_object_fmt ("#<%s %s 0x%x>", imp->name, name, header->uid); else - printing_unreadable_object - ("#<%s 0x%x>", -#ifdef NEW_GC - LHEADER_IMPLEMENTATION (header)->name, -#else /* not NEW_GC */ - LHEADER_IMPLEMENTATION (&header->lheader)->name, -#endif /* not NEW_GC */ - header->uid); + printing_unreadable_object_fmt ("#<%s 0x%x>", imp->name, header->uid); } void -default_object_printer (Lisp_Object obj, Lisp_Object printcharfun, - int UNUSED (escapeflag)) +external_object_printer (Lisp_Object obj, Lisp_Object printcharfun, + int UNUSED (escapeflag)) { - struct LCRECORD_HEADER *header = (struct LCRECORD_HEADER *) XPNTR (obj); - -#ifndef NEW_GC - /* This must be a real lcrecord */ - assert (!LHEADER_IMPLEMENTATION (&header->lheader)->basic_p); -#endif + struct lrecord_header *header = (struct lrecord_header *) XPNTR (obj); + const struct lrecord_implementation *imp = + XRECORD_LHEADER_IMPLEMENTATION (obj); if (print_readably) - printing_unreadable_lcrecord (obj, 0); + printing_unreadable_lisp_object (obj, 0); - write_fmt_string (printcharfun, "#<%s 0x%x>", -#ifdef NEW_GC - LHEADER_IMPLEMENTATION (header)->name, -#else /* not NEW_GC */ - LHEADER_IMPLEMENTATION (&header->lheader)->name, -#endif /* not NEW_GC */ - header->uid); + write_fmt_string (printcharfun, "#<%s 0x%x>", imp->name, header->uid); } void internal_object_printer (Lisp_Object obj, Lisp_Object printcharfun, int UNUSED (escapeflag)) { + if (print_readably) + printing_unreadable_object_fmt + ("#", + XRECORD_LHEADER_IMPLEMENTATION (obj)->name, LISP_OBJECT_UID (obj)); + /* Internal objects shouldn't normally escape to the Lisp level; that's why we say "XEmacs bug?". This can happen, however, when printing backtraces. */ write_fmt_string (printcharfun, - "#", + "#", XRECORD_LHEADER_IMPLEMENTATION (obj)->name, - (unsigned long) XPNTR (obj)); + LISP_OBJECT_UID (obj)); } enum printing_badness @@ -1894,7 +1876,7 @@ } #else /* not NEW_GC */ Lisp_String *l = (Lisp_String *) lheader; - if (!debug_can_access_memory (l->data_, l->size_)) + if (l->size_ && !debug_can_access_memory (l->data_, l->size_)) { printing_major_badness (printcharfun, "BAD STRING DATA", (int) (lheader->type), @@ -1935,11 +1917,13 @@ } } - if (LHEADER_IMPLEMENTATION (lheader)->printer) - ((LHEADER_IMPLEMENTATION (lheader)->printer) - (obj, printcharfun, escapeflag)); - else - internal_object_printer (obj, printcharfun, escapeflag); + /* Either use a custom-written printer, or use + internal_object_printer or external_object_printer, depending on + whether the object is internal (not visible at Lisp level) or + external. */ + assert (LHEADER_IMPLEMENTATION (lheader)->printer); + ((LHEADER_IMPLEMENTATION (lheader)->printer) + (obj, printcharfun, escapeflag)); break; } @@ -2047,7 +2031,7 @@ for (; confusing < size; confusing++) { - if (!isdigit (data[confusing])) + if (!isdigit (data[confusing]) && '/' != data[confusing]) { confusing = 0; break; @@ -2059,7 +2043,8 @@ /* #### Ugh, this is needlessly complex and slow for what we need here. It might be a good idea to copy equivalent code from FSF. --hniksic */ - confusing = isfloat_string ((char *) data); + confusing = isfloat_string ((char *) data) + || isratio_string ((char *) data); if (confusing) write_ascstring (printcharfun, "\\"); } @@ -2437,19 +2422,10 @@ debug_out ("<< bad object type=%d 0x%lx>>", header->type, (EMACS_INT) header); else -#ifdef NEW_GC debug_out ("#<%s addr=0x%lx uid=0x%lx>", LHEADER_IMPLEMENTATION (header)->name, (EMACS_INT) header, (EMACS_INT) ((struct lrecord_header *) header)->uid); -#else /* not NEW_GC */ - debug_out ("#<%s addr=0x%lx uid=0x%lx>", - LHEADER_IMPLEMENTATION (header)->name, - (EMACS_INT) header, - (EMACS_INT) (LHEADER_IMPLEMENTATION (header)->basic_p ? - ((struct lrecord_header *) header)->uid : - ((struct old_lcrecord_header *) header)->uid)); -#endif /* not NEW_GC */ } } @@ -2494,6 +2470,33 @@ external_debug_print (debug_print_obj, EXT_PRINT_ALL); } +/* Printf-style output when the objects being printed are Lisp objects. + Calling style is e.g. + + debug_out_lisp ("Called foo(%s %s)\n", 2, arg0, arg1) +*/ + +void +debug_out_lisp (const CIbyte *format, int nargs, ...) +{ + /* This function cannot GC, since GC is forbidden */ + struct debug_bindings bindings; + int specdepth = debug_print_enter (&bindings); + Lisp_Object *args = alloca_array (Lisp_Object, nargs); + va_list va; + int i; + Ibyte *msgout; + + va_start (va, nargs); + for (i = 0; i < nargs; i++) + args[i] = va_arg (va, Lisp_Object); + va_end (va); + msgout = emacs_vsprintf_malloc_lisp (format, Qnil, nargs, args, NULL); + debug_out ("%s", msgout); + xfree (msgout); + unbind_to (specdepth); +} + /* Getting tired of typing debug_print() ... */ void dp (Lisp_Object debug_print_obj); void diff -r 861f2601a38b -r 1f0b15040456 src/process-nt.c --- a/src/process-nt.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/process-nt.c Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Written by Kirill M. Katsnelson , April 1998 */ @@ -656,9 +654,8 @@ } static void -nt_finalize_process_data (Lisp_Process *p, int for_disksave) +nt_finalize_process_data (Lisp_Process *p) { - assert (!for_disksave); /* If it's still in the list of processes we are waiting on delete it. This can happen if we forcibly delete a process and are unable to kill it. */ @@ -1159,7 +1156,7 @@ of handles when lots of processes are run. (The handle gets closed anyway upon GC, but that might be a ways away, esp. if deleted-exited-processes is set to nil.) */ - nt_finalize_process_data (p, 0); + nt_finalize_process_data (p); } /* diff -r 861f2601a38b -r 1f0b15040456 src/process-slots.h --- a/src/process-slots.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/process-slots.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: ????. Split out of procimpl.h. */ @@ -68,4 +66,6 @@ all of the Lisp objects, including in process-type-specific data. */ MARKED_SLOT (tty_name) + MARKED_SLOT (plist) + #undef MARKED_SLOT diff -r 861f2601a38b -r 1f0b15040456 src/process-unix.c --- a/src/process-unix.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/process-unix.c Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Mule-ized as of 6-14-00 */ @@ -2120,10 +2118,10 @@ CHECK_STRING (dest); - CHECK_NATNUM (port); + check_integer_range (port, Qzero, make_integer (USHRT_MAX)); theport = htons ((unsigned short) XINT (port)); - CHECK_NATNUM (ttl); + check_integer_range (ttl, Qzero, make_integer (UCHAR_MAX)); thettl = (unsigned char) XINT (ttl); if ((udp = getprotobyname ("udp")) == NULL) diff -r 861f2601a38b -r 1f0b15040456 src/process.c --- a/src/process.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/process.c Sun May 01 18:44:03 2011 +0100 @@ -2,14 +2,14 @@ Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 1996, 2001, 2002, 2004, 2005 Ben Wing. + Copyright (C) 1995, 1996, 2001, 2002, 2004, 2005, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* This file has been Mule-ized. */ @@ -150,7 +148,7 @@ Lisp_Process *process = XPROCESS (obj); if (print_readably) - printing_unreadable_lcrecord (obj, XSTRING_DATA (process->name)); + printing_unreadable_lisp_object (obj, XSTRING_DATA (process->name)); if (!escapeflag) { @@ -170,36 +168,68 @@ write_ascstring (printcharfun, ">"); } } +/* Process plists are directly accessible, so we need to protect against + invalid property list structure */ + +static Lisp_Object +process_getprop (Lisp_Object process, Lisp_Object property) +{ + return external_plist_get (&XPROCESS (process)->plist, property, 0, + ERROR_ME); +} + +static int +process_putprop (Lisp_Object process, Lisp_Object property, Lisp_Object value) +{ + external_plist_put (&XPROCESS (process)->plist, property, value, 0, + ERROR_ME); + return 1; +} + +static int +process_remprop (Lisp_Object process, Lisp_Object property) +{ + return external_remprop (&XPROCESS (process)->plist, property, 0, ERROR_ME); +} + +static Lisp_Object +process_plist (Lisp_Object process) +{ + return XPROCESS (process)->plist; +} + +static Lisp_Object +process_setplist (Lisp_Object process, Lisp_Object newplist) +{ + XPROCESS (process)->plist = newplist; + return newplist; +} #ifdef HAVE_WINDOW_SYSTEM extern void debug_process_finalization (Lisp_Process *p); #endif /* HAVE_WINDOW_SYSTEM */ static void -finalize_process (void *header, int for_disksave) +finalize_process (Lisp_Object obj) { /* #### this probably needs to be tied into the tty event loop */ /* #### when there is one */ - Lisp_Process *p = (Lisp_Process *) header; + Lisp_Process *p = XPROCESS (obj); #ifdef HAVE_WINDOW_SYSTEM - if (!for_disksave) - { - debug_process_finalization (p); - } + debug_process_finalization (p); #endif /* HAVE_WINDOW_SYSTEM */ if (p->process_data) { - MAYBE_PROCMETH (finalize_process_data, (p, for_disksave)); - if (!for_disksave) - xfree (p->process_data); + MAYBE_PROCMETH (finalize_process_data, (p)); + xfree (p->process_data); + p->process_data = 0; } } -DEFINE_LRECORD_IMPLEMENTATION ("process", process, - 0, /*dumpable-flag*/ - mark_process, print_process, finalize_process, - 0, 0, process_description, Lisp_Process); +DEFINE_NODUMP_LISP_OBJECT ("process", process, + mark_process, print_process, finalize_process, + 0, 0, process_description, Lisp_Process); /************************************************************************/ /* basic process accessors */ @@ -468,9 +498,10 @@ Lisp_Object make_process_internal (Lisp_Object name) { - Lisp_Object val, name1; + Lisp_Object name1; int i; - Lisp_Process *p = ALLOC_LCRECORD_TYPE (Lisp_Process, &lrecord_process); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (process); + Lisp_Process *p = XPROCESS (obj); #define MARKED_SLOT(x) p->x = Qnil; #include "process-slots.h" @@ -495,10 +526,8 @@ MAYBE_PROCMETH (alloc_process_data, (p)); - val = wrap_process (p); - - Vprocess_list = Fcons (val, Vprocess_list); - return val; + Vprocess_list = Fcons (obj, Vprocess_list); + return obj; } void @@ -946,8 +975,8 @@ (process, height, width)) { CHECK_PROCESS (process); - CHECK_NATNUM (height); - CHECK_NATNUM (width); + check_integer_range (height, Qzero, make_integer (EMACS_INT_MAX)); + check_integer_range (width, Qzero, make_integer (EMACS_INT_MAX)); return MAYBE_INT_PROCMETH (set_window_size, (XPROCESS (process), XINT (height), XINT (width))) <= 0 @@ -2410,6 +2439,16 @@ } +void +reinit_process_early (void) +{ + OBJECT_HAS_METHOD (process, getprop); + OBJECT_HAS_METHOD (process, putprop); + OBJECT_HAS_METHOD (process, remprop); + OBJECT_HAS_METHOD (process, plist); + OBJECT_HAS_METHOD (process, setplist); +} + /* This is not named init_process in order to avoid a conflict with NS 3.3 */ void init_xemacs_process (void) @@ -2486,12 +2525,14 @@ Vshell_file_name = build_istring (shell); } + + reinit_process_early (); } void syms_of_process (void) { - INIT_LRECORD_IMPLEMENTATION (process); + INIT_LISP_OBJECT (process); DEFSYMBOL (Qprocessp); DEFSYMBOL (Qprocess_live_p); diff -r 861f2601a38b -r 1f0b15040456 src/process.h --- a/src/process.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/process.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ #ifndef INCLUDED_process_h_ #define INCLUDED_process_h_ @@ -27,7 +25,7 @@ /* struct Lisp_Process is defined in procimpl.h; only process-*.c need to know about the guts of it. */ -DECLARE_LRECORD (process, Lisp_Process); +DECLARE_LISP_OBJECT (process, Lisp_Process); #define XPROCESS(x) XRECORD (x, process, Lisp_Process) #define wrap_process(p) wrap_record (p, process) #define PROCESSP(x) RECORDP (x, process) diff -r 861f2601a38b -r 1f0b15040456 src/procimpl.h --- a/src/procimpl.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/procimpl.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: ????. Split out of process.h. */ @@ -39,7 +37,7 @@ struct process_methods { void (*print_process_data) (Lisp_Process *proc, Lisp_Object printcharfun); - void (*finalize_process_data) (Lisp_Process *proc, int for_disksave); + void (*finalize_process_data) (Lisp_Process *proc); void (*alloc_process_data) (Lisp_Process *p); void (*init_process_io_handles) (Lisp_Process *p, void* in, void* out, void *err, int flags); @@ -94,7 +92,7 @@ struct Lisp_Process { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; /* Exit code if process has terminated, signal which stopped/interrupted process diff -r 861f2601a38b -r 1f0b15040456 src/profile.c --- a/src/profile.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/profile.c Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,13 @@ /* Why the hell is XEmacs so fucking slow? - Copyright (C) 1996, 2002, 2003, 2004 Ben Wing. + Copyright (C) 1996, 2002, 2003, 2004, 2010 Ben Wing. Copyright (C) 1998 Free Software Foundation, Inc. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ #include #include "lisp.h" @@ -25,6 +23,7 @@ #include "backtrace.h" #include "bytecode.h" #include "elhash.h" +#include "gc.h" #include "hash.h" #include "profile.h" @@ -125,7 +124,7 @@ { /* The hash code can safely be called from a signal handler except when it has to grow the hash table. In this case, it calls realloc(), - which is not (in general) re-entrant. The way we deal with this is + which is not (in general) reentrant. The way we deal with this is documented at the top of this file. */ if (!big_profile_table) big_profile_table = make_hash_table (2000); @@ -137,16 +136,16 @@ create_timing_profile_table (); if (NILP (Vtotal_timing_profile_table)) Vtotal_timing_profile_table = - make_lisp_hash_table (1000, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (1000, HASH_TABLE_NON_WEAK, Qeq); if (NILP (Vcall_count_profile_table)) Vcall_count_profile_table = - make_lisp_hash_table (1000, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (1000, HASH_TABLE_NON_WEAK, Qeq); if (NILP (Vgc_usage_profile_table)) Vgc_usage_profile_table = - make_lisp_hash_table (1000, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (1000, HASH_TABLE_NON_WEAK, Qeq); if (NILP (Vtotal_gc_usage_profile_table)) Vtotal_gc_usage_profile_table = - make_lisp_hash_table (1000, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (1000, HASH_TABLE_NON_WEAK, Qeq); } static Lisp_Object @@ -364,8 +363,16 @@ msecs = default_profiling_interval; else { - CHECK_NATNUM (microsecs); +#ifdef HAVE_BIGNUM + check_integer_range (microsecs, make_int (1000), make_integer (INT_MAX)); + msecs = + BIGNUMP (microsecs) ? bignum_to_int (XBIGNUM_DATA (microsecs)) : + XINT (microsecs); +#else + check_integer_range (microsecs, make_int (1000), + make_integer (EMACS_INT_MAX)); msecs = XINT (microsecs); +#endif } if (msecs <= 0) msecs = 1000; @@ -475,7 +482,7 @@ { return !NILP (table) ? Fcopy_hash_table (table) : make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, - HASH_TABLE_EQ); + Qeq); } DEFUN ("get-profiling-info", Fget_profiling_info, 0, 0, 0, /* @@ -514,7 +521,7 @@ const void *overhead; closure.timing = - make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, Qequal); if (big_profile_table) { @@ -533,15 +540,16 @@ unbind_to (count); } - retv = nconc2 (list6 (Qtiming, closure.timing, Qtotal_timing, - copy_hash_table_or_blank (Vtotal_timing_profile_table), - Qcall_count, - copy_hash_table_or_blank (Vcall_count_profile_table)), - list4 (Qgc_usage, - copy_hash_table_or_blank (Vgc_usage_profile_table), - Qtotal_gc_usage, - copy_hash_table_or_blank (Vtotal_gc_usage_profile_table - ))); + retv = listu (Qtiming, closure.timing, + Qtotal_timing, + copy_hash_table_or_blank (Vtotal_timing_profile_table), + Qcall_count, + copy_hash_table_or_blank (Vcall_count_profile_table), + Qgc_usage, + copy_hash_table_or_blank (Vgc_usage_profile_table), + Qtotal_gc_usage, + copy_hash_table_or_blank (Vtotal_gc_usage_profile_table), + Qunbound); unbind_to (depth); return retv; } @@ -609,7 +617,7 @@ void *UNUSED (void_closure)) { #ifdef USE_KKCC - kkcc_gc_stack_push_lisp_object (GET_LISP_FROM_VOID (void_key), 0, -1); + kkcc_gc_stack_push_lisp_object_0 (GET_LISP_FROM_VOID (void_key)); #else /* NOT USE_KKCC */ mark_object (GET_LISP_FROM_VOID (void_key)); #endif /* NOT USE_KKCC */ diff -r 861f2601a38b -r 1f0b15040456 src/profile.h --- a/src/profile.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/profile.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/ralloc.c --- a/src/ralloc.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/ralloc.c Sun May 01 18:44:03 2011 +0100 @@ -1,12 +1,13 @@ /* Block-relocating memory allocator. Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc. + Copyright (C) 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,10 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. - +along with XEmacs. If not, see . Synched Up with: FSF 20.2 (non-mmap portion only) */ @@ -257,8 +255,7 @@ break; } - if (! heap) - ABORT (); + assert (heap); /* If we can't fit SIZE bytes in that heap, try successive later heaps. */ @@ -362,9 +359,8 @@ if ((char *)last_heap->end - (char *)last_heap->bloc_start <= excess) { /* This heap should have no blocs in it. */ - if (last_heap->first_bloc != NIL_BLOC - || last_heap->last_bloc != NIL_BLOC) - ABORT (); + assert (last_heap->first_bloc == NIL_BLOC && + last_heap->last_bloc == NIL_BLOC); /* Return the last heap, with its header, to the system. */ excess = (char *)last_heap->end - (char *)last_heap->start; @@ -481,8 +477,7 @@ register bloc_ptr b = bloc; /* No need to ever call this if arena is frozen, bug somewhere! */ - if (r_alloc_freeze_level) - ABORT(); + assert (!r_alloc_freeze_level); while (b) { @@ -636,8 +631,7 @@ size_t old_size; /* No need to ever call this if arena is frozen, bug somewhere! */ - if (r_alloc_freeze_level) - ABORT(); + assert (!r_alloc_freeze_level); if (bloc == NIL_BLOC || size == bloc->size) return 1; @@ -648,8 +642,7 @@ break; } - if (heap == NIL_HEAP) - ABORT (); + assert (heap != NIL_HEAP); old_size = bloc->size; bloc->size = size; @@ -979,8 +972,7 @@ init_ralloc (); dead_bloc = find_bloc (ptr); - if (dead_bloc == NIL_BLOC) - ABORT (); + assert (dead_bloc != NIL_BLOC); free_bloc (dead_bloc); *ptr = 0; @@ -1026,8 +1018,7 @@ } bloc = find_bloc (ptr); - if (bloc == NIL_BLOC) - ABORT (); + assert (bloc != NIL_BLOC); if (size < bloc->size) { @@ -1096,8 +1087,7 @@ if (! r_alloc_initialized) init_ralloc (); - if (--r_alloc_freeze_level < 0) - ABORT (); + assert (--r_alloc_freeze_level >= 0); /* This frees all unused blocs. It is not too inefficient, as the resize and memmove is done only once. Afterwards, all unreferenced blocs are @@ -1140,8 +1130,7 @@ first_heap->next = first_heap->prev = NIL_HEAP; first_heap->start = first_heap->bloc_start = virtual_break_value = break_value = (*real_morecore) (0); - if (break_value == NIL) - ABORT (); + assert (break_value != NIL); page_size = PAGE; extra_bytes = ROUNDUP (50000); @@ -1817,13 +1806,13 @@ { if (p->addr == addr) { - if (p->sz != sz) ABORT(); /* ACK! Shouldn't happen at all. */ + assert (p->sz == sz); /* ACK! Shouldn't happen at all. */ munmap( (VM_ADDR) p->addr, p->sz ); p->flag = empty; break; } } - if (!p) ABORT(); /* Can't happen... we've got a block to free which is not in + assert (p); /* Can't happen... we've got a block to free which is not in the address list. */ Coalesce_Addr_Blocks(); } diff -r 861f2601a38b -r 1f0b15040456 src/rangetab.c --- a/src/rangetab.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/rangetab.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -90,8 +88,8 @@ Lisp_Range_Table *rt = XRANGE_TABLE (obj); int i; - for (i = 0; i < Dynarr_length (rt->entries); i++) - mark_object (Dynarr_at (rt->entries, i).val); + for (i = 0; i < gap_array_length (rt->entries); i++) + mark_object (rangetab_gap_array_at (rt->entries, i).val); return Qnil; } @@ -104,13 +102,13 @@ int i; if (print_readably) - write_fmt_string_lisp (printcharfun, "#s(range-table type %s data (", + write_fmt_string_lisp (printcharfun, "#s(range-table :type %s :data (", 1, range_table_type_to_symbol (rt->type)); else write_ascstring (printcharfun, "#entries); i++) + for (i = 0; i < gap_array_length (rt->entries); i++) { - struct range_table_entry *rte = Dynarr_atp (rt->entries, i); + struct range_table_entry rte = rangetab_gap_array_at (rt->entries, i); int so, ec; if (i > 0) write_ascstring (printcharfun, " "); @@ -124,16 +122,16 @@ } write_fmt_string (printcharfun, "%c%ld %ld%c ", print_readably ? '(' : so ? '(' : '[', - (long) (rte->first - so), - (long) (rte->last - ec), + (long) (rte.first - so), + (long) (rte.last - ec), print_readably ? ')' : ec ? ']' : ')' ); - print_internal (rte->val, printcharfun, 1); + print_internal (rte.val, printcharfun, 1); } if (print_readably) write_ascstring (printcharfun, "))"); else - write_fmt_string (printcharfun, " 0x%x>", rt->header.uid); + write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); } static int @@ -143,13 +141,15 @@ Lisp_Range_Table *rt2 = XRANGE_TABLE (obj2); int i; - if (Dynarr_length (rt1->entries) != Dynarr_length (rt2->entries)) + if (gap_array_length (rt1->entries) != gap_array_length (rt2->entries)) return 0; - for (i = 0; i < Dynarr_length (rt1->entries); i++) + for (i = 0; i < gap_array_length (rt1->entries); i++) { - struct range_table_entry *rte1 = Dynarr_atp (rt1->entries, i); - struct range_table_entry *rte2 = Dynarr_atp (rt2->entries, i); + struct range_table_entry *rte1 = + rangetab_gap_array_atp (rt1->entries, i); + struct range_table_entry *rte2 = + rangetab_gap_array_atp (rt2->entries, i); if (rte1->first != rte2->first || rte1->last != rte2->last @@ -161,17 +161,19 @@ } static Hashcode -range_table_entry_hash (struct range_table_entry *rte, int depth) +range_table_entry_hash (struct range_table_entry *rte, int depth, + Boolint equalp) { - return HASH3 (rte->first, rte->last, internal_hash (rte->val, depth + 1)); + return HASH3 (rte->first, rte->last, + internal_hash (rte->val, depth + 1, equalp)); } static Hashcode -range_table_hash (Lisp_Object obj, int depth) +range_table_hash (Lisp_Object obj, int depth, Boolint equalp) { Lisp_Range_Table *rt = XRANGE_TABLE (obj); int i; - int size = Dynarr_length (rt->entries); + int size = gap_array_length (rt->entries); Hashcode hash = size; /* approach based on internal_array_hash(). */ @@ -179,8 +181,8 @@ { for (i = 0; i < size; i++) hash = HASH2 (hash, - range_table_entry_hash (Dynarr_atp (rt->entries, i), - depth)); + range_table_entry_hash + (rangetab_gap_array_atp (rt->entries, i), depth, equalp)); return hash; } @@ -188,12 +190,32 @@ A slightly better approach would be to offset by some noise factor from the points chosen below. */ for (i = 0; i < 5; i++) - hash = HASH2 (hash, range_table_entry_hash (Dynarr_atp (rt->entries, - i*size/5), - depth)); + hash = HASH2 (hash, + range_table_entry_hash + (rangetab_gap_array_atp (rt->entries, i*size/5), + depth, equalp)); return hash; } +#ifndef NEW_GC + +/* #### This leaks memory under NEW_GC. To fix this, convert to Lisp object + gap array. */ + +static void +finalize_range_table (Lisp_Object obj) +{ + Lisp_Range_Table *rt = XRANGE_TABLE (obj); + if (rt->entries) + { + if (!DUMPEDP (rt->entries)) + free_gap_array (rt->entries); + rt->entries = 0; + } +} + +#endif /* not NEW_GC */ + static const struct memory_description rte_description_1[] = { { XD_LISP_OBJECT, offsetof (range_table_entry, val) }, { XD_END } @@ -204,28 +226,27 @@ rte_description_1 }; -static const struct memory_description rted_description_1[] = { - XD_DYNARR_DESC (range_table_entry_dynarr, &rte_description), +static const struct memory_description rtega_description_1[] = { + XD_GAP_ARRAY_DESC (&rte_description), { XD_END } }; -static const struct sized_memory_description rted_description = { - sizeof (range_table_entry_dynarr), - rted_description_1 +static const struct sized_memory_description rtega_description = { + 0, rtega_description_1 }; static const struct memory_description range_table_description[] = { { XD_BLOCK_PTR, offsetof (Lisp_Range_Table, entries), 1, - { &rted_description } }, + { &rtega_description } }, { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("range-table", range_table, - 1, /*dumpable-flag*/ - mark_range_table, print_range_table, 0, - range_table_equal, range_table_hash, - range_table_description, - Lisp_Range_Table); +DEFINE_DUMPABLE_LISP_OBJECT ("range-table", range_table, + mark_range_table, print_range_table, + IF_OLD_GC (finalize_range_table), + range_table_equal, range_table_hash, + range_table_description, + Lisp_Range_Table); /************************************************************************/ /* Range table operations */ @@ -238,12 +259,12 @@ { int i; - for (i = 0; i < Dynarr_length (rt->entries); i++) + for (i = 0; i < gap_array_length (rt->entries); i++) { - struct range_table_entry *rte = Dynarr_atp (rt->entries, i); + struct range_table_entry *rte = rangetab_gap_array_atp (rt->entries, i); assert (rte->last >= rte->first); if (i > 0) - assert (Dynarr_at (rt->entries, i - 1).last <= rte->first); + assert (rangetab_gap_array_at (rt->entries, i - 1).last <= rte->first); } } @@ -253,14 +274,18 @@ #endif -/* Look up in a range table without the Dynarr wrapper. - Used also by the unified range table format. */ +/* Locate the range table entry corresponding to the value POS, and return + it. If found, FOUNDP is set to 1 and the return value specifies an entry + that encloses POS. Otherwise, FOUNDP is set to 0 and the return value + specifies where an entry that encloses POS would be inserted. */ -static Lisp_Object -get_range_table (EMACS_INT pos, int nentries, struct range_table_entry *tab, - Lisp_Object default_) +static Elemcount +get_range_table_pos (Elemcount pos, Elemcount nentries, + struct range_table_entry *tab, + Elemcount gappos, Elemcount gapsize, + int *foundp) { - int left = 0, right = nentries; + Elemcount left = 0, right = nentries; /* binary search for the entry. Based on similar code in extent_list_locate(). */ @@ -268,14 +293,41 @@ { /* RIGHT might not point to a valid entry (i.e. it's at the end of the list), so NEWPOS must round down. */ - int newpos = (left + right) >> 1; - struct range_table_entry *entry = tab + newpos; + Elemcount newpos = (left + right) >> 1; + struct range_table_entry *entry = + tab + GAP_ARRAY_ARRAY_TO_MEMORY_POS_1 (newpos, gappos, gapsize); if (pos >= entry->last) left = newpos + 1; else if (pos < entry->first) right = newpos; else - return entry->val; + { + *foundp = 1; + return newpos; + } + } + + *foundp = 0; + return left; +} + +/* Look up in a range table without the gap array wrapper. + Used also by the unified range table format. */ + +static Lisp_Object +get_range_table (Elemcount pos, Elemcount nentries, + struct range_table_entry *tab, + Elemcount gappos, Elemcount gapsize, + Lisp_Object default_) +{ + int foundp; + Elemcount entrypos = get_range_table_pos (pos, nentries, tab, gappos, + gapsize, &foundp); + if (foundp) + { + struct range_table_entry *entry = + tab + GAP_ARRAY_ARRAY_TO_MEMORY_POS_1 (entrypos, gappos, gapsize); + return entry->val; } return default_; @@ -332,11 +384,11 @@ */ (type)) { - Lisp_Range_Table *rt = ALLOC_LCRECORD_TYPE (Lisp_Range_Table, - &lrecord_range_table); - rt->entries = Dynarr_new (range_table_entry); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (range_table); + Lisp_Range_Table *rt = XRANGE_TABLE (obj); + rt->entries = make_gap_array (sizeof (struct range_table_entry), 0); rt->type = range_table_symbol_to_type (type); - return wrap_range_table (rt); + return obj; } DEFUN ("copy-range-table", Fcopy_range_table, 1, 1, 0, /* @@ -347,17 +399,22 @@ (range_table)) { Lisp_Range_Table *rt, *rtnew; + Lisp_Object obj; + Elemcount i; CHECK_RANGE_TABLE (range_table); rt = XRANGE_TABLE (range_table); - rtnew = ALLOC_LCRECORD_TYPE (Lisp_Range_Table, &lrecord_range_table); - rtnew->entries = Dynarr_new (range_table_entry); + obj = ALLOC_NORMAL_LISP_OBJECT (range_table); + rtnew = XRANGE_TABLE (obj); + rtnew->entries = make_gap_array (sizeof (struct range_table_entry), 0); rtnew->type = rt->type; - Dynarr_add_many (rtnew->entries, Dynarr_begin (rt->entries), - Dynarr_length (rt->entries)); - return wrap_range_table (rtnew); + for (i = 0; i < gap_array_length (rt->entries); i++) + rtnew->entries = + gap_array_insert_els (rtnew->entries, i, + rangetab_gap_array_atp (rt->entries, i), 1); + return obj; } DEFUN ("get-range-table", Fget_range_table, 2, 3, 0, /* @@ -373,8 +430,12 @@ CHECK_INT_COERCE_CHAR (pos); - return get_range_table (XINT (pos), Dynarr_length (rt->entries), - Dynarr_begin (rt->entries), default_); + return get_range_table (XINT (pos), gap_array_length (rt->entries), + gap_array_begin (rt->entries, + struct range_table_entry), + gap_array_gappos (rt->entries), + gap_array_gapsize (rt->entries), + default_); } static void @@ -414,6 +475,7 @@ int i; int insert_me_here = -1; Lisp_Range_Table *rt = XRANGE_TABLE (table); + int foundp; external_to_internal_adjust_ends (rt->type, &first, &last); if (first == last) @@ -423,15 +485,59 @@ open. #### Should we signal an error? */ return; + if (DUMPEDP (rt->entries)) + rt->entries = gap_array_clone (rt->entries); + + i = get_range_table_pos (first, gap_array_length (rt->entries), + gap_array_begin (rt->entries, + struct range_table_entry), + gap_array_gappos (rt->entries), + gap_array_gapsize (rt->entries), &foundp); + +#ifdef ERROR_CHECK_TYPES + if (foundp) + { + if (i < gap_array_length (rt->entries)) + { + struct range_table_entry *entry = + rangetab_gap_array_atp (rt->entries, i); + assert (first >= entry->first && first < entry->last); + } + } + else + { + if (i < gap_array_length (rt->entries)) + { + struct range_table_entry *entry = + rangetab_gap_array_atp (rt->entries, i); + assert (first < entry->first); + } + if (i > 0) + { + struct range_table_entry *entry = + rangetab_gap_array_atp (rt->entries, i - 1); + assert (first >= entry->last); + } + } +#endif /* ERROR_CHECK_TYPES */ + + /* If the beginning of the new range isn't within any existing range, + it might still be just grazing the end of an end-open range (remember, + internally all ranges are start-close end-open); so back up one + so we consider this range. */ + if (!foundp && i > 0) + i--; + /* Now insert in the proper place. This gets tricky because we may be overlapping one or more existing ranges and need to fix them up. */ /* First delete all sections of any existing ranges that overlap the new range. */ - for (i = 0; i < Dynarr_length (rt->entries); i++) + for (; i < gap_array_length (rt->entries); i++) { - struct range_table_entry *entry = Dynarr_atp (rt->entries, i); + struct range_table_entry *entry = + rangetab_gap_array_atp (rt->entries, i); /* We insert before the first range that begins at or after the new range. */ if (entry->first >= first && insert_me_here < 0) @@ -475,7 +581,8 @@ insert_me_too.last = entry->last; insert_me_too.val = entry->val; entry->last = first; - Dynarr_insert_many (rt->entries, &insert_me_too, 1, i + 1); + rt->entries = + gap_array_insert_els (rt->entries, i + 1, &insert_me_too, 1); } else if (entry->last >= last) { @@ -496,7 +603,7 @@ else { /* existing is entirely within new. */ - Dynarr_delete_many (rt->entries, i, 1); + gap_array_delete_els (rt->entries, i, 1); i--; /* back up since everything shifted one to the left. */ } } @@ -517,7 +624,8 @@ insert_me.last = last; insert_me.val = val; - Dynarr_insert_many (rt->entries, &insert_me, 1, insert_me_here); + rt->entries = + gap_array_insert_els (rt->entries, insert_me_here, &insert_me, 1); } /* Now see if we can combine this entry with adjacent ones just @@ -525,12 +633,12 @@ if (insert_me_here > 0) { - struct range_table_entry *entry = Dynarr_atp (rt->entries, - insert_me_here - 1); + struct range_table_entry *entry = + rangetab_gap_array_atp (rt->entries, insert_me_here - 1); if (EQ (val, entry->val) && entry->last == first) { entry->last = last; - Dynarr_delete_many (rt->entries, insert_me_here, 1); + gap_array_delete_els (rt->entries, insert_me_here, 1); insert_me_here--; /* We have morphed into a larger range. Update our records in case we also combine with the one after. */ @@ -538,14 +646,14 @@ } } - if (insert_me_here < Dynarr_length (rt->entries) - 1) + if (insert_me_here < gap_array_length (rt->entries) - 1) { - struct range_table_entry *entry = Dynarr_atp (rt->entries, - insert_me_here + 1); + struct range_table_entry *entry = + rangetab_gap_array_atp (rt->entries, insert_me_here + 1); if (EQ (val, entry->val) && entry->first == last) { entry->first = first; - Dynarr_delete_many (rt->entries, insert_me_here, 1); + gap_array_delete_els (rt->entries, insert_me_here, 1); } } } @@ -584,7 +692,7 @@ (range_table)) { CHECK_RANGE_TABLE (range_table); - Dynarr_reset (XRANGE_TABLE (range_table)->entries); + gap_array_delete_all_els (XRANGE_TABLE (range_table)->entries); return Qnil; } @@ -610,17 +718,18 @@ /* Do not "optimize" by pulling out the length computation below! FUNCTION may have changed the table. */ - for (i = 0; i < Dynarr_length (rt->entries); i++) + for (i = 0; i < gap_array_length (rt->entries); i++) { - struct range_table_entry *entry = Dynarr_atp (rt->entries, i); + struct range_table_entry entry = + rangetab_gap_array_at (rt->entries, i); EMACS_INT first, last; Lisp_Object args[4]; int oldlen; again: - first = entry->first; - last = entry->last; - oldlen = Dynarr_length (rt->entries); + first = entry.first; + last = entry.last; + oldlen = gap_array_length (rt->entries); args[0] = function; /* Fix up the numbers in accordance with the open/closedness of the table. */ @@ -630,12 +739,12 @@ args[1] = make_int (premier); args[2] = make_int (dernier); } - args[3] = entry->val; + args[3] = entry.val; Ffuncall (countof (args), args); /* Has FUNCTION removed the entry? */ - if (oldlen > Dynarr_length (rt->entries) - && i < Dynarr_length (rt->entries) - && (first != entry->first || last != entry->last)) + if (oldlen > gap_array_length (rt->entries) + && i < gap_array_length (rt->entries) + && (first != entry.first || last != entry.last)) goto again; } @@ -679,13 +788,38 @@ { Lisp_Object data = Qnil, type = Qnil, rangetab; - PROPERTY_LIST_LOOP_3 (key, value, plist) + if (KEYWORDP (Fcar (plist))) { - if (EQ (key, Qtype)) type = value; - else if (EQ (key, Qdata)) data = value; - else - ABORT (); + PROPERTY_LIST_LOOP_3 (key, value, plist) + { + if (EQ (key, Q_type)) type = value; + else if (EQ (key, Q_data)) data = value; + else if (!KEYWORDP (key)) + signal_error + (Qinvalid_read_syntax, + "can't mix keyword and non-keyword structure syntax", + key); + else + ABORT (); + } } +#ifdef NEED_TO_HANDLE_21_4_CODE + else + { + PROPERTY_LIST_LOOP_3 (key, value, plist) + { + if (EQ (key, Qtype)) type = value; + else if (EQ (key, Qdata)) data = value; + else if (KEYWORDP (key)) + signal_error + (Qinvalid_read_syntax, + "can't mix keyword and non-keyword structure syntax", + key); + else + ABORT (); + } + } +#endif /* NEED_TO_HANDLE_21_4_CODE */ rangetab = Fmake_range_table (type); @@ -777,7 +911,7 @@ unified_range_table_bytes_needed (Lisp_Object rangetab) { return (sizeof (struct range_table_entry) * - (Dynarr_length (XRANGE_TABLE (rangetab)->entries) - 1) + + (gap_array_length (XRANGE_TABLE (rangetab)->entries) - 1) + sizeof (struct unified_range_table) + /* ALIGNOF a struct may be too big. */ /* We have four bytes for the size numbers, and an extra @@ -797,9 +931,10 @@ char * and adding sizeof(int), because that will lead to mis-aligned data on the Alpha machines. */ struct unified_range_table *un; - range_table_entry_dynarr *rted = XRANGE_TABLE (rangetab)->entries; + Gap_Array *rtega = XRANGE_TABLE (rangetab)->entries; int total_needed = unified_range_table_bytes_needed (rangetab); void *new_dest = ALIGN_PTR ((char *) dest + 4, EMACS_INT); + Elemcount i; * (char *) dest = (char) ((char *) new_dest - (char *) dest); * ((unsigned char *) dest + 1) = total_needed & 0xFF; @@ -808,10 +943,10 @@ total_needed >>= 8; * ((unsigned char *) dest + 3) = total_needed & 0xFF; un = (struct unified_range_table *) new_dest; - un->nentries = Dynarr_length (rted); + un->nentries = gap_array_length (rtega); un->type = XRANGE_TABLE (rangetab)->type; - memcpy (&un->first, Dynarr_begin (rted), - sizeof (struct range_table_entry) * Dynarr_length (rted)); + for (i = 0; i < gap_array_length (rtega); i++) + (&un->first)[i] = rangetab_gap_array_at (rtega, i); } /* Return number of bytes actually used by a unified range table. */ @@ -854,7 +989,7 @@ new_dest = (char *) unrangetab + * (char *) unrangetab; un = (struct unified_range_table *) new_dest; - return get_range_table (pos, un->nentries, &un->first, default_); + return get_range_table (pos, un->nentries, &un->first, 0, 0, default_); } /* Return number of entries in a unified range table. */ @@ -902,7 +1037,7 @@ void syms_of_rangetab (void) { - INIT_LRECORD_IMPLEMENTATION (range_table); + INIT_LISP_OBJECT (range_table); DEFSYMBOL_MULTIWORD_PREDICATE (Qrange_tablep); DEFSYMBOL (Qrange_table); @@ -930,6 +1065,10 @@ st = define_structure_type (Qrange_table, 0, rangetab_instantiate); + define_structure_type_keyword (st, Q_data, rangetab_data_validate); + define_structure_type_keyword (st, Q_type, rangetab_type_validate); +#ifdef NEED_TO_HANDLE_21_4_CODE define_structure_type_keyword (st, Qdata, rangetab_data_validate); define_structure_type_keyword (st, Qtype, rangetab_type_validate); +#endif /* NEED_TO_HANDLE_21_4_CODE */ } diff -r 861f2601a38b -r 1f0b15040456 src/rangetab.h --- a/src/rangetab.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/rangetab.h Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,13 @@ /* XEmacs routines to deal with range tables. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 2004 Ben Wing. + Copyright (C) 1995, 2004, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -29,6 +27,9 @@ typedef struct range_table_entry range_table_entry; struct range_table_entry { +#ifdef NEW_GC + NORMAL_LISP_OBJECT_HEADER header; +#endif /* NEW_GC */ EMACS_INT first; EMACS_INT last; Lisp_Object val; @@ -49,16 +50,20 @@ struct Lisp_Range_Table { - struct LCRECORD_HEADER header; - range_table_entry_dynarr *entries; + NORMAL_LISP_OBJECT_HEADER header; + Gap_Array *entries; enum range_table_type type; }; typedef struct Lisp_Range_Table Lisp_Range_Table; -DECLARE_LRECORD (range_table, Lisp_Range_Table); +DECLARE_LISP_OBJECT (range_table, Lisp_Range_Table); #define XRANGE_TABLE(x) XRECORD (x, range_table, Lisp_Range_Table) #define wrap_range_table(p) wrap_record (p, range_table) #define RANGE_TABLEP(x) RECORDP (x, range_table) #define CHECK_RANGE_TABLE(x) CHECK_RECORD (x, range_table) +#define rangetab_gap_array_at(ga, pos) \ + gap_array_at (ga, pos, struct range_table_entry) +#define rangetab_gap_array_atp(ga, pos) \ + gap_array_atp (ga, pos, struct range_table_entry) #endif /* INCLUDED_rangetab_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/realpath.c --- a/src/realpath.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/realpath.c Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/redisplay-gtk.c --- a/src/redisplay-gtk.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/redisplay-gtk.c Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/redisplay-msw.c --- a/src/redisplay-msw.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/redisplay-msw.c Sun May 01 18:44:03 2011 +0100 @@ -2,14 +2,14 @@ Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. Copyright (C) 1994 Lucid, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2001, 2002, 2003 Ben Wing. + Copyright (C) 2001, 2002, 2003, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -51,7 +49,7 @@ #include "console-msw-impl.h" #include "glyphs-msw.h" -#include "objects-msw-impl.h" +#include "fontcolor-msw-impl.h" #define MSWINDOWS_EOL_CURSOR_WIDTH 5 @@ -633,6 +631,17 @@ SelectObject (hcompdc, old); } +/* Return x MOD y, but the result is guaranteed positive */ + +static int +posmod (int x, int y) +{ + int retval = x % y; + if (retval < 0) + retval += y; + return retval; +} + /* X gc's have this nice property that setting the bg pixmap will * output it offset relative to the window. Windows doesn't have this * feature so we have to emulate this by outputting multiple pixmaps. @@ -642,13 +651,15 @@ mswindows_output_dibitmap_region (struct frame *f, Lisp_Image_Instance *p, struct display_box *db, - struct display_glyph_area *dga) + struct display_glyph_area *dga, + int absolute) { struct display_box xdb = { db->xpos, db->ypos, db->width, db->height }; struct display_glyph_area xdga = { 0, 0, IMAGE_INSTANCE_PIXMAP_WIDTH (p), IMAGE_INSTANCE_PIXMAP_HEIGHT (p) }; int pxoffset = 0, pyoffset = 0; + int absolute_pxoffset = 0, absolute_pyoffset = 0; if (dga) { @@ -658,16 +669,30 @@ else if (!redisplay_normalize_glyph_area (&xdb, &xdga)) return; + if (absolute) + { + POINT point; + point.x = 0; + point.y = 0; + if (ScreenToClient (FRAME_MSWINDOWS_HANDLE (f), &point)) + { + absolute_pxoffset = point.x; + absolute_pyoffset = point.y; + } + } + /* when doing a bg pixmap do a partial pixmap first so that we blt whole pixmaps thereafter */ xdga.height = min (xdga.height, IMAGE_INSTANCE_PIXMAP_HEIGHT (p) - - db->ypos % IMAGE_INSTANCE_PIXMAP_HEIGHT (p)); + posmod (db->ypos - absolute_pyoffset, + IMAGE_INSTANCE_PIXMAP_HEIGHT (p))); while (xdga.height > 0) { xdga.width = min (min (db->width, IMAGE_INSTANCE_PIXMAP_WIDTH (p)), IMAGE_INSTANCE_PIXMAP_WIDTH (p) - - db->xpos % IMAGE_INSTANCE_PIXMAP_WIDTH (p)); + posmod (db->xpos - absolute_pxoffset, + IMAGE_INSTANCE_PIXMAP_WIDTH (p))); pxoffset = 0; while (xdga.width > 0) { @@ -675,9 +700,13 @@ xdb.ypos = db->ypos + pyoffset; /* do we need to offset the pixmap vertically? this is necessary for background pixmaps. */ - xdga.yoffset = xdb.ypos % IMAGE_INSTANCE_PIXMAP_HEIGHT (p); - xdga.xoffset = xdb.xpos % IMAGE_INSTANCE_PIXMAP_WIDTH (p); - /* the width is handled by mswindows_output_pixmap_region */ + xdga.xoffset = posmod (xdb.xpos - absolute_pxoffset, + IMAGE_INSTANCE_PIXMAP_WIDTH (p)); + xdga.yoffset = posmod (xdb.ypos - absolute_pyoffset, + IMAGE_INSTANCE_PIXMAP_HEIGHT (p)); + /* [[ the width is handled by mswindows_output_pixmap_region ]] + #### -- What is the correct meaning of this comment? There is + no mswindows_output_pixmap_region(). --ben*/ mswindows_output_dibitmap (f, p, &xdb, &xdga); pxoffset += xdga.width; xdga.width = min ((db->width - pxoffset), @@ -711,7 +740,9 @@ WINDOW_FACE_CACHEL_BACKGROUND (w, findex), Qnil); if (bg_pixmap) - mswindows_output_dibitmap_region (f, p, db, dga); + mswindows_output_dibitmap_region + (f, p, db, dga, + EQ (WINDOW_FACE_CACHEL_BACKGROUND_PLACEMENT (w, findex), Qabsolute)); else mswindows_output_dibitmap (f, p, db, dga); } @@ -1208,16 +1239,13 @@ given face. ****************************************************************************/ static void -mswindows_clear_region ( -#ifdef HAVE_SCROLLBARS - Lisp_Object locale, -#else - Lisp_Object UNUSED (locale), -#endif +mswindows_clear_region (Lisp_Object USED_IF_SCROLLBARS (locale), struct device *UNUSED (d), struct frame *f, face_index UNUSED (findex), int x, int y, int width, int height, Lisp_Object fcolor, - Lisp_Object bcolor, Lisp_Object background_pixmap) + Lisp_Object bcolor, + Lisp_Object background_pixmap, + Lisp_Object background_placement) { RECT rect = { x, y, x+width, y+height }; HDC hdc = get_frame_dc (f, 1); @@ -1228,7 +1256,8 @@ mswindows_update_dc (hdc, fcolor, bcolor, background_pixmap); mswindows_output_dibitmap_region - ( f, XIMAGE_INSTANCE (background_pixmap), &db, 0); + (f, XIMAGE_INSTANCE (background_pixmap), &db, 0, + EQ (background_placement, Qabsolute)); } else { diff -r 861f2601a38b -r 1f0b15040456 src/redisplay-output.c --- a/src/redisplay-output.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/redisplay-output.c Sun May 01 18:44:03 2011 +0100 @@ -3,13 +3,14 @@ Copyright (C) 1995, 1996, 2002, 2003 Ben Wing. Copyright (C) 1996 Chuck Thompson. Copyright (C) 1999, 2002 Andy Piper. + Copyright (C) 2010 Didier Verna This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +18,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -83,7 +82,7 @@ redisplay performance so avoiding all excess overhead is a good thing. Is all of this true? */ memcpy (cra->base, dra->base, sizeof (struct rune) * max_move); - Dynarr_set_length (cra, max_move); + Dynarr_set_lengthr (cra, max_move); } else Dynarr_reset (cra); @@ -171,7 +170,7 @@ tr = cdb->runes; memcpy (cdb, ddb, sizeof (struct display_block)); cdb->runes = tr; - Dynarr_increment (clp->display_blocks); + Dynarr_incrementr (clp->display_blocks); } sync_rune_structs (w, cdb->runes, ddb->runes); @@ -183,7 +182,7 @@ else if (line >= Dynarr_length (cdla)) { assert (line == Dynarr_length (cdla)); - Dynarr_increment (cdla); + Dynarr_incrementr (cdla); } } @@ -475,7 +474,7 @@ rb = Dynarr_atp (db->runes, cursor_location); *cursor_start = rb->xpos; - default_face_height_and_width (window, &defheight, &defwidth); + default_face_width_and_height (window, &defwidth, &defheight); *cursor_height = defheight; if (rb->type == RUNE_BLANK) @@ -637,8 +636,8 @@ Lisp_Object window = wrap_window (w); redisplay_clear_region (window, DEFAULT_INDEX, - FRAME_LEFT_BORDER_START (f), y, - FRAME_BORDER_WIDTH (f), height); + FRAME_LEFT_INTERNAL_BORDER_START (f), y, + FRAME_INTERNAL_BORDER_WIDTH (f), height); } /***************************************************************************** @@ -653,8 +652,8 @@ Lisp_Object window = wrap_window (w); redisplay_clear_region (window, DEFAULT_INDEX, - FRAME_RIGHT_BORDER_START (f), - y, FRAME_BORDER_WIDTH (f), height); + FRAME_RIGHT_INTERNAL_BORDER_START (f), + y, FRAME_INTERNAL_BORDER_WIDTH (f), height); } /***************************************************************************** @@ -1662,8 +1661,7 @@ dga->width = IMAGE_INSTANCE_PIXMAP_WIDTH (p); #ifdef DEBUG_REDISPLAY - printf ("redisplay_output_pixmap(request) \ -[%dx%d@%d+%d] in [%dx%d@%d+%d]\n", + printf ("redisplay_output_pixmap(request) [%dx%d@%d+%d] in [%dx%d@%d+%d]\n", db->width, db->height, db->xpos, db->ypos, dga->width, dga->height, dga->xoffset, dga->yoffset); #endif @@ -1673,8 +1671,7 @@ return; #ifdef DEBUG_REDISPLAY - printf ("redisplay_output_pixmap(normalized) \ -[%dx%d@%d+%d] in [%dx%d@%d+%d]\n", + printf ("redisplay_output_pixmap(normalized) [%dx%d@%d+%d] in [%dx%d@%d+%d]\n", db->width, db->height, db->xpos, db->ypos, dga->width, dga->height, dga->xoffset, dga->yoffset); #endif @@ -1721,6 +1718,7 @@ struct frame *f = NULL; struct device *d; Lisp_Object background_pixmap = Qunbound; + Lisp_Object background_placement = Qunbound; Lisp_Object fcolor = Qnil, bcolor = Qnil; if (!width || !height) @@ -1747,11 +1745,12 @@ /* #### This isn't quite right for when this function is called from the toolbar code. */ + /* #### GEOM! This uses a backing pixmap in the gutter. Correct? */ /* Don't use a backing pixmap in the border area */ - if (x >= FRAME_LEFT_BORDER_END (f) - && x < FRAME_RIGHT_BORDER_START (f) - && y >= FRAME_TOP_BORDER_END (f) - && y < FRAME_BOTTOM_BORDER_START (f)) + if (x >= FRAME_LEFT_INTERNAL_BORDER_END (f) + && x < FRAME_RIGHT_INTERNAL_BORDER_START (f) + && y >= FRAME_TOP_INTERNAL_BORDER_END (f) + && y < FRAME_BOTTOM_INTERNAL_BORDER_START (f)) { Lisp_Object temp; @@ -1765,22 +1764,26 @@ /* #### maybe we could implement such that a string can be a background pixmap? */ background_pixmap = temp; + background_placement + = WINDOW_FACE_CACHEL_BACKGROUND_PLACEMENT (w, findex); } } else { temp = FACE_BACKGROUND_PIXMAP (Vdefault_face, locale); - + if (IMAGE_INSTANCEP (temp) && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (temp))) { background_pixmap = temp; + background_placement + = FACE_BACKGROUND_PLACEMENT (Vdefault_face, locale); } } } - if (!UNBOUNDP (background_pixmap) && - XIMAGE_INSTANCE_PIXMAP_DEPTH (background_pixmap) == 0) + if (!UNBOUNDP (background_pixmap) + && XIMAGE_INSTANCE_PIXMAP_DEPTH (background_pixmap) == 0) { if (w) { @@ -1804,8 +1807,9 @@ if (UNBOUNDP (background_pixmap)) background_pixmap = Qnil; - DEVMETH (d, clear_region, - (locale, d, f, findex, x, y, width, height, fcolor, bcolor, background_pixmap)); + DEVMETH (d, clear_region, (locale, d, f, findex, x, y, width, height, + fcolor, bcolor, + background_pixmap, background_placement)); } /**************************************************************************** @@ -2091,7 +2095,10 @@ { Lisp_Object window = wrap_window (w); - + /* #### GEOM! FIXME #### This is definitely wrong. It was clearly not + fixed up to accommodate the gutter. The internal border width is now + no longer adjacent to the leftmost window, since the gutter + intervenes. */ if (!NILP (Fwindow_highest_p (window))) { struct frame *f = XFRAME (w->frame); @@ -2102,14 +2109,15 @@ if (window_is_leftmost (w)) { - x -= FRAME_BORDER_WIDTH (f); - width += FRAME_BORDER_WIDTH (f); + x -= FRAME_INTERNAL_BORDER_WIDTH (f); + width += FRAME_INTERNAL_BORDER_WIDTH (f); } if (window_is_rightmost (w)) - width += FRAME_BORDER_WIDTH (f); - - y = FRAME_TOP_BORDER_START (f) - 1; - height = FRAME_BORDER_HEIGHT (f) + 1; + width += FRAME_INTERNAL_BORDER_WIDTH (f); + + /* #### This off-by-one stuff also occurs in XLIKE_clear_frame(). */ + y = FRAME_TOP_INTERNAL_BORDER_START (f) - 1; + height = FRAME_INTERNAL_BORDER_HEIGHT (f) + 1; redisplay_clear_region (window, DEFAULT_INDEX, x, y, width, height); } @@ -2144,12 +2152,15 @@ window = wrap_window (w); if (window_is_leftmost (w)) - redisplay_clear_region (window, DEFAULT_INDEX, FRAME_LEFT_BORDER_START (f), - ypos1, FRAME_BORDER_WIDTH (f), height); + redisplay_clear_region (window, DEFAULT_INDEX, + FRAME_LEFT_INTERNAL_BORDER_START (f), + ypos1, FRAME_INTERNAL_BORDER_WIDTH (f), + height); if (bounds.left_in - bounds.left_out > 0) redisplay_clear_region (window, - get_builtin_face_cache_index (w, Vleft_margin_face), + get_builtin_face_cache_index + (w, Vleft_margin_face), bounds.left_out, ypos1, bounds.left_in - bounds.left_out, height); @@ -2161,13 +2172,17 @@ if (bounds.right_out - bounds.right_in > 0) redisplay_clear_region (window, - get_builtin_face_cache_index (w, Vright_margin_face), + get_builtin_face_cache_index + (w, Vright_margin_face), bounds.right_in, ypos1, - bounds.right_out - bounds.right_in, height); + bounds.right_out - bounds.right_in, + height); if (window_is_rightmost (w)) - redisplay_clear_region (window, DEFAULT_INDEX, FRAME_RIGHT_BORDER_START (f), - ypos1, FRAME_BORDER_WIDTH (f), height); + redisplay_clear_region (window, DEFAULT_INDEX, + FRAME_RIGHT_INTERNAL_BORDER_START (f), + ypos1, FRAME_INTERNAL_BORDER_WIDTH (f), + height); } } } @@ -2217,7 +2232,7 @@ /* #### See if this can be made conditional on the frame changing size. */ if (MINI_WINDOW_P (w)) - ypos2 += FRAME_BORDER_HEIGHT (f); + ypos2 += FRAME_INTERNAL_BORDER_HEIGHT (f); if (min_start >= 0 && ypos1 < min_start) ypos1 = min_start; @@ -2464,7 +2479,7 @@ /* If the number of display lines has shrunk, adjust. */ if (cdla_len > ddla_len) { - Dynarr_set_length (cdla, ddla_len); + Dynarr_set_lengthr (cdla, ddla_len); } /* Output a vertical divider between windows, if necessary. */ diff -r 861f2601a38b -r 1f0b15040456 src/redisplay-tty.c --- a/src/redisplay-tty.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/redisplay-tty.c Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not completely synched with FSF. Mostly divergent from FSF. */ @@ -44,7 +42,7 @@ #include "window.h" #include "console-tty-impl.h" -#include "objects-tty-impl.h" +#include "fontcolor-tty-impl.h" #include "syssignal.h" @@ -428,7 +426,8 @@ struct frame * f, face_index findex, int x, int y, int width, int height, Lisp_Object UNUSED (fcolor), Lisp_Object UNUSED (bcolor), - Lisp_Object UNUSED (background_pixmap)) + Lisp_Object UNUSED (background_pixmap), + Lisp_Object UNUSED (background_placement)) { struct console *c = XCONSOLE (FRAME_CONSOLE (f)); int line; @@ -1115,6 +1114,13 @@ if (CONSOLE_TTY_DATA (c)->width <= 0 || CONSOLE_TTY_DATA (c)->height <= 0) return TTY_SIZE_UNSPECIFIED; + CONSOLE_TTY_DATA (c)->colors = tgetnum("Co"); + if (CONSOLE_TTY_DATA (c)->colors == 0) + CONSOLE_TTY_DATA (c)->colors = tgetnum("colors"); + if (CONSOLE_TTY_DATA (c)->colors == 0) + /* There is always foreground and background. */ + CONSOLE_TTY_DATA (c)->colors = 2; + /* * Initialize cursor motion information. */ diff -r 861f2601a38b -r 1f0b15040456 src/redisplay-x.c --- a/src/redisplay-x.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/redisplay-x.c Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/redisplay-xlike-inc.c --- a/src/redisplay-xlike-inc.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/redisplay-xlike-inc.c Sun May 01 18:44:03 2011 +0100 @@ -3,13 +3,14 @@ Copyright (C) 1994 Lucid, Inc. Copyright (C) 1995 Sun Microsystems, Inc. Copyright (C) 2002, 2003, 2005, 2009, 2010 Ben Wing. + Copyright (C) 2010 Didier Verna This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +18,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -181,7 +180,7 @@ separate_textual_runs_nomule (unsigned char *text_storage, struct textual_run *run_storage, const Ichar *str, Charcount len, - struct face_cachel *UNUSED(cachel)) + struct face_cachel *UNUSED (cachel)) { if (!len) return 0; @@ -211,7 +210,7 @@ separate_textual_runs_xft_nomule (unsigned char *text_storage, struct textual_run *run_storage, const Ichar *str, Charcount len, - struct face_cachel *UNUSED(cachel)) + struct face_cachel *UNUSED (cachel)) { int i; if (!len) @@ -225,7 +224,7 @@ for (i = 0; i < len; i++) { *(XftChar16 *)text_storage = str[i]; - text_storage += sizeof(XftChar16); + text_storage += sizeof (XftChar16); } return 1; } @@ -236,7 +235,7 @@ separate_textual_runs_xft_mule (unsigned char *text_storage, struct textual_run *run_storage, const Ichar *str, Charcount len, - struct face_cachel *UNUSED(cachel)) + struct face_cachel *UNUSED (cachel)) { Lisp_Object prev_charset = Qunbound; int runs_so_far = 0, i; @@ -249,8 +248,8 @@ for (i = 0; i < len; i++) { Ichar ch = str[i]; - Lisp_Object charset = ichar_charset(ch); - int ucs = ichar_to_unicode(ch); + Lisp_Object charset = ichar_charset (ch); + int ucs = ichar_to_unicode (ch); /* If UCS is less than zero or greater than 0xFFFF, set ucs2 to REPLACMENT CHARACTER. */ @@ -269,7 +268,7 @@ } *(XftChar16 *)text_storage = ucs; - text_storage += sizeof(XftChar16); + text_storage += sizeof (XftChar16); } if (runs_so_far) @@ -334,7 +333,7 @@ These flags are almost mutually exclusive, but we're sloppy about resetting "shadowed" flags. So the flags must be checked in the proper order in computing byte1 and byte2, below. */ - charset_leading_byte = XCHARSET_LEADING_BYTE(charset); + charset_leading_byte = XCHARSET_LEADING_BYTE (charset); translate_to_ucs_2 = bit_vector_bit (FACE_CACHEL_FONT_FINAL_STAGE (cachel), charset_leading_byte - MIN_LEADING_BYTE); @@ -383,7 +382,7 @@ /* Must check flags in this order. See comment above. */ if (translate_to_ucs_2) { - int ucs = ichar_to_unicode(ch); + int ucs = ichar_to_unicode (ch); /* If UCS is less than zero or greater than 0xFFFF, set ucs2 to REPLACMENT CHARACTER. */ ucs = (ucs & ~0xFFFF) ? 0xFFFD : ucs; @@ -812,8 +811,9 @@ /* Called as gtk_get_gc from gtk-glue.c */ -XLIKE_GC XLIKE_get_gc (struct device *d, Lisp_Object font, Lisp_Object fg, - Lisp_Object bg, Lisp_Object bg_pmap, +XLIKE_GC XLIKE_get_gc (struct frame *f, Lisp_Object font, + Lisp_Object fg, Lisp_Object bg, + Lisp_Object bg_pixmap, Lisp_Object bg_placement, Lisp_Object lwidth); /***************************************************************************** @@ -822,9 +822,12 @@ Given a number of parameters return a GC with those properties. ****************************************************************************/ XLIKE_GC -XLIKE_get_gc (struct device *d, Lisp_Object font, Lisp_Object fg, - Lisp_Object bg, Lisp_Object bg_pmap, Lisp_Object lwidth) +XLIKE_get_gc (struct frame *f, Lisp_Object font, + Lisp_Object fg, Lisp_Object bg, + Lisp_Object bg_pixmap, Lisp_Object bg_placement, + Lisp_Object lwidth) { + struct device *d = XDEVICE (f->device); XLIKE_GCVALUES gcv; unsigned long mask; @@ -836,7 +839,8 @@ gcv.clip_x_origin = 0; gcv.clip_y_origin = 0; XLIKE_SET_GC_FILL (gcv, XLIKE_FILL_SOLID); - mask = XLIKE_GC_EXPOSURES | XLIKE_GC_CLIP_MASK | XLIKE_GC_CLIP_X_ORIGIN | XLIKE_GC_CLIP_Y_ORIGIN; + mask = XLIKE_GC_EXPOSURES + | XLIKE_GC_CLIP_MASK | XLIKE_GC_CLIP_X_ORIGIN | XLIKE_GC_CLIP_Y_ORIGIN; mask |= XLIKE_GC_FILL; if (!NILP (font) @@ -882,7 +886,7 @@ /* This special case comes from a request to draw text with a face which has the dim property. We'll use a stippled foreground GC. */ - if (EQ (bg_pmap, Qdim)) + if (EQ (bg_pixmap, Qdim)) { assert (DEVICE_XLIKE_GRAY_PIXMAP (d) != XLIKE_NONE); @@ -890,21 +894,35 @@ gcv.stipple = DEVICE_XLIKE_GRAY_PIXMAP (d); mask |= (XLIKE_GC_FILL | XLIKE_GC_STIPPLE); } - else if (IMAGE_INSTANCEP (bg_pmap) - && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap))) + else if (IMAGE_INSTANCEP (bg_pixmap) + && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pixmap))) { - if (XIMAGE_INSTANCE_PIXMAP_DEPTH (bg_pmap) == 0) + if (XIMAGE_INSTANCE_PIXMAP_DEPTH (bg_pixmap) == 0) { XLIKE_SET_GC_FILL (gcv, XLIKE_FILL_OPAQUE_STIPPLED); - gcv.stipple = XIMAGE_INSTANCE_XLIKE_PIXMAP (bg_pmap); + gcv.stipple = XIMAGE_INSTANCE_XLIKE_PIXMAP (bg_pixmap); mask |= (XLIKE_GC_STIPPLE | XLIKE_GC_FILL); } else { XLIKE_SET_GC_FILL (gcv, XLIKE_FILL_TILED); - gcv.tile = XIMAGE_INSTANCE_XLIKE_PIXMAP (bg_pmap); + gcv.tile = XIMAGE_INSTANCE_XLIKE_PIXMAP (bg_pixmap); mask |= (XLIKE_GC_TILE | XLIKE_GC_FILL); } + if (EQ (bg_placement, Qabsolute)) + { +#ifdef THIS_IS_GTK + /* #### WARNING: this does not currently work. -- dvl + gcv.ts_x_origin = - FRAME_GTK_X (f); + gcv.ts_y_origin = - FRAME_GTK_Y (f); + mask |= (XLIKE_GC_TS_X_ORIGIN | XLIKE_GC_TS_Y_ORIGIN); + */ +#else + gcv.ts_x_origin = - FRAME_X_X (f); + gcv.ts_y_origin = - FRAME_X_Y (f); + mask |= (XLIKE_GC_TS_X_ORIGIN | XLIKE_GC_TS_Y_ORIGIN); +#endif + } } if (!NILP (lwidth)) @@ -1076,8 +1094,8 @@ && !NILP (w->text_cursor_visible_p)) || NILP (bg_pmap)) bgc = 0; else - bgc = XLIKE_get_gc (d, Qnil, cachel->foreground, cachel->background, - bg_pmap, Qnil); + bgc = XLIKE_get_gc (f, Qnil, cachel->foreground, cachel->background, + bg_pmap, cachel->background_placement, Qnil); if (bgc) { @@ -1157,8 +1175,8 @@ fg = XFT_FROB_LISP_COLOR (cursor_cachel->foreground, 0); bg = XFT_FROB_LISP_COLOR (cursor_cachel->background, 0); #endif - gc = XLIKE_get_gc (d, font, cursor_cachel->foreground, - cursor_cachel->background, Qnil, Qnil); + gc = XLIKE_get_gc (f, font, cursor_cachel->foreground, + cursor_cachel->background, Qnil, Qnil, Qnil); } else if (cachel->dim) { @@ -1179,8 +1197,8 @@ fg = XFT_FROB_LISP_COLOR (cachel->foreground, 1); bg = XFT_FROB_LISP_COLOR (cachel->background, 0); #endif - gc = XLIKE_get_gc (d, font, cachel->foreground, cachel->background, - Qdim, Qnil); + gc = XLIKE_get_gc (f, font, cachel->foreground, cachel->background, + Qdim, Qnil, Qnil); } else { @@ -1188,8 +1206,8 @@ fg = XFT_FROB_LISP_COLOR (cachel->foreground, 0); bg = XFT_FROB_LISP_COLOR (cachel->background, 0); #endif - gc = XLIKE_get_gc (d, font, cachel->foreground, cachel->background, - Qnil, Qnil); + gc = XLIKE_get_gc (f, font, cachel->foreground, cachel->background, + Qnil, Qnil, Qnil); } #ifdef USE_XFT { @@ -1205,8 +1223,8 @@ clip_end - clip_start, height }; XUnionRectWithRegion (&clip_box, clip_reg, clip_reg); - XftDrawSetClip(xftDraw, clip_reg); - XDestroyRegion(clip_reg); + XftDrawSetClip (xftDraw, clip_reg); + XDestroyRegion (clip_reg); } if (!bgc) @@ -1228,19 +1246,19 @@ struct textual_run *run = &runs[i]; int rect_width = x_text_width_single_run (f, cachel, run); #ifndef USE_XFTTEXTENTS_TO_AVOID_FONT_DROPPINGS - int rect_height = FONT_INSTANCE_ASCENT(fi) - + FONT_INSTANCE_DESCENT(fi) + 1; + int rect_height = FONT_INSTANCE_ASCENT (fi) + + FONT_INSTANCE_DESCENT (fi) + 1; #else - int rect_height = FONT_INSTANCE_ASCENT(fi) - + FONT_INSTANCE_DESCENT(fi); + int rect_height = FONT_INSTANCE_ASCENT (fi) + + FONT_INSTANCE_DESCENT (fi); XGlyphInfo gi; if (run->dimension == 2) { XftTextExtents16 (dpy, - FONT_INSTANCE_X_XFTFONT(fi), + FONT_INSTANCE_X_XFTFONT (fi), (XftChar16 *) run->ptr, run->len, &gi); } else { XftTextExtents8 (dpy, - FONT_INSTANCE_X_XFTFONT(fi), + FONT_INSTANCE_X_XFTFONT (fi), run->ptr, run->len, &gi); } rect_height = rect_height > gi.height @@ -1433,13 +1451,13 @@ cursor_width, height }; XUnionRectWithRegion (&clip_box, clip_reg, clip_reg); - XftDrawSetClip(xftDraw, clip_reg); - XDestroyRegion(clip_reg); + XftDrawSetClip (xftDraw, clip_reg); + XDestroyRegion (clip_reg); } { /* draw background rectangle & draw text */ - int rect_height = FONT_INSTANCE_ASCENT(fi) - + FONT_INSTANCE_DESCENT(fi); - int rect_width = x_text_width_single_run(f, cachel, &runs[i]); + int rect_height = FONT_INSTANCE_ASCENT (fi) + + FONT_INSTANCE_DESCENT (fi); + int rect_width = x_text_width_single_run (f, cachel, &runs[i]); XftColor xft_color; xft_color = XFT_FROB_LISP_COLOR (cursor_cachel->background, 0); @@ -1455,15 +1473,15 @@ (XftChar16 *) runs[i].ptr, runs[i].len); } - XftDrawSetClip(xftDraw, 0); + XftDrawSetClip (xftDraw, 0); } else /* core font, not Xft */ #endif /* USE_XFT */ { XLIKE_RECTANGLE clip_box; XLIKE_GC cgc; - cgc = XLIKE_get_gc (d, font, cursor_cachel->foreground, - cursor_cachel->background, Qnil, Qnil); + cgc = XLIKE_get_gc (f, font, cursor_cachel->foreground, + cursor_cachel->background, Qnil, Qnil, Qnil); clip_box.x = 0; clip_box.y = 0; @@ -1534,13 +1552,14 @@ if (!NILP (bar_cursor_value)) { - gc = XLIKE_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, + gc = XLIKE_get_gc (f, Qnil, cursor_cachel->background, Qnil, + Qnil, Qnil, make_int (bar_width)); } else { - gc = XLIKE_get_gc (d, Qnil, cursor_cachel->background, - Qnil, Qnil, Qnil); + gc = XLIKE_get_gc (f, Qnil, cursor_cachel->background, + Qnil, Qnil, Qnil, Qnil); } tmp_y = dl->ypos - bogusly_obtained_ascent_value; @@ -1728,7 +1747,8 @@ get_builtin_face_cache_index (w, Vtext_cursor_face)); - gc = XLIKE_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil); + gc = XLIKE_get_gc (f, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil, + Qnil); if (cursor_width > db->xpos + dga->width - cursor_start) cursor_width = db->xpos + dga->width - cursor_start; @@ -1750,7 +1770,7 @@ Draw a vertical divider down the right side of the given window. ****************************************************************************/ static void -XLIKE_output_vertical_divider (struct window *w, int USED_IF_X(clear)) +XLIKE_output_vertical_divider (struct window *w, int USED_IF_X (clear)) { struct frame *f = XFRAME (w->frame); struct device *d = XDEVICE (f->device); @@ -1872,11 +1892,13 @@ bg_pmap = Qnil; if (NILP (bg_pmap)) - gc = XLIKE_get_gc (d, Qnil, WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex), - Qnil, Qnil, Qnil); + gc = XLIKE_get_gc (f, Qnil, WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex), + Qnil, Qnil, Qnil, Qnil); else - gc = XLIKE_get_gc (d, Qnil, WINDOW_FACE_CACHEL_FOREGROUND (w, rb->findex), - WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex), bg_pmap, + gc = XLIKE_get_gc (f, Qnil, WINDOW_FACE_CACHEL_FOREGROUND (w, rb->findex), + WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex), + bg_pmap, + WINDOW_FACE_CACHEL_BACKGROUND_PLACEMENT (w, rb->findex), Qnil); XLIKE_FILL_RECTANGLE (dpy, x_win, gc, x, y, width, height); @@ -1897,7 +1919,8 @@ (WINDOW_FACE_CACHEL (w, rb->findex), Vcharset_ascii)); - gc = XLIKE_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil); + gc = XLIKE_get_gc (f, Qnil, cursor_cachel->background, Qnil, + Qnil, Qnil, Qnil); cursor_y = dl->ypos - fi->ascent; cursor_height = fi->height; @@ -1915,8 +1938,9 @@ { int bar_width = EQ (bar_cursor_value, Qt) ? 1 : 2; - gc = XLIKE_get_gc (d, Qnil, cursor_cachel->background, - Qnil, Qnil, make_int (bar_width)); + gc = XLIKE_get_gc (f, Qnil, cursor_cachel->background, + Qnil, Qnil, Qnil, + make_int (bar_width)); XLIKE_DRAW_LINE (dpy, x_win, gc, cursor_start + bar_width - 1, cursor_y, cursor_start + bar_width - 1, cursor_y + cursor_height - 1); @@ -1959,9 +1983,9 @@ /* First clear the area not covered by the line. */ if (height - rb->object.hline.thickness > 0) { - gc = XLIKE_get_gc (d, Qnil, + gc = XLIKE_get_gc (f, Qnil, WINDOW_FACE_CACHEL_FOREGROUND (w, rb->findex), - Qnil, Qnil, Qnil); + Qnil, Qnil, Qnil, Qnil); if (ypos2 - ypos1 > 0) XLIKE_FILL_RECTANGLE (dpy, x_win, gc, x, ypos1, width, ypos2 - ypos1); @@ -1977,8 +2001,8 @@ } #else /* THIS_IS_X */ /* Now draw the line. */ - gc = XLIKE_get_gc (d, Qnil, WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex), - Qnil, Qnil, Qnil); + gc = XLIKE_get_gc (f, Qnil, WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex), + Qnil, Qnil, Qnil, Qnil); if (ypos2 < ypos1) ypos2 = ypos1; @@ -1999,8 +2023,10 @@ static void XLIKE_clear_region (Lisp_Object UNUSED (locale), struct device* d, struct frame* f, face_index UNUSED (findex), int x, int y, - int width, int height, Lisp_Object fcolor, - Lisp_Object bcolor, Lisp_Object background_pixmap) + int width, int height, + Lisp_Object fcolor, Lisp_Object bcolor, + Lisp_Object background_pixmap, + Lisp_Object background_placement) { XLIKE_DISPLAY dpy = GET_XLIKE_DISPLAY (d); XLIKE_WINDOW x_win = GET_XLIKE_WINDOW (f); @@ -2008,7 +2034,8 @@ if (!UNBOUNDP (background_pixmap)) { - gc = XLIKE_get_gc (d, Qnil, fcolor, bcolor, background_pixmap, Qnil); + gc = XLIKE_get_gc (f, Qnil, fcolor, bcolor, + background_pixmap, background_placement, Qnil); } if (gc) @@ -2054,9 +2081,10 @@ if (NILP (w->text_cursor_visible_p)) return; - gc = XLIKE_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil); + gc = XLIKE_get_gc (f, Qnil, cursor_cachel->background, Qnil, + Qnil, Qnil, Qnil); - default_face_font_info (window, &defascent, 0, &defheight, 0, 0); + default_face_font_info (window, &defascent, 0, 0, &defheight, 0); /* make sure the cursor is entirely contained between y and y+height */ cursor_height = min (defheight, height); @@ -2078,7 +2106,8 @@ { int bar_width = EQ (bar_cursor_value, Qt) ? 1 : 2; - gc = XLIKE_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, + gc = XLIKE_get_gc (f, Qnil, cursor_cachel->background, Qnil, + Qnil, Qnil, make_int (bar_width)); XLIKE_DRAW_LINE (dpy, x_win, gc, x + bar_width - 1, cursor_y, x + bar_width - 1, cursor_y + cursor_height - 1); @@ -2127,19 +2156,16 @@ int x, y, width, height; Lisp_Object frame; - x = FRAME_LEFT_BORDER_START (f); - width = (FRAME_PIXWIDTH (f) - FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) - - FRAME_REAL_RIGHT_TOOLBAR_WIDTH (f) - - 2 * FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f) - - 2 * FRAME_REAL_RIGHT_TOOLBAR_BORDER_WIDTH (f)); + /* #### GEOM! This clears the internal border and gutter (and scrollbars) + but not the toolbar. Correct? */ + x = FRAME_LEFT_INTERNAL_BORDER_START (f); + width = (FRAME_RIGHT_INTERNAL_BORDER_END (f) - x); /* #### This adjustment by 1 should be being done in the macros. There is some small differences between when the menubar is on - and off that we still need to deal with. */ - y = FRAME_TOP_BORDER_START (f) - 1; - height = (FRAME_PIXHEIGHT (f) - FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) - - FRAME_REAL_BOTTOM_TOOLBAR_HEIGHT (f) - - 2 * FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f) - - 2 * FRAME_REAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f)) + 1; + and off that we still need to deal with. The adjustment also occurs in + redisplay_clear_top_of_window(). */ + y = FRAME_TOP_INTERNAL_BORDER_START (f) - 1; + height = (FRAME_BOTTOM_INTERNAL_BORDER_END (f) - y); XLIKE_CLEAR_AREA (dpy, x_win, x, y, width, height); @@ -2188,7 +2214,7 @@ gcv.graphics_exposures = XLIKE_FALSE; gc = gc_cache_lookup (DEVICE_XLIKE_GC_CACHE (XDEVICE (f->device)), &gcv, XLIKE_GC_FOREGROUND | XLIKE_GC_FUNCTION | XLIKE_GC_EXPOSURES); - default_face_height_and_width (frame, &flash_height, 0); + default_face_width_and_height (frame, 0, &flash_height); /* If window is tall, flash top and bottom line. */ if (EQ (Vvisible_bell, Qtop_bottom) && w->pixel_height > 3 * flash_height) diff -r 861f2601a38b -r 1f0b15040456 src/redisplay.c --- a/src/redisplay.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/redisplay.c Sun May 01 18:44:03 2011 +0100 @@ -7,10 +7,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -18,9 +18,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -61,7 +59,7 @@ #include "gutter.h" #include "insdel.h" #include "menubar.h" -#include "objects-impl.h" +#include "fontcolor-impl.h" #include "opaque.h" #include "process.h" #include "profile.h" @@ -728,7 +726,7 @@ struct display_block *dbp = Dynarr_atp (dl->display_blocks, elt); /* "add" the block to the list */ - Dynarr_increment (dl->display_blocks); + Dynarr_incrementr (dl->display_blocks); /* initialize and return */ dbp->type = type; @@ -924,8 +922,8 @@ int scaled_default_font_ascent, scaled_default_font_descent; default_face_font_info (data->window, &default_font_ascent, - &default_font_descent, &default_font_height, - 0, 0); + &default_font_descent, 0, &default_font_height, + 0); scaled_default_font_ascent = data->max_pixmap_height * default_font_ascent / default_font_height; @@ -1221,7 +1219,7 @@ if (local) Dynarr_add (data->db->runes, *crb); else - Dynarr_increment (data->db->runes); + Dynarr_incrementr (data->db->runes); data->pixpos += width; @@ -1686,7 +1684,10 @@ break; case PROP_STRING: if (pb->data.p_string.str) - xfree (pb->data.p_string.str); + { + xfree (pb->data.p_string.str); + pb->data.p_string.str = 0; + } /* #### bogus bogus -- this doesn't do anything! Should probably call add_ibyte_string_runes(), once that function is fixed. */ @@ -2220,9 +2221,9 @@ else if (MINI_WINDOW_P (w) && !active_minibuffer) data.cursor_type = NO_CURSOR; else if (w == XWINDOW (FRAME_SELECTED_WINDOW (f)) && - EQ(DEVICE_CONSOLE(d), Vselected_console) && - d == XDEVICE(CONSOLE_SELECTED_DEVICE(XCONSOLE(DEVICE_CONSOLE(d))))&& - f == XFRAME(DEVICE_SELECTED_FRAME(d))) + EQ (DEVICE_CONSOLE (d), Vselected_console) && + d == XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (DEVICE_CONSOLE (d))))&& + f == XFRAME (DEVICE_SELECTED_FRAME (d))) { data.byte_cursor_charpos = BYTE_BUF_PT (b); data.cursor_type = CURSOR_ON; @@ -4532,7 +4533,7 @@ if (Dynarr_length (dla) == 0) { if (Dynarr_largest (dla) > 0) - Dynarr_increment (dla); + Dynarr_incrementr (dla); else { struct display_line modeline; @@ -5301,9 +5302,10 @@ /* -Info on Re-entrancy crashes, with backtraces given: - - (Info-goto-node "(internals)Nasty Bugs due to Reentrancy in Redisplay Structures handling QUIT") +Info on reentrancy crashes, with backtraces given: + + (Info-goto-node "(internals)Critical Redisplay Sections") + */ @@ -5405,7 +5407,7 @@ if (pos_of_dlp < 0) Dynarr_add (dla, *dlp); else if (pos_of_dlp == Dynarr_length (dla)) - Dynarr_increment (dla); + Dynarr_incrementr (dla); else ABORT (); @@ -5459,13 +5461,13 @@ if (!in_display) depth = enter_redisplay_critical_section (); - /* This is one spot where a re-entrancy crash will occur, due to a check + /* This is one spot where a reentrancy crash will occur, due to a check in the dynarr to make sure it isn't "locked" */ /* -Info on Re-entrancy crashes, with backtraces given: - - (Info-goto-node "(internals)Nasty Bugs due to Reentrancy in Redisplay Structures handling QUIT") +Info on reentrancy crashes, with backtraces given: + + (Info-goto-node "(internals)Critical Redisplay Sections") */ Dynarr_reset (dla); @@ -5515,10 +5517,10 @@ Lisp_Object string; prop = Dynarr_new (prop_block); - string = concat2(Vminibuf_preprompt, Vminibuf_prompt); + string = concat2 (Vminibuf_preprompt, Vminibuf_prompt); pb.type = PROP_MINIBUF_PROMPT; - pb.data.p_string.str = XSTRING_DATA(string); - pb.data.p_string.len = XSTRING_LENGTH(string); + pb.data.p_string.str = XSTRING_DATA (string); + pb.data.p_string.len = XSTRING_LENGTH (string); Dynarr_add (prop, pb); } else @@ -5628,7 +5630,7 @@ if (pos_of_dlp < 0) Dynarr_add (dla, *dlp); else if (pos_of_dlp == Dynarr_length (dla)) - Dynarr_increment (dla); + Dynarr_incrementr (dla); else ABORT (); @@ -6257,9 +6259,9 @@ selected_in_its_frame = (w == XWINDOW (FRAME_SELECTED_WINDOW (f))); selected_globally = selected_in_its_frame && - EQ(DEVICE_CONSOLE(d), Vselected_console) && - XDEVICE(CONSOLE_SELECTED_DEVICE(XCONSOLE(DEVICE_CONSOLE(d)))) == d && - XFRAME(DEVICE_SELECTED_FRAME(d)) == f; + EQ (DEVICE_CONSOLE (d), Vselected_console) && + XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (DEVICE_CONSOLE (d)))) == d && + XFRAME (DEVICE_SELECTED_FRAME (d)) == f; if (skip_selected && selected_in_its_frame) return; @@ -6684,12 +6686,25 @@ unbind_to (depth); } +static int the_ritual_suicide_has_been_cancelled = 0; + +void +redisplay_cancel_ritual_suicide(void) +{ + the_ritual_suicide_has_been_cancelled = 1; +} + #ifdef ERROR_CHECK_TRAPPING_PROBLEMS static Lisp_Object commit_ritual_suicide (Lisp_Object UNUSED (ceci_nest_pas_une_pipe)) { - assert (!in_display); + if (!the_ritual_suicide_has_been_cancelled) + { + assert (!in_display); + } + else + the_ritual_suicide_has_been_cancelled = 0; return Qnil; } @@ -6764,7 +6779,7 @@ { struct frame *f = XFRAME (XCAR (frmcons)); if (f->size_change_pending) - change_frame_size (f, f->new_height, f->new_width, 0); + change_frame_size (f, f->new_width, f->new_height, 0); } } return Qnil; @@ -6901,7 +6916,7 @@ /* Before we put a hold on frame size changes, attempt to process any which are already pending. */ if (f->size_change_pending) - change_frame_size (f, f->new_height, f->new_width, 0); + change_frame_size (f, f->new_width, f->new_height, 0); /* If frame size might need to be changed, due to changed size of toolbars, scrollbars etc, change it now */ @@ -7065,7 +7080,7 @@ if (FRAME_REPAINT_P (f)) { - if (CLASS_REDISPLAY_FLAGS_CHANGEDP(f)) + if (CLASS_REDISPLAY_FLAGS_CHANGEDP (f)) { int preempted = redisplay_frame (f, 1); if (preempted) @@ -7239,10 +7254,10 @@ fail if DEVICE_SELECTED_FRAME == Qnil (since w->frame cannot be). This can occur when the frame title is computed really early */ Charbpos pos = - ((EQ(DEVICE_SELECTED_FRAME(d), w->frame) && - (w == XWINDOW (FRAME_SELECTED_WINDOW (device_selected_frame(d)))) && - EQ(DEVICE_CONSOLE(d), Vselected_console) && - XDEVICE(CONSOLE_SELECTED_DEVICE(XCONSOLE(DEVICE_CONSOLE(d)))) == d ) + ((EQ (DEVICE_SELECTED_FRAME (d), w->frame) && + (w == XWINDOW (FRAME_SELECTED_WINDOW (device_selected_frame (d)))) && + EQ (DEVICE_CONSOLE (d), Vselected_console) && + XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (DEVICE_CONSOLE (d)))) == d ) ? BUF_PT (b) : marker_position (w->pointm[type])); EMACS_INT line; @@ -7984,7 +7999,7 @@ int partially) { struct buffer *b = XBUFFER (w->buffer); - int pixpos = -WINDOW_TEXT_TOP_CLIP(w); + int pixpos = -WINDOW_TEXT_TOP_CLIP (w); int bottom = WINDOW_TEXT_HEIGHT (w); int start_elt; @@ -8316,7 +8331,7 @@ int defheight; window = wrap_window (w); - default_face_height_and_width (window, &defheight, 0); + default_face_width_and_height (window, 0, &defheight); cur_elt = Dynarr_length (w->line_start_cache) - 1; @@ -8469,7 +8484,7 @@ return; } - Dynarr_insert_many_at_start (cache, Dynarr_begin (internal_cache), + Dynarr_prepend_many (cache, Dynarr_begin (internal_cache), ic_elt + 1); } @@ -8621,7 +8636,7 @@ int defheight, defwidth; window = wrap_window (w); - default_face_height_and_width (window, &defheight, &defwidth); + default_face_width_and_height (window, &defwidth, &defheight); /* If we get a bogus value indicating somewhere above or to the left of the window, use the first window line or character position @@ -8767,7 +8782,7 @@ d->pixel_to_glyph_cache.obj_x = *obj_x; \ d->pixel_to_glyph_cache.obj_y = *obj_y; \ d->pixel_to_glyph_cache.w = *w; \ - d->pixel_to_glyph_cache.charpos = *charpos; \ + d->pixel_to_glyph_cache.charpos = *charpos; \ d->pixel_to_glyph_cache.closest = *closest; \ d->pixel_to_glyph_cache.modeline_closest = *modeline_closest; \ d->pixel_to_glyph_cache.obj1 = *obj1; \ @@ -8784,10 +8799,15 @@ OVER_TOOLBAR: over one of the 4 frame toolbars OVER_MODELINE: over a modeline OVER_BORDER: over an internal border + OVER_V_DIVIDER: over a vertical divider between windows (used as a + grab bar for resizing) OVER_NOTHING: over the text area, but not over text OVER_OUTSIDE: outside of the frame border OVER_TEXT: over text in the text area + #### GEOM! We need to also have an OVER_GUTTER, OVER_SCROLLBAR and + OVER_DEAD_BOX. + OBJ1 is one of -- a toolbar button @@ -8880,25 +8900,28 @@ if (device_check_failed) return OVER_NOTHING; - frm_left = FRAME_LEFT_BORDER_END (f); - frm_right = FRAME_RIGHT_BORDER_START (f); - frm_top = FRAME_TOP_BORDER_END (f); - frm_bottom = FRAME_BOTTOM_BORDER_START (f); + /* #### GEOM! The gutter is just inside of this. We should also have an + OVER_GUTTER return value to indicate that we're over a gutter. See + above. */ + frm_left = FRAME_LEFT_INTERNAL_BORDER_END (f); + frm_right = FRAME_RIGHT_INTERNAL_BORDER_START (f); + frm_top = FRAME_TOP_INTERNAL_BORDER_END (f); + frm_bottom = FRAME_BOTTOM_INTERNAL_BORDER_START (f); /* Check if the mouse is outside of the text area actually used by redisplay. */ if (y_coord < frm_top) { - if (y_coord >= FRAME_TOP_BORDER_START (f)) - { - low_y_coord = FRAME_TOP_BORDER_START (f); + if (y_coord >= FRAME_TOP_INTERNAL_BORDER_START (f)) + { + low_y_coord = FRAME_TOP_INTERNAL_BORDER_START (f); high_y_coord = frm_top; position = OVER_BORDER; } else if (y_coord >= 0) { low_y_coord = 0; - high_y_coord = FRAME_TOP_BORDER_START (f); + high_y_coord = FRAME_TOP_INTERNAL_BORDER_START (f); position = OVER_TOOLBAR; } else @@ -8910,15 +8933,15 @@ } else if (y_coord >= frm_bottom) { - if (y_coord < FRAME_BOTTOM_BORDER_END (f)) + if (y_coord < FRAME_BOTTOM_INTERNAL_BORDER_END (f)) { low_y_coord = frm_bottom; - high_y_coord = FRAME_BOTTOM_BORDER_END (f); + high_y_coord = FRAME_BOTTOM_INTERNAL_BORDER_END (f); position = OVER_BORDER; } else if (y_coord < FRAME_PIXHEIGHT (f)) { - low_y_coord = FRAME_BOTTOM_BORDER_END (f); + low_y_coord = FRAME_BOTTOM_INTERNAL_BORDER_END (f); high_y_coord = FRAME_PIXHEIGHT (f); position = OVER_TOOLBAR; } @@ -8934,16 +8957,16 @@ { if (x_coord < frm_left) { - if (x_coord >= FRAME_LEFT_BORDER_START (f)) - { - low_x_coord = FRAME_LEFT_BORDER_START (f); + if (x_coord >= FRAME_LEFT_INTERNAL_BORDER_START (f)) + { + low_x_coord = FRAME_LEFT_INTERNAL_BORDER_START (f); high_x_coord = frm_left; position = OVER_BORDER; } else if (x_coord >= 0) { low_x_coord = 0; - high_x_coord = FRAME_LEFT_BORDER_START (f); + high_x_coord = FRAME_LEFT_INTERNAL_BORDER_START (f); position = OVER_TOOLBAR; } else @@ -8955,15 +8978,15 @@ } else if (x_coord >= frm_right) { - if (x_coord < FRAME_RIGHT_BORDER_END (f)) + if (x_coord < FRAME_RIGHT_INTERNAL_BORDER_END (f)) { low_x_coord = frm_right; - high_x_coord = FRAME_RIGHT_BORDER_END (f); + high_x_coord = FRAME_RIGHT_INTERNAL_BORDER_END (f); position = OVER_BORDER; } else if (x_coord < FRAME_PIXWIDTH (f)) { - low_x_coord = FRAME_RIGHT_BORDER_END (f); + low_x_coord = FRAME_RIGHT_INTERNAL_BORDER_END (f); high_x_coord = FRAME_PIXWIDTH (f); position = OVER_TOOLBAR; } @@ -9142,19 +9165,27 @@ for (*col = 0; *col <= Dynarr_length (db->runes); (*col)++) { - int past_end = (*col == Dynarr_length (db->runes)); - - if (!past_end) - rb = Dynarr_atp (db->runes, *col); - - if (past_end || - (rb->xpos <= x_coord && x_coord < rb->xpos + rb->width)) + if (*col == Dynarr_length (db->runes)) { - if (past_end) - { - (*col)--; - rb = Dynarr_atp (db->runes, *col); - } + /* We've run out of runes to look at. Treat the same as + the case below where we failed to find a non-glyph + character. */ + if (dl->modeline) + *modeline_closest = dl->end_charpos + dl->offset; + else + *closest = dl->end_charpos + dl->offset; + + if (check_margin_glyphs) + get_position_object (dl, obj1, obj2, x_coord, + &low_x_coord, &high_x_coord); + + UPDATE_CACHE_RETURN; + } + + rb = Dynarr_atp (db->runes, *col); + + if (rb->xpos <= x_coord && x_coord < rb->xpos + rb->width) + { *charpos = rb->charpos + dl->offset; low_x_coord = rb->xpos; @@ -9228,9 +9259,8 @@ UPDATE_CACHE_RETURN; } - else if (past_end - || (rb->type == RUNE_CHAR - && rb->object.chr.ch == '\n')) + else if (rb->type == RUNE_CHAR + && rb->object.chr.ch == '\n') { (*row)--; /* At this point we may have glyphs in the right @@ -9290,7 +9320,7 @@ int defheight; lwin = wrap_window (*w); - default_face_height_and_width (lwin, 0, &defheight); + default_face_width_and_height (lwin, 0, &defheight); *row += (adj_area / defheight); } @@ -9656,50 +9686,50 @@ /***************************************************************************/ static int -compute_rune_dynarr_usage (rune_dynarr *dyn, struct overhead_stats *ovstats) -{ - return dyn ? Dynarr_memory_usage (dyn, ovstats) : 0; +compute_rune_dynarr_usage (rune_dynarr *dyn, struct usage_stats *ustats) +{ + return dyn ? Dynarr_memory_usage (dyn, ustats) : 0; } static int compute_display_block_dynarr_usage (display_block_dynarr *dyn, - struct overhead_stats *ovstats) + struct usage_stats *ustats) { int total, i; if (!dyn) return 0; - total = Dynarr_memory_usage (dyn, ovstats); + total = Dynarr_memory_usage (dyn, ustats); for (i = 0; i < Dynarr_largest (dyn); i++) - total += compute_rune_dynarr_usage (Dynarr_at (dyn, i).runes, ovstats); + total += compute_rune_dynarr_usage (Dynarr_at (dyn, i).runes, ustats); return total; } static int compute_glyph_block_dynarr_usage (glyph_block_dynarr *dyn, - struct overhead_stats *ovstats) -{ - return dyn ? Dynarr_memory_usage (dyn, ovstats) : 0; + struct usage_stats *ustats) +{ + return dyn ? Dynarr_memory_usage (dyn, ustats) : 0; } int compute_display_line_dynarr_usage (display_line_dynarr *dyn, - struct overhead_stats *ovstats) + struct usage_stats *ustats) { int total, i; if (!dyn) return 0; - total = Dynarr_memory_usage (dyn, ovstats); + total = Dynarr_memory_usage (dyn, ustats); for (i = 0; i < Dynarr_largest (dyn); i++) { struct display_line *dl = &Dynarr_at (dyn, i); - total += compute_display_block_dynarr_usage(dl->display_blocks, ovstats); - total += compute_glyph_block_dynarr_usage (dl->left_glyphs, ovstats); - total += compute_glyph_block_dynarr_usage (dl->right_glyphs, ovstats); + total += compute_display_block_dynarr_usage (dl->display_blocks, ustats); + total += compute_glyph_block_dynarr_usage (dl->left_glyphs, ustats); + total += compute_glyph_block_dynarr_usage (dl->right_glyphs, ustats); } return total; @@ -9707,9 +9737,9 @@ int compute_line_start_cache_dynarr_usage (line_start_cache_dynarr *dyn, - struct overhead_stats *ovstats) -{ - return dyn ? Dynarr_memory_usage (dyn, ovstats) : 0; + struct usage_stats *ustats) +{ + return dyn ? Dynarr_memory_usage (dyn, ustats) : 0; } #endif /* MEMORY_USAGE_STATS */ diff -r 861f2601a38b -r 1f0b15040456 src/redisplay.h --- a/src/redisplay.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/redisplay.h Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -777,9 +775,9 @@ #ifdef MEMORY_USAGE_STATS int compute_display_line_dynarr_usage (display_line_dynarr *dyn, - struct overhead_stats *ovstats); + struct usage_stats *ustats); int compute_line_start_cache_dynarr_usage (line_start_cache_dynarr *dyn, - struct overhead_stats *ovstats); + struct usage_stats *ustats); #endif @@ -848,4 +846,6 @@ int enter_redisplay_critical_section_if (Boolint from_outside); void exit_redisplay_critical_section_if (Boolint from_outside, int depth); +void redisplay_cancel_ritual_suicide(void); + #endif /* INCLUDED_redisplay_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/regex.c --- a/src/regex.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/regex.c Sun May 01 18:44:03 2011 +0100 @@ -5,23 +5,22 @@ Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 2001, 2002, 2003 Ben Wing. - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - + Copyright (C) 1995, 2001, 2002, 2003, 2010 Ben Wing. + + 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 3 of the License, 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 this program; see the file COPYING. If not, write to - the Free Software Foundation, Inc., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ - + along with XEmacs. If not, see . */ /* Synched up with: FSF 19.29. */ #ifdef HAVE_CONFIG_H @@ -734,17 +733,48 @@ #include #endif -static int debug = 0; +extern int debug_regexps; #define DEBUG_STATEMENT(e) e -#define DEBUG_PRINT1(x) if (debug) printf (x) -#define DEBUG_PRINT2(x1, x2) if (debug) printf (x1, x2) -#define DEBUG_PRINT3(x1, x2, x3) if (debug) printf (x1, x2, x3) -#define DEBUG_PRINT4(x1, x2, x3, x4) if (debug) printf (x1, x2, x3, x4) + +#define DEBUG_PRINT1(x) if (debug_regexps) printf (x) +#define DEBUG_PRINT2(x1, x2) if (debug_regexps) printf (x1, x2) +#define DEBUG_PRINT3(x1, x2, x3) if (debug_regexps) printf (x1, x2, x3) +#define DEBUG_PRINT4(x1, x2, x3, x4) if (debug_regexps) printf (x1, x2, x3, x4) #define DEBUG_PRINT_COMPILED_PATTERN(p, s, e) \ - if (debug) print_partial_compiled_pattern (s, e) + if (debug_regexps) print_partial_compiled_pattern (s, e) #define DEBUG_PRINT_DOUBLE_STRING(w, s1, sz1, s2, sz2) \ - if (debug) print_double_string (w, s1, sz1, s2, sz2) + if (debug_regexps) print_double_string (w, s1, sz1, s2, sz2) + +#define DEBUG_FAIL_PRINT1(x) \ + if (debug_regexps & RE_DEBUG_FAILURE_POINT) printf (x) +#define DEBUG_FAIL_PRINT2(x1, x2) \ + if (debug_regexps & RE_DEBUG_FAILURE_POINT) printf (x1, x2) +#define DEBUG_FAIL_PRINT3(x1, x2, x3) \ + if (debug_regexps & RE_DEBUG_FAILURE_POINT) printf (x1, x2, x3) +#define DEBUG_FAIL_PRINT4(x1, x2, x3, x4) \ + if (debug_regexps & RE_DEBUG_FAILURE_POINT) printf (x1, x2, x3, x4) +#define DEBUG_FAIL_PRINT_COMPILED_PATTERN(p, s, e) \ + if (debug_regexps & RE_DEBUG_FAILURE_POINT) \ + print_partial_compiled_pattern (s, e) +#define DEBUG_FAIL_PRINT_DOUBLE_STRING(w, s1, sz1, s2, sz2) \ + if (debug_regexps & RE_DEBUG_FAILURE_POINT) \ + print_double_string (w, s1, sz1, s2, sz2) + +#define DEBUG_MATCH_PRINT1(x) \ + if (debug_regexps & RE_DEBUG_MATCHING) printf (x) +#define DEBUG_MATCH_PRINT2(x1, x2) \ + if (debug_regexps & RE_DEBUG_MATCHING) printf (x1, x2) +#define DEBUG_MATCH_PRINT3(x1, x2, x3) \ + if (debug_regexps & RE_DEBUG_MATCHING) printf (x1, x2, x3) +#define DEBUG_MATCH_PRINT4(x1, x2, x3, x4) \ + if (debug_regexps & RE_DEBUG_MATCHING) printf (x1, x2, x3, x4) +#define DEBUG_MATCH_PRINT_COMPILED_PATTERN(p, s, e) \ + if (debug_regexps & RE_DEBUG_MATCHING) \ + print_partial_compiled_pattern (s, e) +#define DEBUG_MATCH_PRINT_DOUBLE_STRING(w, s1, sz1, s2, sz2) \ + if (debug_regexps & RE_DEBUG_MATCHING) \ + print_double_string (w, s1, sz1, s2, sz2) /* Print the fastmap in human-readable form. */ @@ -1133,6 +1163,7 @@ #endif #define DEBUG_STATEMENT(e) + #define DEBUG_PRINT1(x) #define DEBUG_PRINT2(x1, x2) #define DEBUG_PRINT3(x1, x2, x3) @@ -1140,6 +1171,20 @@ #define DEBUG_PRINT_COMPILED_PATTERN(p, s, e) #define DEBUG_PRINT_DOUBLE_STRING(w, s1, sz1, s2, sz2) +#define DEBUG_FAIL_PRINT1(x) +#define DEBUG_FAIL_PRINT2(x1, x2) +#define DEBUG_FAIL_PRINT3(x1, x2, x3) +#define DEBUG_FAIL_PRINT4(x1, x2, x3, x4) +#define DEBUG_FAIL_PRINT_COMPILED_PATTERN(p, s, e) +#define DEBUG_FAIL_PRINT_DOUBLE_STRING(w, s1, sz1, s2, sz2) + +#define DEBUG_MATCH_PRINT1(x) +#define DEBUG_MATCH_PRINT2(x1, x2) +#define DEBUG_MATCH_PRINT3(x1, x2, x3) +#define DEBUG_MATCH_PRINT4(x1, x2, x3, x4) +#define DEBUG_MATCH_PRINT_COMPILED_PATTERN(p, s, e) +#define DEBUG_MATCH_PRINT_DOUBLE_STRING(w, s1, sz1, s2, sz2) + #endif /* DEBUG */ /* Set by `re_set_syntax' to the current regexp syntax to recognize. Can @@ -1523,14 +1568,14 @@ \ DEBUG_STATEMENT (failure_id++); \ DEBUG_STATEMENT (nfailure_points_pushed++); \ - DEBUG_PRINT2 ("\nPUSH_FAILURE_POINT #%d:\n", failure_id); \ - DEBUG_PRINT2 (" Before push, next avail: %ld\n", \ + DEBUG_FAIL_PRINT2 ("\nPUSH_FAILURE_POINT #%d:\n", failure_id); \ + DEBUG_FAIL_PRINT2 (" Before push, next avail: %ld\n", \ (long) (fail_stack).avail); \ - DEBUG_PRINT2 (" size: %ld\n", \ + DEBUG_FAIL_PRINT2 (" size: %ld\n", \ (long) (fail_stack).size); \ \ - DEBUG_PRINT2 (" slots needed: %d\n", NUM_FAILURE_ITEMS); \ - DEBUG_PRINT2 (" available: %ld\n", \ + DEBUG_FAIL_PRINT2 (" slots needed: %d\n", NUM_FAILURE_ITEMS); \ + DEBUG_FAIL_PRINT2 (" available: %ld\n", \ (long) REMAINING_AVAIL_SLOTS); \ \ /* Ensure we have enough space allocated for what we will push. */ \ @@ -1544,59 +1589,59 @@ return failure_code; \ } \ END_REGEX_MALLOC_OK (); \ - DEBUG_PRINT2 ("\n Doubled stack; size now: %ld\n", \ + DEBUG_FAIL_PRINT2 ("\n Doubled stack; size now: %ld\n", \ (long) (fail_stack).size); \ - DEBUG_PRINT2 (" slots available: %ld\n", \ + DEBUG_FAIL_PRINT2 (" slots available: %ld\n", \ (long) REMAINING_AVAIL_SLOTS); \ \ RE_MATCH_RELOCATE_MOVEABLE_DATA_POINTERS (); \ } \ \ /* Push the info, starting with the registers. */ \ - DEBUG_PRINT1 ("\n"); \ + DEBUG_FAIL_PRINT1 ("\n"); \ \ for (this_reg = lowest_active_reg; this_reg <= highest_active_reg; \ this_reg++) \ { \ - DEBUG_PRINT2 (" Pushing reg: %d\n", this_reg); \ + DEBUG_FAIL_PRINT2 (" Pushing reg: %d\n", this_reg); \ DEBUG_STATEMENT (num_regs_pushed++); \ \ - DEBUG_PRINT2 (" start: 0x%lx\n", (long) regstart[this_reg]); \ + DEBUG_FAIL_PRINT2 (" start: 0x%lx\n", (long) regstart[this_reg]); \ PUSH_FAILURE_POINTER (regstart[this_reg]); \ \ - DEBUG_PRINT2 (" end: 0x%lx\n", (long) regend[this_reg]); \ + DEBUG_FAIL_PRINT2 (" end: 0x%lx\n", (long) regend[this_reg]); \ PUSH_FAILURE_POINTER (regend[this_reg]); \ \ - DEBUG_PRINT2 (" info: 0x%lx\n ", \ + DEBUG_FAIL_PRINT2 (" info: 0x%lx\n ", \ * (long *) (®_info[this_reg])); \ - DEBUG_PRINT2 (" match_null=%d", \ + DEBUG_FAIL_PRINT2 (" match_null=%d", \ REG_MATCH_NULL_STRING_P (reg_info[this_reg])); \ - DEBUG_PRINT2 (" active=%d", IS_ACTIVE (reg_info[this_reg])); \ - DEBUG_PRINT2 (" matched_something=%d", \ + DEBUG_FAIL_PRINT2 (" active=%d", IS_ACTIVE (reg_info[this_reg])); \ + DEBUG_FAIL_PRINT2 (" matched_something=%d", \ MATCHED_SOMETHING (reg_info[this_reg])); \ - DEBUG_PRINT2 (" ever_matched_something=%d", \ + DEBUG_FAIL_PRINT2 (" ever_matched_something=%d", \ EVER_MATCHED_SOMETHING (reg_info[this_reg])); \ - DEBUG_PRINT1 ("\n"); \ + DEBUG_FAIL_PRINT1 ("\n"); \ PUSH_FAILURE_ELT (reg_info[this_reg].word); \ } \ \ - DEBUG_PRINT2 (" Pushing low active reg: %d\n", lowest_active_reg); \ + DEBUG_FAIL_PRINT2 (" Pushing low active reg: %d\n", lowest_active_reg); \ PUSH_FAILURE_INT (lowest_active_reg); \ \ - DEBUG_PRINT2 (" Pushing high active reg: %d\n", highest_active_reg); \ + DEBUG_FAIL_PRINT2 (" Pushing high active reg: %d\n", highest_active_reg); \ PUSH_FAILURE_INT (highest_active_reg); \ \ - DEBUG_PRINT2 (" Pushing pattern 0x%lx: \n", (long) pattern_place); \ - DEBUG_PRINT_COMPILED_PATTERN (bufp, pattern_place, pend); \ + DEBUG_FAIL_PRINT2 (" Pushing pattern 0x%lx: \n", (long) pattern_place); \ + DEBUG_FAIL_PRINT_COMPILED_PATTERN (bufp, pattern_place, pend); \ PUSH_FAILURE_POINTER (pattern_place); \ \ - DEBUG_PRINT2 (" Pushing string 0x%lx: `", (long) string_place); \ - DEBUG_PRINT_DOUBLE_STRING (string_place, string1, size1, string2, \ + DEBUG_FAIL_PRINT2 (" Pushing string 0x%lx: `", (long) string_place); \ + DEBUG_FAIL_PRINT_DOUBLE_STRING (string_place, string1, size1, string2, \ size2); \ - DEBUG_PRINT1 ("'\n"); \ + DEBUG_FAIL_PRINT1 ("'\n"); \ PUSH_FAILURE_POINTER (string_place); \ \ - DEBUG_PRINT2 (" Pushing failure id: %u\n", failure_id); \ + DEBUG_FAIL_PRINT2 (" Pushing failure id: %u\n", failure_id); \ DEBUG_PUSH (failure_id); \ } while (0) @@ -1648,16 +1693,16 @@ assert (!FAIL_STACK_EMPTY ()); \ \ /* Remove failure points and point to how many regs pushed. */ \ - DEBUG_PRINT1 ("POP_FAILURE_POINT:\n"); \ - DEBUG_PRINT2 (" Before pop, next avail: %ld\n", \ + DEBUG_FAIL_PRINT1 ("POP_FAILURE_POINT:\n"); \ + DEBUG_FAIL_PRINT2 (" Before pop, next avail: %ld\n", \ (long) fail_stack.avail); \ - DEBUG_PRINT2 (" size: %ld\n", \ + DEBUG_FAIL_PRINT2 (" size: %ld\n", \ (long) fail_stack.size); \ \ assert (fail_stack.avail >= NUM_NONREG_ITEMS); \ \ DEBUG_POP (&ffailure_id.integer); \ - DEBUG_PRINT2 (" Popping failure id: %d\n", \ + DEBUG_FAIL_PRINT2 (" Popping failure id: %d\n", \ * (int *) &ffailure_id); \ \ /* If the saved string location is NULL, it came from an \ @@ -1667,34 +1712,34 @@ if (string_temp != NULL) \ str = string_temp; \ \ - DEBUG_PRINT2 (" Popping string 0x%lx: `", (long) str); \ - DEBUG_PRINT_DOUBLE_STRING (str, string1, size1, string2, size2); \ - DEBUG_PRINT1 ("'\n"); \ + DEBUG_FAIL_PRINT2 (" Popping string 0x%lx: `", (long) str); \ + DEBUG_FAIL_PRINT_DOUBLE_STRING (str, string1, size1, string2, size2); \ + DEBUG_FAIL_PRINT1 ("'\n"); \ \ pat = (unsigned char *) POP_FAILURE_POINTER (); \ - DEBUG_PRINT2 (" Popping pattern 0x%lx: ", (long) pat); \ - DEBUG_PRINT_COMPILED_PATTERN (bufp, pat, pend); \ + DEBUG_FAIL_PRINT2 (" Popping pattern 0x%lx: ", (long) pat); \ + DEBUG_FAIL_PRINT_COMPILED_PATTERN (bufp, pat, pend); \ \ /* Restore register info. */ \ high_reg = POP_FAILURE_INT (); \ - DEBUG_PRINT2 (" Popping high active reg: %d\n", high_reg); \ + DEBUG_FAIL_PRINT2 (" Popping high active reg: %d\n", high_reg); \ \ low_reg = POP_FAILURE_INT (); \ - DEBUG_PRINT2 (" Popping low active reg: %d\n", low_reg); \ + DEBUG_FAIL_PRINT2 (" Popping low active reg: %d\n", low_reg); \ \ for (this_reg = high_reg; this_reg >= low_reg; this_reg--) \ { \ - DEBUG_PRINT2 (" Popping reg: %d\n", this_reg); \ + DEBUG_FAIL_PRINT2 (" Popping reg: %d\n", this_reg); \ \ reg_info[this_reg].word = POP_FAILURE_ELT (); \ - DEBUG_PRINT2 (" info: 0x%lx\n", \ + DEBUG_FAIL_PRINT2 (" info: 0x%lx\n", \ * (long *) ®_info[this_reg]); \ \ regend[this_reg] = POP_FAILURE_POINTER (); \ - DEBUG_PRINT2 (" end: 0x%lx\n", (long) regend[this_reg]); \ + DEBUG_FAIL_PRINT2 (" end: 0x%lx\n", (long) regend[this_reg]); \ \ regstart[this_reg] = POP_FAILURE_POINTER (); \ - DEBUG_PRINT2 (" start: 0x%lx\n", (long) regstart[this_reg]); \ + DEBUG_FAIL_PRINT2 (" start: 0x%lx\n", (long) regstart[this_reg]); \ } \ \ set_regs_matched_done = 0; \ @@ -2157,11 +2202,11 @@ regnum_t regnum = 0; #ifdef DEBUG - DEBUG_PRINT1 ("\nCompiling pattern: "); - if (debug) + if (debug_regexps & RE_DEBUG_COMPILATION) { int debug_count; + DEBUG_PRINT1 ("\nCompiling pattern: "); for (debug_count = 0; debug_count < size; debug_count++) putchar (pattern[debug_count]); putchar ('\n'); @@ -3405,7 +3450,7 @@ bufp->used = buf_end - bufp->buffer; #ifdef DEBUG - if (debug) + if (debug_regexps & RE_DEBUG_COMPILATION) { DEBUG_PRINT1 ("\nCompiled pattern: \n"); print_compiled_pattern (bufp); @@ -4906,7 +4951,7 @@ #endif #endif /* emacs */ - DEBUG_PRINT1 ("\n\nEntering re_match_2.\n"); + DEBUG_MATCH_PRINT1 ("\n\nEntering re_match_2.\n"); BEGIN_REGEX_MALLOC_OK (); INIT_FAIL_STACK (); @@ -5024,18 +5069,18 @@ dend = end_match_2; } - DEBUG_PRINT1 ("The compiled pattern is: \n"); - DEBUG_PRINT_COMPILED_PATTERN (bufp, p, pend); - DEBUG_PRINT1 ("The string to match is: `"); - DEBUG_PRINT_DOUBLE_STRING (d, string1, size1, string2, size2); - DEBUG_PRINT1 ("'\n"); + DEBUG_MATCH_PRINT1 ("The compiled pattern is: \n"); + DEBUG_MATCH_PRINT_COMPILED_PATTERN (bufp, p, pend); + DEBUG_MATCH_PRINT1 ("The string to match is: `"); + DEBUG_MATCH_PRINT_DOUBLE_STRING (d, string1, size1, string2, size2); + DEBUG_MATCH_PRINT1 ("'\n"); /* This loops over pattern commands. It exits by returning from the function if the match is complete, or it drops through if the match fails at this starting point in the input data. */ for (;;) { - DEBUG_PRINT2 ("\n0x%lx: ", (long) p); + DEBUG_MATCH_PRINT2 ("\n0x%lx: ", (long) p); #ifdef emacs /* XEmacs added, w/removal of immediate_quit */ if (!no_quit_in_re_search) { @@ -5048,7 +5093,7 @@ if (p == pend) { /* End of pattern means we might have succeeded. */ - DEBUG_PRINT1 ("end of pattern ... "); + DEBUG_MATCH_PRINT1 ("end of pattern ... "); /* If we haven't matched the entire string, and we want the longest match, try backtracking. */ @@ -5064,7 +5109,7 @@ else best_match_p = !MATCHING_IN_FIRST_STRING; - DEBUG_PRINT1 ("backtracking.\n"); + DEBUG_MATCH_PRINT1 ("backtracking.\n"); if (!FAIL_STACK_EMPTY ()) { /* More failure points to try. */ @@ -5075,7 +5120,7 @@ best_regs_set = true; match_end = d; - DEBUG_PRINT1 ("\nSAVING match as best so far.\n"); + DEBUG_MATCH_PRINT1 ("\nSAVING match as best so far.\n"); for (mcnt = 1; mcnt < num_regs; mcnt++) { @@ -5097,7 +5142,7 @@ For example, the pattern `x.*y.*z' against the strings `x-' and `y-z-', if the two strings are not consecutive in memory. */ - DEBUG_PRINT1 ("Restoring best registers.\n"); + DEBUG_MATCH_PRINT1 ("Restoring best registers.\n"); d = match_end; dend = ((d >= string1 && d <= end1) @@ -5112,7 +5157,7 @@ } /* d != end_match_2 */ succeed_label: - DEBUG_PRINT1 ("Accepting match.\n"); + DEBUG_MATCH_PRINT1 ("Accepting match.\n"); /* If caller wants register contents data back, do it. */ { @@ -5214,16 +5259,16 @@ for (mcnt = num_nonshy_regs; mcnt < regs->num_regs; mcnt++) regs->start[mcnt] = regs->end[mcnt] = -1; } - DEBUG_PRINT4 ("%u failure points pushed, %u popped (%u remain).\n", + DEBUG_MATCH_PRINT4 ("%u failure points pushed, %u popped (%u remain).\n", nfailure_points_pushed, nfailure_points_popped, nfailure_points_pushed - nfailure_points_popped); - DEBUG_PRINT2 ("%u registers pushed.\n", num_regs_pushed); + DEBUG_MATCH_PRINT2 ("%u registers pushed.\n", num_regs_pushed); mcnt = d - pos - (MATCHING_IN_FIRST_STRING ? string1 : string2 - size1); - DEBUG_PRINT2 ("Returning %d from re_match_2.\n", mcnt); + DEBUG_MATCH_PRINT2 ("Returning %d from re_match_2.\n", mcnt); FREE_VARIABLES (); return mcnt; @@ -5235,11 +5280,11 @@ /* Ignore these. Used to ignore the n of succeed_n's which currently have n == 0. */ case no_op: - DEBUG_PRINT1 ("EXECUTING no_op.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING no_op.\n"); break; case succeed: - DEBUG_PRINT1 ("EXECUTING succeed.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING succeed.\n"); goto succeed_label; /* Match exactly a string of length n in the pattern. The @@ -5248,7 +5293,7 @@ the default internal format.) */ case exactn: mcnt = *p++; - DEBUG_PRINT2 ("EXECUTING exactn %d.\n", mcnt); + DEBUG_MATCH_PRINT2 ("EXECUTING exactn %d.\n", mcnt); /* This is written out as an if-else so we don't waste time testing `translate' inside the loop. */ @@ -5321,7 +5366,7 @@ /* Match any character except possibly a newline or a null. */ case anychar: - DEBUG_PRINT1 ("EXECUTING anychar.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING anychar.\n"); REGEX_PREFETCH (); @@ -5333,7 +5378,7 @@ goto fail; SET_REGS_MATCHED (); - DEBUG_PRINT2 (" Matched `%d'.\n", *d); + DEBUG_MATCH_PRINT2 (" Matched `%d'.\n", *d); INC_IBYTEPTR_FMT (d, fmt); /* XEmacs change */ break; @@ -5344,7 +5389,7 @@ REGISTER Ichar c; re_bool not_p = (re_opcode_t) *(p - 1) == charset_not; - DEBUG_PRINT2 ("EXECUTING charset%s.\n", not_p ? "_not" : ""); + DEBUG_MATCH_PRINT2 ("EXECUTING charset%s.\n", not_p ? "_not" : ""); REGEX_PREFETCH (); c = itext_ichar_fmt (d, fmt, lispobj); @@ -5372,7 +5417,7 @@ REGISTER Ichar c; re_bool not_p = (re_opcode_t) *(p - 1) == charset_mule_not; - DEBUG_PRINT2 ("EXECUTING charset_mule%s.\n", not_p ? "_not" : ""); + DEBUG_MATCH_PRINT2 ("EXECUTING charset_mule%s.\n", not_p ? "_not" : ""); REGEX_PREFETCH (); c = itext_ichar_fmt (d, fmt, lispobj); @@ -5398,7 +5443,7 @@ matched within the group is recorded (in the internal registers data structure) under the register number. */ case start_memory: - DEBUG_PRINT3 ("EXECUTING start_memory %d (%d):\n", *p, p[1]); + DEBUG_MATCH_PRINT3 ("EXECUTING start_memory %d (%d):\n", *p, p[1]); /* Find out if this group can match the empty string. */ p1 = p; /* To send to group_match_null_string_p. */ @@ -5407,7 +5452,7 @@ REG_MATCH_NULL_STRING_P (reg_info[*p]) = group_match_null_string_p (&p1, pend, reg_info); - DEBUG_PRINT2 (" group CAN%s match null string\n", + DEBUG_MATCH_PRINT2 (" group CAN%s match null string\n", REG_MATCH_NULL_STRING_P (reg_info[*p]) ? "NOT" : ""); /* Save the position in the string where we were the last time @@ -5418,11 +5463,11 @@ old_regstart[*p] = REG_MATCH_NULL_STRING_P (reg_info[*p]) ? REG_UNSET (regstart[*p]) ? d : regstart[*p] : regstart[*p]; - DEBUG_PRINT2 (" old_regstart: %d\n", + DEBUG_MATCH_PRINT2 (" old_regstart: %d\n", POINTER_TO_OFFSET (old_regstart[*p])); regstart[*p] = d; - DEBUG_PRINT2 (" regstart: %d\n", POINTER_TO_OFFSET (regstart[*p])); + DEBUG_MATCH_PRINT2 (" regstart: %d\n", POINTER_TO_OFFSET (regstart[*p])); IS_ACTIVE (reg_info[*p]) = 1; MATCHED_SOMETHING (reg_info[*p]) = 0; @@ -5449,7 +5494,7 @@ arguments are the same as start_memory's: the register number, and the number of inner groups. */ case stop_memory: - DEBUG_PRINT3 ("EXECUTING stop_memory %d (%d):\n", *p, p[1]); + DEBUG_MATCH_PRINT3 ("EXECUTING stop_memory %d (%d):\n", *p, p[1]); /* We need to save the string position the last time we were at this close-group operator in case the group is operated @@ -5459,11 +5504,11 @@ old_regend[*p] = REG_MATCH_NULL_STRING_P (reg_info[*p]) ? REG_UNSET (regend[*p]) ? d : regend[*p] : regend[*p]; - DEBUG_PRINT2 (" old_regend: %d\n", + DEBUG_MATCH_PRINT2 (" old_regend: %d\n", POINTER_TO_OFFSET (old_regend[*p])); regend[*p] = d; - DEBUG_PRINT2 (" regend: %d\n", POINTER_TO_OFFSET (regend[*p])); + DEBUG_MATCH_PRINT2 (" regend: %d\n", POINTER_TO_OFFSET (regend[*p])); /* This register isn't active anymore. */ IS_ACTIVE (reg_info[*p]) = 0; @@ -5599,7 +5644,7 @@ REGISTER re_char *d2, *dend2; /* Get which register to match against. */ int regno = *p++; - DEBUG_PRINT2 ("EXECUTING duplicate %d.\n", regno); + DEBUG_MATCH_PRINT2 ("EXECUTING duplicate %d.\n", regno); /* Can't back reference a group which we've never matched. */ if (REG_UNSET (regstart[regno]) || REG_UNSET (regend[regno])) @@ -5666,7 +5711,7 @@ (unless `not_bol' is set in `bufp'), and, if `newline_anchor' is set, after newlines. */ case begline: - DEBUG_PRINT1 ("EXECUTING begline.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING begline.\n"); if (AT_STRINGS_BEG (d)) { @@ -5686,7 +5731,7 @@ /* endline is the dual of begline. */ case endline: - DEBUG_PRINT1 ("EXECUTING endline.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING endline.\n"); if (AT_STRINGS_END (d)) { @@ -5706,7 +5751,7 @@ /* Match at the very beginning of the data. */ case begbuf: - DEBUG_PRINT1 ("EXECUTING begbuf.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING begbuf.\n"); if (AT_STRINGS_BEG (d)) break; goto fail; @@ -5714,7 +5759,7 @@ /* Match at the very end of the data. */ case endbuf: - DEBUG_PRINT1 ("EXECUTING endbuf.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING endbuf.\n"); if (AT_STRINGS_END (d)) break; goto fail; @@ -5737,10 +5782,10 @@ `anychar's code to do something besides goto fail in this case; that seems worse than this. */ case on_failure_keep_string_jump: - DEBUG_PRINT1 ("EXECUTING on_failure_keep_string_jump"); + DEBUG_MATCH_PRINT1 ("EXECUTING on_failure_keep_string_jump"); EXTRACT_NUMBER_AND_INCR (mcnt, p); - DEBUG_PRINT3 (" %d (to 0x%lx):\n", mcnt, (long) (p + mcnt)); + DEBUG_MATCH_PRINT3 (" %d (to 0x%lx):\n", mcnt, (long) (p + mcnt)); PUSH_FAILURE_POINT (p + mcnt, (unsigned char *) 0, -2); break; @@ -5760,10 +5805,10 @@ pop_failure_jump back to this on_failure_jump. */ case on_failure_jump: on_failure: - DEBUG_PRINT1 ("EXECUTING on_failure_jump"); + DEBUG_MATCH_PRINT1 ("EXECUTING on_failure_jump"); EXTRACT_NUMBER_AND_INCR (mcnt, p); - DEBUG_PRINT3 (" %d (to 0x%lx)", mcnt, (long) (p + mcnt)); + DEBUG_MATCH_PRINT3 (" %d (to 0x%lx)", mcnt, (long) (p + mcnt)); /* If this on_failure_jump comes right before a group (i.e., the original * applied to a group), save the information @@ -5794,7 +5839,7 @@ lowest_active_reg = *(p1 + 1); } - DEBUG_PRINT1 (":\n"); + DEBUG_MATCH_PRINT1 (":\n"); PUSH_FAILURE_POINT (p + mcnt, d, -2); break; @@ -5803,7 +5848,7 @@ We change it to either `pop_failure_jump' or `jump'. */ case maybe_pop_jump: EXTRACT_NUMBER_AND_INCR (mcnt, p); - DEBUG_PRINT2 ("EXECUTING maybe_pop_jump %d.\n", mcnt); + DEBUG_MATCH_PRINT2 ("EXECUTING maybe_pop_jump %d.\n", mcnt); { REGISTER unsigned char *p2 = p; @@ -5849,7 +5894,7 @@ against ":/". I don't really understand this code yet. */ p[-3] = (unsigned char) pop_failure_jump; - DEBUG_PRINT1 + DEBUG_MATCH_PRINT1 (" End of pattern: change to `pop_failure_jump'.\n"); } @@ -5862,7 +5907,7 @@ if ((re_opcode_t) p1[3] == exactn && p1[5] != c) { p[-3] = (unsigned char) pop_failure_jump; - DEBUG_PRINT3 (" %c != %c => pop_failure_jump.\n", + DEBUG_MATCH_PRINT3 (" %c != %c => pop_failure_jump.\n", c, p1[5]); } @@ -5880,7 +5925,7 @@ if (!not_p) { p[-3] = (unsigned char) pop_failure_jump; - DEBUG_PRINT1 (" No match => pop_failure_jump.\n"); + DEBUG_MATCH_PRINT1 (" No match => pop_failure_jump.\n"); } } } @@ -5897,7 +5942,7 @@ & (1 << (p1[5] % BYTEWIDTH))))) { p[-3] = (unsigned char) pop_failure_jump; - DEBUG_PRINT3 (" %c != %c => pop_failure_jump.\n", + DEBUG_MATCH_PRINT3 (" %c != %c => pop_failure_jump.\n", c, p1[5]); } @@ -5915,7 +5960,7 @@ if (idx == p2[1]) { p[-3] = (unsigned char) pop_failure_jump; - DEBUG_PRINT1 (" No match => pop_failure_jump.\n"); + DEBUG_MATCH_PRINT1 (" No match => pop_failure_jump.\n"); } } else if ((re_opcode_t) p1[3] == charset) @@ -5932,7 +5977,7 @@ if (idx == p2[1] || idx == p1[4]) { p[-3] = (unsigned char) pop_failure_jump; - DEBUG_PRINT1 (" No match => pop_failure_jump.\n"); + DEBUG_MATCH_PRINT1 (" No match => pop_failure_jump.\n"); } } } @@ -5941,7 +5986,7 @@ if ((re_opcode_t) p[-1] != pop_failure_jump) { p[-1] = (unsigned char) jump; - DEBUG_PRINT1 (" Match => jump.\n"); + DEBUG_MATCH_PRINT1 (" Match => jump.\n"); goto unconditional_jump; } /* Note fall through. */ @@ -5964,7 +6009,7 @@ unsigned char *pdummy; re_char *sdummy = NULL; - DEBUG_PRINT1 ("EXECUTING pop_failure_jump.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING pop_failure_jump.\n"); POP_FAILURE_POINT (sdummy, pdummy, dummy_low_reg, dummy_high_reg, reg_dummy, reg_dummy, reg_info_dummy); @@ -5976,16 +6021,16 @@ case jump: unconditional_jump: EXTRACT_NUMBER_AND_INCR (mcnt, p); /* Get the amount to jump. */ - DEBUG_PRINT2 ("EXECUTING jump %d ", mcnt); + DEBUG_MATCH_PRINT2 ("EXECUTING jump %d ", mcnt); p += mcnt; /* Do the jump. */ - DEBUG_PRINT2 ("(to 0x%lx).\n", (long) p); + DEBUG_MATCH_PRINT2 ("(to 0x%lx).\n", (long) p); break; /* We need this opcode so we can detect where alternatives end in `group_match_null_string_p' et al. */ case jump_past_alt: - DEBUG_PRINT1 ("EXECUTING jump_past_alt.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING jump_past_alt.\n"); goto unconditional_jump; @@ -5995,7 +6040,7 @@ are skipping over the on_failure_jump, so we have to push something meaningless for pop_failure_jump to pop. */ case dummy_failure_jump: - DEBUG_PRINT1 ("EXECUTING dummy_failure_jump.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING dummy_failure_jump.\n"); /* It doesn't matter what we push for the string here. What the code at `fail' tests is the value for the pattern. */ PUSH_FAILURE_POINT ((unsigned char *) 0, (unsigned char *) 0, -2); @@ -6008,7 +6053,7 @@ popped. For example, matching `(a|ab)*' against `aab' requires that we match the `ab' alternative. */ case push_dummy_failure: - DEBUG_PRINT1 ("EXECUTING push_dummy_failure.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING push_dummy_failure.\n"); /* See comments just above at `dummy_failure_jump' about the two zeroes. */ PUSH_FAILURE_POINT ((unsigned char *) 0, (unsigned char *) 0, -2); @@ -6018,7 +6063,7 @@ After that, handle like `on_failure_jump'. */ case succeed_n: EXTRACT_NUMBER (mcnt, p + 2); - DEBUG_PRINT2 ("EXECUTING succeed_n %d.\n", mcnt); + DEBUG_MATCH_PRINT2 ("EXECUTING succeed_n %d.\n", mcnt); assert (mcnt >= 0); /* Originally, this is how many times we HAVE to succeed. */ @@ -6027,11 +6072,11 @@ mcnt--; p += 2; STORE_NUMBER_AND_INCR (p, mcnt); - DEBUG_PRINT3 (" Setting 0x%lx to %d.\n", (long) p, mcnt); + DEBUG_MATCH_PRINT3 (" Setting 0x%lx to %d.\n", (long) p, mcnt); } else if (mcnt == 0) { - DEBUG_PRINT2 (" Setting two bytes from 0x%lx to no_op.\n", + DEBUG_MATCH_PRINT2 (" Setting two bytes from 0x%lx to no_op.\n", (long) (p+2)); p[2] = (unsigned char) no_op; p[3] = (unsigned char) no_op; @@ -6041,7 +6086,7 @@ case jump_n: EXTRACT_NUMBER (mcnt, p + 2); - DEBUG_PRINT2 ("EXECUTING jump_n %d.\n", mcnt); + DEBUG_MATCH_PRINT2 ("EXECUTING jump_n %d.\n", mcnt); /* Originally, this is how many times we CAN jump. */ if (mcnt) @@ -6057,18 +6102,18 @@ case set_number_at: { - DEBUG_PRINT1 ("EXECUTING set_number_at.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING set_number_at.\n"); EXTRACT_NUMBER_AND_INCR (mcnt, p); p1 = p + mcnt; EXTRACT_NUMBER_AND_INCR (mcnt, p); - DEBUG_PRINT3 (" Setting 0x%lx to %d.\n", (long) p1, mcnt); + DEBUG_MATCH_PRINT3 (" Setting 0x%lx to %d.\n", (long) p1, mcnt); STORE_NUMBER (p1, mcnt); break; } case wordbound: - DEBUG_PRINT1 ("EXECUTING wordbound.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING wordbound.\n"); should_succeed = 1; matchwordbound: { @@ -6138,12 +6183,12 @@ } case notwordbound: - DEBUG_PRINT1 ("EXECUTING notwordbound.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING notwordbound.\n"); should_succeed = 0; goto matchwordbound; case wordbeg: - DEBUG_PRINT1 ("EXECUTING wordbeg.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING wordbeg.\n"); if (AT_STRINGS_END (d)) goto fail; { @@ -6186,7 +6231,7 @@ } case wordend: - DEBUG_PRINT1 ("EXECUTING wordend.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING wordend.\n"); if (AT_STRINGS_BEG (d)) goto fail; { @@ -6235,7 +6280,7 @@ #ifdef emacs case before_dot: - DEBUG_PRINT1 ("EXECUTING before_dot.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING before_dot.\n"); if (!BUFFERP (lispobj) || (BUF_PTR_BYTE_POS (XBUFFER (lispobj), (unsigned char *) d) >= BUF_PT (XBUFFER (lispobj)))) @@ -6243,7 +6288,7 @@ break; case at_dot: - DEBUG_PRINT1 ("EXECUTING at_dot.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING at_dot.\n"); if (!BUFFERP (lispobj) || (BUF_PTR_BYTE_POS (XBUFFER (lispobj), (unsigned char *) d) != BUF_PT (XBUFFER (lispobj)))) @@ -6251,7 +6296,7 @@ break; case after_dot: - DEBUG_PRINT1 ("EXECUTING after_dot.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING after_dot.\n"); if (!BUFFERP (lispobj) || (BUF_PTR_BYTE_POS (XBUFFER (lispobj), (unsigned char *) d) <= BUF_PT (XBUFFER (lispobj)))) @@ -6259,12 +6304,12 @@ break; case syntaxspec: - DEBUG_PRINT2 ("EXECUTING syntaxspec %d.\n", mcnt); + DEBUG_MATCH_PRINT2 ("EXECUTING syntaxspec %d.\n", mcnt); mcnt = *p++; goto matchsyntax; case wordchar: - DEBUG_PRINT1 ("EXECUTING Emacs wordchar.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING Emacs wordchar.\n"); mcnt = (int) Sword; matchsyntax: should_succeed = 1; @@ -6294,12 +6339,12 @@ break; case notsyntaxspec: - DEBUG_PRINT2 ("EXECUTING notsyntaxspec %d.\n", mcnt); + DEBUG_MATCH_PRINT2 ("EXECUTING notsyntaxspec %d.\n", mcnt); mcnt = *p++; goto matchnotsyntax; case notwordchar: - DEBUG_PRINT1 ("EXECUTING Emacs notwordchar.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING Emacs notwordchar.\n"); mcnt = (int) Sword; matchnotsyntax: should_succeed = 0; @@ -6331,7 +6376,7 @@ #endif /* MULE */ #else /* not emacs */ case wordchar: - DEBUG_PRINT1 ("EXECUTING non-Emacs wordchar.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING non-Emacs wordchar.\n"); REGEX_PREFETCH (); if (!WORDCHAR_P ((int) (*d))) goto fail; @@ -6340,7 +6385,7 @@ break; case notwordchar: - DEBUG_PRINT1 ("EXECUTING non-Emacs notwordchar.\n"); + DEBUG_MATCH_PRINT1 ("EXECUTING non-Emacs notwordchar.\n"); REGEX_PREFETCH (); if (!WORDCHAR_P ((int) (*d))) goto fail; @@ -6359,7 +6404,7 @@ fail: if (!FAIL_STACK_EMPTY ()) { /* A restart point is known. Restore to that state. */ - DEBUG_PRINT1 ("\nFAIL:\n"); + DEBUG_MATCH_PRINT1 ("\nFAIL:\n"); POP_FAILURE_POINT (d, p, lowest_active_reg, highest_active_reg, regstart, regend, reg_info); diff -r 861f2601a38b -r 1f0b15040456 src/regex.h --- a/src/regex.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/regex.h Sun May 01 18:44:03 2011 +0100 @@ -2,23 +2,22 @@ expression library, version 0.12. Copyright (C) 1985, 89, 90, 91, 92, 93, 95 Free Software Foundation, Inc. - Copyright (C) 2002 Ben Wing. - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. + Copyright (C) 2002, 2010 Ben Wing. - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - + 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 3 of the License, 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 this program; see the file COPYING. If not, write to - the Free Software Foundation, Inc., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ - + along with XEmacs. If not, see . */ /* Synched up with: FSF 19.29. */ #ifndef INCLUDED_regex_h_ @@ -42,6 +41,18 @@ #define Bytecount ssize_t #endif /* emacs */ +#ifndef emacs +# ifdef __cplusplus +# define BEGIN_C_DECLS extern "C" { +# define END_C_DECLS } +# else +# define BEGIN_C_DECLS +# define END_C_DECLS +# endif +#endif /* emacs */ + +BEGIN_C_DECLS + /* POSIX says that must be included (by the caller) before . */ @@ -526,4 +537,15 @@ size_t errbuf_size); void regfree (regex_t *preg); +enum regex_debug + { + RE_DEBUG_COMPILATION = 1 << 0, + RE_DEBUG_FAILURE_POINT = 1 << 1, + RE_DEBUG_MATCHING = 1 << 2, + }; + +extern int debug_regexps; + +END_C_DECLS + #endif /* INCLUDED_regex_h_ */ diff -r 861f2601a38b -r 1f0b15040456 src/s/aix4-2.h --- a/src/s/aix4-2.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/s/aix4-2.h Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,18 @@ * * 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. - * + * 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 3 of the License, or (at your + * option) any later version. + * + * XEmacs is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * for more details. + * * You should have received a copy of the GNU General Public License - * along with XEmacs; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 59 Temple Place - Suite 330, - * Boston, MA 02111-1307, USA. */ + * along with XEmacs. If not, see . */ /* Synched up with: FSF 19.31. */ diff -r 861f2601a38b -r 1f0b15040456 src/s/bsd-common.h --- a/src/s/bsd-common.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/s/bsd-common.h Sun May 01 18:44:03 2011 +0100 @@ -5,20 +5,18 @@ 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synced up with: FSF 23.1.92 */ /* Synced by: Ben Wing, 2-17-10 */ diff -r 861f2601a38b -r 1f0b15040456 src/s/cygwin32.h --- a/src/s/cygwin32.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/s/cygwin32.h Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,18 @@ 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Building under cygwin * @@ -36,7 +34,7 @@ * once you have done this, configure and make. * * windows '95 - I haven't tested this under '95, it will probably - * build but I konw there are some limitations with cygwin under 95 so + * build but I know there are some limitations with cygwin under 95 so * YMMV. I build with NT4 SP3. * * Andy Piper 8/1/98 diff -r 861f2601a38b -r 1f0b15040456 src/s/freebsd.h --- a/src/s/freebsd.h Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,154 +0,0 @@ -/* System description header for FreeBSD systems. - This file describes the parameters that system description files - should define or not. - Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, - 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 - Free Software Foundation, Inc. - Copyright (C) 2010 Ben Wing. - -Author: Shawn M. Carey -(according to authors.el) - -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 3 of the License, 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. If not, see . */ - -/* Synced up with: FSF 23.1.92. */ -/* Synced by: Ben Wing, 2-18-10. */ - -/* Get the correct __FreeBSD_version, even if this is before that was - defined. */ -#ifndef __FreeBSD_version -#include -#endif /* !defined __FreeBSD_version */ - -/* XEmacs: Delete obsolete stuff for FreeBSD v1 and v2 */ -/* Get most of the stuff from bsd-common */ -#include "bsd-common.h" - -/* Delete BSD4_2 -- unused in XEmacs */ - -/* KERNEL_FILE, LDAV_SYMBOL deleted */ -#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base) - -/* XEmacs deleted LIBS_DEBUG */ - -#if __FreeBSD_version >= 199701 && __FreeBSD_version < 600006 -/* XEmacs: */ -#define LIBS_SYSTEM "-lutil -lxpg4" -#else -#define LIBS_SYSTEM "-lutil" -#endif - -/* LIBS_TERMCAP, TERMINFO deleted */ - -/* SYSV_SYSTEM_DIR, BSD_PGRPS deleted */ - -#ifdef __ELF__ /* since from 3.0-CURRENT(maybe 19980831 or later) */ -/* XEmacs: */ -#ifndef NOT_C_CODE -#include -#endif - -/* GNU: [[ Let `ld' find image libs and similar things in /usr/local/lib. The - system compiler, GCC, has apparently been modified to not look - there, contrary to what a stock GCC would do. ]] But we don't add - /usr/local/lib to LD_SWITCH_SYSTEM; there are configure flags for that. */ - -#define LD_SWITCH_SYSTEM /* -L/usr/local/lib */ -#define START_FILES pre-crt0.o /usr/lib/crt1.o /usr/lib/crti.o /usr/lib/crtbegin.o -#define UNEXEC "unexelf.o" -#define LIB_STANDARD -lgcc -lc -lgcc /usr/lib/crtend.o /usr/lib/crtn.o -/* XEmacs addition this line: */ -#define LINKER "$(CC) -nostdlib" -#undef LIB_GCC -#define LIB_GCC - -#else /* not __ELF__ */ - -#error "Obsolete pre-v3 versions not supported" - -#endif /* not __ELF__ */ - -/* HAVE_GETLOADAVG, HAVE_TERMIOS, NO_TERMIO deleted */ -#define DECLARE_GETPWUID_WITH_UID_T - -/* freebsd uses OXTABS instead of the expected TAB3. */ -#define TABDLY OXTABS -#define TAB3 OXTABS - -/* this silences a few compilation warnings */ -#undef BSD_SYSTEM -/* XEmacs: Delete obsolete stuff for FreeBSD v1 and v2 */ -#define BSD_SYSTEM 199506 -#endif - -/* DONT_REOPEN_PTY deleted -- unused in XEmacs */ - -/* If the system's imake configuration file defines `NeedWidePrototypes' - as `NO', we must define NARROWPROTO manually. Such a define is - generated in the Makefile generated by `xmkmf'. If we don't - define NARROWPROTO, we will see the wrong function prototypes - for X functions taking float or double parameters. */ - -/* NARROWPROTO deleted */ - -/* The following is needed to make `configure' find Xpm, Xaw3d and - image include and library files if using /usr/bin/gcc. That - compiler seems to be modified to not find headers in - /usr/local/include or libs in /usr/local/lib by default. */ - -/* XEmacs: let configure flags do this */ -/* #define C_SWITCH_SYSTEM -I/usr/X11R6/include -I/usr/local/include -L/usr/local/lib */ - -#if 0 /* unnecessary GNU stuff */ -/* Circumvent a bug in FreeBSD. In the following sequence of - writes/reads on a PTY, read(2) returns bogus data: - - write(2) 1022 bytes - write(2) 954 bytes, get EAGAIN - read(2) 1024 bytes in process_read_output - read(2) 11 bytes in process_read_output - - That is, read(2) returns more bytes than have ever been written - successfully. The 1033 bytes read are the 1022 bytes written - successfully after processing (for example with CRs added if the - terminal is set up that way which it is here). The same bytes will - be seen again in a later read(2), without the CRs. */ - -#define BROKEN_PTY_READ_AFTER_EAGAIN 1 - -/* Deleted GC_SETJMP_WORKS, GC_MARK_STACK, USE_MMAP_FOR_BUFFERS, - POSIX_SIGNALS -- unnecessary and/or autoconfigured on XEmacs */ - -/* The `combreloc' setting became the default, and it seems to be - incompatible with unexec. Symptom is an immediate SEGV in - XtInitializeWidget when starting Emacs under X11. */ - -#if defined __FreeBSD_version && __FreeBSD_version >= 500042 -#define LD_SWITCH_SYSTEM_TEMACS -znocombreloc -#endif -#endif /* 0 */ - -/* arch-tag: 426529ca-b7c4-448f-b10a-d4dcdc9c78eb - (do not change this comment) */ - -/* Begin XEmacs additions */ - -#ifndef NOT_C_CODE -#ifdef BSD /* fixing BSD define */ -#undef BSD -#endif -#include -#endif /* C code */ diff -r 861f2601a38b -r 1f0b15040456 src/s/gnu.h --- a/src/s/gnu.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/s/gnu.h Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,18 @@ 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.31. */ diff -r 861f2601a38b -r 1f0b15040456 src/s/hpux11-shr.h --- a/src/s/hpux11-shr.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/s/hpux11-shr.h Sun May 01 18:44:03 2011 +0100 @@ -3,20 +3,18 @@ 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin St. - Fifth Floor, -Boston, MA 02110-1301, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.31. */ diff -r 861f2601a38b -r 1f0b15040456 src/s/hpux11.h --- a/src/s/hpux11.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/s/hpux11.h Sun May 01 18:44:03 2011 +0100 @@ -2,22 +2,20 @@ * Copyright (C) 1985, 1986 Free Software Foundation, Inc. * Copyright (C) 2010 Ben Wing. * - * 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. + * This file is part of XEmacs. * - * XEmacs is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with XEmacs; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 59 Temple Place - Suite 330, - * Boston, MA 02111-1307, USA. */ + * 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 3 of the License, 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. If not, see . */ /* Synched up with: FSF 19.31. */ @@ -82,11 +80,11 @@ /* This is how to get the device name of the tty end of a pty. */ #define PTY_TTY_NAME_SPRINTF \ - sprintf (pty_name, "/dev/pty/tty%c%x", c, i); + qxesprintf (pty_name, "/dev/pty/tty%c%x", c, i); /* This is how to get the device name of the control end of a pty. */ #define PTY_NAME_SPRINTF \ - sprintf (pty_name, "/dev/ptym/pty%c%x", c, i); + qxesprintf (pty_name, "/dev/ptym/pty%c%x", c, i); #ifdef HPUX_USE_SHLIBS #define LD_SWITCH_SYSTEM diff -r 861f2601a38b -r 1f0b15040456 src/s/mach-bsd4-3.h --- a/src/s/mach-bsd4-3.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/s/mach-bsd4-3.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin St. - Fifth Floor, -Boston, MA 02110-1301, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.31. */ diff -r 861f2601a38b -r 1f0b15040456 src/s/mingw32.h --- a/src/s/mingw32.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/s/mingw32.h Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,18 @@ 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* based on cygwin32.h by Andy Piper */ diff -r 861f2601a38b -r 1f0b15040456 src/s/netbsd.h --- a/src/s/netbsd.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/s/netbsd.h Sun May 01 18:44:03 2011 +0100 @@ -1,23 +1,20 @@ /* s/ file for netbsd system. - - Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, - Copyright (C) 2010 Ben Wing. - 2008, 2009, 2010 Free Software Foundation, Inc. + Copyright (C) 1997, 2000, 2001 Martin Buchholz 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 3 of the License, or -(at your option) any later version. +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 3 of the License, 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. +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. If not, see . */ +along with XEmacs. If not, see . */ /* Synced up with: FSF 23.1.92. */ /* Synced by: Ben Wing, 2-18-10. */ diff -r 861f2601a38b -r 1f0b15040456 src/s/sol2.h --- a/src/s/sol2.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/s/sol2.h Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,21 @@ +/* Copyright (C) 2000, 2003 Martin Buchholz + +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 3 of the License, 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. If not, see . */ + + /* Synched up with: Completely divergent from FSF. */ #define SOLARIS2 1 /* #define POSIX -- not used in XEmacs */ diff -r 861f2601a38b -r 1f0b15040456 src/s/usg5-4.h --- a/src/s/usg5-4.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/s/usg5-4.h Sun May 01 18:44:03 2011 +0100 @@ -1,22 +1,20 @@ -/* Definitions file for GNU Emacs running on AT&T's System V Release 4 - Copyright (C) 1987, 1990, 1999, 2000, 2001, 2002, 2003, 2004, 2005, - 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - Copyright (C) 2010 Ben Wing. +/* Definitions file for XEmacs running on AT&T's System V Release 4 + Copyright (C) 1987, 1990 Free Software Foundation, Inc. -This file is part of GNU Emacs. +This file is part of XEmacs. -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 3 of the License, or -(at your option) any later version. +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 3 of the License, 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. +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 GNU Emacs. If not, see . */ +along with XEmacs. If not, see . */ /* Synced up with: FSF 23.1.92. */ /* Synced by: Ben Wing, 2-18-10. */ @@ -40,21 +38,67 @@ HAVE_SYSV_SIGPAUSE, BSTRING, SIGTYPE -- not used in XEmacs or found by configure */ +/* Letter to use in finding device name of first pty, + * if system supports pty's. 'p' means it is /dev/ptyp0 */ + +#define FIRST_PTY_LETTER 'z' + +/* define MAIL_USE_FLOCK if the mailer uses flock + * to interlock access to /usr/spool/mail/$USER. + * The alternative is that a lock file named + * /usr/spool/mail/$USER.lock. */ + +/* #define MAIL_USE_FLOCK */ + +/* Special hacks needed to make Emacs run on this system. */ + +/* On USG systems the system calls are interruptible by signals + * that the user program has elected to catch. Thus the system call + * must be retried in these cases. To handle this without massive + * changes in the source code, we remap the standard system call names + * to names for our own functions in sysdep.c that do the system call + * with retries. */ + +#define INTERRUPTIBLE_OPEN +#define INTERRUPTIBLE_IO + +/* Compiler bug bites on many systems when default ADDR_CORRECT is used. */ + +#define ADDR_CORRECT(x) (x) + +/* Prevent -lg from being used for debugging. Not implemented? */ + +#define LIBS_DEBUG + +/* 5.3 apparently makes close() interruptible */ + +#define INTERRUPTIBLE_CLOSE + +/* Apparently -lg is provided in 5.3 */ + +#undef LIBS_DEBUG + +/* Enable support for shared libraries in unexec. */ + +#define USG_SHARED_LIBRARIES + +#define LIBS_SYSTEM "-lsocket -lnsl -lelf" #define ORDINARY_LINK +#define LIB_STANDARD /* there are no -lg libraries on this system, and no libPW */ /* XEmacs deleted LIBS_DEBUG, LIB_STANDARD */ -/* Undump with ELF */ +/* No */ -#undef COFF +#define NO_SIOCTL_H #define UNEXEC "unexelf.o" -/* Get FIONREAD from . Get to get struct +/* Get to get struct * tchars. But get first to make sure ttold.h doesn't - * interfere. And don't try to use SIGIO yet. + * interfere. */ #ifndef NOT_C_CODE @@ -65,41 +109,55 @@ #include #include #include -/* Delete #include */ #include -#include #include -/* XEmacs -- GNU added this, but we never had it defined and C-g apparently - worked fine before, so don't define it */ -/* #define BROKEN_SIGIO */ +#endif + +/* This sets the name of the master side of the PTY. */ + +#define PTY_NAME_SPRINTF qxestrcpy_ascii (pty_name, "/dev/ptmx"); + +/* This sets the name of the slave side of the PTY. On SysVr4, + grantpt(3) forks a subprocess, so keep sigchld_handler() from + intercepting that death. If any child but grantpt's should die + within, it should be caught after EMACS_UNBLOCK_SIGNAL. */ + +/* XEmacs change */ +#ifndef NOT_C_CODE +# if !__STDC__ && !defined(STDC_HEADERS) +char *ptsname (); +# endif #endif -/* Delete NSIG_MINIMUM -- unused in XEmacs */ - -/* Delete CLASH_DETECTION (config option), HAVE_PTYS, HAVE_TERMIOS, - wait3, WRETCODE, TIOCSIGSEND -- not used in XEmacs or found by configure */ - -/* Delete FIRST_PTY_LETTER, PTY_NAME_SPRINTF, PTY_TTY_NAME_SPRINTF -- - duplicative of code already in process-unix.c */ - -/* Delete SETUP_SLAVE_PTY -- unused in XEmacs */ - -/* Delete HAVE_SOCKETS -- autodetected */ - +#define PTY_TTY_NAME_SPRINTF \ + { \ + char *ptyname; \ + \ + EMACS_BLOCK_SIGCHLD; \ + if (grantpt (fd) == -1) \ + { close (fd); return -1; } \ + EMACS_UNBLOCK_SIGCHLD; \ + if (unlockpt (fd) == -1) \ + { close (fd); return -1; } \ + if (!(ptyname = ptsname (fd))) \ + { close (fd); return -1; } \ + qxestrncpy_ascii (pty_name, ptyname, \ + sizeof (pty_name)); \ + pty_name[sizeof (pty_name) - 1] = 0; \ + } - -/* Begin XEmacs additions */ - -/* Compiler bug bites on many systems when default ADDR_CORRECT is used. */ - -#define ADDR_CORRECT(x) (x) +/* Push various streams modules onto a PTY channel. */ -/* Enable support for shared libraries in unexec. */ +#define SETUP_SLAVE_PTY \ + if (ioctl (xforkin, I_PUSH, "ptem") == -1) \ + fatal ("ioctl I_PUSH ptem: errno %d\n", errno); \ + if (ioctl (xforkin, I_PUSH, "ldterm") == -1) \ + fatal ("ioctl I_PUSH ldterm: errno %d\n", errno); \ + if (ioctl (xforkin, I_PUSH, "ttcompat") == -1) \ + fatal ("ioctl I_PUSH ttcompat: errno %d\n", errno); -#define USG_SHARED_LIBRARIES - -#define LIBS_SYSTEM "-lsocket -lnsl -lelf" - +/* Tell x11term.c and keyboard.c we have the system V streams feature. */ +#define SYSV_STREAMS /* On Some SysV System , w3 freeze. If freeze your xemacs , Add below definition */ /* This definition added by Shogo Fujii(shogo@bsd1.kbnes.nec.co.jp) */ #define PROCESS_IO_BLOCKING diff -r 861f2601a38b -r 1f0b15040456 src/s/win32-common.h --- a/src/s/win32-common.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/s/win32-common.h Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,18 @@ 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* See win32.c for info about the different Windows files in XEmacs. */ @@ -30,3 +28,5 @@ /* Define an identifier for all MS Windows systems -- Cygwin, native, MinGW */ #define WIN32_ANY + +#define DEFAULT_FILE_SYSTEM_IGNORE_CASE 1 diff -r 861f2601a38b -r 1f0b15040456 src/s/win32-native.h --- a/src/s/win32-native.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/s/win32-native.h Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,18 @@ 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* See win32.c for info about the different Windows files in XEmacs. */ diff -r 861f2601a38b -r 1f0b15040456 src/s/windowsnt.h --- a/src/s/windowsnt.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/s/windowsnt.h Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,18 @@ 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.31. */ diff -r 861f2601a38b -r 1f0b15040456 src/scrollbar-gtk.c --- a/src/scrollbar-gtk.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/scrollbar-gtk.c Sun May 01 18:44:03 2011 +0100 @@ -3,13 +3,14 @@ Copyright (C) 1994 Amdhal Corporation. Copyright (C) 1995 Sun Microsystems, Inc. Copyright (C) 1995 Darrell Kindred . + Copyright (C) 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +18,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ /* Gtk version by William M. Perry */ @@ -65,6 +64,7 @@ } xfree (instance->scrollbar_data); + instance->scrollbar_data = 0; } } @@ -474,23 +474,15 @@ } #ifdef MEMORY_USAGE_STATS -static int +static Bytecount gtk_compute_scrollbar_instance_usage (struct device *UNUSED (d), struct scrollbar_instance *inst, - struct overhead_stats *ovstats) + struct usage_stats *ustats) { - int total = 0; + struct gtk_scrollbar_data *data = + (struct gtk_scrollbar_data *) inst->scrollbar_data; - while (inst) - { - struct gtk_scrollbar_data *data = - (struct gtk_scrollbar_data *) inst->scrollbar_data; - - total += malloced_storage_size (data, sizeof (*data), ovstats); - inst = inst->next; - } - - return total; + return malloced_storage_size (data, sizeof (*data), ustats); } #endif /* MEMORY_USAGE_STATS */ diff -r 861f2601a38b -r 1f0b15040456 src/scrollbar-gtk.h --- a/src/scrollbar-gtk.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/scrollbar-gtk.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/scrollbar-msw.c --- a/src/scrollbar-msw.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/scrollbar-msw.c Sun May 01 18:44:03 2011 +0100 @@ -3,14 +3,14 @@ Copyright (C) 1994 Amdahl Corporation. Copyright (C) 1995 Sun Microsystems, Inc. Copyright (C) 1995 Darrell Kindred . - Copyright (C) 2001, 2002 Ben Wing. + Copyright (C) 2001, 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -18,9 +18,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -102,6 +100,7 @@ assert (!NILP (ptr)); DestroyWindow (SCROLLBAR_MSW_HANDLE (sb)); xfree (sb->scrollbar_data); + sb->scrollbar_data = 0; } } @@ -423,23 +422,15 @@ #ifdef MEMORY_USAGE_STATS -static int +static Bytecount mswindows_compute_scrollbar_instance_usage (struct device *UNUSED (d), struct scrollbar_instance *inst, - struct overhead_stats *ovstats) + struct usage_stats *ustats) { - int total = 0; + struct mswindows_scrollbar_data *data = + (struct mswindows_scrollbar_data *) inst->scrollbar_data; - while (inst) - { - struct mswindows_scrollbar_data *data = - (struct mswindows_scrollbar_data *) inst->scrollbar_data; - - total += malloced_storage_size (data, sizeof (*data), ovstats); - inst = inst->next; - } - - return total; + return malloced_storage_size (data, sizeof (*data), ustats); } #endif /* MEMORY_USAGE_STATS */ @@ -497,5 +488,5 @@ staticpro (&Vmswindows_scrollbar_instance_table); Vmswindows_scrollbar_instance_table = - make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, Qeq); } diff -r 861f2601a38b -r 1f0b15040456 src/scrollbar-msw.h --- a/src/scrollbar-msw.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/scrollbar-msw.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/scrollbar-x.c --- a/src/scrollbar-x.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/scrollbar-x.c Sun May 01 18:44:03 2011 +0100 @@ -3,13 +3,14 @@ Copyright (C) 1994 Amdahl Corporation. Copyright (C) 1995 Sun Microsystems, Inc. Copyright (C) 1995 Darrell Kindred . + Copyright (C) 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +18,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -75,7 +74,10 @@ if (instance->scrollbar_data) { if (SCROLLBAR_X_NAME (instance)) - xfree (SCROLLBAR_X_NAME (instance)); + { + xfree (SCROLLBAR_X_NAME (instance)); + SCROLLBAR_X_NAME (instance) = 0; + } if (SCROLLBAR_X_WIDGET (instance)) { @@ -86,6 +88,7 @@ } xfree (instance->scrollbar_data); + instance->scrollbar_data = 0; } } @@ -283,7 +286,7 @@ } } - if (!wv->scrollbar_data) ABORT (); + assert (wv->scrollbar_data); free_widget_value_tree (wv); } else if (managed) @@ -693,23 +696,18 @@ #ifdef MEMORY_USAGE_STATS -static int +static Bytecount x_compute_scrollbar_instance_usage (struct device *UNUSED (d), struct scrollbar_instance *inst, - struct overhead_stats *ovstats) + struct usage_stats *ustats) { - int total = 0; + Bytecount total = 0; + struct x_scrollbar_data *data = + (struct x_scrollbar_data *) inst->scrollbar_data; - while (inst) - { - struct x_scrollbar_data *data = - (struct x_scrollbar_data *) inst->scrollbar_data; - - total += malloced_storage_size (data, sizeof (*data), ovstats); - total += malloced_storage_size (data->name, 1 + strlen (data->name), - ovstats); - inst = inst->next; - } + total += malloced_storage_size (data, sizeof (*data), ustats); + total += malloced_storage_size (data->name, 1 + strlen (data->name), + ustats); return total; } diff -r 861f2601a38b -r 1f0b15040456 src/scrollbar-x.h --- a/src/scrollbar-x.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/scrollbar-x.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/scrollbar.c --- a/src/scrollbar.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/scrollbar.c Sun May 01 18:44:03 2011 +0100 @@ -3,14 +3,14 @@ Copyright (C) 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. Copyright (C) 1995 Darrell Kindred . - Copyright (C) 2003 Ben Wing. + Copyright (C) 2003, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -18,9 +18,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -96,12 +94,10 @@ return Qnil; } -DEFINE_LRECORD_IMPLEMENTATION ("scrollbar-instance", scrollbar_instance, - 0, /*dumpable-flag*/ - mark_scrollbar_instance, - internal_object_printer, 0, 0, 0, - scrollbar_instance_description, - struct scrollbar_instance); +DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("scrollbar-instance", scrollbar_instance, + mark_scrollbar_instance, + scrollbar_instance_description, + struct scrollbar_instance); static void free_scrollbar_instance (struct scrollbar_instance *instance, @@ -114,7 +110,7 @@ struct device *d = XDEVICE (frame->device); MAYBE_DEVMETH (d, free_scrollbar_instance, (instance)); - /* not worth calling free_managed_lcrecord() -- scrollbar instances + /* not worth calling free_normal_lisp_object() -- scrollbar instances are not created that frequently and it's dangerous. */ } } @@ -198,9 +194,8 @@ create_scrollbar_instance (struct frame *f, int vertical) { struct device *d = XDEVICE (f->device); - struct scrollbar_instance *instance = - ALLOC_LCRECORD_TYPE (struct scrollbar_instance, - &lrecord_scrollbar_instance); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (scrollbar_instance); + struct scrollbar_instance *instance = XSCROLLBAR_INSTANCE (obj); MAYBE_DEVMETH (d, create_scrollbar_instance, (f, vertical, instance)); @@ -260,25 +255,43 @@ #ifdef MEMORY_USAGE_STATS -int -compute_scrollbar_instance_usage (struct device *d, - struct scrollbar_instance *inst, - struct overhead_stats *ovstats) +struct scrollbar_instance_stats { - int total = 0; + struct usage_stats u; + Bytecount device_data; +}; - if (HAS_DEVMETH_P(d, compute_scrollbar_instance_usage)) - total += DEVMETH (d, compute_scrollbar_instance_usage, (d, inst, ovstats)); +Bytecount +compute_all_scrollbar_instance_usage (struct scrollbar_instance *inst) +{ + Bytecount total = 0; while (inst) { - total += LISPOBJ_STORAGE_SIZE (inst, sizeof (*inst), ovstats); + total += lisp_object_memory_usage (wrap_scrollbar_instance (inst)); inst = inst->next; } return total; } +static void +scrollbar_instance_memory_usage (Lisp_Object scrollbar_instance, + struct generic_usage_stats *gustats) +{ + struct scrollbar_instance_stats *stats = + (struct scrollbar_instance_stats *) gustats; + struct scrollbar_instance *inst = XSCROLLBAR_INSTANCE (scrollbar_instance); + struct device *d = FRAME_XDEVICE (inst->mirror->frame); + Bytecount total = 0; + + if (HAS_DEVMETH_P (d, compute_scrollbar_instance_usage)) + total += DEVMETH (d, compute_scrollbar_instance_usage, (d, inst, + &gustats->u)); + + stats->device_data = total; +} + #endif /* MEMORY_USAGE_STATS */ void @@ -926,9 +939,16 @@ /************************************************************************/ void +scrollbar_objects_create (void) +{ +#ifdef MEMORY_USAGE_STATS + OBJECT_HAS_METHOD (scrollbar_instance, memory_usage); +#endif +} +void syms_of_scrollbar (void) { - INIT_LRECORD_IMPLEMENTATION (scrollbar_instance); + INIT_LISP_OBJECT (scrollbar_instance); DEFSYMBOL (Qscrollbar_line_up); DEFSYMBOL (Qscrollbar_line_down); @@ -964,6 +984,12 @@ void vars_of_scrollbar (void) { +#ifdef MEMORY_USAGE_STATS + OBJECT_HAS_PROPERTY + (scrollbar_instance, memusage_stats_list, + list1 (intern ("device-data"))); +#endif /* MEMORY_USAGE_STATS */ + DEFVAR_LISP ("scrollbar-pointer-glyph", &Vscrollbar_pointer_glyph /* *The shape of the mouse-pointer when over a scrollbar. This is a glyph; use `set-glyph-image' to change it. diff -r 861f2601a38b -r 1f0b15040456 src/scrollbar.h --- a/src/scrollbar.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/scrollbar.h Sun May 01 18:44:03 2011 +0100 @@ -1,12 +1,13 @@ /* Define scrollbar instance. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. + Copyright (C) 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -27,7 +26,7 @@ struct scrollbar_instance { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; /* Used by the frame caches. */ struct scrollbar_instance *next; @@ -47,7 +46,7 @@ void *scrollbar_data; }; -DECLARE_LRECORD (scrollbar_instance, struct scrollbar_instance); +DECLARE_LISP_OBJECT (scrollbar_instance, struct scrollbar_instance); #define XSCROLLBAR_INSTANCE(x) XRECORD (x, scrollbar_instance, struct scrollbar_instance) #define wrap_scrollbar_instance(p) wrap_record (p, scrollbar_instance) #define SCROLLBAR_INSTANCEP(x) RECORDP (x, scrollbar_instance) @@ -65,9 +64,8 @@ struct window_mirror *mirror, int active, int horiz_only); #ifdef MEMORY_USAGE_STATS -int compute_scrollbar_instance_usage (struct device *d, - struct scrollbar_instance *inst, - struct overhead_stats *ovstats); +Bytecount compute_all_scrollbar_instance_usage (struct scrollbar_instance * + inst); #endif extern Lisp_Object Vscrollbar_width, Vscrollbar_height; diff -r 861f2601a38b -r 1f0b15040456 src/search.c --- a/src/search.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/search.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* String search routines for XEmacs. Copyright (C) 1985, 1986, 1987, 1992-1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2001, 2002 Ben Wing. + Copyright (C) 2001, 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.29, except for region-cache stuff. */ @@ -50,10 +48,17 @@ #ifdef DEBUG_XEMACS /* Used in tests/automated/case-tests.el if available. */ -Fixnum debug_xemacs_searches; +Fixnum debug_searches; + +/* Declare as int rather than Bitflags because it's used by regex.c, which + may be used outside of XEmacs (e.g. etags.c). */ +int debug_regexps; +Lisp_Object Vdebug_regexps; Lisp_Object Qsearch_algorithm_used, Qboyer_moore, Qsimple_search; +Lisp_Object Qcompilation, Qfailure_point, Qmatching; + #endif /* If the regexp is non-nil, then the buffer contains the compiled form @@ -1461,7 +1466,7 @@ if (!checked) { #ifdef DEBUG_XEMACS - if (debug_xemacs_searches) + if (debug_searches) { Lisp_Symbol *sym = XSYMBOL (Qsearch_algorithm_used); sym->value = Qnil; @@ -1527,7 +1532,7 @@ pat = base_pat = patbuf; #ifdef DEBUG_XEMACS - if (debug_xemacs_searches) + if (debug_searches) { Lisp_Symbol *sym = XSYMBOL (Qsearch_algorithm_used); sym->value = boyer_moore_ok ? Qboyer_moore : Qsimple_search; @@ -2794,8 +2799,8 @@ Lisp_Object before, after; speccount = specpdl_depth (); - before = Fsubstring (string, Qzero, make_int (search_regs.start[sub])); - after = Fsubstring (string, make_int (search_regs.end[sub]), Qnil); + before = Fsubseq (string, Qzero, make_int (search_regs.start[sub])); + after = Fsubseq (string, make_int (search_regs.end[sub]), Qnil); /* Do case substitution into REPLACEMENT if desired. */ if (NILP (literal)) @@ -2881,13 +2886,12 @@ Lisp_Object literal_text = Qnil; Lisp_Object substring = Qnil; if (literal_end != literal_start) - literal_text = Fsubstring (replacement, - make_int (literal_start), - make_int (literal_end)); + literal_text = Fsubseq (replacement, + make_int (literal_start), + make_int (literal_end)); if (substart >= 0 && subend != substart) - substring = Fsubstring (string, - make_int (substart), - make_int (subend)); + substring = Fsubseq (string, make_int (substart), + make_int (subend)); if (!NILP (literal_text) || !NILP (substring)) accum = concat3 (accum, literal_text, substring); literal_start = strpos + 1; @@ -2896,9 +2900,9 @@ if (strpos != literal_start) /* some literal text at end to be inserted */ - replacement = concat2 (accum, Fsubstring (replacement, - make_int (literal_start), - make_int (strpos))); + replacement = concat2 (accum, Fsubseq (replacement, + make_int (literal_start), + make_int (strpos))); else replacement = accum; } @@ -3333,6 +3337,35 @@ } +#ifdef DEBUG_XEMACS + +static int +debug_regexps_changed (Lisp_Object UNUSED (sym), Lisp_Object *val, + Lisp_Object UNUSED (in_object), + int UNUSED (flags)) +{ + int newval = 0; + + EXTERNAL_LIST_LOOP_2 (elt, *val) + { + CHECK_SYMBOL (elt); + if (EQ (elt, Qcompilation)) + newval |= RE_DEBUG_COMPILATION; + else if (EQ (elt, Qfailure_point)) + newval |= RE_DEBUG_FAILURE_POINT; + else if (EQ (elt, Qmatching)) + newval |= RE_DEBUG_MATCHING; + else + invalid_argument + ("Expected `compilation', `failure-point' or `matching'", elt); + } + debug_regexps = newval; + return 0; +} + +#endif /* DEBUG_XEMACS */ + + /************************************************************************/ /* initialization */ /************************************************************************/ @@ -3421,10 +3454,26 @@ DEFSYMBOL (Qboyer_moore); DEFSYMBOL (Qsimple_search); - DEFVAR_INT ("debug-xemacs-searches", &debug_xemacs_searches /* + DEFSYMBOL (Qcompilation); + DEFSYMBOL (Qfailure_point); + DEFSYMBOL (Qmatching); + + DEFVAR_INT ("debug-searches", &debug_searches /* If non-zero, bind `search-algorithm-used' to `boyer-moore' or `simple-search', depending on the algorithm used for each search. Used for testing. */ ); - debug_xemacs_searches = 0; -#endif + debug_searches = 0; + + DEFVAR_LISP_MAGIC ("debug-regexps", &Vdebug_regexps, /* +List of areas to display debug info about during regexp operation. +The following areas are recognized: + +`compilation' Display the result of compiling a regexp. +`failure-point' Display info about failure points reached. +`matching' Display info about the process of matching a regex against + text. +*/ debug_regexps_changed); + Vdebug_regexps = Qnil; + debug_regexps = 0; +#endif /* DEBUG_XEMACS */ } diff -r 861f2601a38b -r 1f0b15040456 src/select-gtk.c --- a/src/select-gtk.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/select-gtk.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not synched with FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/select-msw.c --- a/src/select-msw.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/select-msw.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not synched with FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/select-x.c --- a/src/select-x.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/select-x.c Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,13 @@ /* X Selection processing for XEmacs Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 2001, 2002 Ben Wing. + Copyright (C) 2001, 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not synched with FSF. */ @@ -33,7 +31,7 @@ #include "select.h" #include "console-x-impl.h" -#include "objects-x.h" +#include "fontcolor-x.h" #include "systime.h" @@ -691,10 +689,8 @@ event->type = 0; /* Data need not have been allocated; cf. select-convert-to-delete in lisp/select.el . */ - if ((Rawbyte *)0 != data) - { + if (data) xfree (data); - } } unbind_to (count); diff -r 861f2601a38b -r 1f0b15040456 src/select-xlike-inc.c --- a/src/select-xlike-inc.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/select-xlike-inc.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not synched with FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/select.c --- a/src/select.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/select.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not synched with FSF. */ @@ -28,7 +26,7 @@ #include "device-impl.h" #include "extents.h" #include "console.h" -#include "objects.h" +#include "fontcolor.h" #include "frame.h" #include "opaque.h" @@ -183,19 +181,8 @@ if (!NILP (local_selection_data)) { owned_p = 1; - /* Don't use Fdelq() as that may QUIT;. */ - if (EQ (local_selection_data, Fcar (Vselection_alist))) - Vselection_alist = Fcdr (Vselection_alist); - else - { - Lisp_Object rest; - for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest)) - if (EQ (local_selection_data, Fcar (XCDR (rest)))) - { - XCDR (rest) = Fcdr (XCDR (rest)); - break; - } - } + Vselection_alist + = delq_no_quit (local_selection_data, Vselection_alist); } } else @@ -412,21 +399,8 @@ /* Well, we already believe that we don't own it, so that's just fine. */ if (NILP (local_selection_data)) return; - /* Otherwise, we're really honest and truly being told to drop it. - Don't use Fdelq() as that may QUIT;. - */ - if (EQ (local_selection_data, Fcar (Vselection_alist))) - Vselection_alist = Fcdr (Vselection_alist); - else - { - Lisp_Object rest; - for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest)) - if (EQ (local_selection_data, Fcar (XCDR (rest)))) - { - XCDR (rest) = Fcdr (XCDR (rest)); - break; - } - } + /* Otherwise, we're really honest and truly being told to drop it. */ + Vselection_alist = delq_no_quit (local_selection_data, Vselection_alist); /* Let random lisp code notice that the selection has been stolen. */ diff -r 861f2601a38b -r 1f0b15040456 src/select.h --- a/src/select.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/select.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/sgiplay.c --- a/src/sgiplay.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/sgiplay.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/sheap.c --- a/src/sheap.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/sheap.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to the Free -Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -02111-1307, USA.*/ +along with XEmacs. If not, see . */ #include #include "lisp.h" diff -r 861f2601a38b -r 1f0b15040456 src/signal.c --- a/src/signal.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/signal.c Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,13 @@ /* Handling asynchronous signals. Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995, 1996, 2001, 2002, 2004 Ben Wing. + Copyright (C) 1995, 1996, 2001, 2002, 2004, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not synched with FSF. Split out of keyboard.c. */ @@ -727,7 +725,7 @@ Backtrace given in - (Info-goto-node "(internals)Nasty Bugs due to Reentrancy in Redisplay Structures handling QUIT") + (Info-goto-node "(internals)Critical Redisplay Sections") */ assert_with_message diff -r 861f2601a38b -r 1f0b15040456 src/sound.c --- a/src/sound.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/sound.c Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/sound.h --- a/src/sound.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/sound.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/specifier.c --- a/src/specifier.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/specifier.c Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -257,9 +255,9 @@ Lisp_Specifier* sp = XSPECIFIER (rest); /* A bit of assertion that we're removing both parts of the magic one altogether */ - assert (!MAGIC_SPECIFIER_P(sp) - || (BODILY_SPECIFIER_P(sp) && marked_p (sp->fallback)) - || (GHOST_SPECIFIER_P(sp) && marked_p (sp->magic_parent))); + assert (!MAGIC_SPECIFIER_P (sp) + || (BODILY_SPECIFIER_P (sp) && marked_p (sp->fallback)) + || (GHOST_SPECIFIER_P (sp) && marked_p (sp->magic_parent))); /* This specifier is garbage. Remove it from the list. */ if (NILP (prev)) Vall_specifiers = sp->next_specifier; @@ -280,8 +278,8 @@ Lisp_Object the_specs; if (print_readably) - printing_unreadable_object ("#<%s-specifier 0x%x>", - sp->methods->name, sp->header.uid); + printing_unreadable_object_fmt ("#<%s-specifier 0x%x>", + sp->methods->name, LISP_OBJECT_UID (obj)); write_fmt_string (printcharfun, "#<%s-specifier global=", sp->methods->name); #if 0 @@ -302,16 +300,15 @@ write_fmt_string_lisp (printcharfun, " fallback=%S", 1, sp->fallback); } unbind_to (count); - write_fmt_string (printcharfun, " 0x%x>", sp->header.uid); + write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); } #ifndef NEW_GC static void -finalize_specifier (void *header, int for_disksave) +finalize_specifier (Lisp_Object obj) { - Lisp_Specifier *sp = (Lisp_Specifier *) header; - /* don't be snafued by the disksave finalization. */ - if (!for_disksave && !GHOST_SPECIFIER_P(sp) && sp->caching) + Lisp_Specifier *sp = XSPECIFIER (obj); + if (!GHOST_SPECIFIER_P (sp) && sp->caching) { xfree (sp->caching); sp->caching = 0; @@ -349,7 +346,7 @@ } static Hashcode -specifier_hash (Lisp_Object obj, int depth) +specifier_hash (Lisp_Object obj, int depth, Boolint equalp) { Lisp_Specifier *s = XSPECIFIER (obj); @@ -357,11 +354,11 @@ many places where data can be stored. We pick what are perhaps the most likely places where interesting stuff will be. */ return HASH5 ((HAS_SPECMETH_P (s, hash) ? - SPECMETH (s, hash, (obj, depth)) : 0), + SPECMETH (s, hash, (obj, depth, equalp)) : 0), (Hashcode) s->methods, - internal_hash (s->global_specs, depth + 1), - internal_hash (s->frame_specs, depth + 1), - internal_hash (s->buffer_specs, depth + 1)); + internal_hash (s->global_specs, depth + 1, equalp), + internal_hash (s->frame_specs, depth + 1, equalp), + internal_hash (s->buffer_specs, depth + 1, equalp)); } inline static Bytecount @@ -372,9 +369,9 @@ } static Bytecount -sizeof_specifier (const void *header) +sizeof_specifier (Lisp_Object obj) { - const Lisp_Specifier *p = (const Lisp_Specifier *) header; + const Lisp_Specifier *p = XSPECIFIER (obj); return aligned_sizeof_specifier (GHOST_SPECIFIER_P (p) ? 0 : p->methods->extra_data_size); @@ -395,12 +392,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("specifier-caching", - specifier_caching, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - specifier_caching_description_1, - struct specifier_caching); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("specifier-caching", specifier_caching, + 0, specifier_caching_description_1, + struct specifier_caching); #else /* not NEW_GC */ static const struct sized_memory_description specifier_caching_description = { sizeof (struct specifier_caching), @@ -446,24 +440,13 @@ 0, specifier_empty_extra_description_1 }; -#ifdef NEW_GC -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("specifier", specifier, - 1, /*dumpable-flag*/ - mark_specifier, print_specifier, - 0, specifier_equal, specifier_hash, - specifier_description, - sizeof_specifier, - Lisp_Specifier); -#else /* not NEW_GC */ -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("specifier", specifier, - 1, /*dumpable-flag*/ - mark_specifier, print_specifier, - finalize_specifier, - specifier_equal, specifier_hash, - specifier_description, - sizeof_specifier, - Lisp_Specifier); -#endif /* not NEW_GC */ +DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("specifier", specifier, + mark_specifier, print_specifier, + IF_OLD_GC (finalize_specifier), + specifier_equal, specifier_hash, + specifier_description, + sizeof_specifier, + Lisp_Specifier); /************************************************************************/ /* Creating specifiers */ @@ -526,10 +509,9 @@ make_specifier_internal (struct specifier_methods *spec_meths, Bytecount data_size, int call_create_meth) { - Lisp_Object specifier; - Lisp_Specifier *sp = (Lisp_Specifier *) - BASIC_ALLOC_LCRECORD (aligned_sizeof_specifier (data_size), - &lrecord_specifier); + Lisp_Object specifier = + ALLOC_SIZED_LISP_OBJECT (aligned_sizeof_specifier (data_size), specifier); + Lisp_Specifier *sp = XSPECIFIER (specifier); sp->methods = spec_meths; sp->global_specs = Qnil; @@ -542,7 +524,6 @@ sp->caching = 0; sp->next_specifier = Vall_specifiers; - specifier = wrap_specifier (sp); Vall_specifiers = specifier; if (call_create_meth) @@ -575,9 +556,9 @@ UNGCPRO; /* Connect guys together */ - XSPECIFIER(bodily)->magic_parent = Qt; - XSPECIFIER(bodily)->fallback = ghost; - XSPECIFIER(ghost)->magic_parent = bodily; + XSPECIFIER (bodily)->magic_parent = Qt; + XSPECIFIER (bodily)->fallback = ghost; + XSPECIFIER (ghost)->magic_parent = bodily; return bodily; } @@ -998,7 +979,7 @@ Lisp_Object rest; int res = 0; - assert(stage < NUM_MATCHSPEC_STAGES); + assert (stage < NUM_MATCHSPEC_STAGES); LIST_LOOP (rest, tag_set) { @@ -1270,7 +1251,7 @@ } } - return define_specifier_tag(tag, device_predicate, charset_predicate); + return define_specifier_tag (tag, device_predicate, charset_predicate); } /* Called at device-creation time to initialize the user-defined @@ -1293,11 +1274,11 @@ for (rest = Vuser_defined_tags, rest2 = DEVICE_USER_DEFINED_TAGS (d); !NILP (rest); rest = XCDR (rest), rest2 = XCDR (rest2)) { - GET_LIST_LENGTH(XCAR(rest), list_len); - - assert(3 == list_len); - - device_predicate = XCADR(XCAR (rest)); + GET_LIST_LENGTH (XCAR(rest), list_len); + + assert (3 == list_len); + + device_predicate = XCADR (XCAR (rest)); if (NILP (device_predicate)) { @@ -1658,7 +1639,7 @@ bodily_specifier (Lisp_Object spec) { return (GHOST_SPECIFIER_P (XSPECIFIER (spec)) - ? XSPECIFIER(spec)->magic_parent : spec); + ? XSPECIFIER (spec)->magic_parent : spec); } /* Signal error if (specifier SPEC is read-only. @@ -2336,7 +2317,7 @@ Lisp_Object how_to_add) { int depth = unlock_ghost_specifiers_protected (); - Fadd_spec_to_specifier (XSPECIFIER(specifier)->fallback, + Fadd_spec_to_specifier (XSPECIFIER (specifier)->fallback, instantiator, locale, tag_set, how_to_add); unbind_to (depth); } @@ -2534,7 +2515,7 @@ Lisp_Object tag_set, Lisp_Object exact_p) { int depth = unlock_ghost_specifiers_protected (); - Fremove_specifier (XSPECIFIER(specifier)->fallback, + Fremove_specifier (XSPECIFIER (specifier)->fallback, locale, tag_set, exact_p); unbind_to (depth); } @@ -2722,7 +2703,7 @@ if (SPECIFIERP (fallback)) assert (EQ (Fspecifier_type (specifier), Fspecifier_type (fallback))); if (BODILY_SPECIFIER_P (sp)) - GHOST_SPECIFIER(sp)->fallback = fallback; + GHOST_SPECIFIER (sp)->fallback = fallback; else sp->fallback = fallback; /* call the after-change method */ @@ -2812,14 +2793,14 @@ FROB (initial, STAGE_INITIAL) else FROB (final, STAGE_FINAL) - else assert(0); + else assert (0); #undef FROB } } #endif /* MULE */ - LIST_LOOP(rest, inst_list) + LIST_LOOP (rest, inst_list) { Lisp_Object tagged_inst = XCAR (rest); Lisp_Object tag_set = XCAR (tagged_inst); @@ -2833,7 +2814,7 @@ val = XCDR (tagged_inst); the_instantiator = val; - if (!NILP(charset) && + if (!NILP (charset) && !(charset_matches_specifier_tag_set_p (charset, tag_set, stage))) { ++respected_charsets; @@ -2843,7 +2824,7 @@ if (HAS_SPECMETH_P (sp, instantiate)) val = call_with_suspended_errors ((lisp_fn_t) RAW_SPECMETH (sp, instantiate), - Qunbound, Qspecifier, errb, 5, specifier, + Qunbound, Qspecifier, ERROR_ME_WARN, 5, specifier, matchspec, domain, val, depth, no_fallback); if (!UNBOUNDP (val)) @@ -3190,6 +3171,10 @@ no_fallback, 1); } +/* MATCHSPEC is backward-incompatible with code written to 21.4's API. + So far such code has been seen only in x-symbol-mule.el, and that + was addressed by a change `face-property-matching-instance'. + See tracker issue752 for a more general patch against 21.5.29. */ DEFUN ("specifier-matching-instance", Fspecifier_matching_instance, 2, 5, 0, /* Return an instance for SPECIFIER in DOMAIN that matches MATCHSPEC. If no instance can be generated for this domain, return DEFAULT. @@ -3394,8 +3379,7 @@ if (!sp->caching) #ifdef NEW_GC - sp->caching = alloc_lrecord_type (struct specifier_caching, - &lrecord_specifier_caching); + sp->caching = XSPECIFIER_CACHING (ALLOC_NORMAL_LISP_OBJECT (specifier_caching)); #else /* not NEW_GC */ sp->caching = xnew_and_zero (struct specifier_caching); #endif /* not NEW_GC */ @@ -3410,7 +3394,7 @@ sp->caching->always_recompute = always_recompute; Vcached_specifiers = Fcons (specifier, Vcached_specifiers); if (BODILY_SPECIFIER_P (sp)) - GHOST_SPECIFIER(sp)->caching = sp->caching; + GHOST_SPECIFIER (sp)->caching = sp->caching; recompute_cached_specifier_everywhere (specifier); } @@ -3742,17 +3726,63 @@ return DISPLAYTABLE_SPECIFIERP (object) ? Qt : Qnil; } + + +#ifdef MEMORY_USAGE_STATS + +struct specifier_stats +{ + struct usage_stats u; + /* Ancillary Lisp */ + Bytecount global, device, frame, window, buffer, fallback; + Bytecount magic_parent; +}; + +static void +specifier_memory_usage (Lisp_Object UNUSED (specifier), + struct generic_usage_stats * UNUSED (gustats)) +{ +#if 0 + struct specifier_stats *stats = (struct specifier_stats *) gustats; + Lisp_Specifier *spec = XSPECIFIER (specifier); + + /* #### FIXME -- sometimes it appears that the specs, or at least global + specs, can have circularities in the tree structure. This makes + everything much slower and in fact can result in a hang with 100% CPU. + Need to investigate properly and figure out what's going on here, + since the specs are copied when stored in and so supposedly, circular + structures shouldn't exist. */ + stats->global = tree_memory_usage (spec->global_specs, 1); + stats->device = tree_memory_usage (spec->device_specs, 1); + stats->frame = tree_memory_usage (spec->frame_specs, 1); + stats->window = tree_memory_usage (spec->window_specs, 1); + stats->buffer = tree_memory_usage (spec->buffer_specs, 1); + stats->fallback = tree_memory_usage (spec->fallback, 1); + if (SPECIFIERP (spec->magic_parent)) + stats->magic_parent = lisp_object_memory_usage (spec->magic_parent); +#endif +} + +#endif /* MEMORY_USAGE_STATS */ /************************************************************************/ /* Initialization */ /************************************************************************/ + +void +specifier_objects_create (void) +{ +#ifdef MEMORY_USAGE_STATS + OBJECT_HAS_METHOD (specifier, memory_usage); +#endif +} void syms_of_specifier (void) { - INIT_LRECORD_IMPLEMENTATION (specifier); + INIT_LISP_OBJECT (specifier); #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (specifier_caching); + INIT_LISP_OBJECT (specifier_caching); #endif /* NEW_GC */ DEFSYMBOL (Qspecifierp); @@ -3870,6 +3900,13 @@ void vars_of_specifier (void) { +#ifdef MEMORY_USAGE_STATS + OBJECT_HAS_PROPERTY (specifier, memusage_stats_list, + listu (Qt, Qglobal, Qdevice, Qframe, Qwindow, Qbuffer, + Qfallback, intern ("magic-parent"), + Qunbound)); +#endif /* MEMORY_USAGE_STATS */ + Vcached_specifiers = Qnil; staticpro (&Vcached_specifiers); @@ -3885,6 +3922,6 @@ staticpro (&Vunlock_ghost_specifiers); Vcharset_tag_lists = - make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, Qeq); staticpro (&Vcharset_tag_lists); } diff -r 861f2601a38b -r 1f0b15040456 src/specifier.h --- a/src/specifier.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/specifier.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -115,7 +113,7 @@ If this function is not present, hashing behaves as if it returned zero. */ - Hashcode (*hash_method) (Lisp_Object specifier, int depth); + Hashcode (*hash_method) (Lisp_Object specifier, int depth, Boolint equalp); /* Validate method: Given an instantiator, verify that it's valid for this specifier type. If not, signal an error. @@ -220,7 +218,7 @@ struct Lisp_Specifier { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; struct specifier_methods *methods; /* we keep a chained list of all current specifiers, for GC cleanup @@ -259,7 +257,7 @@ }; typedef struct Lisp_Specifier Lisp_Specifier; -DECLARE_LRECORD (specifier, Lisp_Specifier); +DECLARE_LISP_OBJECT (specifier, Lisp_Specifier); #define XSPECIFIER(x) XRECORD (x, specifier, Lisp_Specifier) #define wrap_specifier(p) wrap_record (p, specifier) #define SPECIFIERP(x) RECORDP (x, specifier) @@ -428,7 +426,7 @@ struct specifier_caching { #ifdef NEW_GC - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; #endif /* NEW_GC */ int offset_into_struct_window; void (*value_changed_in_window) (Lisp_Object specifier, struct window *w, @@ -440,7 +438,7 @@ }; #ifdef NEW_GC -DECLARE_LRECORD (specifier_caching, struct specifier_caching); +DECLARE_LISP_OBJECT (specifier_caching, struct specifier_caching); #define XSPECIFIER_CACHING(x) \ XRECORD (x, specifier_caching, struct specifier_caching) #define wrap_specifier_caching(p) \ diff -r 861f2601a38b -r 1f0b15040456 src/src-headers --- a/src/src-headers Sat Feb 20 06:03:00 2010 -0600 +++ b/src/src-headers Sun May 01 18:44:03 2011 +0100 @@ -2,21 +2,19 @@ # Copyright (C) 1998 Free Software Foundation, Inc. # This file is part of XEmacs. -# -# XEmacs is free software; you can redistribute it and/or modify it +# +# 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. -# +# Free Software Foundation, either version 3 of the License, or (at your +# option) any later version. +# # XEmacs is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License # for more details. -# +# # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. +# along with XEmacs. If not, see . # Author: Martin Buchholz eval 'exec perl -w -S $0 ${1+"$@"}' diff -r 861f2601a38b -r 1f0b15040456 src/strcat.c --- a/src/strcat.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/strcat.c Sun May 01 18:44:03 2011 +0100 @@ -1,20 +1,18 @@ /* Copyright (C) 1991 Free Software Foundation, Inc. This file is part of the GNU C Library. -The GNU C Library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public License as -published by the Free Software Foundation; either version 2 of the -License, or (at your option) any later version. +The GNU C Library 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 3 of the License, or (at your +option) any later version. -The GNU C Library 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 -Library General Public License for more details. +The GNU C Library 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 Library General Public -License along with the GNU C Library; see the file COPYING.LIB. If -not, write to the Free Software Foundation, Inc., 675 Mass Ave, -Cambridge, MA 02139, USA. */ +You should have received a copy of the GNU General Public License +along with the GNU C Library. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/strftime.c --- a/src/strftime.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/strftime.c Sun May 01 18:44:03 2011 +0100 @@ -1,21 +1,20 @@ /* strftime - custom formatting of date and/or time Copyright (C) 1989, 1991, 1992 Free Software Foundation, Inc. - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - + 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 3 of the License, 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 this program; see the file COPYING. If not, write to - the Free Software Foundation, Inc., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ - + along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ /* This file has been ... uhhhhh ... Mule-ized. Yeah. @@ -132,6 +131,16 @@ "July", "August", "September", "October", "November", "December" }; +static char const * const roman_upper[] = +{ + "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX", "X", "XI", "XII" +}; + +static char const * const roman_lower[] = +{ + "i", "ii", "iii", "iv", "v", "vi", "vii", "viii", "ix", "x", "xi", "xii" +}; + /* Add character C to STRING and increment LENGTH, unless LENGTH would exceed MAX. */ @@ -601,6 +610,16 @@ add_num3 (&string[length], (1900 + tm->tm_year) % 1000, max - length, zero); break; + case '\xe6': + length += + add_str (&string[length], roman_lower[tm->tm_mon], + max - length); + break; + case '\xC6': + length += + add_str (&string[length], roman_upper[tm->tm_mon], + max - length); + break; } } } diff -r 861f2601a38b -r 1f0b15040456 src/sunplay.c --- a/src/sunplay.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/sunplay.c Sun May 01 18:44:03 2011 +0100 @@ -50,7 +50,7 @@ reset_volume_p = 0; reset_device_p = 0; - if (data && fd) ABORT (); /* one or the other */ + assert (!(data && fd)); /* one or the other */ if (AUDIO_SUCCESS != audio_get_play_config (audio_fd, &dev_hdr)) { diff -r 861f2601a38b -r 1f0b15040456 src/sunpro.c --- a/src/sunpro.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/sunpro.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/symbols.c --- a/src/symbols.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/symbols.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ @@ -141,15 +139,10 @@ return external_remprop (&XSYMBOL (symbol)->plist, property, 0, ERROR_ME); } -DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("symbol", symbol, - 1, /*dumpable-flag*/ - mark_symbol, print_symbol, - 0, 0, 0, symbol_description, - symbol_getprop, - symbol_putprop, - symbol_remprop, - Fsymbol_plist, - Lisp_Symbol); +DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("symbol", symbol, + mark_symbol, print_symbol, + 0, 0, 0, symbol_description, + Lisp_Symbol); /**********************************************************************/ /* Intern */ @@ -203,15 +196,23 @@ } Lisp_Object -intern_converting_underscores_to_dashes (const CIbyte *str) +intern_massaging_name (const CIbyte *str) { Bytecount len = strlen (str); CIbyte *tmp = alloca_extbytes (len + 1); Bytecount i; strcpy (tmp, str); for (i = 0; i < len; i++) - if (tmp[i] == '_') - tmp[i] = '-'; + { + if (tmp[i] == '_') + { + tmp[i] = '-'; + } + else if (tmp[i] == 'X') + { + tmp[i] = '*'; + } + } return intern_istring ((Ibyte *) tmp); } @@ -505,7 +506,8 @@ closure.accumulation = Qnil; GCPRO1 (closure.accumulation); map_obarray (Vobarray, apropos_mapper, &closure); - closure.accumulation = Fsort (closure.accumulation, Qstring_lessp); + closure.accumulation = list_sort (closure.accumulation, + check_string_lessp_nokey, Qnil, Qnil); UNGCPRO; return closure.accumulation; } @@ -602,7 +604,7 @@ !(unloading_module && UNBOUNDP(newval)) && #endif (symbol_is_constant (sym, val) -#ifndef NO_NEED_TO_HANDLE_21_4_CODE +#ifdef NEED_TO_HANDLE_21_4_CODE || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym)) #endif )) @@ -1105,47 +1107,43 @@ int UNUSED (escapeflag)) { write_fmt_string (printcharfun, - "#", + "#", XRECORD_LHEADER_IMPLEMENTATION (obj)->name, XSYMBOL_VALUE_MAGIC_TYPE (obj), - (long) XPNTR (obj)); + LISP_OBJECT_UID (obj)); } static const struct memory_description symbol_value_forward_description[] = { { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward", - symbol_value_forward, - 1, /*dumpable-flag*/ - 0, - print_symbol_value_magic, 0, 0, 0, - symbol_value_forward_description, - struct symbol_value_forward); - -DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local", - symbol_value_buffer_local, - 1, /*dumpable-flag*/ - mark_symbol_value_buffer_local, - print_symbol_value_magic, 0, 0, 0, - symbol_value_buffer_local_description, - struct symbol_value_buffer_local); - -DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic", - symbol_value_lisp_magic, - 1, /*dumpable-flag*/ - mark_symbol_value_lisp_magic, - print_symbol_value_magic, 0, 0, 0, - symbol_value_lisp_magic_description, - struct symbol_value_lisp_magic); - -DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias", - symbol_value_varalias, - 1, /*dumpable-flag*/ - mark_symbol_value_varalias, - print_symbol_value_magic, 0, 0, 0, - symbol_value_varalias_description, - struct symbol_value_varalias); +DEFINE_DUMPABLE_LISP_OBJECT ("symbol-value-forward", + symbol_value_forward, + 0, + print_symbol_value_magic, 0, 0, 0, + symbol_value_forward_description, + struct symbol_value_forward); + +DEFINE_DUMPABLE_LISP_OBJECT ("symbol-value-buffer-local", + symbol_value_buffer_local, + mark_symbol_value_buffer_local, + print_symbol_value_magic, 0, 0, 0, + symbol_value_buffer_local_description, + struct symbol_value_buffer_local); + +DEFINE_DUMPABLE_LISP_OBJECT ("symbol-value-lisp-magic", + symbol_value_lisp_magic, + mark_symbol_value_lisp_magic, + print_symbol_value_magic, 0, 0, 0, + symbol_value_lisp_magic_description, + struct symbol_value_lisp_magic); + +DEFINE_DUMPABLE_LISP_OBJECT ("symbol-value-varalias", + symbol_value_varalias, + mark_symbol_value_varalias, + print_symbol_value_magic, 0, 0, 0, + symbol_value_varalias_description, + struct symbol_value_varalias); /* Getting and setting values of symbols */ @@ -2293,8 +2291,8 @@ { struct symbol_value_buffer_local *bfwd - = ALLOC_LCRECORD_TYPE (struct symbol_value_buffer_local, - &lrecord_symbol_value_buffer_local); + = XSYMBOL_VALUE_BUFFER_LOCAL + (ALLOC_NORMAL_LISP_OBJECT (symbol_value_buffer_local)); Lisp_Object foo; bfwd->magic.type = SYMVAL_BUFFER_LOCAL; @@ -2401,8 +2399,8 @@ } /* Make sure variable is set up to hold per-buffer values */ - bfwd = ALLOC_LCRECORD_TYPE (struct symbol_value_buffer_local, - &lrecord_symbol_value_buffer_local); + bfwd = XSYMBOL_VALUE_BUFFER_LOCAL + (ALLOC_NORMAL_LISP_OBJECT (symbol_value_buffer_local)); bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL; bfwd->current_buffer = Qnil; @@ -2546,7 +2544,8 @@ = buffer_local_alist_element (current_buffer, variable, bfwd); if (!NILP (alist_element)) - current_buffer->local_var_alist = Fdelq (alist_element, alist); + current_buffer->local_var_alist = delq_no_quit (alist_element, + alist); /* Make sure symbol does not think it is set up for this buffer; force it to look once again for this buffer's value */ @@ -3193,8 +3192,9 @@ valcontents = XSYMBOL (variable)->value; if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents)) { - bfwd = ALLOC_LCRECORD_TYPE (struct symbol_value_lisp_magic, - &lrecord_symbol_value_lisp_magic); + bfwd = + XSYMBOL_VALUE_LISP_MAGIC + (ALLOC_NORMAL_LISP_OBJECT (symbol_value_lisp_magic)); bfwd->magic.type = SYMVAL_LISP_MAGIC; for (i = 0; i < MAGIC_HANDLER_MAX; i++) { @@ -3411,8 +3411,8 @@ invalid_change ("Variable is magic and cannot be aliased", variable); reject_constant_symbols (variable, Qunbound, 0, Qt); - bfwd = ALLOC_LCRECORD_TYPE (struct symbol_value_varalias, - &lrecord_symbol_value_varalias); + bfwd = + XSYMBOL_VALUE_VARALIAS (ALLOC_NORMAL_LISP_OBJECT (symbol_value_varalias)); bfwd->magic.type = SYMVAL_VARALIAS; bfwd->aliasee = aliased; bfwd->shadowed = valcontents; @@ -3524,30 +3524,38 @@ 1, /* lisp_readonly bit */ }, 0, /* next */ - 0, /* uid */ - 0, /* free */ }, 0, /* value */ SYMVAL_UNBOUND_MARKER }; #endif /* not NEW_GC */ +static void +reinit_symbol_objects_early (void) +{ + OBJECT_HAS_METHOD (symbol, getprop); + OBJECT_HAS_METHOD (symbol, putprop); + OBJECT_HAS_METHOD (symbol, remprop); + OBJECT_HAS_NAMED_METHOD (symbol, plist, Fsymbol_plist); + OBJECT_HAS_NAMED_METHOD (symbol, setplist, Fsetplist); +} + void init_symbols_once_early (void) { - INIT_LRECORD_IMPLEMENTATION (symbol); - INIT_LRECORD_IMPLEMENTATION (symbol_value_forward); - INIT_LRECORD_IMPLEMENTATION (symbol_value_buffer_local); - INIT_LRECORD_IMPLEMENTATION (symbol_value_lisp_magic); - INIT_LRECORD_IMPLEMENTATION (symbol_value_varalias); - - reinit_symbols_early (); + INIT_LISP_OBJECT (symbol); + INIT_LISP_OBJECT (symbol_value_forward); + INIT_LISP_OBJECT (symbol_value_buffer_local); + INIT_LISP_OBJECT (symbol_value_lisp_magic); + INIT_LISP_OBJECT (symbol_value_varalias); + + reinit_symbol_objects_early (); /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is called the first time. */ Qnil = Fmake_symbol (make_string_nocopy ((const Ibyte *) "nil", 3)); XSTRING_PLIST (XSYMBOL (Qnil)->name) = Qnil; - XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */ + XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihilo */ XSYMBOL (Qnil)->plist = Qnil; Vobarray = make_vector (OBARRAY_SIZE, Qzero); @@ -3596,6 +3604,7 @@ void reinit_symbols_early (void) { + reinit_symbol_objects_early (); } static void diff -r 861f2601a38b -r 1f0b15040456 src/symeval.h --- a/src/symeval.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/symeval.h Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,13 @@ /* Definitions of symbol-value forwarding for XEmacs Lisp interpreter. Copyright (C) 1985, 1986, 1987, 1992, 1993 Free Software Foundation, Inc. - Copyright (C) 2000, 2001, 2002 Ben Wing. + Copyright (C) 2000, 2001, 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -77,7 +75,7 @@ struct symbol_value_magic { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; void *value; enum symbol_value_type type; }; @@ -141,7 +139,7 @@ int (*magicfun) (Lisp_Object sym, Lisp_Object *val, Lisp_Object in_object, int flags); }; -DECLARE_LRECORD (symbol_value_forward, struct symbol_value_forward); +DECLARE_LISP_OBJECT (symbol_value_forward, struct symbol_value_forward); #define XSYMBOL_VALUE_FORWARD(x) \ XRECORD (x, symbol_value_forward, struct symbol_value_forward) #define symbol_value_forward_forward(m) ((void *)((m)->magic.value)) @@ -228,7 +226,7 @@ Lisp_Object current_buffer; Lisp_Object current_alist_element; }; -DECLARE_LRECORD (symbol_value_buffer_local, struct symbol_value_buffer_local); +DECLARE_LISP_OBJECT (symbol_value_buffer_local, struct symbol_value_buffer_local); #define XSYMBOL_VALUE_BUFFER_LOCAL(x) \ XRECORD (x, symbol_value_buffer_local, struct symbol_value_buffer_local) #define SYMBOL_VALUE_BUFFER_LOCAL_P(x) RECORDP (x, symbol_value_buffer_local) @@ -253,7 +251,7 @@ Lisp_Object harg[MAGIC_HANDLER_MAX]; Lisp_Object shadowed; }; -DECLARE_LRECORD (symbol_value_lisp_magic, struct symbol_value_lisp_magic); +DECLARE_LISP_OBJECT (symbol_value_lisp_magic, struct symbol_value_lisp_magic); #define XSYMBOL_VALUE_LISP_MAGIC(x) \ XRECORD (x, symbol_value_lisp_magic, struct symbol_value_lisp_magic) #define SYMBOL_VALUE_LISP_MAGIC_P(x) RECORDP (x, symbol_value_lisp_magic) @@ -266,7 +264,7 @@ Lisp_Object aliasee; Lisp_Object shadowed; }; -DECLARE_LRECORD (symbol_value_varalias, struct symbol_value_varalias); +DECLARE_LISP_OBJECT (symbol_value_varalias, struct symbol_value_varalias); #define XSYMBOL_VALUE_VARALIAS(x) \ XRECORD (x, symbol_value_varalias, struct symbol_value_varalias) #define SYMBOL_VALUE_VARALIAS_P(x) RECORDP (x, symbol_value_varalias) @@ -294,6 +292,9 @@ #define DEFSUBR(Fname) \ do { \ + /* #### As far as I can see, this has no upside compared to the non-NEW_GC \ + code. The MC_ALLOC_S##Fname structure is also in the dumped \ + XEmacs. Aidan Kehoe, Mon Sep 20 23:14:01 IST 2010 */ \ DEFSUBR_MC_ALLOC (Fname); \ defsubr (S##Fname); \ } while (0) @@ -401,8 +402,7 @@ do \ { \ struct symbol_value_forward *I_hate_C = \ - alloc_lrecord_type (struct symbol_value_forward, \ - &lrecord_symbol_value_forward); \ + XSYMBOL_VALUE_FORWARD (ALLOC_NORMAL_LISP_OBJECT (symbol_value_forward)); \ /* mcpro ((Lisp_Object) I_hate_C);*/ \ \ MARK_LRECORD_AS_LISP_READONLY (I_hate_C); \ @@ -426,11 +426,8 @@ 1, /* mark bit */ \ 1, /* c_readonly bit */ \ 1, /* lisp_readonly bit */ \ - 0 /* unused */ \ }, \ 0, /* next */ \ - 0, /* uid */ \ - 0 /* free */ \ }, \ c_location, \ forward_type \ @@ -489,7 +486,7 @@ void flush_all_buffer_local_cache (void); struct multiple_value { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; Elemcount count; Elemcount allocated_count; Elemcount first_desired; @@ -497,7 +494,7 @@ }; typedef struct multiple_value multiple_value; -DECLARE_LRECORD (multiple_value, multiple_value); +DECLARE_LISP_OBJECT (multiple_value, multiple_value); #define MULTIPLE_VALUEP(x) RECORDP (x, multiple_value) #define XMULTIPLE_VALUE(x) XRECORD (x, multiple_value, multiple_value) diff -r 861f2601a38b -r 1f0b15040456 src/symsinit.h --- a/src/symsinit.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/symsinit.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin St - Fifth Floor, -Boston, MA 02111-1301, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -54,6 +52,7 @@ void init_errors_once_early (void); void reinit_opaque_early (void); void init_opaque_once_early (void); +void reinit_process_early (void); void reinit_symbols_early (void); void init_symbols_once_early (void); @@ -72,6 +71,7 @@ void syms_of_abbrev (void); void syms_of_alloc (void); +void syms_of_array (void); void syms_of_balloon_x (void); void syms_of_buffer (void); void syms_of_bytecode (void); @@ -147,6 +147,7 @@ void syms_of_intl_x (void); void syms_of_keymap (void); void syms_of_lread (void); +void syms_of_lstream (void); void syms_of_macros (void); void syms_of_marker (void); void syms_of_mc_alloc (void); @@ -163,11 +164,11 @@ void syms_of_mule_wnn (void); void syms_of_nt (void); void syms_of_number (void); -void syms_of_objects (void); -void syms_of_objects_gtk (void); -void syms_of_objects_mswindows (void); -void syms_of_objects_tty (void); -void syms_of_objects_x (void); +void syms_of_fontcolor (void); +void syms_of_fontcolor_gtk (void); +void syms_of_fontcolor_mswindows (void); +void syms_of_fontcolor_tty (void); +void syms_of_fontcolor_x (void); EXTERN_C void syms_of_postgresql (void); void syms_of_print (void); void syms_of_process (void); @@ -202,6 +203,24 @@ void syms_of_win32 (void); void syms_of_window (void); +/* Initialize dynamic properties of objects (i.e. those properties not + initialized statically through a DEFINE_*_LISP_OBJECT declaration). + Dump time and post-pdump-load-time. */ + +void buffer_objects_create (void); +void casetab_objects_create (void); +void extent_objects_create (void); +void face_objects_create (void); +void frame_objects_create (void); +void glyph_objects_create (void); +void hash_table_objects_create (void); +void lstream_objects_create (void); +void mule_charset_objects_create (void); +void scrollbar_objects_create (void); +void specifier_objects_create (void); +void ui_gtk_objects_create (void); +void window_objects_create (void); + /* Initialize the console types (dump-time only for console_type_(), post-pdump-load-time only for reinit_). */ @@ -228,10 +247,10 @@ void console_type_create_menubar_x (void); void console_type_create_mswindows (void); void reinit_console_type_create_mswindows (void); -void console_type_create_objects_gtk (void); -void console_type_create_objects_mswindows (void); -void console_type_create_objects_tty (void); -void console_type_create_objects_x (void); +void console_type_create_fontcolor_gtk (void); +void console_type_create_fontcolor_mswindows (void); +void console_type_create_fontcolor_tty (void); +void console_type_create_fontcolor_x (void); void console_type_create_redisplay_gtk (void); void console_type_create_redisplay_mswindows (void); void console_type_create_redisplay_tty (void); @@ -261,8 +280,8 @@ void reinit_specifier_type_create_gutter (void); void specifier_type_create_image (void); void reinit_specifier_type_create_image (void); -void specifier_type_create_objects (void); -void reinit_specifier_type_create_objects (void); +void specifier_type_create_fontcolor (void); +void reinit_specifier_type_create_fontcolor (void); void specifier_type_create_toolbar (void); void reinit_specifier_type_create_toolbar (void); @@ -329,6 +348,7 @@ void vars_of_abbrev (void); void vars_of_alloc (void); +void reinit_vars_of_alloc (void); void vars_of_balloon_x (void); void vars_of_buffer (void); void reinit_vars_of_buffer (void); @@ -336,6 +356,7 @@ void reinit_vars_of_bytecode (void); void vars_of_callint (void); EXTERN_C void vars_of_canna_api (void); +void vars_of_casetab (void); void vars_of_chartab (void); void vars_of_cmdloop (void); void vars_of_cmds (void); @@ -366,6 +387,7 @@ void vars_of_dragdrop (void); void vars_of_editfns (void); EXTERN_C void vars_of_eldap (void); +void vars_of_elhash (void); void vars_of_emacs (void); void vars_of_eval (void); void reinit_vars_of_eval (void); @@ -382,7 +404,6 @@ void vars_of_events (void); void reinit_vars_of_events (void); void vars_of_extents (void); -void reinit_vars_of_extents (void); void vars_of_faces (void); void vars_of_file_coding (void); void reinit_vars_of_file_coding (void); @@ -450,13 +471,13 @@ void vars_of_nt (void); void vars_of_number (void); void reinit_vars_of_number (void); -void reinit_vars_of_object_mswindows (void); -void vars_of_objects (void); -void reinit_vars_of_objects (void); -void vars_of_objects_gtk (void); -void vars_of_objects_mswindows (void); -void vars_of_objects_tty (void); -void vars_of_objects_x (void); +void reinit_vars_of_fontcolor_mswindows (void); +void vars_of_fontcolor (void); +void reinit_vars_of_fontcolor (void); +void vars_of_fontcolor_gtk (void); +void vars_of_fontcolor_mswindows (void); +void vars_of_fontcolor_tty (void); +void vars_of_fontcolor_x (void); EXTERN_C void vars_of_postgresql (void); void vars_of_print (void); void reinit_vars_of_print (void); diff -r 861f2601a38b -r 1f0b15040456 src/syntax.c --- a/src/syntax.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/syntax.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* XEmacs routines to deal with syntax tables; also word and list parsing. Copyright (C) 1985-1994 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2001, 2002, 2003 Ben Wing. + Copyright (C) 2001, 2002, 2003, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.28. */ @@ -31,12 +29,6 @@ #include "syntax.h" #include "extents.h" -#ifdef NEW_GC -# define UNUSED_IF_NEW_GC(decl) UNUSED (decl) -#else -# define UNUSED_IF_NEW_GC(decl) decl -#endif - #define ST_COMMENT_STYLE 0x101 #define ST_STRING_STYLE 0x102 @@ -265,11 +257,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("syntax-cache", syntax_cache, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - syntax_cache_description_1, - Lisp_Syntax_Cache); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("syntax-cache", syntax_cache, + 0, syntax_cache_description_1, + Lisp_Syntax_Cache); #else /* not NEW_GC */ const struct sized_memory_description syntax_cache_description = { @@ -529,8 +519,7 @@ { struct syntax_cache *cache; #ifdef NEW_GC - buf->syntax_cache = alloc_lrecord_type (struct syntax_cache, - &lrecord_syntax_cache); + buf->syntax_cache = XSYNTAX_CACHE (ALLOC_NORMAL_LISP_OBJECT (syntax_cache)); #else /* not NEW_GC */ buf->syntax_cache = xnew_and_zero (struct syntax_cache); #endif /* not NEW_GC */ @@ -551,8 +540,11 @@ uninit_buffer_syntax_cache (struct buffer *UNUSED_IF_NEW_GC (buf)) { #ifndef NEW_GC - xfree (buf->syntax_cache); - buf->syntax_cache = 0; + if (buf->syntax_cache) + { + xfree (buf->syntax_cache); + buf->syntax_cache = 0; + } #endif /* not NEW_GC */ } @@ -2399,7 +2391,7 @@ syms_of_syntax (void) { #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (syntax_cache); + INIT_LISP_OBJECT (syntax_cache); #endif /* NEW_GC */ DEFSYMBOL (Qsyntax_table_p); DEFSYMBOL (Qsyntax_table); diff -r 861f2601a38b -r 1f0b15040456 src/syntax.h --- a/src/syntax.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/syntax.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.28. */ @@ -296,7 +294,7 @@ struct syntax_cache { #ifdef NEW_GC - struct lrecord_header header; + NORMAL_LISP_OBJECT_HEADER header; #endif /* NEW_GC */ int use_code; /* Whether to use syntax_code or syntax_table. This is set @@ -339,7 +337,7 @@ #ifdef NEW_GC typedef struct syntax_cache Lisp_Syntax_Cache; -DECLARE_LRECORD (syntax_cache, Lisp_Syntax_Cache); +DECLARE_LISP_OBJECT (syntax_cache, Lisp_Syntax_Cache); #define XSYNTAX_CACHE(x) \ XRECORD (x, syntax_cache, Lisp_Syntax_Cache) diff -r 861f2601a38b -r 1f0b15040456 src/sysdep.c --- a/src/sysdep.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/sysdep.c Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30 except for some Windows-NT crap. */ @@ -108,12 +106,6 @@ #endif -#ifdef HAVE_TTY -#define USED_IF_TTY(decl) decl -#else -#define USED_IF_TTY(decl) UNUSED (decl) -#endif - /************************************************************************/ /* subprocess control */ diff -r 861f2601a38b -r 1f0b15040456 src/sysdep.h --- a/src/sysdep.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/sysdep.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. Split out of sysdep.c/emacs.c. */ diff -r 861f2601a38b -r 1f0b15040456 src/sysdir.h --- a/src/sysdir.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/sysdir.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not really in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/sysdll.c --- a/src/sysdll.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/sysdll.c Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to the Free -Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -02111-1307, USA. */ +along with XEmacs. If not, see . */ /* This file has been Mule-ized, Ben Wing, 1-26-10. */ @@ -345,7 +343,7 @@ } /* - * dyld adds libraries by first adding the directly dependant libraries in + * dyld adds libraries by first adding the directly dependent libraries in * link order, and then adding the dependencies for those libraries, so we * should do the same... but we don't bother adding the extra dependencies, if * the symbols are neither in the loaded image nor any of it's direct @@ -368,9 +366,9 @@ struct mach_header *wh; if ((wh = (struct mach_header *) - my_find_image((Rawbyte *) + my_find_image((const Chbyte *) (((struct dylib_command *) lc)-> - dylib.name.offset + (Rawbyte *) lc)))) + dylib.name.offset + (const Chbyte *) lc)))) { Extbyte *symext = ITEXT_TO_EXTERNAL (symbol, Qdll_symbol_encoding); @@ -442,7 +440,7 @@ MAYBE_PREPEND_UNDERSCORE (n); next = ITEXT_TO_EXTERNAL (n, Qdll_variable_name_encoding); - sym = NSLookupSymbolInModule ((NSModule) h, n); + sym = NSLookupSymbolInModule ((NSModule) h, (const Chbyte *)n); if (sym == 0) return 0; return (dll_var) NSAddressOfSymbol (sym); } diff -r 861f2601a38b -r 1f0b15040456 src/sysdll.h --- a/src/sysdll.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/sysdll.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to the Free -Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -02111-1307, USA. */ +along with XEmacs. If not, see . */ /* This file has been Mule-ized, Ben Wing, 1-26-10. */ diff -r 861f2601a38b -r 1f0b15040456 src/sysfile.h --- a/src/sysfile.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/sysfile.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not really in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/sysfloat.h --- a/src/sysfloat.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/sysfloat.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not really in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/sysgdkx.h --- a/src/sysgdkx.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/sysgdkx.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/sysgtk.h --- a/src/sysgtk.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/sysgtk.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/sysproc.h --- a/src/sysproc.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/sysproc.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not really in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/syspwd.h --- a/src/syspwd.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/syspwd.h Sun May 01 18:44:03 2011 +0100 @@ -2,10 +2,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -13,9 +13,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not really in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/syssignal.h --- a/src/syssignal.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/syssignal.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ diff -r 861f2601a38b -r 1f0b15040456 src/systime.h --- a/src/systime.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/systime.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ diff -r 861f2601a38b -r 1f0b15040456 src/systty.h --- a/src/systty.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/systty.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ diff -r 861f2601a38b -r 1f0b15040456 src/syswait.h --- a/src/syswait.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/syswait.h Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ #ifndef INCLUDED_syswait_h_ #define INCLUDED_syswait_h_ diff -r 861f2601a38b -r 1f0b15040456 src/syswindows.h --- a/src/syswindows.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/syswindows.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -74,7 +72,7 @@ Corresponding s/ file: s/mingw32.h (none) There's no flag to indicate that you are specifically - targetting native Windows and not doing this with MINGW. + targeting native Windows and not doing this with MINGW. Presumably this means you're using Visual C++. Corresponding s/ file: s/windowsnt.h @@ -130,6 +128,30 @@ In fact, in general, it's possible to compile with support for all of these at the same time. + + + Here is a table mapping from GNU Emacs constants to XEmacs constants for + use in porting code. + + + Old Constant New Constant + --------------------------------------------------------------- + `WINDOWSNT' `WIN32_NATIVE' + `WIN32' `WIN32_NATIVE' + `_WIN32' `WIN32_NATIVE' + `HAVE_WIN32' `WIN32_NATIVE' + `DOS_NT' `WIN32_NATIVE' + `HAVE_NTGUI' `WIN32_NATIVE', unless it ends up already bracketed + by this + `HAVE_FACES' always true + `MSDOS' determine whether this code is really specific to + MS-DOS (and not Windows - e.g. DJGPP code); if so, + delete the code; otherwise, convert to `WIN32_NATIVE' + (we do not support MS-DOS w/DOS Extender under XEmacs) + `__CYGWIN__' `CYGWIN' + `__CYGWIN32__' `CYGWIN' + `__MINGW32__' `MINGW' + */ /* ------------------------- Basic includes ------------------------- */ @@ -572,7 +594,6 @@ and cause problems if we used Cygwin headers to generate intl-auto-encap-win32.[ch]. */ typedef LPCVOID PCVOID; -typedef LPDWORD *PDWORD_PTR; #endif /* CYGWIN_HEADERS */ diff -r 861f2601a38b -r 1f0b15040456 src/termcap.c --- a/src/termcap.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/termcap.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not synched with FSF. */ @@ -25,7 +23,10 @@ #ifdef emacs #include #include "lisp.h" /* For encapsulated open, close, read */ -#include "device.h" /* For DEVICE_BAUD_RATE */ +#include "device.h" +#include "device-impl.h" /* For DEVICE_BAUD_RATE */ +#include "sysfile.h" +#include "process.h" #else /* not emacs */ #include diff -r 861f2601a38b -r 1f0b15040456 src/terminfo.c --- a/src/terminfo.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/terminfo.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ diff -r 861f2601a38b -r 1f0b15040456 src/tests.c --- a/src/tests.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/tests.c Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Author: Martin Buchholz @@ -49,7 +47,7 @@ ()) { void *ptr; Bytecount len; - Lisp_Object string, opaque, conversion_result = Qnil; + Lisp_Object string = Qnil, opaque = Qnil, conversion_result = Qnil; Ibyte int_foo[] = "\n\nfoo\nbar"; Extbyte ext_unix[]= "\n\nfoo\nbar"; @@ -72,6 +70,20 @@ Lisp_Object string_latin1 = make_string (int_latin1, sizeof (int_latin1) - 1); int autodetect_eol_p = !NILP (Fsymbol_value (intern ("eol-detection-enabled-p"))); + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; + struct gcpro ngcpro1, ngcpro2, ngcpro3; +#ifdef MULE + struct gcpro ngcpro4; +#endif + + /* DFC conversion inhibits GC, but we have a call2() below which calls + Lisp, which can trigger GC, so we need to GC-protect everything here. */ + GCPRO5 (string, opaque, conversion_result, opaque_dos, string_foo); +#ifdef MULE + NGCPRO4 (string_latin2, opaque_latin, opaque0_latin, string_latin1); +#else + NGCPRO3 (opaque_latin, opaque0_latin, string_latin1); +#endif /* Check for expected strings before and after conversion. Conversions depend on whether MULE is defined. */ @@ -541,6 +553,8 @@ Qbinary); DFC_CHECK_DATA (ptr, len, ext_dos, "DOS Lisp opaque, ALLOCA, binary"); + NUNGCPRO; + UNGCPRO; return conversion_result; } @@ -599,7 +613,7 @@ test_hash_tables_data data; data.hash_table = make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, - HASH_TABLE_EQUAL); + Qequal); Fputhash (make_int (1), make_int (2), data.hash_table); Fputhash (make_int (3), make_int (4), data.hash_table); @@ -682,7 +696,7 @@ FROB (0XFFFFFFFFFFFFFFFE); #endif /* INT_VALBITS >= 63 */ - return list3 (build_ascstring ("STORE_VOID_IN_LISP"), Qt, Qnil); + return list1 (list3 (build_ascstring ("STORE_VOID_IN_LISP"), Qt, Qnil)); } diff -r 861f2601a38b -r 1f0b15040456 src/text.c --- a/src/text.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/text.c Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -550,7 +548,7 @@ Well yes, this was the whole point of my "no lossage" proposal of being able to undo any coding-system transformation on a buffer. The idea was -to figure out which transformations were definitely reversable, and for +to figure out which transformations were definitely reversible, and for all the others, cache the original text in a text property. This way, you could probably still do a fairly good job at constructing a good reversal even after you've gone into the text and added, deleted, and rearranged @@ -589,7 +587,7 @@ Well yes, this was the whole point of my "no lossage" proposal of being able to undo any coding-system transformation on a buffer. The idea was -to figure out which transformations were definitely reversable, and for +to figure out which transformations were definitely reversible, and for all the others, cache the original text in a text property. This way, you could probably still do a fairly good job at constructing a good reversal even after you've gone into the text and added, deleted, and rearranged @@ -5170,9 +5168,9 @@ composite_char_col_next = 32; Vcomposite_char_string2char_hash_table = - make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, Qequal); Vcomposite_char_char2string_hash_table = - make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, Qeq); staticpro (&Vcomposite_char_string2char_hash_table); staticpro (&Vcomposite_char_char2string_hash_table); #endif /* ENABLE_COMPOSITE_CHARS */ diff -r 861f2601a38b -r 1f0b15040456 src/text.h --- a/src/text.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/text.h Sun May 01 18:44:03 2011 +0100 @@ -5,10 +5,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ @@ -47,6 +45,62 @@ BEGIN_C_DECLS +/* Forward compatibility from ben-unicode-internal: Following used for + functions that do character conversion and need to handle errors. */ + +enum converr + { + /* ---- Basic actions ---- */ + + /* Do nothing upon failure and return a failure indication. + Same as what happens when the *_raw() version is called. */ + CONVERR_FAIL, + /* abort() on failure, i.e. crash. */ + CONVERR_ABORT, + /* Signal a Lisp error. */ + CONVERR_ERROR, + /* Try to "recover" and continue processing. Currently this is always + the same as CONVERR_SUBSTITUTE, where one of the substitution + characters defined below (CANT_CONVERT_*) is used. */ + CONVERR_SUCCEED, + + /* ---- More specific actions ---- */ + + /* Substitute something (0xFFFD, the Unicode replacement character, + when converting to Unicode or to a Unicode-internal Ichar, JISX0208 + GETA mark when converting to non-Mule Ichar). */ + CONVERR_SUBSTITUTE, + /* Use private Unicode space when converting to Unicode. */ + CONVERR_USE_PRIVATE + }; + +/************************************************************************/ +/* A short intro to the format of text and of characters */ +/************************************************************************/ + +/* + "internally formatted text" and the term "internal format" in + general are likely to refer to the format of text in buffers and + strings; "externally formatted text" and the term "external format" + refer to any text format used in the O.S. or elsewhere outside of + XEmacs. The format of text and of a character are related and + there must be a one-to-one relationship (hopefully through a + relatively simple algorithmic means of conversion) between a string + of text and an equivalent array of characters, but the conversion + between the two is NOT necessarily trivial. + + In a non-Mule XEmacs, allowed characters are numbered 0 through + 255, where no fixed meaning is assigned to them, but (when + representing text, rather than bytes in a binary file) in practice + the lower half represents ASCII and the upper half some other 8-bit + character set (chosen by setting the font, case tables, syntax + tables, etc. appropriately for the character set through ad-hoc + means such as the `iso-8859-1' file and the + `standard-display-european' function). + + For more info, see `text.c' and the Internals Manual. +*/ + /* ---------------------------------------------------------------------- */ /* Super-basic character properties */ /* ---------------------------------------------------------------------- */ @@ -166,6 +220,29 @@ #endif /* not MULE */ +#ifdef MULE + +MODULE_API int non_ascii_valid_ichar_p (Ichar ch); + +/* Return whether the given Ichar is valid. + */ + +DECLARE_INLINE_HEADER ( +int +valid_ichar_p (Ichar ch) +) +{ + return (! (ch & ~0xFF)) || non_ascii_valid_ichar_p (ch); +} + +#else /* not MULE */ + +/* This works when CH is negative, and correctly returns non-zero only when CH + is in the range [0, 255], inclusive. */ +#define valid_ichar_p(ch) (! (ch & ~0xFF)) + +#endif /* not MULE */ + /* For more discussion, see text.c, "handling non-default formats" */ typedef enum internal_format @@ -2010,9 +2087,15 @@ if ((ei)->mallocp_) \ { \ if ((ei)->data_) \ - xfree ((ei)->data_); \ + { \ + xfree ((ei)->data_); \ + (ei)->data_ = 0; \ + } \ if ((ei)->extdata_) \ - xfree ((ei)->extdata_); \ + { \ + xfree ((ei)->extdata_); \ + (ei)->extdata_ = 0; \ + } \ eiinit_malloc (ei); \ } \ else \ @@ -3010,7 +3093,7 @@ #endif #define Qunix_host_name_encoding Qnative #define Qunix_service_name_encoding Qnative -#define Qtime_function_encoding Qnative +#define Qtime_function_encoding Qbinary #define Qtime_zone_encoding Qtime_function_encoding #define Qmswindows_host_name_encoding Qmswindows_multibyte #define Qmswindows_service_name_encoding Qmswindows_multibyte diff -r 861f2601a38b -r 1f0b15040456 src/toolbar-gtk.c --- a/src/toolbar-gtk.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/toolbar-gtk.c Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/toolbar-msw.c --- a/src/toolbar-msw.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/toolbar-msw.c Sun May 01 18:44:03 2011 +0100 @@ -1,16 +1,16 @@ /* toolbar implementation -- mswindows interface. Copyright (C) 1995 Board of Trustees, University of Illinois. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 1996, 2002 Ben Wing. + Copyright (C) 1995, 1996, 2002, 2010 Ben Wing. Copyright (C) 1996 Chuck Thompson. Copyright (C) 1998 Andy Piper. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -18,9 +18,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* This implementation by Andy Piper , with bits borrowed from toolbar-x.c */ @@ -45,49 +43,28 @@ #include "console-msw-impl.h" #include "glyphs-msw.h" -/* #include "objects-msw.h" */ +/* #include "fontcolor-msw.h" */ #define TOOLBAR_ITEM_ID_MIN 0x4000 #define TOOLBAR_ITEM_ID_MAX 0x7FFF #define TOOLBAR_ITEM_ID_BITS(x) (((x) & 0x3FFF) | 0x4000) #define TOOLBAR_ID_BIAS 16 #define TOOLBAR_HANDLE(f,p) \ -GetDlgItem(FRAME_MSWINDOWS_HANDLE(f), TOOLBAR_ID_BIAS + p) +GetDlgItem (FRAME_MSWINDOWS_HANDLE (f), TOOLBAR_ID_BIAS + p) #define MSWINDOWS_BUTTON_SHADOW_THICKNESS 2 #define MSWINDOWS_BLANK_SIZE 5 #define MSWINDOWS_MINIMUM_TOOLBAR_SIZE 8 static void -mswindows_move_toolbar (struct frame *f, enum toolbar_pos pos); - -#define SET_TOOLBAR_WAS_VISIBLE_FLAG(frame, pos, flag) \ - do { \ - switch (pos) \ - { \ - case TOP_TOOLBAR: \ - (frame)->top_toolbar_was_visible = flag; \ - break; \ - case BOTTOM_TOOLBAR: \ - (frame)->bottom_toolbar_was_visible = flag; \ - break; \ - case LEFT_TOOLBAR: \ - (frame)->left_toolbar_was_visible = flag; \ - break; \ - case RIGHT_TOOLBAR: \ - (frame)->right_toolbar_was_visible = flag; \ - break; \ - default: \ - ABORT (); \ - } \ - } while (0) +mswindows_move_toolbar (struct frame *f, enum edge_pos pos); static int allocate_toolbar_item_id (struct frame *f, struct toolbar_button *button, - enum toolbar_pos UNUSED (pos)) + enum edge_pos UNUSED (pos)) { /* hmm what do we generate an id based on */ - int id = TOOLBAR_ITEM_ID_BITS (internal_hash (button->callback, 0)); + int id = TOOLBAR_ITEM_ID_BITS (internal_hash (button->callback, 0, 0)); while (!NILP (Fgethash (make_int (id), FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE (f), Qnil))) { @@ -97,7 +74,7 @@ } static void -mswindows_clear_toolbar (struct frame *f, enum toolbar_pos pos, +mswindows_clear_toolbar (struct frame *f, enum edge_pos pos, int UNUSED (thickness_change)) { HIMAGELIST ilist = NULL; @@ -123,11 +100,11 @@ qxeSendMessage (toolbarwnd, TB_GETIMAGELIST, 0, (LONG) &ilist); if (ilist) { - ImageList_Destroy(ilist); + ImageList_Destroy (ilist); } qxeSendMessage (toolbarwnd, TB_SETIMAGELIST, 0, (LPARAM)NULL); - ShowWindow(toolbarwnd, SW_HIDE); + ShowWindow (toolbarwnd, SW_HIDE); } FRAME_MSWINDOWS_TOOLBAR_CHECKSUM (f, pos) = 0; @@ -135,7 +112,7 @@ } static void -mswindows_output_toolbar (struct frame *f, enum toolbar_pos pos) +mswindows_output_toolbar (struct frame *f, enum edge_pos pos) { int x, y, bar_width, bar_height, vert; int width=-1, height=-1, bmwidth=0, bmheight=0, maxbmwidth, maxbmheight; @@ -208,8 +185,8 @@ struct toolbar_button *tb = XTOOLBAR_BUTTON (button); checksum = HASH5 (checksum, - internal_hash (get_toolbar_button_glyph(w, tb), 0), - internal_hash (tb->callback, 0), + internal_hash (get_toolbar_button_glyph (w, tb), 0, 0), + internal_hash (tb->callback, 0, 0), width, LISP_HASH (w->toolbar_buttons_captioned_p)); button = tb->next; @@ -217,7 +194,7 @@ } /* only rebuild if something has changed */ - if (!toolbarwnd || FRAME_MSWINDOWS_TOOLBAR_CHECKSUM(f,pos)!=checksum) + if (!toolbarwnd || FRAME_MSWINDOWS_TOOLBAR_CHECKSUM (f,pos)!=checksum) { /* remove the old one */ mswindows_clear_toolbar (f, pos, 0); @@ -401,7 +378,7 @@ /* finally populate with images */ if (qxeSendMessage (toolbarwnd, TB_BUTTONSTRUCTSIZE, - (WPARAM)sizeof(TBBUTTON), (LPARAM)0) == -1) + (WPARAM)sizeof (TBBUTTON), (LPARAM)0) == -1) { mswindows_clear_toolbar (f, pos, 0); gui_error ("couldn't set button structure size", Qunbound); @@ -446,7 +423,7 @@ else { RECT tmp; - qxeSendMessage (toolbarwnd, TB_SETROWS, MAKEWPARAM(1, FALSE), + qxeSendMessage (toolbarwnd, TB_SETROWS, MAKEWPARAM (1, FALSE), (LPARAM)&tmp); } @@ -475,10 +452,10 @@ } static void -mswindows_move_toolbar (struct frame *f, enum toolbar_pos pos) +mswindows_move_toolbar (struct frame *f, enum edge_pos pos) { int bar_x, bar_y, bar_width, bar_height, vert; - HWND toolbarwnd = TOOLBAR_HANDLE(f,pos); + HWND toolbarwnd = TOOLBAR_HANDLE (f,pos); if (toolbarwnd) { @@ -490,19 +467,19 @@ by Windows and by XEmacs. */ switch (pos) { - case TOP_TOOLBAR: + case TOP_EDGE: bar_x--; bar_y-=2; bar_width+=3; bar_height+=3; break; - case LEFT_TOOLBAR: + case LEFT_EDGE: bar_x--; bar_y-=2; bar_height++; bar_width++; break; - case BOTTOM_TOOLBAR: + case BOTTOM_EDGE: bar_y-=2; bar_width+=4; bar_height+=4; break; - case RIGHT_TOOLBAR: + case RIGHT_EDGE: bar_y-=2; bar_x++; bar_width++; bar_height++; break; @@ -517,19 +494,14 @@ int UNUSED (x), int UNUSED (y), int UNUSED (width), int UNUSED (height)) { + enum edge_pos pos; assert (FRAME_MSWINDOWS_P (f)); - if (FRAME_REAL_TOP_TOOLBAR_VISIBLE (f)) - mswindows_move_toolbar (f, TOP_TOOLBAR); - - if (FRAME_REAL_BOTTOM_TOOLBAR_VISIBLE (f)) - mswindows_move_toolbar (f, BOTTOM_TOOLBAR); - - if (FRAME_REAL_LEFT_TOOLBAR_VISIBLE (f)) - mswindows_move_toolbar (f, LEFT_TOOLBAR); - - if (FRAME_REAL_RIGHT_TOOLBAR_VISIBLE (f)) - mswindows_move_toolbar (f, RIGHT_TOOLBAR); + EDGE_POS_LOOP (pos) + { + if (FRAME_REAL_TOOLBAR_VISIBLE (f, pos)) + mswindows_move_toolbar (f, pos); + } } static void @@ -542,41 +514,33 @@ static void mswindows_initialize_frame_toolbars (struct frame *UNUSED (f)) { - } static void mswindows_output_frame_toolbars (struct frame *f) { + enum edge_pos pos; assert (FRAME_MSWINDOWS_P (f)); - if (FRAME_REAL_TOP_TOOLBAR_VISIBLE (f)) - mswindows_output_toolbar (f, TOP_TOOLBAR); - if (FRAME_REAL_BOTTOM_TOOLBAR_VISIBLE (f)) - mswindows_output_toolbar (f, BOTTOM_TOOLBAR); - if (FRAME_REAL_LEFT_TOOLBAR_VISIBLE (f)) - mswindows_output_toolbar (f, LEFT_TOOLBAR); - if (FRAME_REAL_RIGHT_TOOLBAR_VISIBLE (f)) - mswindows_output_toolbar (f, RIGHT_TOOLBAR); + EDGE_POS_LOOP (pos) + { + if (FRAME_REAL_TOOLBAR_VISIBLE (f, pos)) + mswindows_output_toolbar (f, pos); + } } static void mswindows_clear_frame_toolbars (struct frame *f) { + enum edge_pos pos; assert (FRAME_MSWINDOWS_P (f)); - if (f->top_toolbar_was_visible - && !FRAME_REAL_TOP_TOOLBAR_VISIBLE (f)) - mswindows_clear_toolbar (f, TOP_TOOLBAR, 0); - if (f->bottom_toolbar_was_visible - && !FRAME_REAL_BOTTOM_TOOLBAR_VISIBLE (f)) - mswindows_clear_toolbar (f, BOTTOM_TOOLBAR, 0); - if (f->left_toolbar_was_visible - && !FRAME_REAL_LEFT_TOOLBAR_VISIBLE (f)) - mswindows_clear_toolbar (f, LEFT_TOOLBAR, 0); - if (f->right_toolbar_was_visible - && !FRAME_REAL_RIGHT_TOOLBAR_VISIBLE (f)) - mswindows_clear_toolbar (f, RIGHT_TOOLBAR, 0); + EDGE_POS_LOOP (pos) + { + if (f->toolbar_was_visible[pos] + && !FRAME_REAL_TOOLBAR_VISIBLE (f, pos)) + mswindows_clear_toolbar (f, pos, 0); + } } static void @@ -584,15 +548,15 @@ { HWND twnd=NULL; #define DELETE_TOOLBAR(pos) \ - mswindows_clear_toolbar(f, pos, 0); \ - if ((twnd=GetDlgItem(FRAME_MSWINDOWS_HANDLE(f), \ + mswindows_clear_toolbar (f, pos, 0); \ + if ((twnd=GetDlgItem (FRAME_MSWINDOWS_HANDLE (f), \ TOOLBAR_ID_BIAS + pos))) \ - DestroyWindow(twnd) + DestroyWindow (twnd) - DELETE_TOOLBAR(TOP_TOOLBAR); - DELETE_TOOLBAR(BOTTOM_TOOLBAR); - DELETE_TOOLBAR(LEFT_TOOLBAR); - DELETE_TOOLBAR(RIGHT_TOOLBAR); + DELETE_TOOLBAR (TOP_EDGE); + DELETE_TOOLBAR (BOTTOM_EDGE); + DELETE_TOOLBAR (LEFT_EDGE); + DELETE_TOOLBAR (RIGHT_EDGE); #undef DELETE_TOOLBAR } diff -r 861f2601a38b -r 1f0b15040456 src/toolbar-x.c --- a/src/toolbar-x.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/toolbar-x.c Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -37,7 +35,7 @@ #include "console-x-impl.h" #include "glyphs-x.h" -#include "objects-x.h" +#include "fontcolor-x.h" #include "EmacsFrame.h" #include "EmacsFrameP.h" diff -r 861f2601a38b -r 1f0b15040456 src/toolbar-xlike.c --- a/src/toolbar-xlike.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/toolbar-xlike.c Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -38,14 +36,14 @@ /* Only a very few things need to differ based on the toolkit used. ** -** Some of the routines used assert(FRAME_yyy_P(f)) checks, this is +** Some of the routines used assert (FRAME_yyy_P(f)) checks, this is ** now abstracted into __INTERNAL_APPROPRIATENESS_CHECK(). When we ** add new window systems that use this code, we should either add a ** new case here, or just remove the checks completely. ** ** At least for X & GTK redraw_frame_toolbars() might end up getting ** called before we are completely initialized. To avoid this, we use -** the __INTERNAL_MAPPED_P(f) macro, that should return 0 if we should +** the __INTERNAL_MAPPED_P (f) macro, that should return 0 if we should ** not draw the toolbars yet. When we add new window systems that use ** this code, we should add a new case here, if they need it. ** @@ -85,7 +83,7 @@ Lisp_Object window = FRAME_LAST_NONMINIBUF_WINDOW (f); struct window *w = XWINDOW (window); int shadow_thickness; - int def_shadow_thickness = XINT (Fspecifier_instance(Vtoolbar_shadow_thickness, window, Qnil, Qnil)); + int def_shadow_thickness = XINT (Fspecifier_instance (Vtoolbar_shadow_thickness, window, Qnil, Qnil)); face_index toolbar_findex; if (tb->vertical) @@ -103,7 +101,7 @@ toolbar_findex = get_builtin_face_cache_index (w, Vtoolbar_face); - /* Blank toolbar buttons that should be 3d will have EQ(tb->up_glyph, Qt) + /* Blank toolbar buttons that should be 3d will have EQ (tb->up_glyph, Qt) ** Blank toolbar buttons that should be flat will have NILP (tb->up_glyph) ** ** Real toolbar buttons will check tb->enabled && tb->down @@ -143,7 +141,7 @@ MAYBE_DEVMETH (d, bevel_area, (w, toolbar_findex, sx + x_adj, sy + y_adj, swidth + width_adj, - sheight + height_adj, abs(shadow_thickness), + sheight + height_adj, abs (shadow_thickness), EDGE_ALL, (shadow_thickness < 0) ? EDGE_BEVEL_IN : EDGE_BEVEL_OUT)); } @@ -370,7 +368,7 @@ return (size); } -#define XLIKE_OUTPUT_BUTTONS_LOOP(left) \ +#define XLIKE_OUTPUT_BUTTONS_LOOP(left) \ do { \ while (!NILP (button)) \ { \ @@ -436,29 +434,8 @@ } \ } while (0) -#define SET_TOOLBAR_WAS_VISIBLE_FLAG(frame, pos, flag) \ - do { \ - switch (pos) \ - { \ - case TOP_TOOLBAR: \ - (frame)->top_toolbar_was_visible = flag; \ - break; \ - case BOTTOM_TOOLBAR: \ - (frame)->bottom_toolbar_was_visible = flag; \ - break; \ - case LEFT_TOOLBAR: \ - (frame)->left_toolbar_was_visible = flag; \ - break; \ - case RIGHT_TOOLBAR: \ - (frame)->right_toolbar_was_visible = flag; \ - break; \ - default: \ - ABORT (); \ - } \ - } while (0) - static void -xlike_output_toolbar (struct frame *f, enum toolbar_pos pos) +xlike_output_toolbar (struct frame *f, enum edge_pos pos) { int x, y, bar_width, bar_height, vert; int max_pixpos, right_size, right_start, blank_size; @@ -582,7 +559,7 @@ } static void -xlike_clear_toolbar (struct frame *f, enum toolbar_pos pos, int thickness_change) +xlike_clear_toolbar (struct frame *f, enum edge_pos pos, int thickness_change) { Lisp_Object frame; int x, y, width, height, vert; @@ -594,7 +571,7 @@ to clear any excess toolbar if the size shrinks. */ if (thickness_change < 0) { - if (pos == LEFT_TOOLBAR || pos == RIGHT_TOOLBAR) + if (pos == LEFT_EDGE || pos == RIGHT_EDGE) { x = x + width + thickness_change; width = -thickness_change; @@ -616,42 +593,32 @@ void xlike_output_frame_toolbars (struct frame *f) { - __INTERNAL_APPROPRIATENESS_CHECK(f); - - if (FRAME_REAL_TOP_TOOLBAR_VISIBLE (f)) - xlike_output_toolbar (f, TOP_TOOLBAR); + enum edge_pos pos; + __INTERNAL_APPROPRIATENESS_CHECK (f); - if (FRAME_REAL_BOTTOM_TOOLBAR_VISIBLE (f)) - xlike_output_toolbar (f, BOTTOM_TOOLBAR); - - if (FRAME_REAL_LEFT_TOOLBAR_VISIBLE (f)) - xlike_output_toolbar (f, LEFT_TOOLBAR); - - if (FRAME_REAL_RIGHT_TOOLBAR_VISIBLE (f)) - xlike_output_toolbar (f, RIGHT_TOOLBAR); + EDGE_POS_LOOP (pos) + { + if (FRAME_REAL_TOOLBAR_VISIBLE (f, pos)) + xlike_output_toolbar (f, pos); + } } void xlike_clear_frame_toolbars (struct frame *f) { - __INTERNAL_APPROPRIATENESS_CHECK(f); + enum edge_pos pos; + __INTERNAL_APPROPRIATENESS_CHECK (f); - if (f->top_toolbar_was_visible - && !FRAME_REAL_TOP_TOOLBAR_VISIBLE (f)) - xlike_clear_toolbar (f, TOP_TOOLBAR, 0); - if (f->bottom_toolbar_was_visible - && !FRAME_REAL_BOTTOM_TOOLBAR_VISIBLE (f)) - xlike_clear_toolbar (f, BOTTOM_TOOLBAR, 0); - if (f->left_toolbar_was_visible - && !FRAME_REAL_LEFT_TOOLBAR_VISIBLE (f)) - xlike_clear_toolbar (f, LEFT_TOOLBAR, 0); - if (f->right_toolbar_was_visible - && !FRAME_REAL_RIGHT_TOOLBAR_VISIBLE (f)) - xlike_clear_toolbar (f, RIGHT_TOOLBAR, 0); + EDGE_POS_LOOP (pos) + { + if (f->toolbar_was_visible[pos] + && !FRAME_REAL_TOOLBAR_VISIBLE (f, pos)) + xlike_clear_toolbar (f, pos, 0); + } } static void -xlike_redraw_exposed_toolbar (struct frame *f, enum toolbar_pos pos, int x, int y, +xlike_redraw_exposed_toolbar (struct frame *f, enum edge_pos pos, int x, int y, int width, int height) { int bar_x, bar_y, bar_width, bar_height, vert; @@ -701,19 +668,14 @@ xlike_redraw_exposed_toolbars (struct frame *f, int x, int y, int width, int height) { - __INTERNAL_APPROPRIATENESS_CHECK(f); - - if (FRAME_REAL_TOP_TOOLBAR_VISIBLE (f)) - xlike_redraw_exposed_toolbar (f, TOP_TOOLBAR, x, y, width, height); + enum edge_pos pos; + __INTERNAL_APPROPRIATENESS_CHECK (f); - if (FRAME_REAL_BOTTOM_TOOLBAR_VISIBLE (f)) - xlike_redraw_exposed_toolbar (f, BOTTOM_TOOLBAR, x, y, width, height); - - if (FRAME_REAL_LEFT_TOOLBAR_VISIBLE (f)) - xlike_redraw_exposed_toolbar (f, LEFT_TOOLBAR, x, y, width, height); - - if (FRAME_REAL_RIGHT_TOOLBAR_VISIBLE (f)) - xlike_redraw_exposed_toolbar (f, RIGHT_TOOLBAR, x, y, width, height); + EDGE_POS_LOOP (pos) + { + if (FRAME_REAL_TOOLBAR_VISIBLE (f, pos)) + xlike_redraw_exposed_toolbar (f, pos, x, y, width, height); + } } void @@ -724,7 +686,7 @@ particular before we have actually mapped it. That routine can call this one. So, we need to make sure that the frame is actually ready before we try and draw all over it. */ - if (__INTERNAL_MAPPED_P(f)) + if (__INTERNAL_MAPPED_P (f)) xlike_redraw_exposed_toolbars (f, 0, 0, FRAME_PIXWIDTH (f), FRAME_PIXHEIGHT (f)); } diff -r 861f2601a38b -r 1f0b15040456 src/toolbar-xlike.h --- a/src/toolbar-xlike.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/toolbar-xlike.h Sun May 01 18:44:03 2011 +0100 @@ -5,7 +5,20 @@ ** Created by: William M. Perry ** Copyright (c) 2001 Free Software Foundation ** -*/ +** 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 3 of the License, 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. If not, see . */ #ifndef __TOOLBAR_XLIKE_H__ #define __TOOLBAR_XLIKE_H__ diff -r 861f2601a38b -r 1f0b15040456 src/toolbar.c --- a/src/toolbar.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/toolbar.c Sun May 01 18:44:03 2011 +0100 @@ -1,15 +1,15 @@ /* Generic toolbar implementation. Copyright (C) 1995 Board of Trustees, University of Illinois. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 1996, 2003, 2004 Ben Wing. + Copyright (C) 1995, 1996, 2003, 2004, 2010 Ben Wing. Copyright (C) 1996 Chuck Thompson. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -37,10 +35,10 @@ #include "toolbar.h" #include "window.h" -Lisp_Object Vtoolbar[4]; -Lisp_Object Vtoolbar_size[4]; -Lisp_Object Vtoolbar_visible_p[4]; -Lisp_Object Vtoolbar_border_width[4]; +Lisp_Object Vtoolbar[NUM_EDGES]; +Lisp_Object Vtoolbar_size[NUM_EDGES]; +Lisp_Object Vtoolbar_visible_p[NUM_EDGES]; +Lisp_Object Vtoolbar_border_width[NUM_EDGES]; Lisp_Object Vdefault_toolbar, Vdefault_toolbar_visible_p; Lisp_Object Vdefault_toolbar_width, Vdefault_toolbar_height; @@ -71,6 +69,33 @@ { XD_END } }; + +static Lisp_Object +allocate_toolbar_button (struct frame *f, int pushright) +{ + struct toolbar_button *tb; + + tb = XTOOLBAR_BUTTON (ALLOC_NORMAL_LISP_OBJECT (toolbar_button)); + tb->next = Qnil; + tb->frame = wrap_frame (f); + tb->up_glyph = Qnil; + tb->down_glyph = Qnil; + tb->disabled_glyph = Qnil; + tb->cap_up_glyph = Qnil; + tb->cap_down_glyph = Qnil; + tb->cap_disabled_glyph = Qnil; + tb->callback = Qnil; + tb->enabled_p = Qnil; + tb->help_string = Qnil; + + tb->pushright = pushright; + tb->x = tb->y = tb->width = tb->height = -1; + tb->dirty = 1; + + return wrap_toolbar_button (tb); +} + + static Lisp_Object mark_toolbar_button (Lisp_Object obj) { @@ -88,13 +113,10 @@ return data->help_string; } -DEFINE_LRECORD_IMPLEMENTATION ("toolbar-button", toolbar_button, - 0, /*dumpable-flag*/ - mark_toolbar_button, - default_object_printer, - 0, 0, 0, - toolbar_button_description, - struct toolbar_button); +DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("toolbar-button", toolbar_button, + mark_toolbar_button, + toolbar_button_description, + struct toolbar_button); DEFUN ("toolbar-button-p", Ftoolbar_button_p, 1, 1, 0, /* Return non-nil if OBJECT is a toolbar button. @@ -232,16 +254,16 @@ } -static enum toolbar_pos +static enum edge_pos decode_toolbar_position (Lisp_Object position) { - if (EQ (position, Qtop)) return TOP_TOOLBAR; - if (EQ (position, Qbottom)) return BOTTOM_TOOLBAR; - if (EQ (position, Qleft)) return LEFT_TOOLBAR; - if (EQ (position, Qright)) return RIGHT_TOOLBAR; + if (EQ (position, Qtop)) return TOP_EDGE; + if (EQ (position, Qbottom)) return BOTTOM_EDGE; + if (EQ (position, Qleft)) return LEFT_EDGE; + if (EQ (position, Qright)) return RIGHT_EDGE; invalid_constant ("Invalid toolbar position", position); - RETURN_NOT_REACHED (TOP_TOOLBAR); + RETURN_NOT_REACHED (TOP_EDGE); } DEFUN ("set-default-toolbar-position", Fset_default_toolbar_position, 1, 1, 0, /* @@ -251,8 +273,8 @@ */ (position)) { - enum toolbar_pos cur = decode_toolbar_position (Vdefault_toolbar_position); - enum toolbar_pos new_ = decode_toolbar_position (position); + enum edge_pos cur = decode_toolbar_position (Vdefault_toolbar_position); + enum edge_pos new_ = decode_toolbar_position (position); if (cur != new_) { @@ -264,7 +286,7 @@ set_specifier_fallback (Vtoolbar[new_], Vdefault_toolbar); set_specifier_fallback (Vtoolbar_size[cur], list1 (Fcons (Qnil, Qzero))); set_specifier_fallback (Vtoolbar_size[new_], - new_ == TOP_TOOLBAR || new_ == BOTTOM_TOOLBAR + new_ == TOP_EDGE || new_ == BOTTOM_EDGE ? Vdefault_toolbar_height : Vdefault_toolbar_width); set_specifier_fallback (Vtoolbar_border_width[cur], @@ -304,27 +326,7 @@ buffer = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer; if (!tb) - { - tb = ALLOC_LCRECORD_TYPE (struct toolbar_button, &lrecord_toolbar_button); - tb->next = Qnil; - tb->frame = wrap_frame (f); - tb->up_glyph = Qnil; - tb->down_glyph = Qnil; - tb->disabled_glyph = Qnil; - tb->cap_up_glyph = Qnil; - tb->cap_down_glyph = Qnil; - tb->cap_disabled_glyph = Qnil; - tb->callback = Qnil; - tb->enabled_p = Qnil; - tb->help_string = Qnil; - - tb->enabled = 0; - tb->down = 0; - tb->pushright = pushright; - tb->blank = 0; - tb->x = tb->y = tb->width = tb->height = -1; - tb->dirty = 1; - } + tb = XTOOLBAR_BUTTON (allocate_toolbar_button (f, pushright)); retval = wrap_toolbar_button (tb); /* Let's make sure nothing gets mucked up by the potential call to @@ -590,7 +592,7 @@ } void -mark_frame_toolbar_buttons_dirty (struct frame *f, enum toolbar_pos pos) +mark_frame_toolbar_buttons_dirty (struct frame *f, enum edge_pos pos) { Lisp_Object button = FRAME_TOOLBAR_BUTTONS (f, pos); @@ -604,7 +606,7 @@ } static Lisp_Object -compute_frame_toolbar_buttons (struct frame *f, enum toolbar_pos pos, +compute_frame_toolbar_buttons (struct frame *f, enum edge_pos pos, Lisp_Object toolbar) { Lisp_Object buttons, prev_button, first_button; @@ -713,7 +715,7 @@ } static void -set_frame_toolbar (struct frame *f, enum toolbar_pos pos) +set_frame_toolbar (struct frame *f, enum edge_pos pos) { struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)); Lisp_Object toolbar = w->toolbar[pos]; @@ -725,10 +727,10 @@ static void compute_frame_toolbars_data (struct frame *f) { - set_frame_toolbar (f, TOP_TOOLBAR); - set_frame_toolbar (f, BOTTOM_TOOLBAR); - set_frame_toolbar (f, LEFT_TOOLBAR); - set_frame_toolbar (f, RIGHT_TOOLBAR); + set_frame_toolbar (f, TOP_EDGE); + set_frame_toolbar (f, BOTTOM_EDGE); + set_frame_toolbar (f, LEFT_EDGE); + set_frame_toolbar (f, RIGHT_EDGE); } /* Update the toolbar geometry separately from actually displaying the @@ -762,14 +764,15 @@ unchanged, as it will hose windows whose pixsizes are not multiple of character sizes. */ - for (pos = 0; pos < 4; pos++) + EDGE_POS_LOOP (pos) if (FRAME_REAL_TOOLBAR_SIZE (f, pos) != FRAME_CURRENT_TOOLBAR_SIZE (f, pos)) frame_size_changed = 1; - for (pos = 0; pos < 4; pos++) { - f->current_toolbar_size[pos] = FRAME_REAL_TOOLBAR_SIZE (f, pos); - } + EDGE_POS_LOOP (pos) + { + f->current_toolbar_size[pos] = FRAME_REAL_TOOLBAR_SIZE (f, pos); + } /* Removed the check for the minibuffer here. We handle this more correctly now by consistently using @@ -777,18 +780,23 @@ throughout the toolbar code. */ compute_frame_toolbars_data (f); + /* #### GEOM! Turning the toolbar on and off repeatedly causes the + frame to steadily shrink. Basically, turning it on doesn't + increase the frame size, while turning it off does reduce the + frame size. The cause has something to do with the combination + of this maybe questionable code here, plus the fact that toolbars + are included in the displayable area, and the difference between + real and theoretical toolbar sizes, and exactly when the various + computations happen w.r.t. the specifiers or whatever that control + whether toolbars are visible and hence whether their thickness is + greater than zero. --ben */ + if (frame_size_changed) { int width, height; - if (!window_system_pixelated_geometry (wrap_frame (f))) - pixel_to_char_size (f, FRAME_PIXWIDTH (f), FRAME_PIXHEIGHT (f), - &width, &height); - else - width = FRAME_PIXWIDTH (f), height = FRAME_PIXHEIGHT (f); - if (!HAS_FRAMEMETH_P (f, set_frame_size)) - change_frame_size (f, height, width, 0); - else - FRAMEMETH (f, set_frame_size, (f, width, height)); + pixel_to_frame_unit_size (f, FRAME_PIXWIDTH (f), FRAME_PIXHEIGHT (f), + &width, &height); + internal_set_frame_size (f, width, height, 0); MARK_FRAME_LAYOUT_CHANGED (f); } @@ -839,7 +847,7 @@ already recomputed, and possibly modified by resource initialization. Remember current toolbar geometry so next redisplay will not needlessly relayout toolbars. */ - for (pos = 0; pos < 4; pos++) + EDGE_POS_LOOP (pos) f->current_toolbar_size[pos] = FRAME_REAL_TOOLBAR_SIZE (f, pos); } } @@ -874,7 +882,7 @@ } void -get_toolbar_coords (struct frame *f, enum toolbar_pos pos, int *x, int *y, +get_toolbar_coords (struct frame *f, enum edge_pos pos, int *x, int *y, int *width, int *height, int *vert, int for_layout) { int visible_top_toolbar_height, visible_bottom_toolbar_height; @@ -898,7 +906,7 @@ switch (pos) { - case TOP_TOOLBAR: + case TOP_EDGE: *x = 1; *y = 0; /* #### should be 1 if no menubar */ *width = FRAME_PIXWIDTH (f) - 2; @@ -906,7 +914,7 @@ 2 * FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f) - adjust; *vert = 0; break; - case BOTTOM_TOOLBAR: + case BOTTOM_EDGE: *x = 1; *y = FRAME_PIXHEIGHT (f) - FRAME_REAL_BOTTOM_TOOLBAR_HEIGHT (f) - 2 * FRAME_REAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f); @@ -915,7 +923,7 @@ 2 * FRAME_REAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f) - adjust; *vert = 0; break; - case LEFT_TOOLBAR: + case LEFT_EDGE: *x = 1; *y = visible_top_toolbar_height; *width = FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) + @@ -924,7 +932,7 @@ visible_bottom_toolbar_height - 1); *vert = 1; break; - case RIGHT_TOOLBAR: + case RIGHT_EDGE: *x = FRAME_PIXWIDTH (f) - FRAME_REAL_RIGHT_TOOLBAR_WIDTH (f) - 2 * FRAME_REAL_RIGHT_TOOLBAR_BORDER_WIDTH (f); *y = visible_top_toolbar_height; @@ -940,7 +948,7 @@ } #define CHECK_TOOLBAR(pos) do { \ - if (FRAME_REAL_##pos##_VISIBLE (f)) \ + if (FRAME_REAL_TOOLBAR_VISIBLE (f, pos)) \ { \ int x, y, width, height, vert; \ \ @@ -956,10 +964,10 @@ static Lisp_Object toolbar_buttons_at_pixpos (struct frame *f, int x_coord, int y_coord) { - CHECK_TOOLBAR (TOP_TOOLBAR); - CHECK_TOOLBAR (BOTTOM_TOOLBAR); - CHECK_TOOLBAR (LEFT_TOOLBAR); - CHECK_TOOLBAR (RIGHT_TOOLBAR); + CHECK_TOOLBAR (TOP_EDGE); + CHECK_TOOLBAR (BOTTOM_EDGE); + CHECK_TOOLBAR (LEFT_EDGE); + CHECK_TOOLBAR (RIGHT_EDGE); return Qnil; } @@ -1003,9 +1011,9 @@ DEFINE_SPECIFIER_TYPE (toolbar); -#define CTB_ERROR(msg) do { \ - maybe_signal_error (Qinvalid_argument, msg, button, Qtoolbar, errb); \ - RETURN_SANS_WARNINGS Qnil; \ +#define CTB_ERROR(msg) do { \ + maybe_signal_error (Qinvalid_argument, msg, button, Qtoolbar, errb); \ + RETURN_SANS_WARNINGS Qnil; \ } while (0) /* Returns Q_style if key was :style, Qt if ok otherwise, Qnil if error. */ @@ -1222,9 +1230,9 @@ specifier caching changes */ static void -recompute_overlaying_specifier (Lisp_Object real_one[4]) +recompute_overlaying_specifier (Lisp_Object real_one[NUM_EDGES]) { - enum toolbar_pos pos = decode_toolbar_position (Vdefault_toolbar_position); + enum edge_pos pos = decode_toolbar_position (Vdefault_toolbar_position); Fset_specifier_dirty_flag (real_one[pos]); } @@ -1338,7 +1346,7 @@ void syms_of_toolbar (void) { - INIT_LRECORD_IMPLEMENTATION (toolbar_button); + INIT_LISP_OBJECT (toolbar_button); DEFSYMBOL_MULTIWORD_PREDICATE (Qtoolbar_buttonp); DEFSYMBOL (Q2D); @@ -1507,19 +1515,19 @@ 0, 0, 0); DEFVAR_SPECIFIER ("top-toolbar", - &Vtoolbar[TOP_TOOLBAR] /* + &Vtoolbar[TOP_EDGE] /* Specifier for the toolbar at the top of the frame. Use `set-specifier' to change this. See `default-toolbar' for a description of a valid toolbar instantiator. */ ); - Vtoolbar[TOP_TOOLBAR] = Fmake_specifier (Qtoolbar); - set_specifier_caching (Vtoolbar[TOP_TOOLBAR], - offsetof (struct window, toolbar[TOP_TOOLBAR]), + Vtoolbar[TOP_EDGE] = Fmake_specifier (Qtoolbar); + set_specifier_caching (Vtoolbar[TOP_EDGE], + offsetof (struct window, toolbar[TOP_EDGE]), toolbar_specs_changed, 0, 0, 0); DEFVAR_SPECIFIER ("bottom-toolbar", - &Vtoolbar[BOTTOM_TOOLBAR] /* + &Vtoolbar[BOTTOM_EDGE] /* Specifier for the toolbar at the bottom of the frame. Use `set-specifier' to change this. See `default-toolbar' for a description of a valid toolbar instantiator. @@ -1529,14 +1537,14 @@ `bottom-toolbar-height') is 0; thus, a bottom toolbar will not be displayed even if you provide a value for `bottom-toolbar'. */ ); - Vtoolbar[BOTTOM_TOOLBAR] = Fmake_specifier (Qtoolbar); - set_specifier_caching (Vtoolbar[BOTTOM_TOOLBAR], - offsetof (struct window, toolbar[BOTTOM_TOOLBAR]), + Vtoolbar[BOTTOM_EDGE] = Fmake_specifier (Qtoolbar); + set_specifier_caching (Vtoolbar[BOTTOM_EDGE], + offsetof (struct window, toolbar[BOTTOM_EDGE]), toolbar_specs_changed, 0, 0, 0); DEFVAR_SPECIFIER ("left-toolbar", - &Vtoolbar[LEFT_TOOLBAR] /* + &Vtoolbar[LEFT_EDGE] /* Specifier for the toolbar at the left edge of the frame. Use `set-specifier' to change this. See `default-toolbar' for a description of a valid toolbar instantiator. @@ -1546,14 +1554,14 @@ `left-toolbar-width') is 0; thus, a left toolbar will not be displayed even if you provide a value for `left-toolbar'. */ ); - Vtoolbar[LEFT_TOOLBAR] = Fmake_specifier (Qtoolbar); - set_specifier_caching (Vtoolbar[LEFT_TOOLBAR], - offsetof (struct window, toolbar[LEFT_TOOLBAR]), + Vtoolbar[LEFT_EDGE] = Fmake_specifier (Qtoolbar); + set_specifier_caching (Vtoolbar[LEFT_EDGE], + offsetof (struct window, toolbar[LEFT_EDGE]), toolbar_specs_changed, 0, 0, 0); DEFVAR_SPECIFIER ("right-toolbar", - &Vtoolbar[RIGHT_TOOLBAR] /* + &Vtoolbar[RIGHT_EDGE] /* Specifier for the toolbar at the right edge of the frame. Use `set-specifier' to change this. See `default-toolbar' for a description of a valid toolbar instantiator. @@ -1563,9 +1571,9 @@ `right-toolbar-width') is 0; thus, a right toolbar will not be displayed even if you provide a value for `right-toolbar'. */ ); - Vtoolbar[RIGHT_TOOLBAR] = Fmake_specifier (Qtoolbar); - set_specifier_caching (Vtoolbar[RIGHT_TOOLBAR], - offsetof (struct window, toolbar[RIGHT_TOOLBAR]), + Vtoolbar[RIGHT_EDGE] = Fmake_specifier (Qtoolbar); + set_specifier_caching (Vtoolbar[RIGHT_EDGE], + offsetof (struct window, toolbar[RIGHT_EDGE]), toolbar_specs_changed, 0, 0, 0); @@ -1573,10 +1581,10 @@ changed with `set-default-toolbar-position'. */ fb = list1 (Fcons (Qnil, Qnil)); set_specifier_fallback (Vdefault_toolbar, fb); - set_specifier_fallback (Vtoolbar[TOP_TOOLBAR], Vdefault_toolbar); - set_specifier_fallback (Vtoolbar[BOTTOM_TOOLBAR], fb); - set_specifier_fallback (Vtoolbar[LEFT_TOOLBAR], fb); - set_specifier_fallback (Vtoolbar[RIGHT_TOOLBAR], fb); + set_specifier_fallback (Vtoolbar[TOP_EDGE], Vdefault_toolbar); + set_specifier_fallback (Vtoolbar[BOTTOM_EDGE], fb); + set_specifier_fallback (Vtoolbar[LEFT_EDGE], fb); + set_specifier_fallback (Vtoolbar[RIGHT_EDGE], fb); DEFVAR_SPECIFIER ("default-toolbar-height", &Vdefault_toolbar_height /* *Height of the default toolbar, if it's oriented horizontally. @@ -1638,59 +1646,59 @@ default_toolbar_size_changed_in_frame, 0); DEFVAR_SPECIFIER ("top-toolbar-height", - &Vtoolbar_size[TOP_TOOLBAR] /* + &Vtoolbar_size[TOP_EDGE] /* *Height of the top toolbar. This is a specifier; use `set-specifier' to change it. See `default-toolbar-height' for more information. */ ); - Vtoolbar_size[TOP_TOOLBAR] = Fmake_specifier (Qnatnum); - set_specifier_caching (Vtoolbar_size[TOP_TOOLBAR], - offsetof (struct window, toolbar_size[TOP_TOOLBAR]), + Vtoolbar_size[TOP_EDGE] = Fmake_specifier (Qnatnum); + set_specifier_caching (Vtoolbar_size[TOP_EDGE], + offsetof (struct window, toolbar_size[TOP_EDGE]), toolbar_geometry_changed_in_window, - offsetof (struct frame, toolbar_size[TOP_TOOLBAR]), + offsetof (struct frame, toolbar_size[TOP_EDGE]), frame_size_slipped, 0); DEFVAR_SPECIFIER ("bottom-toolbar-height", - &Vtoolbar_size[BOTTOM_TOOLBAR] /* + &Vtoolbar_size[BOTTOM_EDGE] /* *Height of the bottom toolbar. This is a specifier; use `set-specifier' to change it. See `default-toolbar-height' for more information. */ ); - Vtoolbar_size[BOTTOM_TOOLBAR] = Fmake_specifier (Qnatnum); - set_specifier_caching (Vtoolbar_size[BOTTOM_TOOLBAR], - offsetof (struct window, toolbar_size[BOTTOM_TOOLBAR]), + Vtoolbar_size[BOTTOM_EDGE] = Fmake_specifier (Qnatnum); + set_specifier_caching (Vtoolbar_size[BOTTOM_EDGE], + offsetof (struct window, toolbar_size[BOTTOM_EDGE]), toolbar_geometry_changed_in_window, - offsetof (struct frame, toolbar_size[BOTTOM_TOOLBAR]), + offsetof (struct frame, toolbar_size[BOTTOM_EDGE]), frame_size_slipped, 0); DEFVAR_SPECIFIER ("left-toolbar-width", - &Vtoolbar_size[LEFT_TOOLBAR] /* + &Vtoolbar_size[LEFT_EDGE] /* *Width of left toolbar. This is a specifier; use `set-specifier' to change it. See `default-toolbar-height' for more information. */ ); - Vtoolbar_size[LEFT_TOOLBAR] = Fmake_specifier (Qnatnum); - set_specifier_caching (Vtoolbar_size[LEFT_TOOLBAR], - offsetof (struct window, toolbar_size[LEFT_TOOLBAR]), + Vtoolbar_size[LEFT_EDGE] = Fmake_specifier (Qnatnum); + set_specifier_caching (Vtoolbar_size[LEFT_EDGE], + offsetof (struct window, toolbar_size[LEFT_EDGE]), toolbar_geometry_changed_in_window, - offsetof (struct frame, toolbar_size[LEFT_TOOLBAR]), + offsetof (struct frame, toolbar_size[LEFT_EDGE]), frame_size_slipped, 0); DEFVAR_SPECIFIER ("right-toolbar-width", - &Vtoolbar_size[RIGHT_TOOLBAR] /* + &Vtoolbar_size[RIGHT_EDGE] /* *Width of right toolbar. This is a specifier; use `set-specifier' to change it. See `default-toolbar-height' for more information. */ ); - Vtoolbar_size[RIGHT_TOOLBAR] = Fmake_specifier (Qnatnum); - set_specifier_caching (Vtoolbar_size[RIGHT_TOOLBAR], - offsetof (struct window, toolbar_size[RIGHT_TOOLBAR]), + Vtoolbar_size[RIGHT_EDGE] = Fmake_specifier (Qnatnum); + set_specifier_caching (Vtoolbar_size[RIGHT_EDGE], + offsetof (struct window, toolbar_size[RIGHT_EDGE]), toolbar_geometry_changed_in_window, - offsetof (struct frame, toolbar_size[RIGHT_TOOLBAR]), + offsetof (struct frame, toolbar_size[RIGHT_EDGE]), frame_size_slipped, 0); DEFVAR_SPECIFIER ("toolbar-shadow-thickness", @@ -1756,11 +1764,11 @@ if (!NILP (fb)) set_specifier_fallback (Vdefault_toolbar_width, fb); - set_specifier_fallback (Vtoolbar_size[TOP_TOOLBAR], Vdefault_toolbar_height); + set_specifier_fallback (Vtoolbar_size[TOP_EDGE], Vdefault_toolbar_height); fb = list1 (Fcons (Qnil, Qzero)); - set_specifier_fallback (Vtoolbar_size[BOTTOM_TOOLBAR], fb); - set_specifier_fallback (Vtoolbar_size[LEFT_TOOLBAR], fb); - set_specifier_fallback (Vtoolbar_size[RIGHT_TOOLBAR], fb); + set_specifier_fallback (Vtoolbar_size[BOTTOM_EDGE], fb); + set_specifier_fallback (Vtoolbar_size[LEFT_EDGE], fb); + set_specifier_fallback (Vtoolbar_size[RIGHT_EDGE], fb); DEFVAR_SPECIFIER ("default-toolbar-border-width", &Vdefault_toolbar_border_width /* @@ -1792,67 +1800,67 @@ default_toolbar_border_width_changed_in_frame, 0); DEFVAR_SPECIFIER ("top-toolbar-border-width", - &Vtoolbar_border_width[TOP_TOOLBAR] /* + &Vtoolbar_border_width[TOP_EDGE] /* *Border width of the top toolbar. This is a specifier; use `set-specifier' to change it. See `default-toolbar-height' for more information. */ ); - Vtoolbar_border_width[TOP_TOOLBAR] = Fmake_specifier (Qnatnum); - set_specifier_caching (Vtoolbar_border_width[TOP_TOOLBAR], + Vtoolbar_border_width[TOP_EDGE] = Fmake_specifier (Qnatnum); + set_specifier_caching (Vtoolbar_border_width[TOP_EDGE], offsetof (struct window, - toolbar_border_width[TOP_TOOLBAR]), + toolbar_border_width[TOP_EDGE]), toolbar_geometry_changed_in_window, offsetof (struct frame, - toolbar_border_width[TOP_TOOLBAR]), + toolbar_border_width[TOP_EDGE]), frame_size_slipped, 0); DEFVAR_SPECIFIER ("bottom-toolbar-border-width", - &Vtoolbar_border_width[BOTTOM_TOOLBAR] /* + &Vtoolbar_border_width[BOTTOM_EDGE] /* *Border width of the bottom toolbar. This is a specifier; use `set-specifier' to change it. See `default-toolbar-height' for more information. */ ); - Vtoolbar_border_width[BOTTOM_TOOLBAR] = Fmake_specifier (Qnatnum); - set_specifier_caching (Vtoolbar_border_width[BOTTOM_TOOLBAR], + Vtoolbar_border_width[BOTTOM_EDGE] = Fmake_specifier (Qnatnum); + set_specifier_caching (Vtoolbar_border_width[BOTTOM_EDGE], offsetof (struct window, - toolbar_border_width[BOTTOM_TOOLBAR]), + toolbar_border_width[BOTTOM_EDGE]), toolbar_geometry_changed_in_window, offsetof (struct frame, - toolbar_border_width[BOTTOM_TOOLBAR]), + toolbar_border_width[BOTTOM_EDGE]), frame_size_slipped, 0); DEFVAR_SPECIFIER ("left-toolbar-border-width", - &Vtoolbar_border_width[LEFT_TOOLBAR] /* + &Vtoolbar_border_width[LEFT_EDGE] /* *Border width of left toolbar. This is a specifier; use `set-specifier' to change it. See `default-toolbar-height' for more information. */ ); - Vtoolbar_border_width[LEFT_TOOLBAR] = Fmake_specifier (Qnatnum); - set_specifier_caching (Vtoolbar_border_width[LEFT_TOOLBAR], + Vtoolbar_border_width[LEFT_EDGE] = Fmake_specifier (Qnatnum); + set_specifier_caching (Vtoolbar_border_width[LEFT_EDGE], offsetof (struct window, - toolbar_border_width[LEFT_TOOLBAR]), + toolbar_border_width[LEFT_EDGE]), toolbar_geometry_changed_in_window, offsetof (struct frame, - toolbar_border_width[LEFT_TOOLBAR]), + toolbar_border_width[LEFT_EDGE]), frame_size_slipped, 0); DEFVAR_SPECIFIER ("right-toolbar-border-width", - &Vtoolbar_border_width[RIGHT_TOOLBAR] /* + &Vtoolbar_border_width[RIGHT_EDGE] /* *Border width of right toolbar. This is a specifier; use `set-specifier' to change it. See `default-toolbar-height' for more information. */ ); - Vtoolbar_border_width[RIGHT_TOOLBAR] = Fmake_specifier (Qnatnum); - set_specifier_caching (Vtoolbar_border_width[RIGHT_TOOLBAR], + Vtoolbar_border_width[RIGHT_EDGE] = Fmake_specifier (Qnatnum); + set_specifier_caching (Vtoolbar_border_width[RIGHT_EDGE], offsetof (struct window, - toolbar_border_width[RIGHT_TOOLBAR]), + toolbar_border_width[RIGHT_EDGE]), toolbar_geometry_changed_in_window, offsetof (struct frame, - toolbar_border_width[RIGHT_TOOLBAR]), + toolbar_border_width[RIGHT_EDGE]), frame_size_slipped, 0); fb = Qnil; @@ -1871,11 +1879,11 @@ if (!NILP (fb)) set_specifier_fallback (Vdefault_toolbar_border_width, fb); - set_specifier_fallback (Vtoolbar_border_width[TOP_TOOLBAR], Vdefault_toolbar_border_width); + set_specifier_fallback (Vtoolbar_border_width[TOP_EDGE], Vdefault_toolbar_border_width); fb = list1 (Fcons (Qnil, Qzero)); - set_specifier_fallback (Vtoolbar_border_width[BOTTOM_TOOLBAR], fb); - set_specifier_fallback (Vtoolbar_border_width[LEFT_TOOLBAR], fb); - set_specifier_fallback (Vtoolbar_border_width[RIGHT_TOOLBAR], fb); + set_specifier_fallback (Vtoolbar_border_width[BOTTOM_EDGE], fb); + set_specifier_fallback (Vtoolbar_border_width[LEFT_EDGE], fb); + set_specifier_fallback (Vtoolbar_border_width[RIGHT_EDGE], fb); DEFVAR_SPECIFIER ("default-toolbar-visible-p", &Vdefault_toolbar_visible_p /* *Whether the default toolbar is visible. @@ -1905,78 +1913,78 @@ default_toolbar_visible_p_changed_in_frame, 0); DEFVAR_SPECIFIER ("top-toolbar-visible-p", - &Vtoolbar_visible_p[TOP_TOOLBAR] /* + &Vtoolbar_visible_p[TOP_EDGE] /* *Whether the top toolbar is visible. This is a specifier; use `set-specifier' to change it. See `default-toolbar-visible-p' for more information. */ ); - Vtoolbar_visible_p[TOP_TOOLBAR] = Fmake_specifier (Qboolean); - set_specifier_caching (Vtoolbar_visible_p[TOP_TOOLBAR], + Vtoolbar_visible_p[TOP_EDGE] = Fmake_specifier (Qboolean); + set_specifier_caching (Vtoolbar_visible_p[TOP_EDGE], offsetof (struct window, - toolbar_visible_p[TOP_TOOLBAR]), + toolbar_visible_p[TOP_EDGE]), toolbar_geometry_changed_in_window, offsetof (struct frame, - toolbar_visible_p[TOP_TOOLBAR]), + toolbar_visible_p[TOP_EDGE]), frame_size_slipped, 0); DEFVAR_SPECIFIER ("bottom-toolbar-visible-p", - &Vtoolbar_visible_p[BOTTOM_TOOLBAR] /* + &Vtoolbar_visible_p[BOTTOM_EDGE] /* *Whether the bottom toolbar is visible. This is a specifier; use `set-specifier' to change it. See `default-toolbar-visible-p' for more information. */ ); - Vtoolbar_visible_p[BOTTOM_TOOLBAR] = Fmake_specifier (Qboolean); - set_specifier_caching (Vtoolbar_visible_p[BOTTOM_TOOLBAR], + Vtoolbar_visible_p[BOTTOM_EDGE] = Fmake_specifier (Qboolean); + set_specifier_caching (Vtoolbar_visible_p[BOTTOM_EDGE], offsetof (struct window, - toolbar_visible_p[BOTTOM_TOOLBAR]), + toolbar_visible_p[BOTTOM_EDGE]), toolbar_geometry_changed_in_window, offsetof (struct frame, - toolbar_visible_p[BOTTOM_TOOLBAR]), + toolbar_visible_p[BOTTOM_EDGE]), frame_size_slipped, 0); DEFVAR_SPECIFIER ("left-toolbar-visible-p", - &Vtoolbar_visible_p[LEFT_TOOLBAR] /* + &Vtoolbar_visible_p[LEFT_EDGE] /* *Whether the left toolbar is visible. This is a specifier; use `set-specifier' to change it. See `default-toolbar-visible-p' for more information. */ ); - Vtoolbar_visible_p[LEFT_TOOLBAR] = Fmake_specifier (Qboolean); - set_specifier_caching (Vtoolbar_visible_p[LEFT_TOOLBAR], + Vtoolbar_visible_p[LEFT_EDGE] = Fmake_specifier (Qboolean); + set_specifier_caching (Vtoolbar_visible_p[LEFT_EDGE], offsetof (struct window, - toolbar_visible_p[LEFT_TOOLBAR]), + toolbar_visible_p[LEFT_EDGE]), toolbar_geometry_changed_in_window, offsetof (struct frame, - toolbar_visible_p[LEFT_TOOLBAR]), + toolbar_visible_p[LEFT_EDGE]), frame_size_slipped, 0); DEFVAR_SPECIFIER ("right-toolbar-visible-p", - &Vtoolbar_visible_p[RIGHT_TOOLBAR] /* + &Vtoolbar_visible_p[RIGHT_EDGE] /* *Whether the right toolbar is visible. This is a specifier; use `set-specifier' to change it. See `default-toolbar-visible-p' for more information. */ ); - Vtoolbar_visible_p[RIGHT_TOOLBAR] = Fmake_specifier (Qboolean); - set_specifier_caching (Vtoolbar_visible_p[RIGHT_TOOLBAR], + Vtoolbar_visible_p[RIGHT_EDGE] = Fmake_specifier (Qboolean); + set_specifier_caching (Vtoolbar_visible_p[RIGHT_EDGE], offsetof (struct window, - toolbar_visible_p[RIGHT_TOOLBAR]), + toolbar_visible_p[RIGHT_EDGE]), toolbar_geometry_changed_in_window, offsetof (struct frame, - toolbar_visible_p[RIGHT_TOOLBAR]), + toolbar_visible_p[RIGHT_EDGE]), frame_size_slipped, 0); /* initially, top inherits from default; this can be changed with `set-default-toolbar-position'. */ fb = list1 (Fcons (Qnil, Qt)); set_specifier_fallback (Vdefault_toolbar_visible_p, fb); - set_specifier_fallback (Vtoolbar_visible_p[TOP_TOOLBAR], + set_specifier_fallback (Vtoolbar_visible_p[TOP_EDGE], Vdefault_toolbar_visible_p); - set_specifier_fallback (Vtoolbar_visible_p[BOTTOM_TOOLBAR], fb); - set_specifier_fallback (Vtoolbar_visible_p[LEFT_TOOLBAR], fb); - set_specifier_fallback (Vtoolbar_visible_p[RIGHT_TOOLBAR], fb); + set_specifier_fallback (Vtoolbar_visible_p[BOTTOM_EDGE], fb); + set_specifier_fallback (Vtoolbar_visible_p[LEFT_EDGE], fb); + set_specifier_fallback (Vtoolbar_visible_p[RIGHT_EDGE], fb); DEFVAR_SPECIFIER ("toolbar-buttons-captioned-p", &Vtoolbar_buttons_captioned_p /* diff -r 861f2601a38b -r 1f0b15040456 src/toolbar.h --- a/src/toolbar.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/toolbar.h Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* Define general toolbar support. Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996 Ben Wing. + Copyright (C) 1995, 1996, 2010 Ben Wing. Copyright (C) 1996 Chuck Thompson. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -33,12 +31,17 @@ ((frame)->toolbar_buttons[pos]) #define FRAME_CURRENT_TOOLBAR_SIZE(frame, pos) \ ((frame)->current_toolbar_size[pos]) +#define SET_TOOLBAR_WAS_VISIBLE_FLAG(frame, pos, flag) \ + do { \ + (frame)->toolbar_was_visible[pos] = flag; \ + } while (0) + #define DEVICE_SUPPORTS_TOOLBARS_P(d) \ HAS_DEVMETH_P (d, output_frame_toolbars) struct toolbar_button { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; Lisp_Object next; Lisp_Object frame; @@ -69,14 +72,14 @@ int border_width; }; -DECLARE_LRECORD (toolbar_button, struct toolbar_button); +DECLARE_LISP_OBJECT (toolbar_button, struct toolbar_button); #define XTOOLBAR_BUTTON(x) XRECORD (x, toolbar_button, struct toolbar_button) #define wrap_toolbar_button(p) wrap_record (p, toolbar_button) #define TOOLBAR_BUTTONP(x) RECORDP (x, toolbar_button) #define CHECK_TOOLBAR_BUTTON(x) CHECK_RECORD (x, toolbar_button) #define CONCHECK_TOOLBAR_BUTTON(x) CONCHECK_RECORD (x, toolbar_button) -void get_toolbar_coords (struct frame *f, enum toolbar_pos pos, int *x, +void get_toolbar_coords (struct frame *f, enum edge_pos pos, int *x, int *y, int *width, int *height, int *vert, int for_layout); Lisp_Object toolbar_button_at_pixpos (struct frame *f, int x_coord, @@ -106,7 +109,7 @@ void free_frame_toolbars (struct frame *f); Lisp_Object get_toolbar_button_glyph (struct window *w, struct toolbar_button *tb); -void mark_frame_toolbar_buttons_dirty (struct frame *f, enum toolbar_pos pos); +void mark_frame_toolbar_buttons_dirty (struct frame *f, enum edge_pos pos); #endif /* HAVE_TOOLBARS */ diff -r 861f2601a38b -r 1f0b15040456 src/tooltalk.c --- a/src/tooltalk.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/tooltalk.c Sun May 01 18:44:03 2011 +0100 @@ -1,14 +1,14 @@ /* Tooltalk support for Emacs. Copyright (C) 1993, 1994 Sun Microsystems, Inc. Copyright (C) 1995 Free Software Foundation, Inc. - Copyright (C) 2002 Ben Wing. + Copyright (C) 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -16,9 +16,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -147,7 +145,7 @@ struct Lisp_Tooltalk_Message { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; Lisp_Object plist_sym, callback; Tt_message m; }; @@ -172,30 +170,28 @@ Lisp_Tooltalk_Message *p = XTOOLTALK_MESSAGE (obj); if (print_readably) - printing_unreadable_lcrecord (obj, 0); + printing_unreadable_lisp_object (obj, 0); write_fmt_string (printcharfun, "#", - (long) (p->m), p->header.uid); + (long) (p->m), LISP_OBJECT_UID (obj)); } -DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-message", tooltalk_message, - 0, /*dumpable-flag*/ - mark_tooltalk_message, print_tooltalk_message, - 0, 0, 0, - tooltalk_message_description, - Lisp_Tooltalk_Message); +DEFINE_NODUMP_LISP_OBJECT ("tooltalk-message", tooltalk_message, + mark_tooltalk_message, print_tooltalk_message, + 0, 0, 0, + tooltalk_message_description, + Lisp_Tooltalk_Message); static Lisp_Object make_tooltalk_message (Tt_message m) { - Lisp_Object val; - Lisp_Tooltalk_Message *msg = - ALLOC_LCRECORD_TYPE (Lisp_Tooltalk_Message, &lrecord_tooltalk_message); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (tooltalk_message); + Lisp_Tooltalk_Message *msg = XTOOLTALK_MESSAGE (obj); msg->m = m; msg->callback = Qnil; msg->plist_sym = Fmake_symbol (Tooltalk_Message_plist_str); - return wrap_tooltalk_message (msg); + return obj; } Tt_message @@ -224,7 +220,7 @@ struct Lisp_Tooltalk_Pattern { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; Lisp_Object plist_sym, callback; Tt_pattern p; }; @@ -249,31 +245,29 @@ Lisp_Tooltalk_Pattern *p = XTOOLTALK_PATTERN (obj); if (print_readably) - printing_unreadable_lcrecord (obj, 0); + printing_unreadable_lisp_object (obj, 0); write_fmt_string (printcharfun, "#", - (long) (p->p), p->header.uid); + (long) (p->p), LISP_OBJECT_UID (obj)); } -DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-pattern", tooltalk_pattern, - 0, /*dumpable-flag*/ - mark_tooltalk_pattern, print_tooltalk_pattern, - 0, 0, 0, - tooltalk_pattern_description, - Lisp_Tooltalk_Pattern); +DEFINE_NODUMP_LISP_OBJECT ("tooltalk-pattern", tooltalk_pattern, + mark_tooltalk_pattern, print_tooltalk_pattern, + 0, 0, 0, + tooltalk_pattern_description, + Lisp_Tooltalk_Pattern); static Lisp_Object make_tooltalk_pattern (Tt_pattern p) { - Lisp_Tooltalk_Pattern *pat = - ALLOC_LCRECORD_TYPE (Lisp_Tooltalk_Pattern, &lrecord_tooltalk_pattern); - Lisp_Object val; + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (tooltalk_pattern); + Lisp_Tooltalk_Pattern *pat = XTOOLTALK_PATTERN (obj); pat->p = p; pat->callback = Qnil; pat->plist_sym = Fmake_symbol (Tooltalk_Pattern_plist_str); - return wrap_tooltalk_pattern (pat); + return obj; } static Tt_pattern @@ -1314,8 +1308,8 @@ void syms_of_tooltalk (void) { - INIT_LRECORD_IMPLEMENTATION (tooltalk_message); - INIT_LRECORD_IMPLEMENTATION (tooltalk_pattern); + INIT_LISP_OBJECT (tooltalk_message); + INIT_LISP_OBJECT (tooltalk_pattern); DEFSYMBOL_MULTIWORD_PREDICATE (Qtooltalk_messagep); DEFSUBR (Ftooltalk_message_p); @@ -1477,7 +1471,7 @@ staticpro (&Vtooltalk_message_gcpro); staticpro (&Vtooltalk_pattern_gcpro); Vtooltalk_message_gcpro = - make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, Qeq); Vtooltalk_pattern_gcpro = - make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, Qeq); } diff -r 861f2601a38b -r 1f0b15040456 src/tooltalk.doc --- a/src/tooltalk.doc Sat Feb 20 06:03:00 2010 -0600 +++ b/src/tooltalk.doc Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,20 @@ +Copyright (C) 1993 Sun Microsystems, Inc. + +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 3 of the License, 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. If not, see . + Emacs Tooltalk API Summary diff -r 861f2601a38b -r 1f0b15040456 src/tooltalk.h --- a/src/tooltalk.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/tooltalk.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,11 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. - -*/ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -27,14 +23,14 @@ #include TT_C_H_FILE typedef struct Lisp_Tooltalk_Message Lisp_Tooltalk_Message; -DECLARE_LRECORD (tooltalk_message, Lisp_Tooltalk_Message); +DECLARE_LISP_OBJECT (tooltalk_message, Lisp_Tooltalk_Message); #define XTOOLTALK_MESSAGE(x) XRECORD (x, tooltalk_message, Lisp_Tooltalk_Message) #define wrap_tooltalk_message(p) wrap_record (p, tooltalk_message) #define TOOLTALK_MESSAGEP(x) RECORDP (x, tooltalk_message) #define CHECK_TOOLTALK_MESSAGE(x) CHECK_RECORD (x, tooltalk_message) typedef struct Lisp_Tooltalk_Pattern Lisp_Tooltalk_Pattern; -DECLARE_LRECORD (tooltalk_pattern, Lisp_Tooltalk_Pattern); +DECLARE_LISP_OBJECT (tooltalk_pattern, Lisp_Tooltalk_Pattern); #define XTOOLTALK_PATTERN(x) XRECORD (x, tooltalk_pattern, Lisp_Tooltalk_Pattern) #define wrap_tooltalk_pattern(p) wrap_record (p, tooltalk_pattern) #define TOOLTALK_PATTERNP(x) RECORDP (x, tooltalk_pattern) diff -r 861f2601a38b -r 1f0b15040456 src/tparam.c --- a/src/tparam.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/tparam.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not synched with FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/ui-byhand.c --- a/src/ui-byhand.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/ui-byhand.c Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,8 @@ -/* I really wish this entire file could go away, but there is +/* ui-byhand.c --- hand-coded GTK functions + +Copyright (C) 2000, 2001 William M. Perry + + I really wish this entire file could go away, but there is currently no way to do the following in the Foreign Function Interface: @@ -10,10 +14,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -21,10 +25,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -Boston, MA 02111-1301, USA. -*/ +along with XEmacs. If not, see . */ #include "gui.h" diff -r 861f2601a38b -r 1f0b15040456 src/ui-gtk.c --- a/src/ui-gtk.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/ui-gtk.c Sun May 01 18:44:03 2011 +0100 @@ -4,23 +4,24 @@ ** ** Created by: William M. Perry ** Copyright (c) 2000 William M. Perry +** Copyright (C) 2010 Ben Wing. +** +** This file is part of XEmacs. ** ** This file is part of XEmacs. ** -** XEmacs is free software; you can redistribute it and/or modify it +** 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. -** +** Free Software Foundation, either version 3 of the License, or (at your +** option) any later version. +** ** XEmacs is distributed in the hope that it will be useful, but WITHOUT ** ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ** FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ** for more details. -** +** ** You should have received a copy of the GNU General Public License -** along with XEmacs; see the file COPYING. If not, write to -** the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -** Boston, MA 02111-1301, USA. */ +** along with XEmacs. If not, see . */ #include #include "lisp.h" @@ -36,7 +37,7 @@ #include "console-gtk-impl.h" #include "glyphs-gtk.h" -#include "objects-gtk.h" +#include "fontcolor-gtk.h" #include "ui-gtk.h" /* XEmacs specific GTK types */ @@ -295,7 +296,8 @@ static emacs_ffi_data * allocate_ffi_data (void) { - emacs_ffi_data *data = ALLOC_LCRECORD_TYPE (emacs_ffi_data, &lrecord_emacs_ffi); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (emacs_ffi); + emacs_ffi_data *data = XFFI (obj); data->return_type = GTK_TYPE_NONE; data->n_args = 0; @@ -325,7 +327,7 @@ int UNUSED (escapeflag)) { if (print_readably) - printing_unreadable_lcrecord (obj, 0); + printing_unreadable_lisp_object (obj, 0); write_fmt_string_lisp (printcharfun, "#function_name); if (XFFI (obj)->n_args) @@ -333,11 +335,10 @@ write_fmt_string (printcharfun, " %p>", (void *)XFFI (obj)->function_ptr); } -DEFINE_LRECORD_IMPLEMENTATION ("ffi", emacs_ffi, - 0, /*dumpable-flag*/ - mark_ffi_data, ffi_object_printer, - 0, 0, 0, - ffi_data_description, emacs_ffi_data); +DEFINE_NODUMP_LISP_OBJECT ("ffi", emacs_ffi, + mark_ffi_data, ffi_object_printer, + 0, 0, 0, + ffi_data_description, emacs_ffi_data); #if defined (__cplusplus) #define MANY_ARGS ... @@ -795,7 +796,7 @@ int UNUSED (escapeflag)) { if (print_readably) - printing_unreadable_lcrecord (obj, 0); + printing_unreadable_lisp_object (obj, 0); write_ascstring (printcharfun, "#alive_p) @@ -806,7 +807,7 @@ } static Lisp_Object -object_getprop (Lisp_Object obj, Lisp_Object prop) +emacs_gtk_object_getprop (Lisp_Object obj, Lisp_Object prop) { Lisp_Object rval = Qnil; Lisp_Object prop_name = Qnil; @@ -870,7 +871,7 @@ } static int -object_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value) +emacs_gtk_object_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value) { GtkArgInfo *info = NULL; Lisp_Object prop_name = Qnil; @@ -923,44 +924,28 @@ } static void -emacs_gtk_object_finalizer (void *header, int for_disksave) +emacs_gtk_object_finalizer (Lisp_Object obj) { - emacs_gtk_object_data *data = (emacs_gtk_object_data *) header; - - if (for_disksave) - { - Lisp_Object obj = wrap_emacs_gtk_object (data); - - - invalid_operation - ("Can't dump an emacs containing GtkObject objects", obj); - } + emacs_gtk_object_data *data = XEMACS_GTK_OBJECT_DATA (obj); if (data->alive_p) - { - gtk_object_unref (data->object); - } + gtk_object_unref (data->object); } -DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("GtkObject", emacs_gtk_object, - 0, /*dumpable-flag*/ - mark_gtk_object_data, - emacs_gtk_object_printer, - emacs_gtk_object_finalizer, - 0, /* equality */ - 0, /* hash */ - gtk_object_data_description, - object_getprop, - object_putprop, - 0, /* rem prop */ - 0, /* plist */ - emacs_gtk_object_data); +DEFINE_NODUMP_LISP_OBJECT ("GtkObject", emacs_gtk_object, + mark_gtk_object_data, + emacs_gtk_object_printer, + emacs_gtk_object_finalizer, + 0, /* equality */ + 0, /* hash */ + gtk_object_data_description, + emacs_gtk_object_data); static emacs_gtk_object_data * allocate_emacs_gtk_object_data (void) { - emacs_gtk_object_data *data = ALLOC_LCRECORD_TYPE (emacs_gtk_object_data, - &lrecord_emacs_gtk_object); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (emacs_gtk_object); + emacs_gtk_object_data *data = XGTK_OBJECT (obj); data->object = NULL; data->alive_p = FALSE; @@ -1114,7 +1099,7 @@ int UNUSED (escapeflag)) { if (print_readably) - printing_unreadable_lcrecord (obj, 0); + printing_unreadable_lisp_object (obj, 0); write_ascstring (printcharfun, "#object_type)); @@ -1132,25 +1117,21 @@ } static Hashcode -emacs_gtk_boxed_hash (Lisp_Object obj, int UNUSED (depth)) +emacs_gtk_boxed_hash (Lisp_Object obj, int UNUSED (depth), + Boolint UNUSED (equalp)) { emacs_gtk_boxed_data *data = XGTK_BOXED(obj); return (HASH2 ((Hashcode) data->object, data->object_type)); } -DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("GtkBoxed", emacs_gtk_boxed, - 0, /*dumpable-flag*/ - 0, /* marker function */ - emacs_gtk_boxed_printer, - 0, /* nuker */ - emacs_gtk_boxed_equality, - emacs_gtk_boxed_hash, - emacs_gtk_boxed_description, - 0, /* get prop */ - 0, /* put prop */ - 0, /* rem prop */ - 0, /* plist */ - emacs_gtk_boxed_data); +DEFINE_NODUMP_LISP_OBJECT ("GtkBoxed", emacs_gtk_boxed, + 0, /* marker function */ + emacs_gtk_boxed_printer, + 0, /* nuker */ + emacs_gtk_boxed_equality, + emacs_gtk_boxed_hash, + emacs_gtk_boxed_description, + emacs_gtk_boxed_data); /* Currently defined GTK_TYPE_BOXED structures are: GtkAccelGroup - @@ -1168,8 +1149,8 @@ static emacs_gtk_boxed_data * allocate_emacs_gtk_boxed_data (void) { - emacs_gtk_boxed_data *data = ALLOC_LCRECORD_TYPE (emacs_gtk_boxed_data, - &lrecord_emacs_gtk_boxed); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (emacs_gtk_boxed); + emacs_gtk_boxed_data *data = XGTK_BOXED (obj); data->object = NULL; data->object_type = GTK_TYPE_INVALID; @@ -1353,11 +1334,19 @@ void +ui_gtk_objects_create (void) +{ + OBJECT_HAS_METHOD (emacs_gtk_object, getprop); + OBJECT_HAS_METHOD (emacs_gtk_object, putprop); + /* #### No remprop or plist methods */ +} + +void syms_of_ui_gtk (void) { - INIT_LRECORD_IMPLEMENTATION (emacs_ffi); - INIT_LRECORD_IMPLEMENTATION (emacs_gtk_object); - INIT_LRECORD_IMPLEMENTATION (emacs_gtk_boxed); + INIT_LISP_OBJECT (emacs_ffi); + INIT_LISP_OBJECT (emacs_gtk_object); + INIT_LISP_OBJECT (emacs_gtk_boxed); DEFSYMBOL_MULTIWORD_PREDICATE (Qemacs_ffip); DEFSYMBOL_MULTIWORD_PREDICATE (Qemacs_gtk_objectp); DEFSYMBOL_MULTIWORD_PREDICATE (Qemacs_gtk_boxedp); diff -r 861f2601a38b -r 1f0b15040456 src/ui-gtk.h --- a/src/ui-gtk.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/ui-gtk.h Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ** ** This file is part of XEmacs. ** -** XEmacs is free software; you can redistribute it and/or modify it +** 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. -** +** Free Software Foundation, either version 3 of the License, or (at your +** option) any later version. +** ** XEmacs is distributed in the hope that it will be useful, but WITHOUT ** ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ** FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ** for more details. -** +** ** You should have received a copy of the GNU General Public License -** along with XEmacs; see the file COPYING. If not, write to -** the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -** Boston, MA 02111-1301, USA. */ +** along with XEmacs. If not, see . */ #ifndef __UI_GTK_H__ #define __UI_GTK_H__ @@ -36,7 +34,7 @@ #define MAX_GTK_ARGS 100 typedef struct { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; GtkType return_type; GtkType args[MAX_GTK_ARGS]; gint n_args; @@ -45,7 +43,7 @@ ffi_marshalling_function marshal; } emacs_ffi_data; -DECLARE_LRECORD (emacs_ffi, emacs_ffi_data); +DECLARE_LISP_OBJECT (emacs_ffi, emacs_ffi_data); #define XFFI(x) XRECORD (x, emacs_ffi, emacs_ffi_data) #define wrap_emacs_ffi(p) wrap_record (p, emacs_ffi) @@ -54,13 +52,13 @@ /* Encapsulate a GtkObject in Lisp */ typedef struct { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; gboolean alive_p; GtkObject *object; Lisp_Object plist; } emacs_gtk_object_data; -DECLARE_LRECORD (emacs_gtk_object, emacs_gtk_object_data); +DECLARE_LISP_OBJECT (emacs_gtk_object, emacs_gtk_object_data); #define XGTK_OBJECT(x) XRECORD (x, emacs_gtk_object, emacs_gtk_object_data) #define wrap_emacs_gtk_object(p) wrap_record (p, emacs_gtk_object) @@ -71,12 +69,12 @@ /* Encapsulate a GTK_TYPE_BOXED in lisp */ typedef struct { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; GtkType object_type; void *object; } emacs_gtk_boxed_data; -DECLARE_LRECORD (emacs_gtk_boxed, emacs_gtk_boxed_data); +DECLARE_LISP_OBJECT (emacs_gtk_boxed, emacs_gtk_boxed_data); #define XGTK_BOXED(x) XRECORD (x, emacs_gtk_boxed, emacs_gtk_boxed_data) #define wrap_emacs_gtk_boxed(p) wrap_record (p, emacs_gtk_boxed) diff -r 861f2601a38b -r 1f0b15040456 src/undo.c --- a/src/undo.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/undo.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.28. */ diff -r 861f2601a38b -r 1f0b15040456 src/unexaix.c --- a/src/unexaix.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/unexaix.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 20.2. */ diff -r 861f2601a38b -r 1f0b15040456 src/unexalpha.c --- a/src/unexalpha.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/unexalpha.c Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,18 @@ 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.31. */ diff -r 861f2601a38b -r 1f0b15040456 src/unexcw.c --- a/src/unexcw.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/unexcw.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,11 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to the Free -Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -02111-1307, USA. - -*/ +along with XEmacs. If not, see . */ /* This is a complete rewrite, some code snarfed from unexnt.c and unexec.c, Andy Piper (andy@xemacs.org) 13-1-98 */ @@ -244,7 +240,7 @@ f_ohdr.dsize is the total initialized data size on disk which is f_data.s_size + f_idata.s_size. - f_ohdr.data_start is the base addres of all data and so should + f_ohdr.data_start is the base address of all data and so should not be changed. *.s_vaddr is the virtual address of the start of the section diff -r 861f2601a38b -r 1f0b15040456 src/unexec.c --- a/src/unexec.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/unexec.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.31. */ diff -r 861f2601a38b -r 1f0b15040456 src/unexelf.c --- a/src/unexelf.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/unexelf.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 20.4. */ diff -r 861f2601a38b -r 1f0b15040456 src/unexhp9k800.c --- a/src/unexhp9k800.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/unexhp9k800.c Sun May 01 18:44:03 2011 +0100 @@ -1,12 +1,13 @@ /* Unexec for HP 9000 Series 800 machines. - Bob Desinger + +Copyright 1996 Bob Desinger This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not synched with FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/unexnt.c --- a/src/unexnt.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/unexnt.c Sun May 01 18:44:03 2011 +0100 @@ -1,13 +1,13 @@ /* unexec for XEmacs on Windows NT. Copyright (C) 1994 Free Software Foundation, Inc. - Copyright (C) 2002 Ben Wing. + Copyright (C) 2002, 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,10 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to the Free -Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -02111-1307, USA. - +along with XEmacs. If not, see . Geoff Voelker (voelker@cs.washington.edu) 8-12-94 */ /* Adapted for XEmacs by David Hobley */ @@ -525,12 +522,11 @@ file = qxeCreateFile (filename, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); - if (file == INVALID_HANDLE_VALUE) - ABORT (); + assert (file != INVALID_HANDLE_VALUE); /* Seek to where the .bss section is tucked away after the heap... */ index = heap_index_in_executable + get_committed_heap_size (); - if (SetFilePointer (file, index, NULL, FILE_BEGIN) == 0xFFFFFFFF) + if (SetFilePointer (file, index, NULL, FILE_BEGIN) == 0xFFFFFFFF) ABORT (); /* Ok, read in the saved .bss section and initialize all @@ -553,14 +549,12 @@ file = qxeCreateFile (filename, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); - if (file == INVALID_HANDLE_VALUE) - ABORT (); + assert (file != INVALID_HANDLE_VALUE); size = GetFileSize (file, &upper_size); file_mapping = qxeCreateFileMapping (file, NULL, PAGE_WRITECOPY, 0, size, NULL); - if (!file_mapping) - ABORT (); + assert (file_mapping); size = get_committed_heap_size (); file_base = MapViewOfFileEx (file_mapping, FILE_MAP_COPY, 0, diff -r 861f2601a38b -r 1f0b15040456 src/unexsol2-6.c --- a/src/unexsol2-6.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/unexsol2-6.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/unicode.c --- a/src/unicode.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/unicode.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 20.3. Not in FSF. */ @@ -542,7 +540,7 @@ static Bytecount compute_from_unicode_table_size_1 (void *table, int level, - struct overhead_stats *stats) + struct usage_stats *stats) { int i; Bytecount size = 0; @@ -590,7 +588,7 @@ static Bytecount compute_to_unicode_table_size_1 (void *table, int level, - struct overhead_stats *stats) + struct usage_stats *stats) { Bytecount size = 0; @@ -615,7 +613,7 @@ Bytecount compute_from_unicode_table_size (Lisp_Object charset, - struct overhead_stats *stats) + struct usage_stats *stats) { return (compute_from_unicode_table_size_1 (XCHARSET_FROM_UNICODE_TABLE (charset), @@ -625,7 +623,7 @@ Bytecount compute_to_unicode_table_size (Lisp_Object charset, - struct overhead_stats *stats) + struct usage_stats *stats) { return (compute_to_unicode_table_size_1 (XCHARSET_TO_UNICODE_TABLE (charset), @@ -1253,7 +1251,7 @@ charsets, defined by `set-language-unicode-precedence-list'. These are followed by charsets in the default precedence list, defined by `set-default-unicode-precedence-list'. Charsets occurring multiple times are -given precedence according to their first occurrance in either list. These +given precedence according to their first occurrence in either list. These are followed by the remaining charsets, in some arbitrary order. The language-specific precedence list is meant to be set as part of the @@ -1371,7 +1369,8 @@ int ichar, unicode; CHECK_CHAR (character); - CHECK_NATNUM (code); + + check_integer_range (code, Qzero, make_integer (EMACS_INT_MAX)); unicode = XINT (code); ichar = XCHAR (character); @@ -1447,7 +1446,7 @@ int lbs[NUM_LEADING_BYTES]; int c; - CHECK_NATNUM (code); + check_integer_range (code, Qzero, make_integer (EMACS_INT_MAX)); c = XINT (code); { EXTERNAL_LIST_LOOP_2 (elt, charsets) @@ -1473,7 +1472,7 @@ return make_char (ret); } #else - CHECK_NATNUM (code); + check_integer_range (code, Qzero, make_integer (EMACS_INT_MAX)); return Fint_to_char (code); #endif /* MULE */ } @@ -3293,8 +3292,8 @@ Fmake_coding_system_internal (Qutf_8, Qunicode, build_defer_string ("UTF-8"), - nconc2 (list4 (Qdocumentation, - build_defer_string ( + listu (Qdocumentation, + build_defer_string ( "UTF-8 Unicode encoding -- ASCII-compatible 8-bit variable-width encoding\n" "sharing the following principles with the Mule-internal encoding:\n" "\n" @@ -3316,6 +3315,7 @@ " -- Given only the leading byte, you know how many following bytes\n" " are present.\n" ), - Qmnemonic, build_ascstring ("UTF8")), - list2 (Qunicode_type, Qutf_8))); + Qmnemonic, build_ascstring ("UTF8"), + Qunicode_type, Qutf_8, + Qunbound)); } diff -r 861f2601a38b -r 1f0b15040456 src/universe.h --- a/src/universe.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/universe.h Sun May 01 18:44:03 2011 +0100 @@ -2,10 +2,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -13,9 +13,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/vdb-fake.c --- a/src/vdb-fake.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/vdb-fake.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/vdb-mach.c --- a/src/vdb-mach.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/vdb-mach.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/vdb-posix.c --- a/src/vdb-posix.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/vdb-posix.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -73,7 +71,7 @@ } else /* default sigsegv handler */ { - char *signal_name = ""; + const Ascbyte *signal_name = ""; if (signum == SIGSEGV) signal_name = "SIGSEGV"; else if (signum == SIGBUS) diff -r 861f2601a38b -r 1f0b15040456 src/vdb-win32.c --- a/src/vdb-win32.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/vdb-win32.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -29,7 +27,7 @@ #include "syswindows.h" -LONG WINAPI +static LONG WINAPI win32_fault_handler (LPEXCEPTION_POINTERS e) { #define GET_FAULT_ADDRESS (void *) e->ExceptionRecord->ExceptionInformation[1] diff -r 861f2601a38b -r 1f0b15040456 src/vdb.c --- a/src/vdb.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/vdb.c Sun May 01 18:44:03 2011 +0100 @@ -1,12 +1,13 @@ /* Virtual diry bit implementation (platform independent) for XEmacs. Copyright (C) 2005 Marcus Crestani. + Copyright (C) 2010 Ben Wing. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ @@ -74,6 +73,8 @@ /* For testing and debugging... */ +#ifdef DEBUG_XEMACS + DEFUN ("test-vdb", Ftest_vdb, 0, 0, "", /* Test virtual dirty bit implementation. Prints results to stderr. */ @@ -148,9 +149,13 @@ return Qnil; } +#endif /* DEBUG_XEMACS */ + void syms_of_vdb (void) { +#ifdef DEBUG_XEMACS DEFSUBR (Ftest_vdb); DEFSUBR (Ftest_segfault); +#endif /* DEBUG_XEMACS */ } diff -r 861f2601a38b -r 1f0b15040456 src/vdb.h --- a/src/vdb.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/vdb.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/vm-limit.c --- a/src/vm-limit.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/vm-limit.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ diff -r 861f2601a38b -r 1f0b15040456 src/widget.c --- a/src/widget.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/widget.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/win32.c --- a/src/win32.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/win32.c Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to the Free -Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -02111-1307, USA. */ +along with XEmacs. If not, see . */ #include #include "lisp.h" diff -r 861f2601a38b -r 1f0b15040456 src/window-impl.h --- a/src/window-impl.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/window-impl.h Sun May 01 18:44:03 2011 +0100 @@ -7,10 +7,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -18,9 +18,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ @@ -84,7 +82,7 @@ struct window { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; /* The upper left corner coordinates of this window, as integers (pixels) relative to upper left corner of frame = 0, 0 */ @@ -168,7 +166,7 @@ struct window_mirror { - struct LCRECORD_HEADER header; + NORMAL_LISP_OBJECT_HEADER header; /* Frame this mirror is on. */ struct frame *frame; diff -r 861f2601a38b -r 1f0b15040456 src/window.c --- a/src/window.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/window.c Sun May 01 18:44:03 2011 +0100 @@ -1,15 +1,15 @@ /* Window creation, deletion and examination for XEmacs. Copyright (C) 1985-1987, 1992-1995 Free Software Foundation, Inc. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2002 Ben Wing. + Copyright (C) 1995, 1996, 2002, 2010 Ben Wing. Copyright (C) 1996 Chuck Thompson. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ /* Beginning to diverge significantly. */ @@ -47,7 +45,7 @@ #include "frame-impl.h" #include "glyphs.h" #include "gutter.h" -#include "objects.h" +#include "fontcolor.h" #include "redisplay.h" #include "window-impl.h" @@ -55,7 +53,7 @@ Lisp_Object Qdisplay_buffer; #ifdef MEMORY_USAGE_STATS -Lisp_Object Qface_cache, Qglyph_cache, Qline_start_cache, Qother_redisplay; +Lisp_Object Qface_cache, Qglyph_cache, Qline_start_cache, Qredisplay_structs; #ifdef HAVE_SCROLLBARS Lisp_Object Qscrollbar_instances; #endif @@ -182,11 +180,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("face-cachel", face_cachel, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - face_cachel_description_1, - Lisp_Face_Cachel); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("face-cachel", face_cachel, + 0, face_cachel_description_1, + Lisp_Face_Cachel); #endif /* NEW_GC */ static const struct sized_memory_description face_cachel_description = { @@ -204,11 +200,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("face-cachel-dynarr", face_cachel_dynarr, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - face_cachel_dynarr_description_1, - face_cachel_dynarr); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("face-cachel-dynarr", face_cachel_dynarr, + 0, face_cachel_dynarr_description_1, + face_cachel_dynarr); #else /* not NEW_GC */ static const struct sized_memory_description face_cachel_dynarr_description = { sizeof (face_cachel_dynarr), @@ -222,11 +216,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("glyph-cachel", glyph_cachel, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - glyph_cachel_description_1, - Lisp_Glyph_Cachel); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("glyph-cachel", glyph_cachel, + 0, glyph_cachel_description_1, + Lisp_Glyph_Cachel); #endif /* NEW_GC */ static const struct sized_memory_description glyph_cachel_description = { @@ -244,11 +236,10 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("glyph-cachel-dynarr", glyph_cachel_dynarr, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - glyph_cachel_dynarr_description_1, - glyph_cachel_dynarr); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("glyph-cachel-dynarr", + glyph_cachel_dynarr, 0, + glyph_cachel_dynarr_description_1, + glyph_cachel_dynarr); #else /* not NEW_GC */ static const struct sized_memory_description glyph_cachel_dynarr_description = { sizeof (glyph_cachel_dynarr), @@ -316,7 +307,7 @@ Lisp_Object buf; if (print_readably) - printing_unreadable_lcrecord (obj, 0); + printing_unreadable_lisp_object (obj, 0); write_ascstring (printcharfun, "#name; write_fmt_string_lisp (printcharfun, " on %S", 1, name); } - write_fmt_string (printcharfun, " 0x%x>", XWINDOW (obj)->header.uid); + write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); } static void -finalize_window (void *header, int UNUSED (for_disksave)) -{ - struct window *w = (struct window *) header; +finalize_window (Lisp_Object obj) +{ + struct window *w = XWINDOW (obj); if (w->line_start_cache) { @@ -372,13 +363,12 @@ static Lisp_Object make_saved_buffer_point_cache (void) { - return make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ); + return make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, Qeq); } -DEFINE_LRECORD_IMPLEMENTATION ("window", window, - 0, /*dumpable-flag*/ - mark_window, print_window, finalize_window, - 0, 0, window_description, struct window); +DEFINE_NODUMP_LISP_OBJECT ("window", window, + mark_window, print_window, finalize_window, + 0, 0, window_description, struct window); #define INIT_DISP_VARIABLE(field, initialization) \ p->field[CURRENT_DISP] = initialization; \ @@ -397,8 +387,8 @@ Lisp_Object allocate_window (void) { - struct window *p = ALLOC_LCRECORD_TYPE (struct window, &lrecord_window); - Lisp_Object val = wrap_window (p); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (window); + struct window *p = XWINDOW (obj); #define WINDOW_SLOT(slot) p->slot = Qnil; #include "winslots.h" @@ -432,7 +422,7 @@ p->windows_changed = 1; p->shadow_thickness_changed = 1; - return val; + return obj; } #undef INIT_DISP_VARIABLE @@ -531,19 +521,18 @@ return Qnil; } -DEFINE_LRECORD_IMPLEMENTATION ("window-mirror", window_mirror, - 0, /*dumpable-flag*/ - mark_window_mirror, internal_object_printer, - 0, 0, 0, window_mirror_description, - struct window_mirror); +DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("window-mirror", window_mirror, + mark_window_mirror, + window_mirror_description, + struct window_mirror); /* Create a new window mirror structure and associated redisplay structs. */ static struct window_mirror * new_window_mirror (struct frame *f) { - struct window_mirror *t = - ALLOC_LCRECORD_TYPE (struct window_mirror, &lrecord_window_mirror); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (window_mirror); + struct window_mirror *t = XWINDOW_MIRROR (obj); t->frame = f; t->current_display_lines = Dynarr_new (display_line); @@ -636,7 +625,7 @@ find_window_mirror_internal (Lisp_Object win, struct window_mirror *rmir, struct window *w) { - for (; !NILP (win); win = XWINDOW (win)->next, rmir = rmir->next) + for (; !NILP (win) && rmir; win = XWINDOW (win)->next, rmir = rmir->next) { if (w == XWINDOW (win)) return rmir; @@ -687,7 +676,7 @@ #endif free_display_structs (mir); mir = mir->next; - /* not worth calling free_managed_lcrecord() -- window mirrors + /* not worth calling free_normal_lisp_object() -- window mirrors are not created that frequently and it's dangerous. we don't know for sure that there aren't other pointers around -- e.g. in a scrollbar instance. */ @@ -702,8 +691,7 @@ Lisp_Object retval = real_window_internal (mir->frame->root_window, XWINDOW_MIRROR (mir->frame->root_mirror), mir); - if (NILP (retval) && !no_abort) - ABORT (); + assert (!NILP (retval) || no_abort); return retval; } @@ -720,6 +708,18 @@ XWINDOW_MIRROR (f->root_mirror), w); } +/* Given a real window, return its mirror structure, if it exists. + Don't do any updating. */ +static struct window_mirror * +find_window_mirror_maybe (struct window *w) +{ + struct frame *f = XFRAME (w->frame); + if (!WINDOW_MIRRORP (f->root_mirror)) + return 0; + return find_window_mirror_internal (f->root_window, + XWINDOW_MIRROR (f->root_mirror), w); +} + /***************************************************************************** find_window_by_pixel_pos @@ -762,11 +762,8 @@ { struct window_mirror *t; - if (XFRAME (w->frame)->mirror_dirty) - update_frame_window_mirror (XFRAME (w->frame)); t = find_window_mirror (w); - if (!t) - ABORT (); + assert (t); if (which == CURRENT_DISP) return t->current_display_lines; @@ -786,11 +783,8 @@ { struct window_mirror *t; - if (XFRAME (w->frame)->mirror_dirty) - update_frame_window_mirror (XFRAME (w->frame)); t = find_window_mirror (w); - if (!t) - ABORT (); + assert (t); return t->buffer; } @@ -800,11 +794,8 @@ { struct window_mirror *t; - if (XFRAME (w->frame)->mirror_dirty) - update_frame_window_mirror (XFRAME (w->frame)); t = find_window_mirror (w); - if (!t) - ABORT (); + assert (t); t->buffer = b; } @@ -1179,7 +1170,7 @@ margin_cwidth = (left_margin ? XINT (w->left_margin_width) : XINT (w->right_margin_width)); - default_face_height_and_width (window, 0, &font_width); + default_face_width_and_height (window, &font_width, 0); /* The left margin takes precedence over the right margin so we subtract its width from the space available for the right @@ -1662,7 +1653,7 @@ hlimit = WINDOW_TEXT_HEIGHT (w); eobuf = BUF_ZV (XBUFFER (w->buffer)); - default_face_height_and_width (window, &defheight, NULL); + default_face_width_and_height (window, NULL, &defheight); /* guess lines needed in line start cache + a few extra */ needed = (hlimit + defheight-1) / defheight + 3; @@ -1817,10 +1808,8 @@ struct window *w = decode_window (window); struct frame *f = XFRAME (w->frame); - int left = - w->pixel_left - FRAME_LEFT_BORDER_END (f) - FRAME_LEFT_GUTTER_BOUNDS (f); - int top = - w->pixel_top - FRAME_TOP_BORDER_END (f) - FRAME_TOP_GUTTER_BOUNDS (f); + int left = w->pixel_left - FRAME_PANED_LEFT_EDGE (f); + int top = w->pixel_top - FRAME_PANED_TOP_EDGE (f); return list4 (make_int (left), make_int (top), @@ -2024,8 +2013,7 @@ Lisp_Object buf = w->buffer; struct buffer *b = XBUFFER (buf); - if (b != XMARKER (w->pointm[CURRENT_DISP])->buffer) - ABORT (); + assert (b == XMARKER (w->pointm[CURRENT_DISP])->buffer); /* FSF disables this check, so I'll do it too. I hope it won't break things. --ben */ @@ -2151,7 +2139,7 @@ /* Free the extra data structures attached to windows immediately so they don't sit around consuming excess space. They will be reinitialized by the window-configuration code as necessary. */ - finalize_window ((void *) w, 0); + finalize_window (wrap_window (w)); /* Nobody should be accessing anything in this object any more, and making them Qnil allows for better GC'ing in case a pointer @@ -3138,7 +3126,7 @@ w = window_loop (GET_LRU_WINDOW, Qnil, 0, which_frames, 1, which_devices); /* At this point we damn well better have found something. */ - if (NILP (w)) ABORT (); + assert (!NILP (w)); #endif return w; @@ -3482,8 +3470,8 @@ /* Return non-zero if both frame sizes are less than or equal to minimal allowed values. ROWS and COLS are in characters */ -int -frame_size_valid_p (struct frame *frame, int rows, int cols) +static int +frame_size_valid_p (struct frame *frame, int cols, int rows) { return (rows >= frame_min_height (frame) && cols >= MIN_SAFE_WINDOW_WIDTH); @@ -3495,21 +3483,30 @@ frame_pixsize_valid_p (struct frame *frame, int width, int height) { int rows, cols; - pixel_to_real_char_size (frame, width, height, &cols, &rows); - return frame_size_valid_p (frame, rows, cols); + pixel_to_char_size (frame, width, height, &cols, &rows); + return frame_size_valid_p (frame, cols, rows); } /* If *ROWS or *COLS are too small a size for FRAME, set them to the minimum allowable size. */ void -check_frame_size (struct frame *frame, int *rows, int *cols) +check_frame_size (struct frame *frame, int *cols, int *rows) { int min_height = frame_min_height (frame); - - if (*rows < min_height) - *rows = min_height; - if (*cols < MIN_SAFE_WINDOW_WIDTH) - *cols = MIN_SAFE_WINDOW_WIDTH; + int min_pixwidth, min_pixheight; + int min_geomwidth, min_geomheight; + + /* There is no char_to_frame_unit_size(). This can be done with + frame_conversion_internal(), but that's currently static, and we can + do it fine with two steps, as follows. */ + char_to_pixel_size (frame, MIN_SAFE_WINDOW_WIDTH, min_height, + &min_pixwidth, &min_pixheight); + pixel_to_frame_unit_size (frame, min_pixwidth, min_pixheight, + &min_geomwidth, &min_geomheight); + if (*rows < min_geomheight) + *rows = min_geomheight; + if (*cols < min_geomwidth) + *cols = min_geomwidth; } /* Normally the window is deleted if it gets too small. @@ -3528,7 +3525,7 @@ int line_size; int defheight, defwidth; - default_face_height_and_width (window, &defheight, &defwidth); + default_face_width_and_height (window, &defwidth, &defheight); line_size = (set_height ? defheight : defwidth); check_min_window_sizes (); @@ -3758,6 +3755,11 @@ Fset_buffer (buffer); } + if (NILP (XBUFFER (buffer)->display_count)) + XBUFFER (buffer)->display_count = make_int (1); + else + XBUFFER (buffer)->display_count = make_int (1 + XINT (XBUFFER (buffer)->display_count)); + XBUFFER (buffer)->display_time = Fcurrent_time(); return Qnil; } @@ -3870,12 +3872,11 @@ static void make_dummy_parent (Lisp_Object window) { - Lisp_Object new_; struct window *o = XWINDOW (window); - struct window *p = ALLOC_LCRECORD_TYPE (struct window, &lrecord_window); - - new_ = wrap_window (p); - COPY_LCRECORD (p, o); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (window); + struct window *p = XWINDOW (obj); + + copy_lisp_object (obj, window); /* Don't copy the pointers to the line start cache or the face instances. */ @@ -3895,13 +3896,13 @@ make_image_instance_cache_hash_table (); /* Put new into window structure in place of window */ - replace_window (window, new_); + replace_window (window, obj); o->next = Qnil; o->prev = Qnil; o->vchild = Qnil; o->hchild = Qnil; - o->parent = new_; + o->parent = obj; p->start[CURRENT_DISP] = Qnil; p->start[DESIRED_DISP] = Qnil; @@ -4132,7 +4133,7 @@ window_top_window_gutter_height (w) + window_bottom_window_gutter_height (w))); - default_face_height_and_width (window, &defheight, &defwidth); + default_face_width_and_height (window, &defwidth, &defheight); if (defheight) char_height = avail_height / defheight; @@ -4156,7 +4157,7 @@ Lisp_Object window = wrap_window (w); - default_face_height_and_width (window, &defheight, &defwidth); + default_face_width_and_height (window, &defwidth, &defheight); avail_height = char_height * defheight; pixel_height = (avail_height + @@ -4236,7 +4237,7 @@ } } - default_face_height_and_width (window, &defheight, &defwidth); + default_face_width_and_height (window, &defwidth, &defheight); /* #### This probably needs to know about the clipping area once a final definition is decided on. */ if (defheight) @@ -4279,7 +4280,7 @@ (include_margins_p ? 0 : window_left_margin_width (w)) - (include_margins_p ? 0 : window_right_margin_width (w))); - default_face_height_and_width (window, &defheight, &defwidth); + default_face_width_and_height (window, &defwidth, &defheight); if (defwidth) char_width = (avail_width / defwidth); @@ -4302,7 +4303,7 @@ Lisp_Object window = wrap_window (w); - default_face_height_and_width (window, &defheight, &defwidth); + default_face_width_and_height (window, &defwidth, &defheight); avail_width = char_width * defwidth; pixel_width = (avail_width + @@ -4385,7 +4386,7 @@ if (EQ (window, FRAME_ROOT_WINDOW (f))) invalid_operation ("Won't change only window", Qunbound); - default_face_height_and_width (window, &defheight, &defwidth); + default_face_width_and_height (window, &defwidth, &defheight); while (1) { @@ -4614,7 +4615,7 @@ if (INTP (Vwindow_pixel_scroll_increment)) fheight = XINT (Vwindow_pixel_scroll_increment); else if (!NILP (Vwindow_pixel_scroll_increment)) - default_face_height_and_width (window, &fheight, &fwidth); + default_face_width_and_height (window, &fwidth, &fheight); if (Dynarr_length (dla) >= 1) modeline = Dynarr_begin (dla)->modeline; @@ -5164,103 +5165,106 @@ #ifdef MEMORY_USAGE_STATS -struct window_stats -{ - int face; - int glyph; +struct window_mirror_stats +{ + struct usage_stats u; + /* Ancillary non-lisp */ + Bytecount redisplay_structs; #ifdef HAVE_SCROLLBARS - int scrollbar; + /* Ancillary Lisp */ + Bytecount scrollbar; #endif - int line_start; - int other_redisplay; - int other; +}; + +struct window_stats +{ + struct usage_stats u; + /* Ancillary non-Lisp */ + Bytecount line_start; + /* The next two: ancillary non-Lisp under old-GC, ancillary Lisp under + NEW_GC */ + Bytecount face; + Bytecount glyph; + /* The next two are copied out of the window mirror, which is an ancillary + Lisp structure; the first is non-Lisp, the second Lisp, but from our + perspective, they are both counted as Lisp */ + Bytecount redisplay_structs; +#ifdef HAVE_SCROLLBARS + Bytecount scrollbar; +#endif + /* Remaining memory associated with window mirror (ancillary Lisp) */ + Bytecount window_mirror; }; static void compute_window_mirror_usage (struct window_mirror *mir, - struct window_stats *stats, - struct overhead_stats *ovstats) -{ - if (!mir) - return; - stats->other += LISPOBJ_STORAGE_SIZE (mir, sizeof (*mir), ovstats); + struct window_mirror_stats *stats) +{ + stats->redisplay_structs = + compute_display_line_dynarr_usage (mir->current_display_lines, &stats->u) + + + compute_display_line_dynarr_usage (mir->desired_display_lines, &stats->u); #ifdef HAVE_SCROLLBARS - { - struct device *d = XDEVICE (FRAME_DEVICE (mir->frame)); - - stats->scrollbar += - compute_scrollbar_instance_usage (d, mir->scrollbar_vertical_instance, - ovstats); - stats->scrollbar += - compute_scrollbar_instance_usage (d, mir->scrollbar_horizontal_instance, - ovstats); - } + stats->scrollbar = + compute_all_scrollbar_instance_usage (mir->scrollbar_vertical_instance) + + compute_all_scrollbar_instance_usage (mir->scrollbar_horizontal_instance); #endif /* HAVE_SCROLLBARS */ - stats->other_redisplay += - compute_display_line_dynarr_usage (mir->current_display_lines, ovstats); - stats->other_redisplay += - compute_display_line_dynarr_usage (mir->desired_display_lines, ovstats); +} + + +static void +window_mirror_memory_usage (Lisp_Object window_mirror, + struct generic_usage_stats *gustats) +{ + struct window_mirror_stats *stats = (struct window_mirror_stats *) gustats; + + compute_window_mirror_usage (XWINDOW_MIRROR (window_mirror), stats); } static void compute_window_usage (struct window *w, struct window_stats *stats, - struct overhead_stats *ovstats) -{ - xzero (*stats); - stats->other += LISPOBJ_STORAGE_SIZE (w, sizeof (*w), ovstats); - stats->face += compute_face_cachel_usage (w->face_cachels, ovstats); - stats->glyph += compute_glyph_cachel_usage (w->glyph_cachels, ovstats); - stats->line_start += - compute_line_start_cache_dynarr_usage (w->line_start_cache, ovstats); - compute_window_mirror_usage (find_window_mirror (w), stats, ovstats); + struct usage_stats *ustats) +{ + stats->line_start = + compute_line_start_cache_dynarr_usage (w->line_start_cache, ustats); + stats->face = compute_face_cachel_usage (w->face_cachels, + ustats); + stats->glyph = compute_glyph_cachel_usage (w->glyph_cachels, + ustats); + { + struct window_mirror *wm; + + wm = find_window_mirror_maybe (w); + if (wm) + { + struct generic_usage_stats gustats; + struct window_mirror_stats *wmstats; + Bytecount total; + total = lisp_object_memory_usage_full (wrap_window_mirror (wm), + NULL, NULL, NULL, &gustats); + wmstats = (struct window_mirror_stats *) &gustats; + stats->redisplay_structs = wmstats->redisplay_structs; + total -= stats->redisplay_structs; +#ifdef HAVE_SCROLLBARS + stats->scrollbar = wmstats->scrollbar; + total -= stats->scrollbar; +#endif + stats->window_mirror = total; + } + } } -DEFUN ("window-memory-usage", Fwindow_memory_usage, 1, 1, 0, /* -Return stats about the memory usage of window WINDOW. -The values returned are in the form of an alist of usage types and byte -counts. The byte counts attempt to encompass all the memory used -by the window (separate from the memory logically associated with a -buffer or frame), including internal structures and any malloc() -overhead associated with them. In practice, the byte counts are -underestimated because certain memory usage is very hard to determine -\(e.g. the amount of memory used inside the Xt library or inside the -X server) and because there is other stuff that might logically -be associated with a window, buffer, or frame (e.g. window configurations, -glyphs) but should not obviously be included in the usage counts. - -Multiple slices of the total memory usage may be returned, separated -by a nil. Each slice represents a particular view of the memory, a -particular way of partitioning it into groups. Within a slice, there -is no overlap between the groups of memory, and each slice collectively -represents all the memory concerned. -*/ - (window)) -{ - struct window_stats stats; - struct overhead_stats ovstats; - Lisp_Object val = Qnil; - - CHECK_WINDOW (window); /* dead windows should be allowed, no? */ - xzero (ovstats); - compute_window_usage (XWINDOW (window), &stats, &ovstats); - - val = acons (Qface_cache, make_int (stats.face), val); - val = acons (Qglyph_cache, make_int (stats.glyph), val); -#ifdef HAVE_SCROLLBARS - val = acons (Qscrollbar_instances, make_int (stats.scrollbar), val); -#endif - val = acons (Qline_start_cache, make_int (stats.line_start), val); - val = acons (Qother_redisplay, make_int (stats.other_redisplay), val); - val = acons (Qother, make_int (stats.other), val); - val = Fcons (Qnil, val); - val = acons (Qactually_requested, make_int (ovstats.was_requested), val); - val = acons (Qmalloc_overhead, make_int (ovstats.malloc_overhead), val); - val = acons (Qdynarr_overhead, make_int (ovstats.dynarr_overhead), val); - - return Fnreverse (val); +static void +window_memory_usage (Lisp_Object window, struct generic_usage_stats *gustats) +{ + struct window_stats *stats = (struct window_stats *) gustats; + + compute_window_usage (XWINDOW (window), stats, &stats->u); } #endif /* MEMORY_USAGE_STATS */ + + /* Mark all subwindows of a window as deleted. The argument W is actually the subwindow tree of the window in question. */ @@ -5414,7 +5418,7 @@ if (!NILP (buffer) && BUFFERP (buffer)) stderr_out (" on %s", XSTRING_DATA (XBUFFER (buffer)->name)); } - stderr_out (" 0x%x>", XWINDOW (window)->header.uid); + stderr_out (" 0x%x>", LISP_OBJECT_UID (window)); while (!NILP (child)) { @@ -5438,15 +5442,24 @@ /************************************************************************/ void +window_objects_create (void) +{ +#ifdef MEMORY_USAGE_STATS + OBJECT_HAS_METHOD (window, memory_usage); + OBJECT_HAS_METHOD (window_mirror, memory_usage); +#endif +} + +void syms_of_window (void) { - INIT_LRECORD_IMPLEMENTATION (window); - INIT_LRECORD_IMPLEMENTATION (window_mirror); + INIT_LISP_OBJECT (window); + INIT_LISP_OBJECT (window_mirror); #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (face_cachel); - INIT_LRECORD_IMPLEMENTATION (face_cachel_dynarr); - INIT_LRECORD_IMPLEMENTATION (glyph_cachel); - INIT_LRECORD_IMPLEMENTATION (glyph_cachel_dynarr); + INIT_LISP_OBJECT (face_cachel); + INIT_LISP_OBJECT (face_cachel_dynarr); + INIT_LISP_OBJECT (glyph_cachel); + INIT_LISP_OBJECT (glyph_cachel_dynarr); #endif /* NEW_GC */ DEFSYMBOL (Qwindowp); @@ -5460,8 +5473,7 @@ #ifdef HAVE_SCROLLBARS DEFSYMBOL (Qscrollbar_instances); #endif - DEFSYMBOL (Qother_redisplay); - /* Qother in general.c */ + DEFSYMBOL (Qredisplay_structs); #endif DEFSYMBOL (Qtruncate_partial_width_windows); @@ -5539,9 +5551,6 @@ DEFSUBR (Fscroll_other_window); DEFSUBR (Fcenter_to_window_line); DEFSUBR (Fmove_to_window_line); -#ifdef MEMORY_USAGE_STATS - DEFSUBR (Fwindow_memory_usage); -#endif DEFSUBR (Fcurrent_pixel_column); DEFSUBR (Fcurrent_pixel_row); } @@ -5557,6 +5566,34 @@ void vars_of_window (void) { +#ifdef MEMORY_USAGE_STATS + Lisp_Object l; + + l = listu (Qline_start_cache, +#ifdef NEW_GC + Qt, +#endif + Qface_cache, Qglyph_cache, +#ifndef NEW_GC + Qt, +#endif + Qredisplay_structs, +#ifdef HAVE_SCROLLBARS + Qscrollbar_instances, +#endif + intern ("window-mirror"), + Qunbound); + + OBJECT_HAS_PROPERTY (window, memusage_stats_list, l); + + l = listu (Qredisplay_structs, +#ifdef HAVE_SCROLLBARS + Qt, Qscrollbar_instances, +#endif + Qunbound); + OBJECT_HAS_PROPERTY (window_mirror, memusage_stats_list, l); +#endif /* MEMORY_USAGE_STATS */ + DEFVAR_BOOL ("scroll-on-clipped-lines", &scroll_on_clipped_lines /* *Non-nil means to scroll if point lands on a line which is clipped. */ ); diff -r 861f2601a38b -r 1f0b15040456 src/window.h --- a/src/window.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/window.h Sun May 01 18:44:03 2011 +0100 @@ -2,15 +2,15 @@ Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2002 Ben Wing. + Copyright (C) 1995, 1996, 2002, 2010 Ben Wing. Copyright (C) 1996 Chuck Thompson. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -18,9 +18,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: FSF 19.30. */ @@ -34,7 +32,7 @@ struct window; -DECLARE_LRECORD (window, struct window); +DECLARE_LISP_OBJECT (window, struct window); #define XWINDOW(x) XRECORD (x, window, struct window) #define wrap_window(p) wrap_record (p, window) #define WINDOWP(x) RECORDP (x, window) @@ -81,15 +79,13 @@ struct window_mirror; -DECLARE_LRECORD (window_mirror, struct window_mirror); +DECLARE_LISP_OBJECT (window_mirror, struct window_mirror); #define XWINDOW_MIRROR(x) XRECORD (x, window_mirror, struct window_mirror) #define wrap_window_mirror(p) wrap_record (p, window_mirror) #define WINDOW_MIRRORP(x) RECORDP (x, window_mirror) #define CHECK_WINDOW_MIRROR(x) CHECK_RECORD (x, window_mirror) #define CONCHECK_WINDOW_MIRROR(x) CONCHECK_RECORD (x, window_mirror) -DECLARE_LRECORD (window_configuration, struct window_config); - EXFUN (Fget_buffer_window, 3); EXFUN (Fmove_to_window_line, 2); EXFUN (Frecenter, 2); @@ -148,9 +144,8 @@ Error_Behavior errb); int buffer_window_count (struct buffer *b, struct frame *f); int buffer_window_mru (struct window *w); -void check_frame_size (struct frame *frame, int *rows, int *cols); +void check_frame_size (struct frame *frame, int *cols, int *rows); int frame_pixsize_valid_p (struct frame *frame, int width, int height); -int frame_size_valid_p (struct frame *frame, int rows, int cols); struct window *decode_window (Lisp_Object window); struct window *find_window_by_pixel_pos (int pix_x, int pix_y, Lisp_Object win); diff -r 861f2601a38b -r 1f0b15040456 src/winslots.h --- a/src/winslots.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/winslots.h Sun May 01 18:44:03 2011 +0100 @@ -6,10 +6,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -17,9 +17,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Split out of window.h and window.c by Kirill Katsnelson , May 1998 */ diff -r 861f2601a38b -r 1f0b15040456 src/xemacs.def.in.in --- a/src/xemacs.def.in.in Sat Feb 20 06:03:00 2010 -0600 +++ b/src/xemacs.def.in.in Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,18 @@ 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 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 3 of the License, 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. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to the -Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -Boston, MA 02110-1301, USA. */ +along with XEmacs. If not, see . */ /* The symbol to import/export is on the left. If the symbol is not meant to be used directly, but a macro or inline function in the @@ -34,9 +32,9 @@ NAME xemacs.exe EXPORTS /* Exported functions */ -acons #ifdef NEW_GC -alloc_lrecord /* alloc_lrecord_type */ +alloc_lrecord /* ALLOC_LISP_OBJECT */ +alloc_sized_lrecord /* ALLOC_SIZED_LISP_OBJECT */ lrecord_subr /* DEFSUBR */ lrecord_symbol_value_forward /* DEFVAR_SYMVAL_FWD */ #ifdef DEBUG_XEMACS @@ -44,7 +42,8 @@ #endif mc_alloc /* DEFSUBR */ #else /* not NEW_GC */ -alloc_automanaged_lcrecord /* old_alloc_lcrecord_type */ +alloc_automanaged_lcrecord /* ALLOC_LISP_OBJECT */ +old_alloc_sized_lcrecord /* ALLOC_SIZED_LISP_OBJECT */ #endif /* not NEW_GC */ apply1 #ifdef USE_ASSERTIONS @@ -128,6 +127,7 @@ error_check_string_direct_data error_check_string_indirect_data #endif +error_check_symbol_value_forward #endif /* XEMACS_DEFS_NEEDS_ERROR_CHECK_TYPES_DECLS */ free_opaque_ptr get_coding_system_for_text_file @@ -161,7 +161,8 @@ non_ascii_valid_ichar_p /* valid_ichar_p */ #endif out_of_memory /* The postgresql module uses this */ -printing_unreadable_object +printing_unreadable_lisp_object +printing_unreadable_object_fmt #ifdef XEMACS_DEFS_NEEDS_INLINE_DECLS qxestrdup qxestrlen @@ -245,6 +246,7 @@ Dynarr_insert_many /* Dynarr_add_{literal,lisp}_string */ Dynarr_newf /* Dynarr_new, Dynarr_new2 */ Dynarr_resize /* Dynarr_add */ +Facons Fappend Fapply Fbuffer_modified_p @@ -310,6 +312,7 @@ Qconsp /* CHECK_CONS */ Qcritical /* QUIT, QUITP */ Qdelete +Qfixnump /* CHECK_INT */ Qfile_name /* Qdll_filename_encoding */ Qintegerp /* CHECK_INT, CONCHECK_INT */ Qinvalid_argument diff -r 861f2601a38b -r 1f0b15040456 src/xintrinsic.h --- a/src/xintrinsic.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/xintrinsic.h Sun May 01 18:44:03 2011 +0100 @@ -2,10 +2,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -13,9 +13,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/xintrinsicp.h --- a/src/xintrinsicp.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/xintrinsicp.h Sun May 01 18:44:03 2011 +0100 @@ -2,10 +2,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -13,9 +13,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/xmmanagerp.h --- a/src/xmmanagerp.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/xmmanagerp.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/xmotif.h --- a/src/xmotif.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/xmotif.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 src/xmprimitivep.h --- a/src/xmprimitivep.h Sat Feb 20 06:03:00 2010 -0600 +++ b/src/xmprimitivep.h Sun May 01 18:44:03 2011 +0100 @@ -3,10 +3,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -14,9 +14,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ diff -r 861f2601a38b -r 1f0b15040456 tests/ChangeLog --- a/tests/ChangeLog Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/ChangeLog Sun May 01 18:44:03 2011 +0100 @@ -1,3 +1,400 @@ +2011-05-01 Aidan Kehoe + + * automated/lisp-reader-tests.el: + If the bignum feature is available, check that a leading plus sign + is treated correctly when reading bignum integers. + +2011-04-29 Stephen J. Turnbull + + * XEmacs 21.5.31 "ginger" is released. + +2011-04-26 Stephen J. Turnbull + + * XEmacs 21.5.30 "garlic" is released. + +2011-04-24 Aidan Kehoe + + * automated/lisp-tests.el: + Check that distinct symbol macros with identical string names + expand to different things. + +2011-03-24 Jerry James + + * automated/query-coding-tests.el: "Compatiblity" -> "Compatibility". + * gtk/event-stream-tests.el: "proccess" -> "process". + +2011-03-17 Aidan Kehoe + + * automated/lisp-tests.el: + Only test the various old-* function if old-eq is bound and a + subr. + +2011-03-11 Aidan Kehoe + + * automated/byte-compiler-tests.el: + (defconst :foo 1) now gives a warning when byte-compiled, check + for that. + (setq :foo 1) now errors with interpreted code, but succeeds with + byte-compiled code; check for the former, wrap a + Known-Bug-Expect-Failure around a check for the error in the + latter case, we can't yet remove this behaviour while we're using + packages compiled by 21.4. + * automated/lisp-tests.el (wrong-type-argument): + Integer zero is a valid argument to #'substring-no-properties, use + Assert not Check-Error for it. Check some other aspects of the + functionality of #'substring-no-properties in passing. + +2011-02-24 Aidan Kehoe + + * automated/lisp-tests.el (substring-no-properties): + Make sure this function checks its arguments' types, the absence + of which was revealed by Raymond Toy's bug report of + http://mid.gmane.org/4D65D413.5050103@gmail.com . + +2011-02-10 Aidan Kehoe + + * automated/lisp-tests.el: + * automated/lisp-tests.el (mapcar*): + If multiple SEQUENCE arguments are passed to #'mapcar*, and the + last one is circular while the others aren't, make sure that + #'mapcar* doesn't error. + +2011-02-07 Aidan Kehoe + + * automated/lisp-tests.el: + Test lexical scope for `block', `return-from'; add a + Known-Bug-Expect-Failure for a contorted example that fails when + byte-compiled. + +2011-01-23 Aidan Kehoe + + * automated/lisp-tests.el: + When sanity-checking :start and :end keyword arguments, loop at + macroexpansion time, not runtime, allowing us to pick up any + compiler macros and giving a clearer *Test-Log* buffer. + +2011-01-23 Aidan Kehoe + + * automated/lisp-tests.el (test-fun): + #'delete* and friends can now throw a wrong-type-argument if + handed a non-sequence; accept this too when checking for an error + when passing a fixnum as the SEQUENCE argument. + Check #'remove*, #'remove and #'remq too. + +2011-01-15 Aidan Kehoe + + * automated/lisp-tests.el (list): Test #'concatenate, especially + with more complicated TYPEs, which were previously not accepted by + the function. + +2011-01-14 Aidan Kehoe + + * automated/lisp-tests.el (list): Test #'find, especially the + :default keyword, not specified by Common Lisp. + +2011-01-02 Aidan Kehoe + + * automated/lisp-tests.el (test-fun): Test member*, assoc*, + rassoc*, delete* here too. + +2010-12-30 Aidan Kehoe + + * automated/lisp-tests.el (wrong-type-argument): Add a missing + parenthesis here. + Make sure #'count #'position #'find #'delete* #'remove* #'reduce + #'delete-duplicates #'remove-duplicates #'replace #'mismatch + #'search sanity check their :start and :end keyword arguments. + +2010-11-20 Aidan Kehoe + + * automated/lisp-tests.el: + * automated/lisp-tests.el (featurep): + * automated/lisp-tests.el (wrong-type-argument): + * automated/mule-tests.el (featurep): + Check for args-out-of-range errors instead of wrong-type-argument + errors in various places when code is handed a large bignum + instead of a fixnum. + Also check for the wrong-type-argument errors when giving the same + code a non-integer value. + +2010-11-06 Aidan Kehoe + + * automated/lisp-tests.el (list-nreverse): + Check that #'reverse and #'nreverse handle non-list sequences + properly. + +2010-11-06 Aidan Kehoe + + * automated/lisp-tests.el (malformed-list): Check that #'mapcar, + #'map and #'list-length throw this error when appropriate. + +2010-10-25 Aidan Kehoe + + * automated/lisp-tests.el: + Test format strings with %b, too. + +2010-06-14 Stephen J. Turnbull + + * automated/lisp-reader-tests.el: + Change references to SXEmacs to XEmacs. + +2010-06-14 Stephen J. Turnbull + + * gtk/xemacs-toolbar.el: + * gtk/toolbar-test.el: + * gtk/statusbar-test.el: + * gtk/gtk-extra-test.el: + * gtk/gtk-embedded-test.el: + * gtk/gnome-test.el: + * gtk/event-stream-tests.el: + Add copyright notice based on internal evidence. + +2010-06-14 Stephen J. Turnbull + + * reproduce-crashes.el: Amend "this file" to "XEmacs is free...". + +2010-10-14 Aidan Kehoe + + * automated/lisp-tests.el (x): + Test #'nbutlast, #'butlast with dotted lists. + Check that #'ldiff and #'tailp don't hang on circular lists; check + that #'tailp returns t with circular lists when that is + appropriate. Test them both with dotted lists. + +2010-10-12 Aidan Kehoe + + * automated/lisp-tests.el: + Make sure circularity checking with #'merge is sane. + +2010-08-15 Aidan Kehoe + + * automated/lisp-tests.el: + (not, not, invalid-argument, invalid-argument): + Check that error messages from the image specifier instantiator + code are clearer than they used to be. + +2010-08-15 Aidan Kehoe + + * automated/lisp-tests.el: + Test that symbols with names that look like ratios are printed + distinctly from the equivalent ratios. + +2010-07-24 Aidan Kehoe + + * automated/lisp-tests.el: + Test a couple of things #'reduce was just made more careful + about. + +2010-06-13 Stephen J. Turnbull + + * gtk/event-stream-tests.el: + * gtk/gnome-test.el: + * gtk/gtk-embedded-test.el: + * gtk/gtk-extra-test.el: + * gtk/statusbar-test.el: + * gtk/toolbar-test.el: + * gtk/xemacs-toolbar.el: + Correct FSF address in permission notice. + +2010-06-02 Aidan Kehoe + + * gtk/gtk-test.el (gtk-test): + Remove a conditional for InfoDock. + +2010-04-05 Aidan Kehoe + + * automated/hash-table-tests.el: + Test the new built-in #'equalp hash table test. Test + #'define-hash-table-test. + * automated/lisp-tests.el: + When asserting that two objects are #'equalp, also assert that + their #'equalp-hash is identical. + +2010-04-03 Aidan Kehoe + + * automated/lisp-tests.el: + Correct the parentheses in the equalp tests, so they get run more + often. + Within them, only attempt to read a bignum if the bignum + feature is present; actually evaluate (/ 3/2 0.2), (/ 3/2 0.7) if + the ratio feature is present. + Construct the (Assert ...) calls at + macroexpansion time, so the output in the *Test-Log* buffer is + more informative. + +2010-03-18 Ben Wing + + * automated/c-tests.el: + * automated/c-tests.el (when): + Use `with-temp-buffer' so results don't get written into source + file. + +2010-03-12 Ben Wing + + * automated/base64-tests.el (bt-base64-encode-string): + * automated/base64-tests.el (bt-base64-decode-string): + * automated/base64-tests.el (for): + * automated/byte-compiler-tests.el: + * automated/byte-compiler-tests.el (before-and-after-compile-equal): + * automated/case-tests.el (downcase-string): + * automated/case-tests.el (uni-mappings): + * automated/ccl-tests.el (ccl-test-normal-expr): + * automated/ccl-tests.el (ccl-test-map-instructions): + * automated/ccl-tests.el (ccl-test-suites): + * automated/database-tests.el (delete-database-files): + * automated/extent-tests.el (let): + * automated/extent-tests.el (insert): + * automated/extent-tests.el (props): + * automated/file-tests.el: + * automated/file-tests.el (for): + * automated/hash-table-tests.el (test): + * automated/hash-table-tests.el (for): + * automated/hash-table-tests.el (ht): + * automated/hash-table-tests.el (iterations): + * automated/hash-table-tests.el (h1): + * automated/hash-table-tests.el (equal): + * automated/hash-table-tests.el (=): + * automated/lisp-tests.el: + * automated/lisp-tests.el (eq): + * automated/lisp-tests.el (test-setq): + * automated/lisp-tests.el (my-vector): + * automated/lisp-tests.el (x): + * automated/lisp-tests.el (equal): + * automated/lisp-tests.el (y): + * automated/lisp-tests.el (featurep): + * automated/lisp-tests.el (=): + * automated/lisp-tests.el (six): + * automated/lisp-tests.el (three): + * automated/lisp-tests.el (one): + * automated/lisp-tests.el (two): + * automated/lisp-tests.el (five): + * automated/lisp-tests.el (test1): + * automated/lisp-tests.el (division-test): + * automated/lisp-tests.el (for): + * automated/lisp-tests.el (check-function-argcounts): + * automated/lisp-tests.el (z): + * automated/lisp-tests.el (eql): + * automated/lisp-tests.el (test-harness-risk-infloops): + * automated/lisp-tests.el (erase-buffer): + * automated/lisp-tests.el (sym): + * automated/lisp-tests.el (new-char): + * automated/lisp-tests.el (new-load-file-name): + * automated/lisp-tests.el (cl-floor): + * automated/lisp-tests.el (foo): + * automated/md5-tests.el (lambda): + * automated/md5-tests.el (large-string): + * automated/md5-tests.el (mapcar): + * automated/md5-tests.el (insert): + * automated/mule-tests.el: + * automated/mule-tests.el (test-chars): + * automated/mule-tests.el (existing-file-name): + * automated/mule-tests.el (featurep): + * automated/query-coding-tests.el (featurep): + * automated/regexp-tests.el: + * automated/regexp-tests.el (insert): + * automated/regexp-tests.el (Assert): + * automated/regexp-tests.el (=): + * automated/regexp-tests.el (featurep): + * automated/regexp-tests.el (text): + * automated/regexp-tests.el (text1): + * automated/regexp-tests.el ("aáa"): + * automated/regexp-tests.el (eql): + * automated/search-tests.el (insert): + * automated/search-tests.el (featurep): + * automated/search-tests.el (let): + * automated/search-tests.el (boundp): + * automated/symbol-tests.el: + * automated/symbol-tests.el (name): + * automated/symbol-tests.el (check-weak-list-unique): + * automated/symbol-tests.el (string): + * automated/symbol-tests.el (list): + * automated/symbol-tests.el (foo): + * automated/symbol-tests.el (eq): + * automated/symbol-tests.el (fresh-keyword-name): + * automated/symbol-tests.el (print-gensym): + * automated/symbol-tests.el (mysym): + * automated/syntax-tests.el (test-forward-word): + * automated/syntax-tests.el (test-backward-word): + * automated/syntax-tests.el (test-syntax-table): + * automated/syntax-tests.el (with-syntax-table): + * automated/syntax-tests.el (Skip-Test-Unless): + * automated/syntax-tests.el (with): + * automated/tag-tests.el (testfile): + * automated/weak-tests.el (w): + * automated/weak-tests.el (p): + * automated/weak-tests.el (a): + Undo change of e.g. (Assert (equalp ...)) to (Assert-equalp ...). + Get rid of `Assert-equalp' and friends, `Assert-test', and + `Assert-test-not'. Instead, make `Assert' smart enough to do the + equivalent functionality when an expression like (Assert (equalp ...)) + is seen. + +2010-03-07 Stephen J. Turnbull + + * automated/mule-tests.el (string character conversion): + Test escape-quoted for the range U+0000 to U+00FF. + Inspired by Ben's patch to fix quoting of specials from C1 controls. + +2010-02-22 Ben Wing + + * reproduce-crashes.el (8): + objects*.[ch] -> fontcolor*.[ch]. + +2010-02-22 Ben Wing + + * automated/syntax-tests.el: + Use Known-Bug-Expect-Error, not Known-Bug-Expect-Failure, when + error expected; else test suite will abort this file. + +2010-02-22 Ben Wing + + * automated/test-harness.el (test-harness-from-buffer): + Remove unused binding. + +2010-02-15 Ben Wing + + * automated/search-tests.el (let): + * automated/search-tests.el (boundp): + debug-xemacs-searches renamed to debug-searches. + +2010-02-20 Ben Wing + + * automated/test-harness.el: + * automated/test-harness.el (test-harness-bug-expected): New. + * automated/test-harness.el (test-harness-unexpected-error-enter-debugger): New. + * automated/test-harness.el (test-harness-assertion-failure-enter-debugger): New. + * automated/test-harness.el (test-harness-unexpected-error-show-backtrace): New. + * automated/test-harness.el (test-harness-assertion-failure-show-backtrace): New. + * automated/test-harness.el (test-harness-assertion-failure-do-debug): New. + * automated/test-harness.el (test-harness-unexpected-error-do-debug): New. + * automated/test-harness.el (test-harness-unexpected-error-condition-handler): New. + * automated/test-harness.el (test-harness-error-wrap): New. + * automated/test-harness.el (test-harness-from-buffer): + New variables that allow a backtrace to be displayed and/or the + debugger to be entered when an assertion failure or unexpected error + occurs. By default, debugging occurs when interactive and debug-on-error + is set, and backtrace-displaying occurs either + (a) when stack-trace-on-error is set, or (b) always, when an unexpected + error occurs. (However, no backtracing or debugging occurs when a bug + is expected.) + +2010-02-19 Aidan Kehoe + + * automated/lisp-tests.el: + Change the #'split-string-by-char text to use US federal + government information instead of a couple of sentences from the + OED; the latter would probably have qualified as non-infringement, + but with the former the question won't arise. + (The German text in the same tests is from a very public domain + 19th-century work.) + +2010-02-19 Aidan Kehoe + + * automated/lisp-tests.el: + Check that multiple values are discarded correctly with #'mapcar + and one SEQUENCE. + (equal): + 2010-02-05 Jerry James * DLL/dltest.c: Remove old test. Building and using any module now @@ -268,6 +665,11 @@ * automated/mule-tests.el (featurep): Use utf-8 as file-name-coding-system under Cygwin 1.7+. +2010-02-07 Aidan Kehoe + + * automated/lisp-tests.el (split-string-by-char): + Test this function, and its new ESCAPE-CHAR argument. + 2010-01-01 Aidan Kehoe * automated/lisp-tests.el: @@ -1673,3 +2075,22 @@ * ChangeLog: new file + +ChangeLog entries synched from GNU Emacs are the property of the FSF. +Other ChangeLog entries are usually the property of the author of the +change. + +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 3 of the License, 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. If not, see . diff -r 861f2601a38b -r 1f0b15040456 tests/Dnd/droptest.el --- a/tests/Dnd/droptest.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/Dnd/droptest.el Sun May 01 18:44:03 2011 +0100 @@ -1,6 +1,24 @@ ;; a short example how to use the new Drag'n'Drop API in ;; combination with extents. -;; + +;; Copyright (C) 1998 Oliver Graf + +;; 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 3 of the License, 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. If not, see . + +;;; Synched up with: Not in FSF. (defun dnd-drop-message (event object text) (message "Dropped %s with :%s" text object) diff -r 861f2601a38b -r 1f0b15040456 tests/Dnd/droptest.sh --- a/tests/Dnd/droptest.sh Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/Dnd/droptest.sh Sun May 01 18:44:03 2011 +0100 @@ -1,5 +1,24 @@ #!/bin/sh +# Copyright (C) 1998 Oliver Graf + +# 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 3 of the License, 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. If not, see . + +# Synched up with: Not in FSF. + TEMPDIR=/tmp cat README > $TEMPDIR/DropTest.txt diff -r 861f2601a38b -r 1f0b15040456 tests/autoconf/regressiontest.pl --- a/tests/autoconf/regressiontest.pl Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/autoconf/regressiontest.pl Sun May 01 18:44:03 2011 +0100 @@ -3,21 +3,19 @@ # Copyright 2005 Malcolm Purvis # # This file is part of XEmacs. -# -# XEmacs is free software; you can redistribute it and/or modify it +# +# 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. -# +# Free Software Foundation, either version 3 of the License, or (at your +# option) any later version. +# # XEmacs is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License # for more details. -# +# # You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301, USA. +# along with XEmacs. If not, see . # # Commentary # diff -r 861f2601a38b -r 1f0b15040456 tests/automated/base64-tests.el --- a/tests/automated/base64-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/base64-tests.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -52,8 +50,8 @@ (erase-buffer) (insert string) (setq length (base64-encode-region (point-min) (point-max) no-line-break)) - (Assert-eq length (- (point-max) (point-min))) - (Assert-equal (buffer-string) string-result) + (Assert (eq length (- (point-max) (point-min)))) + (Assert (equal (buffer-string) string-result)) ;; partial (erase-buffer) (insert "random junk........\0\0';'eqwrkw[erpqf") @@ -62,8 +60,8 @@ (setq p2 (point-marker)) (insert "...more random junk.q,f3/.qrm314.r,m2typ' 2436T@W$^@$#^T@") (setq length (base64-encode-region p1 p2 no-line-break)) - (Assert-eq length (- p2 p1)) - (Assert-equal (buffer-substring p1 p2) string-result))) + (Assert (eq length (- p2 p1))) + (Assert (equal (buffer-substring p1 p2) string-result)))) string-result)) (defun bt-base64-decode-string (string) @@ -75,12 +73,12 @@ (insert string) (setq length (base64-decode-region (point-min) (point-max))) (cond (string-result - (Assert-eq length (- (point-max) (point-min))) - (Assert-equal (buffer-string) string-result)) + (Assert (eq length (- (point-max) (point-min)))) + (Assert (equal (buffer-string) string-result))) (t (Assert (null length)) ;; The buffer should not have been modified. - (Assert-equal (buffer-string) string))) + (Assert (equal (buffer-string) string)))) ;; partial (erase-buffer) (insert "random junk........\0\0';'eqwrkw[erpqf") @@ -90,12 +88,12 @@ (insert "...more random junk.q,f3/.qrm314.\0\0r,m2typ' 2436T@W$^@$#T@") (setq length (base64-decode-region p1 p2)) (cond (string-result - (Assert-eq length (- p2 p1)) - (Assert-equal (buffer-substring p1 p2) string-result)) + (Assert (eq length (- p2 p1))) + (Assert (equal (buffer-substring p1 p2) string-result))) (t (Assert (null length)) ;; The buffer should not have been modified. - (Assert-equal (buffer-substring p1 p2) string))))) + (Assert (equal (buffer-substring p1 p2) string)))))) string-result)) (defun bt-remove-newlines (str) @@ -126,9 +124,9 @@ ;;----------------------------------------------------- (loop for (raw encoded) in bt-test-strings do - (Assert-equal (bt-base64-encode-string raw) encoded) + (Assert (equal (bt-base64-encode-string raw) encoded)) ;; test the NO-LINE-BREAK flag - (Assert-equal (bt-base64-encode-string raw t) (bt-remove-newlines encoded))) + (Assert (equal (bt-base64-encode-string raw t) (bt-remove-newlines encoded)))) ;; When Mule is around, Lisp programmers should make sure that the ;; buffer contains only characters whose `char-int' is in the [0, 256) @@ -150,8 +148,8 @@ ;;----------------------------------------------------- (loop for (raw encoded) in bt-test-strings do - (Assert-equal (bt-base64-decode-string encoded) raw) - (Assert-equal (bt-base64-decode-string (bt-remove-newlines encoded)) raw)) + (Assert (equal (bt-base64-decode-string encoded) raw)) + (Assert (equal (bt-base64-decode-string (bt-remove-newlines encoded)) raw))) ;; Test errors (dolist (str `("foo" "AAC" "foo\0bar" "====" "Zm=9v" ,bt-allchars)) @@ -182,7 +180,7 @@ ;; Whitespace at the beginning, end, and middle. (let ((mangled (concat bt-nonbase64-chars left bt-nonbase64-chars right bt-nonbase64-chars))) - (Assert-equal (bt-base64-decode-string mangled) raw)) + (Assert (equal (bt-base64-decode-string mangled) raw))) ;; Whitespace between every char. (let ((mangled (concat bt-nonbase64-chars @@ -191,7 +189,7 @@ (mapconcat #'char-to-string encoded (apply #'string bt-nonbase64-chars)) bt-nonbase64-chars))) - (Assert-equal (bt-base64-decode-string mangled) raw))))) + (Assert (equal (bt-base64-decode-string mangled) raw)))))) ;;----------------------------------------------------- ;; Mixed... @@ -205,22 +203,22 @@ ;; practically all aspects of the encoding and decoding process. (loop for (raw ignored) in bt-test-strings do - (Assert-equal (bt-base64-decode-string + (Assert (equal (bt-base64-decode-string (bt-base64-encode-string raw)) - raw) - (Assert-equal (bt-base64-decode-string + raw)) + (Assert (equal (bt-base64-decode-string (bt-base64-decode-string (bt-base64-encode-string (bt-base64-encode-string raw)))) - raw) - (Assert-equal (bt-base64-decode-string + raw)) + (Assert (equal (bt-base64-decode-string (bt-base64-decode-string (bt-base64-decode-string (bt-base64-encode-string (bt-base64-encode-string (bt-base64-encode-string raw)))))) - raw) - (Assert-equal (bt-base64-decode-string + raw)) + (Assert (equal (bt-base64-decode-string (bt-base64-decode-string (bt-base64-decode-string (bt-base64-decode-string @@ -228,8 +226,8 @@ (bt-base64-encode-string (bt-base64-encode-string (bt-base64-encode-string raw)))))))) - raw) - (Assert-equal (bt-base64-decode-string + raw)) + (Assert (equal (bt-base64-decode-string (bt-base64-decode-string (bt-base64-decode-string (bt-base64-decode-string @@ -239,4 +237,4 @@ (bt-base64-encode-string (bt-base64-encode-string (bt-base64-encode-string raw)))))))))) - raw)) + raw))) diff -r 861f2601a38b -r 1f0b15040456 tests/automated/byte-compiler-tests.el --- a/tests/automated/byte-compiler-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/byte-compiler-tests.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -45,7 +43,7 @@ (check-byte-compiler-message "Attempt to set non-symbol" (setq 1 1)) (check-byte-compiler-message "Attempt to set constant symbol" (setq t 1)) (check-byte-compiler-message "Attempt to set constant symbol" (setq nil 1)) -(check-byte-compiler-message "^$" (defconst :foo 1)) +(check-byte-compiler-message "Attempt to set constant symbol" (defconst :foo 1)) (check-byte-compiler-message "Attempt to let-bind non-symbol" (let ((1 'x)) 1)) (check-byte-compiler-message "Attempt to let-bind constant symbol" (let ((t 'x)) (foo))) @@ -60,12 +58,16 @@ (check-byte-compiler-message "reference to free variable" (car free-variable)) (check-byte-compiler-message "called with 2 args, but requires 1" (car 'x 'y)) -(check-byte-compiler-message "^$" (setq :foo 1)) (let ((fun '(lambda () (setq :foo 1)))) (fset 'test-byte-compiler-fun fun)) (Check-Error setting-constant (test-byte-compiler-fun)) -(byte-compile 'test-byte-compiler-fun) -(Check-Error setting-constant (test-byte-compiler-fun)) +(Check-Message "Attempt to set constant symbol" + (byte-compile 'test-byte-compiler-fun)) + +;; Once NEED_TO_HANDLE_21_4_CODE is no longer defined in C, this will error +;; correctly. It's disabled because the packages are compiled by 21.4. +(Known-Bug-Expect-Failure + (Check-Error setting-constant (test-byte-compiler-fun))) (eval-when-compile (defvar setq-test-foo nil) (defvar setq-test-bar nil)) (progn @@ -92,8 +94,8 @@ (eval '(let* ((x 1 2)) 3))) (defmacro before-and-after-compile-equal (&rest form) - `(Assert-equal (funcall (quote (lambda () ,@form))) - (funcall (byte-compile (quote (lambda () ,@form)))))) + `(Assert (equal (funcall (quote (lambda () ,@form))) + (funcall (byte-compile (quote (lambda () ,@form))))))) (defvar simplyamarker (point-min-marker)) diff -r 861f2601a38b -r 1f0b15040456 tests/automated/c-tests.el --- a/tests/automated/c-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/c-tests.el Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,5 @@ ;; Copyright (C) 2000 Martin Buchholz +;; Copyright (C) 2010 Ben Wing. ;; Author: Martin Buchholz ;; Maintainer: Martin Buchholz @@ -7,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -38,8 +37,9 @@ (push (file-name-directory load-file-name) load-path)) (require 'test-harness)))) -(when (boundp 'test-function-list) ; Only if configure --debug - (loop for fun in test-function-list do - ;; #### I hope there's no way we can signal ... - (loop for result in (funcall fun) do - (Assert (nth 1 result) (nth 2 result) (nth 0 result))))) +(with-temp-buffer + (when (boundp 'test-function-list) ; Only if configure --debug + (loop for fun in test-function-list do + ;; #### I hope there's no way we can signal ... + (loop for result in (funcall fun) do + (Assert (nth 1 result) (nth 2 result) (nth 0 result)))))) diff -r 861f2601a38b -r 1f0b15040456 tests/automated/case-tests.el --- a/tests/automated/case-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/case-tests.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -109,10 +107,10 @@ "¡¢£€¥Š§š©ª«¬­®¯°±²³Žµ¶·ž¹º»ŒœŸ¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ")) (table (standard-case-table))) (dotimes (i 256) - (Assert-eq (get-case-table 'downcase (int-to-char i) table) - (aref downcase-string i)) - (Assert-eq (get-case-table 'upcase (int-to-char i) table) - (aref upcase-string i)))) + (Assert (eq (get-case-table 'downcase (int-to-char i) table) + (aref downcase-string i))) + (Assert (eq (get-case-table 'upcase (int-to-char i) table) + (aref upcase-string i))))) (Check-Error-Message error "Char case must be downcase or upcase" (get-case-table 'foo ?a (standard-case-table))) @@ -1507,19 +1505,19 @@ ;; using downcase and upcase, however, won't necessarily work in ;; the presence of such mappings -- that's what the internal canon ;; and eqv tables are for. - (Assert-equalp lowermulti uppermulti) - (Assert-equalp loweruppermulti upperlowermulti) - (Assert-equal lower (downcase upper)) - (Assert-equal upper (upcase lower)) - (Assert-equal (downcase lower) (downcase (downcase lower))) - (Assert-equal (upcase lowerupper) (upcase upperlower)) - (Assert-equal (downcase lowerupper) (downcase upperlower)) + (Assert (equalp lowermulti uppermulti)) + (Assert (equalp loweruppermulti upperlowermulti)) + (Assert (equal lower (downcase upper))) + (Assert (equal upper (upcase lower))) + (Assert (equal (downcase lower) (downcase (downcase lower)))) + (Assert (equal (upcase lowerupper) (upcase upperlower))) + (Assert (equal (downcase lowerupper) (downcase upperlower))) ;; Individually -- we include multi-mappings since we're using ;; `equalp'. (loop for (uc lc) in uni-mappings do - (Assert-equalp uc lc) - (Assert-equalp (string uc) (string lc))) + (Assert (equalp uc lc)) + (Assert (equalp (string uc) (string lc)))) ) ;; Here we include multi-mappings -- searching should be able to @@ -1532,14 +1530,14 @@ (,upperlowermulti ,loweruppermulti)) do (erase-buffer) - (Assert= (point-min) 1) - (Assert= (point) 1) + (Assert (= (point-min) 1)) + (Assert (= (point) 1)) (insert str1) (let ((point (point)) (case-fold-search t)) - (Assert= (length str1) (1- point)) + (Assert (= (length str1) (1- point))) (goto-char (point-min)) - (Assert-eql (search-forward str2 nil t) point))) + (Assert (eql (search-forward str2 nil t) point)))) (loop for (uc lc) in uni-mappings do (loop for (ch1 ch2) in `((,uc ,lc) (,lc ,uc)) @@ -1549,8 +1547,8 @@ (insert ch1) (insert ?1) (goto-char (point-min)) - (Assert-eql (search-forward (char-to-string ch2) nil t) 3 - (format "Case-folded searching doesn't equate %s and %s" - (char-as-unicode-escape ch1) - (char-as-unicode-escape ch2)))))) + (Assert (eql (search-forward (char-to-string ch2) nil t) 3) + (format "Case-folded searching doesn't equate %s and %s" + (char-as-unicode-escape ch1) + (char-as-unicode-escape ch2)))))) ))) diff -r 861f2601a38b -r 1f0b15040456 tests/automated/ccl-tests.el --- a/tests/automated/ccl-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/ccl-tests.el Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Section 0. Useful functions to construct test suites. @@ -141,9 +139,9 @@ (defun ccl-test-normal-expr () ;; normal-expr (let ((r0 0) (r1 10) (r2 20) (r3 21) (r4 7)) - (Assert= (ccl-test '(0 ((r0 = ((((r1 * r2) + r3) % r4) << 2)))) + (Assert (= (ccl-test '(0 ((r0 = ((((r1 * r2) + r3) % r4) << 2)))) (list r0 r1 r2 r3 r4)) - (ash (% (+ (* r1 r2) r3) r4) 2))) + (ash (% (+ (* r1 r2) r3) r4) 2)))) (Assert (\= (ccl-test '(0 ((r2 = (r1 < 10)) (r0 = (r2 > 10)))) @@ -151,9 +149,9 @@ 0)) (let ((r0 0) (r1 #x10FF) (r2 #xCC) (r3 #xE0)) - (Assert= (ccl-test '(0 ((r0 = (((r1 & #xFF) ^ r2) | r3)))) + (Assert (= (ccl-test '(0 ((r0 = (((r1 & #xFF) ^ r2) | r3)))) (list r0 r1 r2 r3)) - (logior (logxor (logand r1 #xFF) r2) r3))) + (logior (logxor (logand r1 #xFF) r2) r3)))) ;; checking range of SJIS ;; 81(40-7E, 80-FC), 82, 9F, E0, E1, EF @@ -187,16 +185,16 @@ (setq low (1+ low))))) ;; self-expr - (Assert= (ccl-test '(0 ((r0 += 20) + (Assert (= (ccl-test '(0 ((r0 += 20) (r0 *= 40) (r0 -= 15))) '(100)) - (- (* (+ 100 20) 40) 15)) + (- (* (+ 100 20) 40) 15))) ;; ref. array - (Assert= (ccl-test '(0 ((r0 = r0 [100 101 102 103 104]))) + (Assert (= (ccl-test '(0 ((r0 = r0 [100 101 102 103 104]))) '(3)) - 103)) + 103))) ;;; Section 2. Simple read and write (defun ccl-test-simple-read-and-write () @@ -360,7 +358,7 @@ ((r0 = -1)))) ;; 1-level normal 1 mapping - (Assert-equal + (Assert (equal (mapcar (lambda (val) (ccl-test-map-multiple @@ -369,9 +367,9 @@ '(0 99 100 101 102 103 104 105 106 107)) '((0 . -1) (99 . -1) (1 . 0) (2 . 0) (3 . 0) (4 . 0) (5 . 0) - (105 . -1) (106 . -1) (107 . -1))) + (105 . -1) (106 . -1) (107 . -1)))) - (Assert-equal + (Assert (equal (mapcar (lambda (val) (ccl-test-iterate-multiple-map @@ -380,10 +378,10 @@ '(0 99 100 101 102 103 104 105 106 107)) '((0 . -1) (99 . -1) (1 . 0) (2 . 0) (3 . 0) (4 . 0) (5 . 0) - (105 . -1) (106 . -1) (107 . -1))) + (105 . -1) (106 . -1) (107 . -1)))) ;; 1-level normal 2 mappings - (Assert-equal + (Assert (equal (mapcar (lambda (val) (ccl-test-map-multiple @@ -393,9 +391,9 @@ '(0 99 100 101 102 103 104 105 106 107)) '((0 . -1) (99 . -1) (1 . 0) (2 . 0) (13 . 1) (4 . 0) (5 . 0) (16 . 1) (17 . 1) - (107 . -1))) + (107 . -1)))) - (Assert-equal + (Assert (equal (mapcar (lambda (val) (ccl-test-iterate-multiple-map @@ -404,11 +402,11 @@ [101 12 13 14 15 16 17]))) '(0 99 100 101 102 103 104 105 106 107)) '((0 . -1) (99 . -1) (1 . 0) (2 . 0) (3 . 0) - (4 . 0) (5 . 0) (16 . 1) (17 . 1) (107 . -1))) + (4 . 0) (5 . 0) (16 . 1) (17 . 1) (107 . -1)))) ;; 1-level normal 7 mappings - (Assert-equal + (Assert (equal (mapcar (lambda (val) (ccl-test-map-multiple @@ -432,9 +430,9 @@ (105 . 2) (106 . 2) (1007 . 3) (108 . 2) (9999 . -1) (10000 . -1) (10001 . -1) (10002 . -1) (10003 . -1) (10004 . -1) (19999 . -1) (20000 . 5) (20001 . 5) - (20002 . 5) (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5))) + (20002 . 5) (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5)))) - (Assert-equal + (Assert (equal (mapcar (lambda (val) (ccl-test-iterate-multiple-map @@ -458,11 +456,11 @@ (105 . 2) (106 . 2) (1007 . 3) (108 . 2) (9999 . -1) (10000 . -1) (10001 . -1) (10002 . -1) (10003 . -1) (10004 . -1) (19999 . -1) (20000 . 5) (20001 . 5) - (20002 . 5)(30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5))) + (20002 . 5)(30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5)))) ;; 1-level 7 mappings including CCL call - (Assert-equal + (Assert (equal (mapcar (lambda (val) (ccl-test-map-multiple @@ -487,9 +485,9 @@ (1009 . 3) (1009 . 3) (9999 . -1) (10000 . -1) (10001 . -1) (10002 . -1) (10003 . -1) (10004 . -1) (19999 . -1) (20000 . 5) (20001 . 5) (20002 . 5) - (30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5))) + (30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5)))) - (Assert-equal + (Assert (equal (mapcar (lambda (val) (ccl-test-iterate-multiple-map @@ -514,10 +512,10 @@ (1009 . 3) (-3 . 0) (9999 . -1) (10000 . -1) (10001 . -1) (10002 . -1) (10003 . -1) (10004 . -1) (19999 . -1) (20000 . 5) (20001 . 5) (20002 . 5) - (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5))) + (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5)))) ;; 3-level mappings - (Assert-equal + (Assert (equal (mapcar (lambda (val) (ccl-test-map-multiple @@ -550,11 +548,11 @@ (30040 . 10) (30050 . 10) (10008 . 11) (10009 . 11) (10010 . 11) (19999 . 11) (20000 . 11) (20001 . 11) (20002 . 11) (20003 . 11) (20004 . 11) (20005 . 11) - (20006 . 11))) + (20006 . 11)))) ;; 3-level mappings including CCL call - (Assert-equal + (Assert (equal (mapcar (lambda (val) (ccl-test-map-multiple @@ -592,7 +590,7 @@ (10005 . 14) (30040 . 12) (1020008 . 12) (10008 . 14) (10009 . 14) (10010 . 14) (19999 . 14) (20000 . 14) (20001 . 14) (20002 . 14) (20003 . 14) (20004 . 14) - (20005 . 14) (20006 . 14))) + (20005 . 14) (20006 . 14)))) ;; All map-instruction tests ends here. ) diff -r 861f2601a38b -r 1f0b15040456 tests/automated/database-tests.el --- a/tests/automated/database-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/database-tests.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -46,9 +44,9 @@ (test-database (db) (Assert (databasep db)) (put-database "key1" "val1" db) - (Assert-equal "val1" (get-database "key1" db)) + (Assert (equal "val1" (get-database "key1" db))) (remove-database "key1" db) - (Assert-equal nil (get-database "key1" db)) + (Assert (equal nil (get-database "key1" db))) (close-database db) (Assert (not (database-live-p db))) (Assert (databasep db)))) diff -r 861f2601a38b -r 1f0b15040456 tests/automated/extent-tests.el --- a/tests/automated/extent-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/extent-tests.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -52,12 +50,12 @@ ;; Put it in a buffer. (set-extent-endpoints extent 1 1 (current-buffer)) - (Assert-eq (extent-object extent) (current-buffer)) + (Assert (eq (extent-object extent) (current-buffer))) ;; And then into another buffer. (with-temp-buffer (set-extent-endpoints extent 1 1 (current-buffer)) - (Assert-eq (extent-object extent) (current-buffer))) + (Assert (eq (extent-object extent) (current-buffer)))) ;; Now that the buffer doesn't exist, extent should be detached ;; again. @@ -65,39 +63,39 @@ ;; This line crashes XEmacs 21.2.46 and prior. (set-extent-endpoints extent 1 (length string) string) - (Assert-eq (extent-object extent) string) + (Assert (eq (extent-object extent) string)) ) (let ((extent (make-extent 1 1))) ;; By default, extent should be closed-open - (Assert-eq (get extent 'start-closed) t) - (Assert-eq (get extent 'start-open) nil) - (Assert-eq (get extent 'end-open) t) - (Assert-eq (get extent 'end-closed) nil) + (Assert (eq (get extent 'start-closed) t)) + (Assert (eq (get extent 'start-open) nil)) + (Assert (eq (get extent 'end-open) t)) + (Assert (eq (get extent 'end-closed) nil)) ;; Make it closed-closed. (set-extent-property extent 'end-closed t) - (Assert-eq (get extent 'start-closed) t) - (Assert-eq (get extent 'start-open) nil) - (Assert-eq (get extent 'end-open) nil) - (Assert-eq (get extent 'end-closed) t) + (Assert (eq (get extent 'start-closed) t)) + (Assert (eq (get extent 'start-open) nil)) + (Assert (eq (get extent 'end-open) nil)) + (Assert (eq (get extent 'end-closed) t)) ;; open-closed (set-extent-property extent 'start-open t) - (Assert-eq (get extent 'start-closed) nil) - (Assert-eq (get extent 'start-open) t) - (Assert-eq (get extent 'end-open) nil) - (Assert-eq (get extent 'end-closed) t) + (Assert (eq (get extent 'start-closed) nil)) + (Assert (eq (get extent 'start-open) t)) + (Assert (eq (get extent 'end-open) nil)) + (Assert (eq (get extent 'end-closed) t)) ;; open-open (set-extent-property extent 'end-open t) - (Assert-eq (get extent 'start-closed) nil) - (Assert-eq (get extent 'start-open) t) - (Assert-eq (get extent 'end-open) t) - (Assert-eq (get extent 'end-closed) nil)) + (Assert (eq (get extent 'start-closed) nil)) + (Assert (eq (get extent 'start-open) t)) + (Assert (eq (get extent 'end-open) t)) + (Assert (eq (get extent 'end-closed) nil))) ) @@ -125,25 +123,25 @@ (let ((e (make-extent 4 7))) ;; current state: "###[eee)###" ;; 123 456 789 - (Assert-equal (et-range e) '(4 7)) + (Assert (equal (et-range e) '(4 7))) (et-insert-at "xxx" 4) ;; current state: "###[xxxeee)###" ;; 123 456789 012 - (Assert-equal (et-range e) '(4 10)) + (Assert (equal (et-range e) '(4 10))) (et-insert-at "yyy" 7) ;; current state: "###[xxxyyyeee)###" ;; 123 456789012 345 - (Assert-equal (et-range e) '(4 13)) + (Assert (equal (et-range e) '(4 13))) (et-insert-at "zzz" 13) ;; current state: "###[xxxyyyeee)zzz###" ;; 123 456789012 345678 - (Assert-equal (et-range e) '(4 13)) + (Assert (equal (et-range e) '(4 13))) )) ;; closed-closed @@ -155,25 +153,25 @@ ;; current state: "###[eee]###" ;; 123 456 789 - (Assert-equal (et-range e) '(4 7)) + (Assert (equal (et-range e) '(4 7))) (et-insert-at "xxx" 4) ;; current state: "###[xxxeee]###" ;; 123 456789 012 - (Assert-equal (et-range e) '(4 10)) + (Assert (equal (et-range e) '(4 10))) (et-insert-at "yyy" 7) ;; current state: "###[xxxyyyeee]###" ;; 123 456789012 345 - (Assert-equal (et-range e) '(4 13)) + (Assert (equal (et-range e) '(4 13))) (et-insert-at "zzz" 13) ;; current state: "###[xxxyyyeeezzz]###" ;; 123 456789012345 678 - (Assert-equal (et-range e) '(4 16)) + (Assert (equal (et-range e) '(4 16))) )) ;; open-closed @@ -186,25 +184,25 @@ ;; current state: "###(eee]###" ;; 123 456 789 - (Assert-equal (et-range e) '(4 7)) + (Assert (equal (et-range e) '(4 7))) (et-insert-at "xxx" 4) ;; current state: "###xxx(eee]###" ;; 123456 789 012 - (Assert-equal (et-range e) '(7 10)) + (Assert (equal (et-range e) '(7 10))) (et-insert-at "yyy" 8) ;; current state: "###xxx(eyyyee]###" ;; 123456 789012 345 - (Assert-equal (et-range e) '(7 13)) + (Assert (equal (et-range e) '(7 13))) (et-insert-at "zzz" 13) ;; current state: "###xxx(eyyyeezzz]###" ;; 123456 789012345 678 - (Assert-equal (et-range e) '(7 16)) + (Assert (equal (et-range e) '(7 16))) )) ;; open-open @@ -216,25 +214,25 @@ ;; current state: "###(eee)###" ;; 123 456 789 - (Assert-equal (et-range e) '(4 7)) + (Assert (equal (et-range e) '(4 7))) (et-insert-at "xxx" 4) ;; current state: "###xxx(eee)###" ;; 123456 789 012 - (Assert-equal (et-range e) '(7 10)) + (Assert (equal (et-range e) '(7 10))) (et-insert-at "yyy" 8) ;; current state: "###xxx(eyyyee)###" ;; 123456 789012 345 - (Assert-equal (et-range e) '(7 13)) + (Assert (equal (et-range e) '(7 13))) (et-insert-at "zzz" 13) ;; current state: "###xxx(eyyyee)zzz###" ;; 123456 789012 345678 - (Assert-equal (et-range e) '(7 13)) + (Assert (equal (et-range e) '(7 13))) )) @@ -256,31 +254,31 @@ ;; current state: xx[xxxxxx]xx ;; 12 345678 90 - (Assert-equal (et-range e) '(3 9)) + (Assert (equal (et-range e) '(3 9))) (delete-region 1 2) ;; current state: x[xxxxxx]xx ;; 1 234567 89 - (Assert-equal (et-range e) '(2 8)) + (Assert (equal (et-range e) '(2 8))) (delete-region 2 4) ;; current state: x[xxxx]xx ;; 1 2345 67 - (Assert-equal (et-range e) '(2 6)) + (Assert (equal (et-range e) '(2 6))) (delete-region 1 3) ;; current state: [xxx]xx ;; 123 45 - (Assert-equal (et-range e) '(1 4)) + (Assert (equal (et-range e) '(1 4))) (delete-region 3 5) ;; current state: [xx]x ;; 12 3 - (Assert-equal (et-range e) '(1 3)) + (Assert (equal (et-range e) '(1 3))) ))) @@ -329,7 +327,7 @@ (delete-region 4 6) ;; ###[]### (Assert (not (extent-detached-p e))) - (Assert-equal (et-range e) '(4 4)) + (Assert (equal (et-range e) '(4 4))) )) ) @@ -343,7 +341,7 @@ (insert "######") (let ((e (make-extent 4 4))) (et-insert-at "foo" 4) - (Assert-equal (et-range e) '(4 4)))) + (Assert (equal (et-range e) '(4 4))))) ;; open-closed (should move) (with-temp-buffer @@ -352,7 +350,7 @@ (put e 'start-open t) (put e 'end-closed t) (et-insert-at "foo" 4) - (Assert-equal (et-range e) '(7 7)))) + (Assert (equal (et-range e) '(7 7))))) ;; closed-closed (should extend) (with-temp-buffer @@ -360,7 +358,7 @@ (let ((e (make-extent 4 4))) (put e 'end-closed t) (et-insert-at "foo" 4) - (Assert-equal (et-range e) '(4 7)))) + (Assert (equal (et-range e) '(4 7))))) ;; open-open (illegal; forced to behave like closed-open) (with-temp-buffer @@ -368,4 +366,4 @@ (let ((e (make-extent 4 4))) (put e 'start-open t) (et-insert-at "foo" 4) - (Assert-equal (et-range e) '(4 4)))) + (Assert (equal (et-range e) '(4 4))))) diff -r 861f2601a38b -r 1f0b15040456 tests/automated/file-tests.el --- a/tests/automated/file-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/file-tests.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -40,6 +38,6 @@ (make-temp-name "foo") ) do - (Assert-equal (file-truename (file-truename file)) (file-truename file))) + (Assert (equal (file-truename (file-truename file)) (file-truename file)))) diff -r 861f2601a38b -r 1f0b15040456 tests/automated/hash-table-tests.el --- a/tests/automated/hash-table-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/hash-table-tests.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -37,7 +35,7 @@ (require 'test-harness)))) ;; Test all combinations of make-hash-table keywords -(dolist (test '(eq eql equal)) +(dolist (test '(eq eql equal equalp)) (dolist (size '(0 1 100)) (dolist (rehash-size '(1.1 9.9)) (dolist (rehash-threshold '(0.2 .9)) @@ -49,26 +47,26 @@ :rehash-size rehash-size :rehash-threshold rehash-threshold :weakness weakness))) - (Assert-equal ht (car (let ((print-readably t)) - (read-from-string (prin1-to-string ht))))) - (Assert-eq test (hash-table-test ht)) + (Assert (equal ht (car (let ((print-readably t)) + (read-from-string (prin1-to-string ht)))))) + (Assert (eq test (hash-table-test ht))) (Assert (<= size (hash-table-size ht))) - (Assert-eql rehash-size (hash-table-rehash-size ht)) - (Assert-eql rehash-threshold (hash-table-rehash-threshold ht)) - (Assert-eq weakness (hash-table-weakness ht))))))))) + (Assert (eql rehash-size (hash-table-rehash-size ht))) + (Assert (eql rehash-threshold (hash-table-rehash-threshold ht))) + (Assert (eq weakness (hash-table-weakness ht)))))))))) (loop for (fun weakness) in '((make-hashtable nil) (make-weak-hashtable key-and-value) (make-key-weak-hashtable key) (make-value-weak-hashtable value)) - do (Assert-eq weakness (hash-table-weakness (funcall fun 10)))) + do (Assert (eq weakness (hash-table-weakness (funcall fun 10))))) (loop for (type weakness) in '((non-weak nil) (weak key-and-value) (key-weak key) (value-weak value)) - do (Assert-equal (make-hash-table :type type) - (make-hash-table :weakness weakness))) + do (Assert (equal (make-hash-table :type type) + (make-hash-table :weakness weakness)))) (Assert (not (equal (make-hash-table :weakness nil) (make-hash-table :weakness t)))) @@ -77,86 +75,86 @@ (size 80)) (Assert (hashtablep ht)) (Assert (hash-table-p ht)) - (Assert-eq 'eq (hash-table-test ht)) - (Assert-eq 'non-weak (hash-table-type ht)) - (Assert-eq 'non-weak (hashtable-type ht)) - (Assert-eq 'nil (hash-table-weakness ht)) + (Assert (eq 'eq (hash-table-test ht))) + (Assert (eq 'non-weak (hash-table-type ht))) + (Assert (eq 'non-weak (hashtable-type ht))) + (Assert (eq 'nil (hash-table-weakness ht))) (dotimes (j size) (puthash j (- j) ht) - (Assert-eq (gethash j ht) (- j)) - (Assert= (hash-table-count ht) (1+ j)) - (Assert= (hashtable-fullness ht) (hash-table-count ht)) + (Assert (eq (gethash j ht) (- j))) + (Assert (= (hash-table-count ht) (1+ j))) + (Assert (= (hashtable-fullness ht) (hash-table-count ht))) (puthash j j ht) - (Assert-eq (gethash j ht 'foo) j) - (Assert= (hash-table-count ht) (1+ j)) + (Assert (eq (gethash j ht 'foo) j)) + (Assert (= (hash-table-count ht) (1+ j))) (setf (gethash j ht) (- j)) - (Assert-eq (gethash j ht) (- j)) - (Assert= (hash-table-count ht) (1+ j))) + (Assert (eq (gethash j ht) (- j))) + (Assert (= (hash-table-count ht) (1+ j)))) (clrhash ht) - (Assert= 0 (hash-table-count ht)) + (Assert (= 0 (hash-table-count ht))) (dotimes (j size) (puthash j (- j) ht) - (Assert-eq (gethash j ht) (- j)) - (Assert= (hash-table-count ht) (1+ j))) + (Assert (eq (gethash j ht) (- j))) + (Assert (= (hash-table-count ht) (1+ j)))) (let ((k-sum 0) (v-sum 0)) (maphash #'(lambda (k v) (incf k-sum k) (incf v-sum v)) ht) - (Assert= k-sum (/ (* size (- size 1)) 2)) - (Assert= v-sum (- k-sum))) + (Assert (= k-sum (/ (* size (- size 1)) 2))) + (Assert (= v-sum (- k-sum)))) (let ((count size)) (dotimes (j size) (remhash j ht) - (Assert-eq (gethash j ht) nil) - (Assert-eq (gethash j ht 'foo) 'foo) - (Assert= (hash-table-count ht) (decf count))))) + (Assert (eq (gethash j ht) nil)) + (Assert (eq (gethash j ht 'foo) 'foo)) + (Assert (= (hash-table-count ht) (decf count)))))) (let ((ht (make-hash-table :size 30 :rehash-threshold .25 :test 'equal)) (size 70)) (Assert (hashtablep ht)) (Assert (hash-table-p ht)) (Assert (>= (hash-table-size ht) (/ 30 .25))) - (Assert-eql .25 (hash-table-rehash-threshold ht)) - (Assert-eq 'equal (hash-table-test ht)) - (Assert-eq (hash-table-test ht) (hashtable-test-function ht)) - (Assert-eq 'non-weak (hash-table-type ht)) + (Assert (eql .25 (hash-table-rehash-threshold ht))) + (Assert (eq 'equal (hash-table-test ht))) + (Assert (eq (hash-table-test ht) (hashtable-test-function ht))) + (Assert (eq 'non-weak (hash-table-type ht))) (dotimes (j size) (puthash (int-to-string j) (- j) ht) - (Assert-eq (gethash (int-to-string j) ht) (- j)) - (Assert= (hash-table-count ht) (1+ j)) + (Assert (eq (gethash (int-to-string j) ht) (- j))) + (Assert (= (hash-table-count ht) (1+ j))) (puthash (int-to-string j) j ht) - (Assert-eq (gethash (int-to-string j) ht 'foo) j) - (Assert= (hash-table-count ht) (1+ j))) + (Assert (eq (gethash (int-to-string j) ht 'foo) j)) + (Assert (= (hash-table-count ht) (1+ j)))) (clrhash ht) - (Assert= 0 (hash-table-count ht)) - (Assert-equal ht (copy-hash-table ht)) + (Assert (= 0 (hash-table-count ht))) + (Assert (equal ht (copy-hash-table ht))) (dotimes (j size) (setf (gethash (int-to-string j) ht) (- j)) - (Assert-eq (gethash (int-to-string j) ht) (- j)) - (Assert= (hash-table-count ht) (1+ j))) + (Assert (eq (gethash (int-to-string j) ht) (- j))) + (Assert (= (hash-table-count ht) (1+ j)))) (let ((count size)) (dotimes (j size) (remhash (int-to-string j) ht) - (Assert-eq (gethash (int-to-string j) ht) nil) - (Assert-eq (gethash (int-to-string j) ht 'foo) 'foo) - (Assert= (hash-table-count ht) (decf count))))) + (Assert (eq (gethash (int-to-string j) ht) nil)) + (Assert (eq (gethash (int-to-string j) ht 'foo) 'foo)) + (Assert (= (hash-table-count ht) (decf count)))))) (let ((iterations 5) (one 1.0) (two 2.0)) (flet ((check-copy (ht) (let ((copy-of-ht (copy-hash-table ht))) - (Assert-equal ht copy-of-ht) + (Assert (equal ht copy-of-ht)) (Assert (not (eq ht copy-of-ht))) - (Assert-eq (hash-table-count ht) (hash-table-count copy-of-ht)) - (Assert-eq (hash-table-type ht) (hash-table-type copy-of-ht)) - (Assert-eq (hash-table-size ht) (hash-table-size copy-of-ht)) - (Assert-eql (hash-table-rehash-size ht) (hash-table-rehash-size copy-of-ht)) - (Assert-eql (hash-table-rehash-threshold ht) (hash-table-rehash-threshold copy-of-ht))))) + (Assert (eq (hash-table-count ht) (hash-table-count copy-of-ht))) + (Assert (eq (hash-table-type ht) (hash-table-type copy-of-ht))) + (Assert (eq (hash-table-size ht) (hash-table-size copy-of-ht))) + (Assert (eql (hash-table-rehash-size ht) (hash-table-rehash-size copy-of-ht))) + (Assert (eql (hash-table-rehash-threshold ht) (hash-table-rehash-threshold copy-of-ht)))))) (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'eq))) (dotimes (j iterations) @@ -164,11 +162,11 @@ (puthash (+ two 0.0) t ht) (puthash (cons 1 2) t ht) (puthash (cons 3 4) t ht)) - (Assert-eq (hashtable-test-function ht) 'eq) - (Assert-eq (hash-table-test ht) 'eq) - (Assert= (* iterations 4) (hash-table-count ht)) - (Assert-eq nil (gethash 1.0 ht)) - (Assert-eq nil (gethash '(1 . 2) ht)) + (Assert (eq (hashtable-test-function ht) 'eq)) + (Assert (eq (hash-table-test ht) 'eq)) + (Assert (= (* iterations 4) (hash-table-count ht))) + (Assert (eq nil (gethash 1.0 ht))) + (Assert (eq nil (gethash '(1 . 2) ht))) (check-copy ht) ) @@ -178,11 +176,11 @@ (puthash (+ two 0.0) t ht) (puthash (cons 1 2) t ht) (puthash (cons 3 4) t ht)) - (Assert-eq (hashtable-test-function ht) 'eql) - (Assert-eq (hash-table-test ht) 'eql) - (Assert= (+ 2 (* 2 iterations)) (hash-table-count ht)) - (Assert-eq t (gethash 1.0 ht)) - (Assert-eq nil (gethash '(1 . 2) ht)) + (Assert (eq (hashtable-test-function ht) 'eql)) + (Assert (eq (hash-table-test ht) 'eql)) + (Assert (= (+ 2 (* 2 iterations)) (hash-table-count ht))) + (Assert (eq t (gethash 1.0 ht))) + (Assert (eq nil (gethash '(1 . 2) ht))) (check-copy ht) ) @@ -192,11 +190,30 @@ (puthash (+ two 0.0) t ht) (puthash (cons 1 2) t ht) (puthash (cons 3 4) t ht)) - (Assert-eq (hashtable-test-function ht) 'equal) - (Assert-eq (hash-table-test ht) 'equal) - (Assert= 4 (hash-table-count ht)) - (Assert-eq t (gethash 1.0 ht)) - (Assert-eq t (gethash '(1 . 2) ht)) + (Assert (eq (hashtable-test-function ht) 'equal)) + (Assert (eq (hash-table-test ht) 'equal)) + (Assert (= 4 (hash-table-count ht))) + (Assert (eq t (gethash 1.0 ht))) + (Assert (eq t (gethash '(1 . 2) ht))) + (check-copy ht) + ) + + (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'equalp))) + (dotimes (j iterations) + (puthash (+ one 0.0) t ht) + (puthash 1 t ht) + (puthash (+ two 0.0) t ht) + (puthash 2 t ht) + (puthash (cons 1.0 2.0) (gensym) ht) + ;; Override the previous entry. + (puthash (cons 1 2) t ht) + (puthash (cons 3.0 4.0) (gensym) ht) + (puthash (cons 3 4) t ht)) + (Assert (eq (hashtable-test-function ht) 'equalp)) + (Assert (eq (hash-table-test ht) 'equalp)) + (Assert (= 4 (hash-table-count ht))) + (Assert (eq t (gethash 1.0 ht))) + (Assert (eq t (gethash '(1 . 2) ht))) (check-copy ht) ) @@ -223,18 +240,18 @@ (when (integerp k) (incf k-sum k)) (when (integerp v) (incf v-sum v))) ht) - (Assert-eq 38 k-sum) - (Assert-eq 25 v-sum)) - (Assert-eq 6 (hash-table-count ht)) + (Assert (eq 38 k-sum)) + (Assert (eq 25 v-sum))) + (Assert (eq 6 (hash-table-count ht))) (garbage-collect) - (Assert-eq expected-count (hash-table-count ht)) + (Assert (eq expected-count (hash-table-count ht))) (let ((k-sum 0) (v-sum 0)) (maphash #'(lambda (k v) (when (integerp k) (incf k-sum k)) (when (integerp v) (incf v-sum v))) ht) - (Assert-eq expected-k-sum k-sum) - (Assert-eq expected-v-sum v-sum)))) + (Assert (eq expected-k-sum k-sum)) + (Assert (eq expected-v-sum v-sum))))) ;;; Test the ability to puthash and remhash the current elt of a maphash (let ((ht (make-hash-table :test 'eql))) @@ -244,41 +261,129 @@ ht) (let ((k-sum 0) (v-sum 0)) (maphash #'(lambda (k v) (incf k-sum k) (incf v-sum v)) ht) - (Assert= (* 50 49) k-sum) - (Assert= v-sum k-sum))) + (Assert (= (* 50 49) k-sum)) + (Assert (= v-sum k-sum)))) ;;; Test reading and printing of hash-table objects -(let ((h1 #s(hashtable weakness t rehash-size 3.0 rehash-threshold .2 test eq data (1 2 3 4))) - (h2 #s(hash-table weakness t rehash-size 3.0 rehash-threshold .2 test eq data (1 2 3 4))) +(let ((h1 #s(hashtable :weakness t :rehash-size 3.0 :rehash-threshold .2 :test eq :data (1 2 3 4))) + (h2 #s(hash-table :weakness t :rehash-size 3.0 :rehash-threshold .2 :test eq :data (1 2 3 4))) (h3 (make-hash-table :weakness t :rehash-size 3.0 :rehash-threshold .2 :test 'eq))) - (Assert-equal h1 h2) + (Assert (equal h1 h2)) (Assert (not (equal h1 h3))) (puthash 1 2 h3) (puthash 3 4 h3) - (Assert-equal h1 h3)) + (Assert (equal h1 h3))) ;;; Testing equality of hash tables -(Assert-equal (make-hash-table :test 'eql :size 300 :rehash-threshold .9 :rehash-size 3.0) - (make-hash-table :test 'eql)) +(Assert (equal (make-hash-table :test 'eql :size 300 :rehash-threshold .9 :rehash-size 3.0) + (make-hash-table :test 'eql))) (Assert (not (equal (make-hash-table :test 'eq) (make-hash-table :test 'equal)))) (let ((h1 (make-hash-table)) (h2 (make-hash-table))) - (Assert-equal h1 h2) + (Assert (equal h1 h2)) (Assert (not (eq h1 h2))) (puthash 1 2 h1) (Assert (not (equal h1 h2))) (puthash 1 2 h2) - (Assert-equal h1 h2) + (Assert (equal h1 h2)) (puthash 1 3 h2) (Assert (not (equal h1 h2))) (clrhash h1) (Assert (not (equal h1 h2))) (clrhash h2) - (Assert-equal h1 h2) + (Assert (equal h1 h2)) ) ;;; Test sxhash -(Assert= (sxhash "foo") (sxhash "foo")) -(Assert= (sxhash '(1 2 3)) (sxhash '(1 2 3))) +(Assert (= (sxhash "foo") (sxhash "foo"))) +(Assert (= (sxhash '(1 2 3)) (sxhash '(1 2 3)))) (Assert (/= (sxhash '(1 2 3)) (sxhash '(3 2 1)))) + +;; Test #'define-hash-table-test. + +(defstruct hash-table-test-structure + number-identifier padding-zero padding-one padding-two) + +(macrolet + ((good-hash () 65599) + (hash-modulo-figure () + (if (featurep 'bignum) + (1+ (* most-positive-fixnum 2)) + most-positive-fixnum)) + (hash-table-test-structure-first-hash-figure () + (rem* (* 65599 (eq-hash 'hash-table-test-structure)) + (if (featurep 'bignum) + (1+ (* most-positive-fixnum 2)) + most-positive-fixnum)))) + (let ((hash-table-test (gensym)) + (no-entry-found (gensym)) + (two 2.0) + (equal-function + #'(lambda (object-one object-two) + (or (equal object-one object-two) + (and (hash-table-test-structure-p object-one) + (hash-table-test-structure-p object-two) + (= (hash-table-test-structure-number-identifier + object-one) + (hash-table-test-structure-number-identifier + object-two)))))) + (hash-function + #'(lambda (object) + (if (hash-table-test-structure-p object) + (rem* (+ (hash-table-test-structure-first-hash-figure) + (equalp-hash + (hash-table-test-structure-number-identifier + object))) + (hash-modulo-figure)) + (equal-hash object)))) + hash-table-test-hash equal-hash) + (Check-Error wrong-type-argument (define-hash-table-test + "hi there everyone" + equal-function hash-function)) + (Check-Error wrong-number-of-arguments (define-hash-table-test + (gensym) + hash-function hash-function)) + (Check-Error wrong-number-of-arguments (define-hash-table-test + (gensym) + equal-function equal-function)) + (define-hash-table-test hash-table-test equal-function hash-function) + (Assert (valid-hash-table-test-p hash-table-test)) + (setq equal-hash (make-hash-table :test #'equal) + hash-table-test-hash (make-hash-table :test hash-table-test)) + (Assert (hash-table-p equal-hash)) + (Assert (hash-table-p hash-table-test-hash)) + (Assert (eq hash-table-test (hash-table-test hash-table-test-hash))) + (loop + for ii from 200 below 300 + with structure = nil + do + (setf structure (make-hash-table-test-structure + :number-identifier (if (oddp ii) (float (% ii 10)) + (% ii 10)) + :padding-zero (random) + :padding-one (random) + :padding-two (random)) + (gethash structure hash-table-test-hash) t + (gethash structure equal-hash) t)) + (Assert (= (hash-table-count hash-table-test-hash) 10)) + (Assert (= (hash-table-count equal-hash) 100)) + (Assert (eq t (gethash (make-hash-table-test-structure + :number-identifier 1 + :padding-zero (random) + :padding-one (random) + :padding-two (random)) + hash-table-test-hash))) + (Assert (eq t (gethash (make-hash-table-test-structure + :number-identifier 2.0 + :padding-zero (random) + :padding-one (random) + :padding-two (random)) + hash-table-test-hash))) + (Assert (eq no-entry-found (gethash (make-hash-table-test-structure + :number-identifier (+ two 0.0) + :padding-zero (random) + :padding-one (random) + :padding-two (random)) + equal-hash + no-entry-found))))) diff -r 861f2601a38b -r 1f0b15040456 tests/automated/iso-ir-196-test.el --- a/tests/automated/iso-ir-196-test.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/iso-ir-196-test.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 tests/automated/lisp-reader-tests.el --- a/tests/automated/lisp-reader-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/lisp-reader-tests.el Sun May 01 18:44:03 2011 +0100 @@ -5,22 +5,20 @@ ;; Created: 2005 ;; Keywords: tests -;; This file is NOT part of SXEmacs. +;; This file is part of XEmacs. -;; SXEmacs 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 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 3 of the License, or (at your +;; option) any later version. -;; SXEmacs 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. +;; 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 SXEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -78,3 +76,14 @@ (insert string) (Check-Error-Message invalid-read-syntax "unrecognized raw string" (eval-buffer)))) + +(when (featurep 'bignum) + ;; This failed, up to 20110501. + (Assert (eql (1+ most-positive-fixnum) + (read (format "+%d" (1+ most-positive-fixnum)))) + "checking leading + is handled properly if reading a bignum") + ;; This never did. + (Assert (eql (1- most-positive-fixnum) + (read (format "+%d" (1- most-positive-fixnum)))) + "checking leading + is handled properly if reading a fixnum")) + diff -r 861f2601a38b -r 1f0b15040456 tests/automated/lisp-tests.el --- a/tests/automated/lisp-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/lisp-tests.el Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,5 @@ -;; Copyright (C) 1998 Free Software Foundation, Inc. +;; Copyright (C) 1998 Free Software Foundation, Inc. -*- coding: iso-8859-1 -*- +;; Copyright (C) 2010 Ben Wing. ;; Author: Martin Buchholz ;; Maintainer: Martin Buchholz @@ -7,20 +8,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -42,19 +41,19 @@ (Check-Error wrong-number-of-arguments (setq setq-test-foo 1 setq-test-bar)) (Check-Error wrong-number-of-arguments (setq-default setq-test-foo)) (Check-Error wrong-number-of-arguments (setq-default setq-test-foo 1 setq-test-bar)) -(Assert-eq (setq) nil) -(Assert-eq (setq-default) nil) -(Assert-eq (setq setq-test-foo 42) 42) -(Assert-eq (setq-default setq-test-foo 42) 42) -(Assert-eq (setq setq-test-foo 42 setq-test-bar 99) 99) -(Assert-eq (setq-default setq-test-foo 42 setq-test-bar 99) 99) +(Assert (eq (setq) nil)) +(Assert (eq (setq-default) nil)) +(Assert (eq (setq setq-test-foo 42) 42)) +(Assert (eq (setq-default setq-test-foo 42) 42)) +(Assert (eq (setq setq-test-foo 42 setq-test-bar 99) 99)) +(Assert (eq (setq-default setq-test-foo 42 setq-test-bar 99) 99)) (macrolet ((test-setq (expected-result &rest body) `(progn (defun test-setq-fun () ,@body) - (Assert-eq ,expected-result (test-setq-fun)) + (Assert (eq ,expected-result (test-setq-fun))) (byte-compile 'test-setq-fun) - (Assert-eq ,expected-result (test-setq-fun))))) + (Assert (eq ,expected-result (test-setq-fun)))))) (test-setq nil (setq)) (test-setq nil (setq-default)) (test-setq 42 (setq test-setq-var 42)) @@ -69,38 +68,38 @@ (my-list '(1 2 3 4))) ;;(Assert (fooooo)) ;; Generate Other failure - ;;(Assert-eq 1 2) ;; Generate Assertion failure + ;;(Assert (eq 1 2)) ;; Generate Assertion failure (dolist (sequence (list my-vector my-bit-vector my-string my-list)) (Assert (sequencep sequence)) - (Assert-eq 4 (length sequence))) + (Assert (eq 4 (length sequence)))) (dolist (array (list my-vector my-bit-vector my-string)) (Assert (arrayp array))) - (Assert-eq (elt my-vector 0) 1) - (Assert-eq (elt my-bit-vector 0) 1) - (Assert-eq (elt my-string 0) ?1) - (Assert-eq (elt my-list 0) 1) + (Assert (eq (elt my-vector 0) 1)) + (Assert (eq (elt my-bit-vector 0) 1)) + (Assert (eq (elt my-string 0) ?1)) + (Assert (eq (elt my-list 0) 1)) (fillarray my-vector 5) (fillarray my-bit-vector 1) (fillarray my-string ?5) (dolist (array (list my-vector my-bit-vector)) - (Assert-eq 4 (length array))) + (Assert (eq 4 (length array)))) - (Assert-eq (elt my-vector 0) 5) - (Assert-eq (elt my-bit-vector 0) 1) - (Assert-eq (elt my-string 0) ?5) + (Assert (eq (elt my-vector 0) 5)) + (Assert (eq (elt my-bit-vector 0) 1)) + (Assert (eq (elt my-string 0) ?5)) - (Assert-eq (elt my-vector 3) 5) - (Assert-eq (elt my-bit-vector 3) 1) - (Assert-eq (elt my-string 3) ?5) + (Assert (eq (elt my-vector 3) 5)) + (Assert (eq (elt my-bit-vector 3) 1)) + (Assert (eq (elt my-string 3) ?5)) (fillarray my-bit-vector 0) - (Assert-eq 4 (length my-bit-vector)) - (Assert-eq (elt my-bit-vector 2) 0) + (Assert (eq 4 (length my-bit-vector))) + (Assert (eq (elt my-bit-vector 2) 0)) ) (defun make-circular-list (length) @@ -124,22 +123,22 @@ (Check-Error circular-list (nconc '(1 . 2) (make-circular-list length) 'foo)) (Check-Error circular-list (nconc '(1 . 2) '(3 . 4) (make-circular-list length) 'foo))) -(Assert-eq (nconc) nil) -(Assert-eq (nconc nil) nil) -(Assert-eq (nconc nil nil) nil) -(Assert-eq (nconc nil nil nil) nil) +(Assert (eq (nconc) nil)) +(Assert (eq (nconc nil) nil)) +(Assert (eq (nconc nil nil) nil)) +(Assert (eq (nconc nil nil nil) nil)) -(let ((x (make-list-012))) (Assert-eq (nconc nil x) x)) -(let ((x (make-list-012))) (Assert-eq (nconc x nil) x)) -(let ((x (make-list-012))) (Assert-eq (nconc nil x nil) x)) -(let ((x (make-list-012))) (Assert-eq (nconc x) x)) -(let ((x (make-list-012))) (Assert-eq (nconc x (make-circular-list 3)) x)) +(let ((x (make-list-012))) (Assert (eq (nconc nil x) x))) +(let ((x (make-list-012))) (Assert (eq (nconc x nil) x))) +(let ((x (make-list-012))) (Assert (eq (nconc nil x nil) x))) +(let ((x (make-list-012))) (Assert (eq (nconc x) x))) +(let ((x (make-list-012))) (Assert (eq (nconc x (make-circular-list 3)) x))) -(Assert-equal (nconc '(1 . 2) '(3 . 4) '(5 . 6)) '(1 3 5 . 6)) +(Assert (equal (nconc '(1 . 2) '(3 . 4) '(5 . 6)) '(1 3 5 . 6))) (let ((y (nconc (make-list-012) nil (list 3 4 5) nil))) - (Assert-eq (length y) 6) - (Assert-eq (nth 3 y) 3)) + (Assert (eq (length y) 6)) + (Assert (eq (nth 3 y) 3))) ;;----------------------------------------------------- ;; Test `last' @@ -150,15 +149,15 @@ (Check-Error circular-list (last (make-circular-list 1))) (Check-Error circular-list (last (make-circular-list 2000))) (let ((x (list 0 1 2 3))) - (Assert-eq (last nil) nil) - (Assert-eq (last x 0) nil) - (Assert-eq (last x ) (cdddr x)) - (Assert-eq (last x 1) (cdddr x)) - (Assert-eq (last x 2) (cddr x)) - (Assert-eq (last x 3) (cdr x)) - (Assert-eq (last x 4) x) - (Assert-eq (last x 9) x) - (Assert-eq (last '(1 . 2) 0) 2) + (Assert (eq (last nil) nil)) + (Assert (eq (last x 0) nil)) + (Assert (eq (last x ) (cdddr x))) + (Assert (eq (last x 1) (cdddr x))) + (Assert (eq (last x 2) (cddr x))) + (Assert (eq (last x 3) (cdr x))) + (Assert (eq (last x 4) x)) + (Assert (eq (last x 9) x)) + (Assert (eq (last '(1 . 2) 0) 2)) ) ;;----------------------------------------------------- @@ -178,31 +177,49 @@ (let* ((x (list 0 1 2 3)) (y (butlast x)) (z (nbutlast x))) - (Assert-eq z x) + (Assert (eq z x)) (Assert (not (eq y x))) - (Assert-equal y '(0 1 2)) - (Assert-equal z y)) + (Assert (equal y '(0 1 2))) + (Assert (equal z y))) (let* ((x (list 0 1 2 3 4)) (y (butlast x 2)) (z (nbutlast x 2))) - (Assert-eq z x) + (Assert (eq z x)) (Assert (not (eq y x))) - (Assert-equal y '(0 1 2)) - (Assert-equal z y)) + (Assert (equal y '(0 1 2))) + (Assert (equal z y))) (let* ((x (list 0 1 2 3)) (y (butlast x 0)) (z (nbutlast x 0))) - (Assert-eq z x) + (Assert (eq z x)) (Assert (not (eq y x))) - (Assert-equal y '(0 1 2 3)) - (Assert-equal z y)) + (Assert (equal y '(0 1 2 3))) + (Assert (equal z y))) + +(let* ((x (list* 0 1 2 3 4 5 6.0 ?7 ?8 (vector 'a 'b 'c))) + (y (butlast x 0)) + (z (nbutlast x 0))) + (Assert (eq z x)) + (Assert (not (eq y x))) + (Assert (equal y '(0 1 2 3 4 5 6.0 ?7 ?8))) + (Assert (equal z y))) -(Assert-eq (butlast '(x)) nil) -(Assert-eq (nbutlast '(x)) nil) -(Assert-eq (butlast '()) nil) -(Assert-eq (nbutlast '()) nil) +(Assert (eq (butlast '(x)) nil)) +(Assert (eq (nbutlast '(x)) nil)) +(Assert (eq (butlast '()) nil)) +(Assert (eq (nbutlast '()) nil)) + +(when (featurep 'bignum) + (let* ((x (list* 0 1 2 3 4 5 6.0 ?7 ?8 (vector 'a 'b 'c))) + (y (butlast x (* 2 most-positive-fixnum))) + (z (nbutlast x (* 3 most-positive-fixnum)))) + (Assert (eq nil y) "checking butlast with a large bignum gives nil") + (Assert (eq nil z) "checking nbutlast with a large bignum gives nil") + (Check-Error wrong-type-argument + (nbutlast x (1- most-negative-fixnum)) + "checking nbutlast with a negative bignum errors"))) ;;----------------------------------------------------- ;; Test `copy-list' @@ -212,34 +229,86 @@ (Check-Error wrong-number-of-arguments (copy-list '(1 2) 1)) (Check-Error circular-list (copy-list (make-circular-list 1))) (Check-Error circular-list (copy-list (make-circular-list 2000))) -(Assert-eq '() (copy-list '())) +(Assert (eq '() (copy-list '()))) (dolist (x '((1) (1 2) (1 2 3) (1 2 . 3))) (let ((y (copy-list x))) (Assert (and (equal x y) (not (eq x y)))))) ;;----------------------------------------------------- +;; Test `ldiff' +;;----------------------------------------------------- +(Check-Error wrong-type-argument (ldiff 'foo pi)) +(Check-Error wrong-number-of-arguments (ldiff)) +(Check-Error wrong-number-of-arguments (ldiff '(1 2))) +(Check-Error circular-list (ldiff (make-circular-list 1) nil)) +(Check-Error circular-list (ldiff (make-circular-list 2000) nil)) +(Assert (eq '() (ldiff '() pi))) +(dolist (x '((1) (1 2) (1 2 3) (1 2 . 3))) + (let ((y (ldiff x nil))) + (Assert (and (equal x y) (not (eq x y)))))) + +(let* ((vector (vector 'foo)) + (dotted `(1 2 3 ,pi 40 50 . ,vector)) + (dotted-pi `(1 2 3 . ,pi)) + without-vector without-pi) + (Assert (equal dotted (ldiff dotted nil)) + "checking ldiff handles dotted lists properly") + (Assert (equal (butlast dotted 0) (ldiff dotted vector)) + "checking ldiff discards dotted elements correctly") + (Assert (equal (butlast dotted-pi 0) (ldiff dotted-pi (* 4 (atan 1)))) + "checking ldiff handles float equivalence correctly")) + +;;----------------------------------------------------- +;; Test `tailp' +;;----------------------------------------------------- +(Check-Error wrong-type-argument (tailp pi 'foo)) +(Check-Error wrong-number-of-arguments (tailp)) +(Check-Error wrong-number-of-arguments (tailp '(1 2))) +(Check-Error circular-list (tailp nil (make-circular-list 1))) +(Check-Error circular-list (tailp nil (make-circular-list 2000))) +(Assert (null (tailp pi '())) + "checking pi is not a tail of the list nil") +(Assert (tailp 3 '(1 2 . 3)) + "checking #'tailp works with a dotted integer.") +(Assert (tailp pi `(1 2 . ,(* 4 (atan 1)))) + "checking tailp works with non-eq dotted floats.") +(let ((list (make-list 2048 nil))) + (Assert (tailp (nthcdr 2000 list) (nconc list list)) + "checking #'tailp succeeds with circular LIST containing SUBLIST")) + +;;----------------------------------------------------- +;; Test `endp' +;;----------------------------------------------------- +(Check-Error wrong-type-argument (endp 'foo)) +(Check-Error wrong-number-of-arguments (endp)) +(Check-Error wrong-number-of-arguments (endp '(1 2) 'foo)) +(Assert (endp nil) "checking nil is recognized as the end of a list") +(Assert (not (endp (list 200 200 4 0 9))) + "checking a cons is not recognised as the end of a list") + +;;----------------------------------------------------- ;; Arithmetic operations ;;----------------------------------------------------- ;; Test `+' -(Assert-eq (+ 1 1) 2) -(Assert= (+ 1.0 1.0) 2.0) -(Assert= (+ 1.0 3.0 0.0) 4.0) -(Assert= (+ 1 1.0) 2.0) -(Assert= (+ 1.0 1) 2.0) -(Assert= (+ 1.0 1 1) 3.0) -(Assert= (+ 1 1 1.0) 3.0) +(Assert (eq (+ 1 1) 2)) +(Assert (= (+ 1.0 1.0) 2.0)) +(Assert (= (+ 1.0 3.0 0.0) 4.0)) +(Assert (= (+ 1 1.0) 2.0)) +(Assert (= (+ 1.0 1) 2.0)) +(Assert (= (+ 1.0 1 1) 3.0)) +(Assert (= (+ 1 1 1.0) 3.0)) (if (featurep 'bignum) (progn (Assert (bignump (1+ most-positive-fixnum))) - (Assert-eq most-positive-fixnum (1- (1+ most-positive-fixnum))) + (Assert (eq most-positive-fixnum (1- (1+ most-positive-fixnum)))) (Assert (bignump (+ most-positive-fixnum 1))) - (Assert-eq most-positive-fixnum (- (+ most-positive-fixnum 1) 1)) - (Assert= (1+ most-positive-fixnum) (- most-negative-fixnum)) + (Assert (eq most-positive-fixnum (- (+ most-positive-fixnum 1) 1))) + (Assert (= (1+ most-positive-fixnum) (- most-negative-fixnum))) (Assert (zerop (+ (* 3 most-negative-fixnum) (* 3 most-positive-fixnum) 3)))) - (Assert-eq (1+ most-positive-fixnum) most-negative-fixnum) - (Assert-eq (+ most-positive-fixnum 1) most-negative-fixnum)) + (Assert (eq (1+ most-positive-fixnum) most-negative-fixnum)) + (Assert (eq (+ most-positive-fixnum 1) most-negative-fixnum))) (when (featurep 'ratio) (let ((threefourths (read "3/4")) @@ -247,47 +316,47 @@ (bigpos (div (+ most-positive-fixnum 2) (1+ most-positive-fixnum))) (bigneg (div (+ most-positive-fixnum 2) most-negative-fixnum)) (negone (div (1+ most-positive-fixnum) most-negative-fixnum))) - (Assert= negone -1) - (Assert= threehalfs (+ threefourths threefourths)) + (Assert (= negone -1)) + (Assert (= threehalfs (+ threefourths threefourths))) (Assert (zerop (+ bigpos bigneg))))) ;; Test `-' (Check-Error wrong-number-of-arguments (-)) -(Assert-eq (- 0) 0) -(Assert-eq (- 1) -1) +(Assert (eq (- 0) 0)) +(Assert (eq (- 1) -1)) (dolist (one `(1 1.0 ?\1 ,(Int-to-Marker 1))) - (Assert= (+ 1 one) 2) - (Assert= (+ one) 1) - (Assert= (+ one) one) - (Assert= (- one) -1) - (Assert= (- one one) 0) - (Assert= (- one one one) -1) - (Assert= (- 0 one) -1) - (Assert= (- 0 one one) -2) - (Assert= (+ one 1) 2) + (Assert (= (+ 1 one) 2)) + (Assert (= (+ one) 1)) + (Assert (= (+ one) one)) + (Assert (= (- one) -1)) + (Assert (= (- one one) 0)) + (Assert (= (- one one one) -1)) + (Assert (= (- 0 one) -1)) + (Assert (= (- 0 one one) -2)) + (Assert (= (+ one 1) 2)) (dolist (zero '(0 0.0 ?\0)) - (Assert= (+ 1 zero) 1 zero) - (Assert= (+ zero 1) 1 zero) - (Assert= (- zero) zero zero) - (Assert= (- zero) 0 zero) - (Assert= (- zero zero) 0 zero) - (Assert= (- zero one one) -2 zero))) + (Assert (= (+ 1 zero) 1) zero) + (Assert (= (+ zero 1) 1) zero) + (Assert (= (- zero) zero) zero) + (Assert (= (- zero) 0) zero) + (Assert (= (- zero zero) 0) zero) + (Assert (= (- zero one one) -2) zero))) -(Assert= (- 1.5 1) .5) -(Assert= (- 1 1.5) (- .5)) +(Assert (= (- 1.5 1) .5)) +(Assert (= (- 1 1.5) (- .5))) (if (featurep 'bignum) (progn (Assert (bignump (1- most-negative-fixnum))) - (Assert-eq most-negative-fixnum (1+ (1- most-negative-fixnum))) + (Assert (eq most-negative-fixnum (1+ (1- most-negative-fixnum)))) (Assert (bignump (- most-negative-fixnum 1))) - (Assert-eq most-negative-fixnum (+ (- most-negative-fixnum 1) 1)) - (Assert= (1- most-negative-fixnum) (- 0 most-positive-fixnum 2)) - (Assert-eq (- (- most-positive-fixnum most-negative-fixnum) + (Assert (eq most-negative-fixnum (+ (- most-negative-fixnum 1) 1))) + (Assert (= (1- most-negative-fixnum) (- 0 most-positive-fixnum 2))) + (Assert (eq (- (- most-positive-fixnum most-negative-fixnum) (* 2 most-positive-fixnum)) - 1)) - (Assert-eq (1- most-negative-fixnum) most-positive-fixnum) - (Assert-eq (- most-negative-fixnum 1) most-positive-fixnum)) + 1))) + (Assert (eq (1- most-negative-fixnum) most-positive-fixnum)) + (Assert (eq (- most-negative-fixnum 1) most-positive-fixnum))) (when (featurep 'ratio) (let ((threefourths (read "3/4")) @@ -295,9 +364,9 @@ (bigpos (div (+ most-positive-fixnum 2) (1+ most-positive-fixnum))) (bigneg (div most-positive-fixnum most-negative-fixnum)) (negone (div (1+ most-positive-fixnum) most-negative-fixnum))) - (Assert= (- negone) 1) - (Assert= threefourths (- threehalfs threefourths)) - (Assert= (- bigpos bigneg) 2))) + (Assert (= (- negone) 1)) + (Assert (= threefourths (- threehalfs threefourths))) + (Assert (= (- bigpos bigneg) 2)))) ;; Test `/' @@ -312,180 +381,180 @@ ;; Other tests for `/' (Check-Error wrong-number-of-arguments (/)) (let (x) - (Assert= (/ (setq x 2)) 0) - (Assert= (/ (setq x 2.0)) 0.5)) + (Assert (= (/ (setq x 2)) 0)) + (Assert (= (/ (setq x 2.0)) 0.5))) (dolist (six '(6 6.0 ?\06)) (dolist (two '(2 2.0 ?\02)) (dolist (three '(3 3.0 ?\03)) - (Assert= (/ six two) three (list six two three))))) + (Assert (= (/ six two) three) (list six two three))))) (dolist (three '(3 3.0 ?\03)) - (Assert= (/ three 2.0) 1.5 three)) + (Assert (= (/ three 2.0) 1.5) three)) (dolist (two '(2 2.0 ?\02)) - (Assert= (/ 3.0 two) 1.5 two)) + (Assert (= (/ 3.0 two) 1.5) two)) (when (featurep 'bignum) (let* ((million 1000000) (billion (* million 1000)) ;; American, not British, billion (trillion (* billion 1000))) - (Assert= (/ billion 1000) (/ trillion million) million 1000000.0) - (Assert= (/ billion -1000) (/ trillion (- million)) (- million)) - (Assert= (/ trillion 1000) billion 1000000000.0) - (Assert= (/ trillion -1000) (- billion) -1000000000.0) - (Assert= (/ trillion 10) (* 100 billion) 100000000000.0) - (Assert= (/ (- trillion) 10) (* -100 billion) -100000000000.0))) + (Assert (= (/ billion 1000) (/ trillion million) million 1000000.0)) + (Assert (= (/ billion -1000) (/ trillion (- million)) (- million))) + (Assert (= (/ trillion 1000) billion 1000000000.0)) + (Assert (= (/ trillion -1000) (- billion) -1000000000.0)) + (Assert (= (/ trillion 10) (* 100 billion) 100000000000.0)) + (Assert (= (/ (- trillion) 10) (* -100 billion) -100000000000.0)))) (when (featurep 'ratio) (let ((half (div 1 2)) (fivefourths (div 5 4)) (fivehalfs (div 5 2))) - (Assert= half (read "3000000000/6000000000")) - (Assert= (/ fivehalfs fivefourths) 2) - (Assert= (/ fivefourths fivehalfs) half) - (Assert= (- half) (read "-3000000000/6000000000")) - (Assert= (/ fivehalfs (- fivefourths)) -2) - (Assert= (/ (- fivefourths) fivehalfs) (- half)))) + (Assert (= half (read "3000000000/6000000000"))) + (Assert (= (/ fivehalfs fivefourths) 2)) + (Assert (= (/ fivefourths fivehalfs) half)) + (Assert (= (- half) (read "-3000000000/6000000000"))) + (Assert (= (/ fivehalfs (- fivefourths)) -2)) + (Assert (= (/ (- fivefourths) fivehalfs) (- half))))) ;; Test `*' -(Assert= 1 (*)) +(Assert (= 1 (*))) (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1))) - (Assert= 1 (* one) one)) + (Assert (= 1 (* one)) one)) (dolist (two '(2 2.0 ?\02)) - (Assert= 2 (* two) two)) + (Assert (= 2 (* two)) two)) (dolist (six '(6 6.0 ?\06)) (dolist (two '(2 2.0 ?\02)) (dolist (three '(3 3.0 ?\03)) - (Assert= (* three two) six (list three two six))))) + (Assert (= (* three two) six) (list three two six))))) (dolist (three '(3 3.0 ?\03)) (dolist (two '(2 2.0 ?\02)) - (Assert= (* 1.5 two) three (list two three)) + (Assert (= (* 1.5 two) three) (list two three)) (dolist (five '(5 5.0 ?\05)) - (Assert= 30 (* five two three) (list five two three))))) + (Assert (= 30 (* five two three)) (list five two three))))) (when (featurep 'bignum) (let ((64K 65536)) - (Assert= (* 64K 64K) (read "4294967296")) - (Assert= (* (- 64K) 64K) (read "-4294967296")) + (Assert (= (* 64K 64K) (read "4294967296"))) + (Assert (= (* (- 64K) 64K) (read "-4294967296"))) (Assert (/= (* -1 most-negative-fixnum) most-negative-fixnum)))) (when (featurep 'ratio) (let ((half (div 1 2)) (fivefourths (div 5 4)) (twofifths (div 2 5))) - (Assert= (* fivefourths twofifths) half) - (Assert= (* half twofifths) (read "3/15")))) + (Assert (= (* fivefourths twofifths) half)) + (Assert (= (* half twofifths) (read "3/15"))))) ;; Test `+' -(Assert= 0 (+)) +(Assert (= 0 (+))) (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1))) - (Assert= 1 (+ one) one)) + (Assert (= 1 (+ one)) one)) (dolist (two '(2 2.0 ?\02)) - (Assert= 2 (+ two) two)) + (Assert (= 2 (+ two)) two)) (dolist (five '(5 5.0 ?\05)) (dolist (two '(2 2.0 ?\02)) (dolist (three '(3 3.0 ?\03)) - (Assert= (+ three two) five (list three two five)) - (Assert= 10 (+ five two three) (list five two three))))) + (Assert (= (+ three two) five) (list three two five)) + (Assert (= 10 (+ five two three)) (list five two three))))) ;; Test `max', `min' (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1))) - (Assert= one (max one) one) - (Assert= one (max one one) one) - (Assert= one (max one one one) one) - (Assert= one (min one) one) - (Assert= one (min one one) one) - (Assert= one (min one one one) one) + (Assert (= one (max one)) one) + (Assert (= one (max one one)) one) + (Assert (= one (max one one one)) one) + (Assert (= one (min one)) one) + (Assert (= one (min one one)) one) + (Assert (= one (min one one one)) one) (dolist (two `(2 2.0 ?\02 ,(Int-to-Marker 2))) - (Assert= one (min one two) (list one two)) - (Assert= one (min one two two) (list one two)) - (Assert= one (min two two one) (list one two)) - (Assert= two (max one two) (list one two)) - (Assert= two (max one two two) (list one two)) - (Assert= two (max two two one) (list one two)))) + (Assert (= one (min one two)) (list one two)) + (Assert (= one (min one two two)) (list one two)) + (Assert (= one (min two two one)) (list one two)) + (Assert (= two (max one two)) (list one two)) + (Assert (= two (max one two two)) (list one two)) + (Assert (= two (max two two one)) (list one two)))) (when (featurep 'bignum) (let ((big (1+ most-positive-fixnum)) (small (1- most-negative-fixnum))) - (Assert= big (max 1 1000000.0 most-positive-fixnum big)) - (Assert= small (min -1 -1000000.0 most-negative-fixnum small)))) + (Assert (= big (max 1 1000000.0 most-positive-fixnum big))) + (Assert (= small (min -1 -1000000.0 most-negative-fixnum small))))) (when (featurep 'ratio) (let* ((big (1+ most-positive-fixnum)) (small (1- most-negative-fixnum)) (bigr (div (* 5 (1+ most-positive-fixnum)) 4)) (smallr (- bigr))) - (Assert= bigr (max 1 1000000.0 most-positive-fixnum big bigr)) - (Assert= smallr (min -1 -1000000.0 most-negative-fixnum small smallr)))) + (Assert (= bigr (max 1 1000000.0 most-positive-fixnum big bigr))) + (Assert (= smallr (min -1 -1000000.0 most-negative-fixnum small smallr))))) ;; The byte compiler has special handling for these constructs: (let ((three 3) (five 5)) - (Assert= (+ three five 1) 9) - (Assert= (+ 1 three five) 9) - (Assert= (+ three five -1) 7) - (Assert= (+ -1 three five) 7) - (Assert= (+ three 1) 4) - (Assert= (+ three -1) 2) - (Assert= (+ -1 three) 2) - (Assert= (+ -1 three) 2) - (Assert= (- three five 1) -3) - (Assert= (- 1 three five) -7) - (Assert= (- three five -1) -1) - (Assert= (- -1 three five) -9) - (Assert= (- three 1) 2) - (Assert= (- three 2 1) 0) - (Assert= (- 2 three 1) -2) - (Assert= (- three -1) 4) - (Assert= (- three 0) 3) - (Assert= (- three 0 five) -2) - (Assert= (- 0 three 0 five) -8) - (Assert= (- 0 three five) -8) - (Assert= (* three 2) 6) - (Assert= (* three -1 five) -15) - (Assert= (* three 1 five) 15) - (Assert= (* three 0 five) 0) - (Assert= (* three 2 five) 30) - (Assert= (/ three 1) 3) - (Assert= (/ three -1) -3) - (Assert= (/ (* five five) 2 2) 6) - (Assert= (/ 64 five 2) 6)) + (Assert (= (+ three five 1) 9)) + (Assert (= (+ 1 three five) 9)) + (Assert (= (+ three five -1) 7)) + (Assert (= (+ -1 three five) 7)) + (Assert (= (+ three 1) 4)) + (Assert (= (+ three -1) 2)) + (Assert (= (+ -1 three) 2)) + (Assert (= (+ -1 three) 2)) + (Assert (= (- three five 1) -3)) + (Assert (= (- 1 three five) -7)) + (Assert (= (- three five -1) -1)) + (Assert (= (- -1 three five) -9)) + (Assert (= (- three 1) 2)) + (Assert (= (- three 2 1) 0)) + (Assert (= (- 2 three 1) -2)) + (Assert (= (- three -1) 4)) + (Assert (= (- three 0) 3)) + (Assert (= (- three 0 five) -2)) + (Assert (= (- 0 three 0 five) -8)) + (Assert (= (- 0 three five) -8)) + (Assert (= (* three 2) 6)) + (Assert (= (* three -1 five) -15)) + (Assert (= (* three 1 five) 15)) + (Assert (= (* three 0 five) 0)) + (Assert (= (* three 2 five) 30)) + (Assert (= (/ three 1) 3)) + (Assert (= (/ three -1) -3)) + (Assert (= (/ (* five five) 2 2) 6)) + (Assert (= (/ 64 five 2) 6))) ;;----------------------------------------------------- ;; Logical bit-twiddling operations ;;----------------------------------------------------- -(Assert= (logxor) 0) -(Assert= (logior) 0) -(Assert= (logand) -1) +(Assert (= (logxor) 0)) +(Assert (= (logior) 0)) +(Assert (= (logand) -1)) (Check-Error wrong-type-argument (logxor 3.0)) (Check-Error wrong-type-argument (logior 3.0)) (Check-Error wrong-type-argument (logand 3.0)) (dolist (three '(3 ?\03)) - (Assert-eq 3 (logand three) three) - (Assert-eq 3 (logxor three) three) - (Assert-eq 3 (logior three) three) - (Assert-eq 3 (logand three three) three) - (Assert-eq 0 (logxor three three) three) - (Assert-eq 3 (logior three three)) three) + (Assert (eq 3 (logand three)) three) + (Assert (eq 3 (logxor three)) three) + (Assert (eq 3 (logior three)) three) + (Assert (eq 3 (logand three three)) three) + (Assert (eq 0 (logxor three three)) three) + (Assert (eq 3 (logior three three))) three) (dolist (one `(1 ?\01 ,(Int-to-Marker 1))) (dolist (two '(2 ?\02)) - (Assert-eq 0 (logand one two) (list one two)) - (Assert-eq 3 (logior one two) (list one two)) - (Assert-eq 3 (logxor one two) (list one two))) + (Assert (eq 0 (logand one two)) (list one two)) + (Assert (eq 3 (logior one two)) (list one two)) + (Assert (eq 3 (logxor one two)) (list one two))) (dolist (three '(3 ?\03)) - (Assert-eq 1 (logand one three) (list one three)) - (Assert-eq 3 (logior one three) (list one three)) - (Assert-eq 2 (logxor one three) (list one three)))) + (Assert (eq 1 (logand one three)) (list one three)) + (Assert (eq 3 (logior one three)) (list one three)) + (Assert (eq 2 (logxor one three)) (list one three)))) ;;----------------------------------------------------- ;; Test `%', mod @@ -501,11 +570,11 @@ (Check-Error wrong-type-argument (% 10.0 2)) (Check-Error wrong-type-argument (% 10 2.0)) -(flet ((test1 (x) (Assert-eql x (+ (% x 17) (* (/ x 17) 17)) x)) - (test2 (x) (Assert-eql (- x) (+ (% (- x) 17) (* (/ (- x) 17) 17)) x)) - (test3 (x) (Assert-eql x (+ (% (- x) 17) (* (/ (- x) 17) 17)) x)) - (test4 (x) (Assert-eql (% x -17) (- (% (- x) 17)) x)) - (test5 (x) (Assert-eql (% x -17) (% (- x) 17)) x)) +(flet ((test1 (x) (Assert (eql x (+ (% x 17) (* (/ x 17) 17))) x)) + (test2 (x) (Assert (eql (- x) (+ (% (- x) 17) (* (/ (- x) 17) 17))) x)) + (test3 (x) (Assert (eql x (+ (% (- x) 17) (* (/ (- x) 17) 17))) x)) + (test4 (x) (Assert (eql (% x -17) (- (% (- x) 17))) x)) + (test5 (x) (Assert (eql (% x -17) (% (- x) 17))) x)) (test1 most-negative-fixnum) (if (featurep 'bignum) (progn @@ -527,54 +596,54 @@ (macrolet ((division-test (seven) `(progn - (Assert-eq (% ,seven 2) 1) - (Assert-eq (% ,seven -2) 1) - (Assert-eq (% (- ,seven) 2) -1) - (Assert-eq (% (- ,seven) -2) -1) + (Assert (eq (% ,seven 2) 1)) + (Assert (eq (% ,seven -2) 1)) + (Assert (eq (% (- ,seven) 2) -1)) + (Assert (eq (% (- ,seven) -2) -1)) - (Assert-eq (% ,seven 4) 3) - (Assert-eq (% ,seven -4) 3) - (Assert-eq (% (- ,seven) 4) -3) - (Assert-eq (% (- ,seven) -4) -3) + (Assert (eq (% ,seven 4) 3)) + (Assert (eq (% ,seven -4) 3)) + (Assert (eq (% (- ,seven) 4) -3)) + (Assert (eq (% (- ,seven) -4) -3)) - (Assert-eq (% 35 ,seven) 0) - (Assert-eq (% -35 ,seven) 0) - (Assert-eq (% 35 (- ,seven)) 0) - (Assert-eq (% -35 (- ,seven)) 0) + (Assert (eq (% 35 ,seven) 0)) + (Assert (eq (% -35 ,seven) 0)) + (Assert (eq (% 35 (- ,seven)) 0)) + (Assert (eq (% -35 (- ,seven)) 0)) - (Assert-eq (mod ,seven 2) 1) - (Assert-eq (mod ,seven -2) -1) - (Assert-eq (mod (- ,seven) 2) 1) - (Assert-eq (mod (- ,seven) -2) -1) + (Assert (eq (mod ,seven 2) 1)) + (Assert (eq (mod ,seven -2) -1)) + (Assert (eq (mod (- ,seven) 2) 1)) + (Assert (eq (mod (- ,seven) -2) -1)) - (Assert-eq (mod ,seven 4) 3) - (Assert-eq (mod ,seven -4) -1) - (Assert-eq (mod (- ,seven) 4) 1) - (Assert-eq (mod (- ,seven) -4) -3) + (Assert (eq (mod ,seven 4) 3)) + (Assert (eq (mod ,seven -4) -1)) + (Assert (eq (mod (- ,seven) 4) 1)) + (Assert (eq (mod (- ,seven) -4) -3)) - (Assert-eq (mod 35 ,seven) 0) - (Assert-eq (mod -35 ,seven) 0) - (Assert-eq (mod 35 (- ,seven)) 0) - (Assert-eq (mod -35 (- ,seven)) 0) + (Assert (eq (mod 35 ,seven) 0)) + (Assert (eq (mod -35 ,seven) 0)) + (Assert (eq (mod 35 (- ,seven)) 0)) + (Assert (eq (mod -35 (- ,seven)) 0)) - (Assert= (mod ,seven 2.0) 1.0) - (Assert= (mod ,seven -2.0) -1.0) - (Assert= (mod (- ,seven) 2.0) 1.0) - (Assert= (mod (- ,seven) -2.0) -1.0) + (Assert (= (mod ,seven 2.0) 1.0)) + (Assert (= (mod ,seven -2.0) -1.0)) + (Assert (= (mod (- ,seven) 2.0) 1.0)) + (Assert (= (mod (- ,seven) -2.0) -1.0)) - (Assert= (mod ,seven 4.0) 3.0) - (Assert= (mod ,seven -4.0) -1.0) - (Assert= (mod (- ,seven) 4.0) 1.0) - (Assert= (mod (- ,seven) -4.0) -3.0) + (Assert (= (mod ,seven 4.0) 3.0)) + (Assert (= (mod ,seven -4.0) -1.0)) + (Assert (= (mod (- ,seven) 4.0) 1.0)) + (Assert (= (mod (- ,seven) -4.0) -3.0)) - (Assert-eq (% 0 ,seven) 0) - (Assert-eq (% 0 (- ,seven)) 0) + (Assert (eq (% 0 ,seven) 0)) + (Assert (eq (% 0 (- ,seven)) 0)) - (Assert-eq (mod 0 ,seven) 0) - (Assert-eq (mod 0 (- ,seven)) 0) + (Assert (eq (mod 0 ,seven) 0)) + (Assert (eq (mod 0 (- ,seven)) 0)) - (Assert= (mod 0.0 ,seven) 0.0) - (Assert= (mod 0.0 (- ,seven)) 0.0)))) + (Assert (= (mod 0.0 ,seven) 0.0)) + (Assert (= (mod 0.0 (- ,seven)) 0.0))))) (division-test 7) (division-test ?\07) @@ -600,12 +669,12 @@ ;; One argument always yields t (loop for x in `(1 1.0 ,(Int-to-Marker 1) ?z) do - (Assert-eq t (= x) x) - (Assert-eq t (< x) x) - (Assert-eq t (> x) x) - (Assert-eq t (>= x) x) - (Assert-eq t (<= x) x) - (Assert-eq t (/= x) x) + (Assert (eq t (= x)) x) + (Assert (eq t (< x)) x) + (Assert (eq t (> x)) x) + (Assert (eq t (>= x)) x) + (Assert (eq t (<= x)) x) + (Assert (eq t (/= x)) x) ) ;; Type checking @@ -633,7 +702,7 @@ (Assert (not (< one one two two)) (list one two)) (Assert (>= two two one one) (list one two)) (Assert (not (> two two one one)) (list one two)) - (Assert= one one one one) + (Assert (= one one one) one) (Assert (not (= one one one two)) (list one two)) (Assert (not (/= one two one)) (list one two)) )) @@ -654,7 +723,7 @@ (Assert (not (< one one two two)) (list one two)) (Assert (>= two two one one) (list one two)) (Assert (not (> two two one one)) (list one two)) - (Assert= one one one one) + (Assert (= one one one) one) (Assert (not (= one one one two)) (list one two)) (Assert (not (/= one two one)) (list one two)) )) @@ -674,8 +743,8 @@ (Assert (<= 1 1)) (Assert (not (eq (point) (point-marker)))) -(Assert= 1 (Int-to-Marker 1)) -(Assert= (point) (point-marker)) +(Assert (= 1 (Int-to-Marker 1))) +(Assert (= (point) (point-marker))) (when (featurep 'bignum) (let ((big1 (1+ most-positive-fixnum)) @@ -700,8 +769,8 @@ (small1 (div (* 10 most-negative-fixnum) 4)) (small2 (div (* 5 most-negative-fixnum) 2)) (small3 (div (* 7 most-negative-fixnum) 2))) - (Assert= big1 big2) - (Assert= small1 small2) + (Assert (= big1 big2)) + (Assert (= small1 small2)) (Assert (< small3 small1 most-negative-fixnum most-positive-fixnum big1 big3)) (Assert (<= small3 small2 small1 most-negative-fixnum most-positive-fixnum @@ -722,71 +791,73 @@ `(progn (Check-Error wrong-number-of-arguments (,fun)) (Check-Error wrong-number-of-arguments (,fun nil)) - (Check-Error malformed-list (,fun nil 1)) + (Check-Error (malformed-list wrong-type-argument) (,fun nil 1)) ,@(loop for n in '(1 2 2000) collect `(Check-Error circular-list (,fun 1 (make-circular-list ,n)))))) - (test-funs (&rest funs) `(progn ,@(loop for fun in funs collect `(test-fun ,fun))))) - - (test-funs member old-member - memq old-memq - assoc old-assoc - rassoc old-rassoc - rassq old-rassq - delete old-delete - delq old-delq - remassoc remassq remrassoc remrassq)) + (test-funs (&rest funs) `(progn ,@(loop for fun in funs collect `(test-fun ,fun)))) + (test-old-funs (&rest funs) + `(when (and (fboundp 'old-eq) (subrp (symbol-function 'old-eq))) + ,@(loop for fun in funs collect `(test-fun ,fun))))) + (test-funs member* member memq + assoc* assoc assq + rassoc* rassoc rassq + delete* delete delq + remove* remove remq + remassoc remassq remrassoc remrassq) + (test-old-funs old-member old-memq old-assoc old-assq old-rassoc old-rassq + old-delete old-delq)) (let ((x '((1 . 2) 3 (4 . 5)))) - (Assert-eq (assoc 1 x) (car x)) - (Assert-eq (assq 1 x) (car x)) - (Assert-eq (rassoc 1 x) nil) - (Assert-eq (rassq 1 x) nil) - (Assert-eq (assoc 2 x) nil) - (Assert-eq (assq 2 x) nil) - (Assert-eq (rassoc 2 x) (car x)) - (Assert-eq (rassq 2 x) (car x)) - (Assert-eq (assoc 3 x) nil) - (Assert-eq (assq 3 x) nil) - (Assert-eq (rassoc 3 x) nil) - (Assert-eq (rassq 3 x) nil) - (Assert-eq (assoc 4 x) (caddr x)) - (Assert-eq (assq 4 x) (caddr x)) - (Assert-eq (rassoc 4 x) nil) - (Assert-eq (rassq 4 x) nil) - (Assert-eq (assoc 5 x) nil) - (Assert-eq (assq 5 x) nil) - (Assert-eq (rassoc 5 x) (caddr x)) - (Assert-eq (rassq 5 x) (caddr x)) - (Assert-eq (assoc 6 x) nil) - (Assert-eq (assq 6 x) nil) - (Assert-eq (rassoc 6 x) nil) - (Assert-eq (rassq 6 x) nil)) + (Assert (eq (assoc 1 x) (car x))) + (Assert (eq (assq 1 x) (car x))) + (Assert (eq (rassoc 1 x) nil)) + (Assert (eq (rassq 1 x) nil)) + (Assert (eq (assoc 2 x) nil)) + (Assert (eq (assq 2 x) nil)) + (Assert (eq (rassoc 2 x) (car x))) + (Assert (eq (rassq 2 x) (car x))) + (Assert (eq (assoc 3 x) nil)) + (Assert (eq (assq 3 x) nil)) + (Assert (eq (rassoc 3 x) nil)) + (Assert (eq (rassq 3 x) nil)) + (Assert (eq (assoc 4 x) (caddr x))) + (Assert (eq (assq 4 x) (caddr x))) + (Assert (eq (rassoc 4 x) nil)) + (Assert (eq (rassq 4 x) nil)) + (Assert (eq (assoc 5 x) nil)) + (Assert (eq (assq 5 x) nil)) + (Assert (eq (rassoc 5 x) (caddr x))) + (Assert (eq (rassq 5 x) (caddr x))) + (Assert (eq (assoc 6 x) nil)) + (Assert (eq (assq 6 x) nil)) + (Assert (eq (rassoc 6 x) nil)) + (Assert (eq (rassq 6 x) nil))) (let ((x '(("1" . "2") "3" ("4" . "5")))) - (Assert-eq (assoc "1" x) (car x)) - (Assert-eq (assq "1" x) nil) - (Assert-eq (rassoc "1" x) nil) - (Assert-eq (rassq "1" x) nil) - (Assert-eq (assoc "2" x) nil) - (Assert-eq (assq "2" x) nil) - (Assert-eq (rassoc "2" x) (car x)) - (Assert-eq (rassq "2" x) nil) - (Assert-eq (assoc "3" x) nil) - (Assert-eq (assq "3" x) nil) - (Assert-eq (rassoc "3" x) nil) - (Assert-eq (rassq "3" x) nil) - (Assert-eq (assoc "4" x) (caddr x)) - (Assert-eq (assq "4" x) nil) - (Assert-eq (rassoc "4" x) nil) - (Assert-eq (rassq "4" x) nil) - (Assert-eq (assoc "5" x) nil) - (Assert-eq (assq "5" x) nil) - (Assert-eq (rassoc "5" x) (caddr x)) - (Assert-eq (rassq "5" x) nil) - (Assert-eq (assoc "6" x) nil) - (Assert-eq (assq "6" x) nil) - (Assert-eq (rassoc "6" x) nil) - (Assert-eq (rassq "6" x) nil)) + (Assert (eq (assoc "1" x) (car x))) + (Assert (eq (assq "1" x) nil)) + (Assert (eq (rassoc "1" x) nil)) + (Assert (eq (rassq "1" x) nil)) + (Assert (eq (assoc "2" x) nil)) + (Assert (eq (assq "2" x) nil)) + (Assert (eq (rassoc "2" x) (car x))) + (Assert (eq (rassq "2" x) nil)) + (Assert (eq (assoc "3" x) nil)) + (Assert (eq (assq "3" x) nil)) + (Assert (eq (rassoc "3" x) nil)) + (Assert (eq (rassq "3" x) nil)) + (Assert (eq (assoc "4" x) (caddr x))) + (Assert (eq (assq "4" x) nil)) + (Assert (eq (rassoc "4" x) nil)) + (Assert (eq (rassq "4" x) nil)) + (Assert (eq (assoc "5" x) nil)) + (Assert (eq (assq "5" x) nil)) + (Assert (eq (rassoc "5" x) (caddr x))) + (Assert (eq (rassq "5" x) nil)) + (Assert (eq (assoc "6" x) nil)) + (Assert (eq (assq "6" x) nil)) + (Assert (eq (rassoc "6" x) nil)) + (Assert (eq (rassq "6" x) nil))) (flet ((a () (list '(1 . 2) 3 '(4 . 5)))) (Assert (let* ((x (a)) (y (remassoc 1 x))) (and (not (eq x y)) (equal y '(3 (4 . 5)))))) @@ -818,19 +889,15 @@ (Assert (let* ((x (a)) (y (remassq 6 x))) (and (eq x y) (equal y (a))))) (Assert (let* ((x (a)) (y (remrassoc 6 x))) (and (eq x y) (equal y (a))))) (Assert (let* ((x (a)) (y (remrassq 6 x))) (and (eq x y) (equal y (a))))) - (Assert (let* ((x (a)) (y (delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5)))))) (Assert (let* ((x (a)) (y (delq 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5)))))) - (Assert (let* ((x (a)) (y (old-delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5)))))) - (Assert (let* ((x (a)) (y (old-delq 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5)))))) - (Assert (let* ((x (a)) (y (delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5)))))) (Assert (let* ((x (a)) (y (delq '(1 . 2) x))) (and (eq x y) (equal y (a))))) - (Assert (let* ((x (a)) (y (old-delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5)))))) - (Assert (let* ((x (a)) (y (old-delq '(1 . 2) x))) (and (eq x y) (equal y (a))))) - ) - - + (when (and (fboundp 'old-eq) (subrp (symbol-function 'old-eq))) + (Assert (let* ((x (a)) (y (old-delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5)))))) + (Assert (let* ((x (a)) (y (old-delq '(1 . 2) x))) (and (eq x y) (equal y (a))))) + (Assert (let* ((x (a)) (y (old-delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5)))))) + (Assert (let* ((x (a)) (y (old-delq 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5)))))))) (flet ((a () (list '("1" . "2") "3" '("4" . "5")))) (Assert (let* ((x (a)) (y (remassoc "1" x))) (and (not (eq x y)) (equal y '("3" ("4" . "5")))))) @@ -868,8 +935,8 @@ ;;----------------------------------------------------- (defmacro check-function-argcounts (fun min max) `(progn - (Assert-eq (function-min-args ,fun) ,min) - (Assert-eq (function-max-args ,fun) ,max))) + (Assert (eq (function-min-args ,fun) ,min)) + (Assert (eq (function-max-args ,fun) ,max)))) (check-function-argcounts 'prog1 1 nil) ; special form (check-function-argcounts 'command-execute 1 3) ; normal subr @@ -896,7 +963,7 @@ (list (0 . many)) (type-of (1 . 1)) (garbage-collect (0 . 0))) - do (Assert-equal (subr-arity (symbol-function function-name)) arity)) + do (Assert (equal (subr-arity (symbol-function function-name)) arity))) (Check-Error wrong-type-argument (subr-arity (lambda () (message "Hi there!")))) @@ -918,37 +985,37 @@ ;;----------------------------------------------------- ;; Test `type-of' ;;----------------------------------------------------- -(Assert-eq (type-of load-path) 'cons) -(Assert-eq (type-of obarray) 'vector) -(Assert-eq (type-of 42) 'integer) -(Assert-eq (type-of ?z) 'character) -(Assert-eq (type-of "42") 'string) -(Assert-eq (type-of 'foo) 'symbol) -(Assert-eq (type-of (selected-device)) 'device) +(Assert (eq (type-of load-path) 'cons)) +(Assert (eq (type-of obarray) 'vector)) +(Assert (eq (type-of 42) 'integer)) +(Assert (eq (type-of ?z) 'character)) +(Assert (eq (type-of "42") 'string)) +(Assert (eq (type-of 'foo) 'symbol)) +(Assert (eq (type-of (selected-device)) 'device)) ;;----------------------------------------------------- ;; Test mapping functions ;;----------------------------------------------------- (Check-Error wrong-type-argument (mapcar #'identity (current-buffer))) -(Assert-equal (mapcar #'identity load-path) load-path) -(Assert-equal (mapcar #'identity '(1 2 3)) '(1 2 3)) -(Assert-equal (mapcar #'identity "123") '(?1 ?2 ?3)) -(Assert-equal (mapcar #'identity [1 2 3]) '(1 2 3)) -(Assert-equal (mapcar #'identity #*010) '(0 1 0)) +(Assert (equal (mapcar #'identity load-path) load-path)) +(Assert (equal (mapcar #'identity '(1 2 3)) '(1 2 3))) +(Assert (equal (mapcar #'identity "123") '(?1 ?2 ?3))) +(Assert (equal (mapcar #'identity [1 2 3]) '(1 2 3))) +(Assert (equal (mapcar #'identity #*010) '(0 1 0))) (let ((z 0) (list (make-list 1000 1))) (mapc (lambda (x) (incf z x)) list) - (Assert-eq 1000 z)) + (Assert (eq 1000 z))) (Check-Error wrong-type-argument (mapvector #'identity (current-buffer))) -(Assert-equal (mapvector #'identity '(1 2 3)) [1 2 3]) -(Assert-equal (mapvector #'identity "123") [?1 ?2 ?3]) -(Assert-equal (mapvector #'identity [1 2 3]) [1 2 3]) -(Assert-equal (mapvector #'identity #*010) [0 1 0]) +(Assert (equal (mapvector #'identity '(1 2 3)) [1 2 3])) +(Assert (equal (mapvector #'identity "123") [?1 ?2 ?3])) +(Assert (equal (mapvector #'identity [1 2 3]) [1 2 3])) +(Assert (equal (mapvector #'identity #*010) [0 1 0])) (Check-Error wrong-type-argument (mapconcat #'identity (current-buffer) "foo")) -(Assert-equal (mapconcat #'identity '("1" "2" "3") "|") "1|2|3") -(Assert-equal (mapconcat #'identity ["1" "2" "3"] "|") "1|2|3") +(Assert (equal (mapconcat #'identity '("1" "2" "3") "|") "1|2|3")) +(Assert (equal (mapconcat #'identity ["1" "2" "3"] "|") "1|2|3")) ;; The following 2 functions used to crash XEmacs via mapcar1(). ;; We don't test the actual values of the mapcar, since they're undefined. @@ -973,32 +1040,50 @@ (car y)) x))) +(Assert + (equal + (let ((list (list pi))) (mapcar* #'cons [1 2 3 4] (nconc list list))) + `((1 . ,pi) (2 . ,pi) (3 . ,pi) (4 . ,pi))) + "checking mapcar* behaves correctly when only one arg is circular") + +(Assert (eql + (length (multiple-value-list + (car (mapcar #'(lambda (argument) (floor argument)) (list pi e))))) + 1) + "checking multiple values are correctly discarded in mapcar") + +(let ((malformed-list '(1 2 3 4 hi there . tail))) + (Check-Error malformed-list (mapcar #'identity malformed-list)) + (Check-Error malformed-list (map nil #'eq [1 2 3 4] + malformed-list)) + (Check-Error malformed-list (list-length malformed-list))) + ;;----------------------------------------------------- ;; Test vector functions ;;----------------------------------------------------- -(Assert-equal [1 2 3] [1 2 3]) -(Assert-equal [] []) +(Assert (equal [1 2 3] [1 2 3])) +(Assert (equal [] [])) (Assert (not (equal [1 2 3] []))) (Assert (not (equal [1 2 3] [1 2 4]))) (Assert (not (equal [0 2 3] [1 2 3]))) (Assert (not (equal [1 2 3] [1 2 3 4]))) (Assert (not (equal [1 2 3 4] [1 2 3]))) -(Assert-equal (vector 1 2 3) [1 2 3]) -(Assert-equal (make-vector 3 1) [1 1 1]) +(Assert (equal (vector 1 2 3) [1 2 3])) +(Assert (equal (make-vector 3 1) [1 1 1])) ;;----------------------------------------------------- ;; Test bit-vector functions ;;----------------------------------------------------- -(Assert-equal #*010 #*010) -(Assert-equal #* #*) +(Assert (equal #*010 #*010)) +(Assert (equal #* #*)) (Assert (not (equal #*010 #*011))) (Assert (not (equal #*010 #*))) (Assert (not (equal #*110 #*010))) (Assert (not (equal #*010 #*0100))) (Assert (not (equal #*0101 #*010))) -(Assert-equal (bit-vector 0 1 0) #*010) -(Assert-equal (make-bit-vector 3 1) #*111) -(Assert-equal (make-bit-vector 3 0) #*000) +(Assert (equal (bit-vector 0 1 0) #*010)) +(Assert (equal (make-bit-vector 3 1) #*111)) +(Assert (equal (make-bit-vector 3 0) #*000)) ;;----------------------------------------------------- ;; Test buffer-local variables used as (ugh!) function parameters @@ -1016,109 +1101,179 @@ ;; Hrvoje didn't like the next 3 tests so I'm disabling them for now. -sb ;; I assume Hrvoje worried about the possibility of infloops. -sjt (when test-harness-risk-infloops - (Assert-equal (split-string "foo" "") '("" "f" "o" "o" "")) - (Assert-equal (split-string "foo" "^") '("" "foo")) - (Assert-equal (split-string "foo" "$") '("foo" ""))) -(Assert-equal (split-string "foo,bar" ",") '("foo" "bar")) -(Assert-equal (split-string ",foo,bar," ",") '("" "foo" "bar" "")) -(Assert-equal (split-string ",foo,bar," "^,") '("" "foo,bar,")) -(Assert-equal (split-string ",foo,bar," ",$") '(",foo,bar" "")) -(Assert-equal (split-string ",foo,,bar," ",") '("" "foo" "" "bar" "")) -(Assert-equal (split-string "foo,,,bar" ",") '("foo" "" "" "bar")) -(Assert-equal (split-string "foo,,bar,," ",") '("foo" "" "bar" "" "")) -(Assert-equal (split-string "foo,,bar" ",+") '("foo" "bar")) -(Assert-equal (split-string ",foo,,bar," ",+") '("" "foo" "bar" "")) + (Assert (equal (split-string "foo" "") '("" "f" "o" "o" ""))) + (Assert (equal (split-string "foo" "^") '("" "foo"))) + (Assert (equal (split-string "foo" "$") '("foo" "")))) +(Assert (equal (split-string "foo,bar" ",") '("foo" "bar"))) +(Assert (equal (split-string ",foo,bar," ",") '("" "foo" "bar" ""))) +(Assert (equal (split-string ",foo,bar," "^,") '("" "foo,bar,"))) +(Assert (equal (split-string ",foo,bar," ",$") '(",foo,bar" ""))) +(Assert (equal (split-string ",foo,,bar," ",") '("" "foo" "" "bar" ""))) +(Assert (equal (split-string "foo,,,bar" ",") '("foo" "" "" "bar"))) +(Assert (equal (split-string "foo,,bar,," ",") '("foo" "" "bar" "" ""))) +(Assert (equal (split-string "foo,,bar" ",+") '("foo" "bar"))) +(Assert (equal (split-string ",foo,,bar," ",+") '("" "foo" "bar" ""))) ;; Omit nulls, explicit SEPARATORS (when test-harness-risk-infloops - (Assert-equal (split-string "foo" "" t) '("f" "o" "o")) - (Assert-equal (split-string "foo" "^" t) '("foo")) - (Assert-equal (split-string "foo" "$" t) '("foo"))) -(Assert-equal (split-string "foo,bar" "," t) '("foo" "bar")) -(Assert-equal (split-string ",foo,bar," "," t) '("foo" "bar")) -(Assert-equal (split-string ",foo,bar," "^," t) '("foo,bar,")) -(Assert-equal (split-string ",foo,bar," ",$" t) '(",foo,bar")) -(Assert-equal (split-string ",foo,,bar," "," t) '("foo" "bar")) -(Assert-equal (split-string "foo,,,bar" "," t) '("foo" "bar")) -(Assert-equal (split-string "foo,,bar,," "," t) '("foo" "bar")) -(Assert-equal (split-string "foo,,bar" ",+" t) '("foo" "bar")) -(Assert-equal (split-string ",foo,,bar," ",+" t) '("foo" "bar")) + (Assert (equal (split-string "foo" "" t) '("f" "o" "o"))) + (Assert (equal (split-string "foo" "^" t) '("foo"))) + (Assert (equal (split-string "foo" "$" t) '("foo")))) +(Assert (equal (split-string "foo,bar" "," t) '("foo" "bar"))) +(Assert (equal (split-string ",foo,bar," "," t) '("foo" "bar"))) +(Assert (equal (split-string ",foo,bar," "^," t) '("foo,bar,"))) +(Assert (equal (split-string ",foo,bar," ",$" t) '(",foo,bar"))) +(Assert (equal (split-string ",foo,,bar," "," t) '("foo" "bar"))) +(Assert (equal (split-string "foo,,,bar" "," t) '("foo" "bar"))) +(Assert (equal (split-string "foo,,bar,," "," t) '("foo" "bar"))) +(Assert (equal (split-string "foo,,bar" ",+" t) '("foo" "bar"))) +(Assert (equal (split-string ",foo,,bar," ",+" t) '("foo" "bar"))) ;; "Double-default" case -(Assert-equal (split-string "foo bar") '("foo" "bar")) -(Assert-equal (split-string " foo bar ") '("foo" "bar")) -(Assert-equal (split-string " foo bar ") '("foo" "bar")) -(Assert-equal (split-string "foo bar") '("foo" "bar")) -(Assert-equal (split-string "foo bar ") '("foo" "bar")) -(Assert-equal (split-string "foobar") '("foobar")) +(Assert (equal (split-string "foo bar") '("foo" "bar"))) +(Assert (equal (split-string " foo bar ") '("foo" "bar"))) +(Assert (equal (split-string " foo bar ") '("foo" "bar"))) +(Assert (equal (split-string "foo bar") '("foo" "bar"))) +(Assert (equal (split-string "foo bar ") '("foo" "bar"))) +(Assert (equal (split-string "foobar") '("foobar"))) ;; Semantics are identical to "double-default" case! Fool ya? -(Assert-equal (split-string "foo bar" nil t) '("foo" "bar")) -(Assert-equal (split-string " foo bar " nil t) '("foo" "bar")) -(Assert-equal (split-string " foo bar " nil t) '("foo" "bar")) -(Assert-equal (split-string "foo bar" nil t) '("foo" "bar")) -(Assert-equal (split-string "foo bar " nil t) '("foo" "bar")) -(Assert-equal (split-string "foobar" nil t) '("foobar")) +(Assert (equal (split-string "foo bar" nil t) '("foo" "bar"))) +(Assert (equal (split-string " foo bar " nil t) '("foo" "bar"))) +(Assert (equal (split-string " foo bar " nil t) '("foo" "bar"))) +(Assert (equal (split-string "foo bar" nil t) '("foo" "bar"))) +(Assert (equal (split-string "foo bar " nil t) '("foo" "bar"))) +(Assert (equal (split-string "foobar" nil t) '("foobar"))) ;; Perverse "anti-double-default" case -(Assert-equal (split-string "foo bar" split-string-default-separators) - '("foo" "bar")) -(Assert-equal (split-string " foo bar " split-string-default-separators) - '("" "foo" "bar" "")) -(Assert-equal (split-string " foo bar " split-string-default-separators) - '("" "foo" "bar" "")) -(Assert-equal (split-string "foo bar" split-string-default-separators) - '("foo" "bar")) -(Assert-equal (split-string "foo bar " split-string-default-separators) - '("foo" "bar" "")) -(Assert-equal (split-string "foobar" split-string-default-separators) - '("foobar")) +(Assert (equal (split-string "foo bar" split-string-default-separators) + '("foo" "bar"))) +(Assert (equal (split-string " foo bar " split-string-default-separators) + '("" "foo" "bar" ""))) +(Assert (equal (split-string " foo bar " split-string-default-separators) + '("" "foo" "bar" ""))) +(Assert (equal (split-string "foo bar" split-string-default-separators) + '("foo" "bar"))) +(Assert (equal (split-string "foo bar " split-string-default-separators) + '("foo" "bar" ""))) +(Assert (equal (split-string "foobar" split-string-default-separators) + '("foobar"))) + +;;----------------------------------------------------- +;; Test split-string-by-char +;;----------------------------------------------------- + +(Assert + (equal + (split-string-by-char + #r"re\:ee:this\\is\\text\\\\:oo\ps: +Eine Sprache, die stagnirt, ist zu vergleichen mit einem See, dem der +bisherige Quellenzufluß versiegt oder abgeleitet wird. Aus dem Wasser, +worüber der Geist Gottes schwebte, wird Sumpf und Moder, worüber die +unreinen\: Geister brüten.\\ +Serum concentrations of vitamin E: (alpha-tocopherol) depend on the liver, +which takes up the nutrient after the various forms are absorbed from the +small intestine. The liver preferentially resecretes only alpha-tocopherol +via the hepatic alpha-tocopherol transfer protein" + ?: ?\\) + '("re:ee" "this\\is\\text\\\\" "oops" " +Eine Sprache, die stagnirt, ist zu vergleichen mit einem See, dem der +bisherige Quellenzufluß versiegt oder abgeleitet wird. Aus dem Wasser, +worüber der Geist Gottes schwebte, wird Sumpf und Moder, worüber die +unreinen: Geister brüten.\\ +Serum concentrations of vitamin E" " (alpha-tocopherol) depend on the liver, +which takes up the nutrient after the various forms are absorbed from the +small intestine. The liver preferentially resecretes only alpha-tocopherol +via the hepatic alpha-tocopherol transfer protein"))) +(Assert + (equal + (split-string-by-char + #r"re\:ee:this\\is\\text\\\\:oo\ps: +Eine Sprache, die stagnirt, ist zu vergleichen mit einem See, dem der +bisherige Quellenzufluß versiegt oder abgeleitet wird. Aus dem Wasser, +worüber der Geist Gottes schwebte, wird Sumpf und Moder, worüber die +unreinen\: Geister brüten.\\ +Serum concentrations of vitamin E: (alpha-tocopherol) depend on the liver, +which takes up the nutrient after the various forms are absorbed from the +small intestine. The liver preferentially resecretes only alpha-tocopherol +via the hepatic alpha-tocopherol transfer protein" + ?: ?\x00) + '("re\\" "ee" "this\\\\is\\\\text\\\\\\\\" "oo\\ps" " +Eine Sprache, die stagnirt, ist zu vergleichen mit einem See, dem der +bisherige Quellenzufluß versiegt oder abgeleitet wird. Aus dem Wasser, +worüber der Geist Gottes schwebte, wird Sumpf und Moder, worüber die +unreinen\\" " Geister brüten.\\\\ +Serum concentrations of vitamin E" " (alpha-tocopherol) depend on the liver, +which takes up the nutrient after the various forms are absorbed from the +small intestine. The liver preferentially resecretes only alpha-tocopherol +via the hepatic alpha-tocopherol transfer protein"))) +(Assert + (equal + (split-string-by-char + #r"re\:ee:this\\is\\text\\\\:oo\ps: +Eine Sprache, die stagnirt, ist zu vergleichen mit einem See, dem der +bisherige Quellenzufluß versiegt oder abgeleitet wird. Aus dem Wasser, +worüber der Geist Gottes schwebte, wird Sumpf und Moder, worüber die +unreinen\: Geister brüten.\\ +Serum concentrations of vitamin E: (alpha-tocopherol) depend on the liver, +which takes up the nutrient after the various forms are absorbed from the +small intestine. The liver preferentially resecretes only alpha-tocopherol +via the hepatic alpha-tocopherol transfer protein" ?\\) + '("re" ":ee:this" "" "is" "" "text" "" "" "" ":oo" "ps: +Eine Sprache, die stagnirt, ist zu vergleichen mit einem See, dem der +bisherige Quellenzufluß versiegt oder abgeleitet wird. Aus dem Wasser, +worüber der Geist Gottes schwebte, wird Sumpf und Moder, worüber die +unreinen" ": Geister brüten." "" " +Serum concentrations of vitamin E: (alpha-tocopherol) depend on the liver, +which takes up the nutrient after the various forms are absorbed from the +small intestine. The liver preferentially resecretes only alpha-tocopherol +via the hepatic alpha-tocopherol transfer protein"))) ;;----------------------------------------------------- ;; Test near-text buffer functions. ;;----------------------------------------------------- (with-temp-buffer (erase-buffer) - (Assert-eq (char-before) nil) - (Assert-eq (char-before (point)) nil) - (Assert-eq (char-before (point-marker)) nil) - (Assert-eq (char-before (point) (current-buffer)) nil) - (Assert-eq (char-before (point-marker) (current-buffer)) nil) - (Assert-eq (char-after) nil) - (Assert-eq (char-after (point)) nil) - (Assert-eq (char-after (point-marker)) nil) - (Assert-eq (char-after (point) (current-buffer)) nil) - (Assert-eq (char-after (point-marker) (current-buffer)) nil) - (Assert-eq (preceding-char) 0) - (Assert-eq (preceding-char (current-buffer)) 0) - (Assert-eq (following-char) 0) - (Assert-eq (following-char (current-buffer)) 0) + (Assert (eq (char-before) nil)) + (Assert (eq (char-before (point)) nil)) + (Assert (eq (char-before (point-marker)) nil)) + (Assert (eq (char-before (point) (current-buffer)) nil)) + (Assert (eq (char-before (point-marker) (current-buffer)) nil)) + (Assert (eq (char-after) nil)) + (Assert (eq (char-after (point)) nil)) + (Assert (eq (char-after (point-marker)) nil)) + (Assert (eq (char-after (point) (current-buffer)) nil)) + (Assert (eq (char-after (point-marker) (current-buffer)) nil)) + (Assert (eq (preceding-char) 0)) + (Assert (eq (preceding-char (current-buffer)) 0)) + (Assert (eq (following-char) 0)) + (Assert (eq (following-char (current-buffer)) 0)) (insert "foobar") - (Assert-eq (char-before) ?r) - (Assert-eq (char-after) nil) - (Assert-eq (preceding-char) ?r) - (Assert-eq (following-char) 0) + (Assert (eq (char-before) ?r)) + (Assert (eq (char-after) nil)) + (Assert (eq (preceding-char) ?r)) + (Assert (eq (following-char) 0)) (goto-char (point-min)) - (Assert-eq (char-before) nil) - (Assert-eq (char-after) ?f) - (Assert-eq (preceding-char) 0) - (Assert-eq (following-char) ?f) + (Assert (eq (char-before) nil)) + (Assert (eq (char-after) ?f)) + (Assert (eq (preceding-char) 0)) + (Assert (eq (following-char) ?f)) ) ;;----------------------------------------------------- ;; Test plist manipulation functions. ;;----------------------------------------------------- (let ((sym (make-symbol "test-symbol"))) - (Assert-eq t (get* sym t t)) - (Assert-eq t (get sym t t)) - (Assert-eq t (getf nil t t)) - (Assert-eq t (plist-get nil t t)) + (Assert (eq t (get* sym t t))) + (Assert (eq t (get sym t t))) + (Assert (eq t (getf nil t t))) + (Assert (eq t (plist-get nil t t))) (put sym 'bar 'baz) - (Assert-eq 'baz (get sym 'bar)) - (Assert-eq 'baz (getf '(bar baz) 'bar)) - (Assert-eq 'baz (getf (symbol-plist sym) 'bar)) - (Assert-eq 2 (getf '(1 2) 1)) - (Assert-eq 4 (put sym 3 4)) - (Assert-eq 4 (get sym 3)) - (Assert-eq t (remprop sym 3)) - (Assert-eq nil (remprop sym 3)) - (Assert-eq 5 (get sym 3 5)) + (Assert (eq 'baz (get sym 'bar))) + (Assert (eq 'baz (getf '(bar baz) 'bar))) + (Assert (eq 'baz (getf (symbol-plist sym) 'bar))) + (Assert (eq 2 (getf '(1 2) 1))) + (Assert (eq 4 (put sym 3 4))) + (Assert (eq 4 (get sym 3))) + (Assert (eq t (remprop sym 3))) + (Assert (eq nil (remprop sym 3))) + (Assert (eq 5 (get sym 3 5))) ) (loop for obj in @@ -1127,18 +1282,18 @@ (make-extent nil nil nil) (make-face 'test-face)) do - (Assert-eq 2 (get obj ?1 2) obj) - (Assert-eq 4 (put obj ?3 4) obj) - (Assert-eq 4 (get obj ?3) obj) + (Assert (eq 2 (get obj ?1 2)) obj) + (Assert (eq 4 (put obj ?3 4)) obj) + (Assert (eq 4 (get obj ?3)) obj) (when (or (stringp obj) (symbolp obj)) - (Assert-equal '(?3 4) (object-plist obj) obj)) - (Assert-eq t (remprop obj ?3) obj) + (Assert (equal '(?3 4) (object-plist obj)) obj)) + (Assert (eq t (remprop obj ?3)) obj) (when (or (stringp obj) (symbolp obj)) - (Assert-eq '() (object-plist obj) obj)) - (Assert-eq nil (remprop obj ?3) obj) + (Assert (eq '() (object-plist obj)) obj)) + (Assert (eq nil (remprop obj ?3)) obj) (when (or (stringp obj) (symbolp obj)) - (Assert-eq '() (object-plist obj) obj)) - (Assert-eq 5 (get obj ?3 5) obj) + (Assert (eq '() (object-plist obj)) obj)) + (Assert (eq 5 (get obj ?3 5)) obj) ) (Check-Error-Message @@ -1164,32 +1319,47 @@ ;;----------------------------------------------------- ;; Test subseq ;;----------------------------------------------------- -(Assert-equal (subseq nil 0) nil) -(Assert-equal (subseq [1 2 3] 0) [1 2 3]) -(Assert-equal (subseq [1 2 3] 1 -1) [2]) -(Assert-equal (subseq "123" 0) "123") -(Assert-equal (subseq "1234" -3 -1) "23") -(Assert-equal (subseq #*0011 0) #*0011) -(Assert-equal (subseq #*0011 -3 3) #*01) -(Assert-equal (subseq '(1 2 3) 0) '(1 2 3)) -(Assert-equal (subseq '(1 2 3 4) -3 nil) '(2 3 4)) +(Assert (equal (subseq nil 0) nil)) +(Assert (equal (subseq [1 2 3] 0) [1 2 3])) +(Assert (equal (subseq [1 2 3] 1 -1) [2])) +(Assert (equal (subseq "123" 0) "123")) +(Assert (equal (subseq "1234" -3 -1) "23")) +(Assert (equal (subseq #*0011 0) #*0011)) +(Assert (equal (subseq #*0011 -3 3) #*01)) +(Assert (equal (subseq '(1 2 3) 0) '(1 2 3))) +(Assert (equal (subseq '(1 2 3 4) -3 nil) '(2 3 4))) (Check-Error wrong-type-argument (subseq 3 2)) (Check-Error args-out-of-range (subseq [1 2 3] -42)) (Check-Error args-out-of-range (subseq [1 2 3] 0 42)) +(let ((string "hi there")) + (Assert (equal (substring-no-properties "123" 0) "123")) + (Assert (equal (substring-no-properties "1234" -3 -1) "23")) + (Assert (equal (substring-no-properties "hi there" 0) "hi there")) + (put-text-property 0 (length string) 'foo 'bar string) + (Assert (eq 'bar (get-text-property 0 'foo string))) + (Assert (not + (get-text-property 0 'foo (substring-no-properties "hi there" 0)))) + (Check-Error wrong-type-argument (substring-no-properties nil 4)) + (Check-Error wrong-type-argument (substring-no-properties "hi there" pi)) + (Check-Error wrong-type-argument (substring-no-properties "hi there" 0.0))) + ;;----------------------------------------------------- ;; Time-related tests ;;----------------------------------------------------- -(Assert= (length (current-time-string)) 24) +(Assert (= (length (current-time-string)) 24)) ;;----------------------------------------------------- ;; format test ;;----------------------------------------------------- (Assert (string= (format "%d" 10) "10")) (Assert (string= (format "%o" 8) "10")) +(Assert (string= (format "%b" 2) "10")) (Assert (string= (format "%x" 31) "1f")) (Assert (string= (format "%X" 31) "1F")) +(Assert (string= (format "%b" 0) "0")) +(Assert (string= (format "%b" 3) "11")) ;; MS-Windows uses +002 in its floating-point numbers. #### We should ;; perhaps fix this, but writing our own floating-point support in doprnt.c ;; is very hard. @@ -1271,20 +1441,20 @@ ;;; The following two tests used to use 1000 instead of 100, ;;; but that merely found buffer overflow bugs in Solaris sprintf(). -(Assert= 102 (length (format "%.100f" 3.14))) -(Assert= 100 (length (format "%100f" 3.14))) +(Assert (= 102 (length (format "%.100f" 3.14)))) +(Assert (= 100 (length (format "%100f" 3.14)))) ;;; Check for 64-bit cleanness on LP64 platforms. -(Assert= (read (format "%d" most-positive-fixnum)) most-positive-fixnum) -(Assert= (read (format "%ld" most-positive-fixnum)) most-positive-fixnum) -(Assert= (read (format "%u" most-positive-fixnum)) most-positive-fixnum) -(Assert= (read (format "%lu" most-positive-fixnum)) most-positive-fixnum) -(Assert= (read (format "%d" most-negative-fixnum)) most-negative-fixnum) -(Assert= (read (format "%ld" most-negative-fixnum)) most-negative-fixnum) +(Assert (= (read (format "%d" most-positive-fixnum)) most-positive-fixnum)) +(Assert (= (read (format "%ld" most-positive-fixnum)) most-positive-fixnum)) +(Assert (= (read (format "%u" most-positive-fixnum)) most-positive-fixnum)) +(Assert (= (read (format "%lu" most-positive-fixnum)) most-positive-fixnum)) +(Assert (= (read (format "%d" most-negative-fixnum)) most-negative-fixnum)) +(Assert (= (read (format "%ld" most-negative-fixnum)) most-negative-fixnum)) ;; These used to crash. -(Assert-eql (read (format "%f" 1.2e+302)) 1.2e+302) -(Assert-eql (read (format "%.1000d" 1)) 1) +(Assert (eql (read (format "%f" 1.2e+302)) 1.2e+302)) +(Assert (eql (read (format "%.1000d" 1)) 1)) ;;; "%u" is undocumented, and Emacs Lisp has no unsigned type. ;;; What to do if "%u" is used with a negative number? @@ -1342,12 +1512,12 @@ (if (= new-char old-char) (setq new-char ?/)) (aset load-file-name 0 new-char) - (Assert= new-char (aref load-file-name 0) + (Assert (= new-char (aref load-file-name 0)) \"Check that we can modify the string value of load-file-name\")) (let* ((new-load-file-name \"hi there\") (load-file-name new-load-file-name)) - (Assert-eq new-load-file-name load-file-name + (Assert (eq new-load-file-name load-file-name) \"Checking that we can bind load-file-name successfully.\")) ") @@ -1391,137 +1561,137 @@ one-fround-result two-fround-result one-truncate-result two-truncate-result one-ftruncate-result two-ftruncate-result) - (Assert-equal one-floor-result (multiple-value-list - (floor first)) + (Assert (equal one-floor-result (multiple-value-list + (floor first))) (format "checking (floor %S) gives %S" first one-floor-result)) - (Assert-equal one-floor-result (multiple-value-list - (floor first 1)) + (Assert (equal one-floor-result (multiple-value-list + (floor first 1))) (format "checking (floor %S 1) gives %S" first one-floor-result)) (Check-Error arith-error (floor first 0)) (Check-Error arith-error (floor first 0.0)) - (Assert-equal two-floor-result (multiple-value-list - (floor first second)) + (Assert (equal two-floor-result (multiple-value-list + (floor first second))) (format "checking (floor %S %S) gives %S" first second two-floor-result)) - (Assert-equal (cl-floor first second) - (multiple-value-list (floor first second)) + (Assert (equal (cl-floor first second) + (multiple-value-list (floor first second))) (format "checking (floor %S %S) gives the same as the old code" first second)) - (Assert-equal one-ffloor-result (multiple-value-list - (ffloor first)) + (Assert (equal one-ffloor-result (multiple-value-list + (ffloor first))) (format "checking (ffloor %S) gives %S" first one-ffloor-result)) - (Assert-equal one-ffloor-result (multiple-value-list - (ffloor first 1)) + (Assert (equal one-ffloor-result (multiple-value-list + (ffloor first 1))) (format "checking (ffloor %S 1) gives %S" first one-ffloor-result)) (Check-Error arith-error (ffloor first 0)) (Check-Error arith-error (ffloor first 0.0)) - (Assert-equal two-ffloor-result (multiple-value-list - (ffloor first second)) + (Assert (equal two-ffloor-result (multiple-value-list + (ffloor first second))) (format "checking (ffloor %S %S) gives %S" first second two-ffloor-result)) - (Assert-equal one-ceiling-result (multiple-value-list - (ceiling first)) + (Assert (equal one-ceiling-result (multiple-value-list + (ceiling first))) (format "checking (ceiling %S) gives %S" first one-ceiling-result)) - (Assert-equal one-ceiling-result (multiple-value-list - (ceiling first 1)) + (Assert (equal one-ceiling-result (multiple-value-list + (ceiling first 1))) (format "checking (ceiling %S 1) gives %S" first one-ceiling-result)) (Check-Error arith-error (ceiling first 0)) (Check-Error arith-error (ceiling first 0.0)) - (Assert-equal two-ceiling-result (multiple-value-list - (ceiling first second)) + (Assert (equal two-ceiling-result (multiple-value-list + (ceiling first second))) (format "checking (ceiling %S %S) gives %S" first second two-ceiling-result)) - (Assert-equal (cl-ceiling first second) - (multiple-value-list (ceiling first second)) + (Assert (equal (cl-ceiling first second) + (multiple-value-list (ceiling first second))) (format "checking (ceiling %S %S) gives the same as the old code" first second)) - (Assert-equal one-fceiling-result (multiple-value-list - (fceiling first)) + (Assert (equal one-fceiling-result (multiple-value-list + (fceiling first))) (format "checking (fceiling %S) gives %S" first one-fceiling-result)) - (Assert-equal one-fceiling-result (multiple-value-list - (fceiling first 1)) + (Assert (equal one-fceiling-result (multiple-value-list + (fceiling first 1))) (format "checking (fceiling %S 1) gives %S" first one-fceiling-result)) (Check-Error arith-error (fceiling first 0)) (Check-Error arith-error (fceiling first 0.0)) - (Assert-equal two-fceiling-result (multiple-value-list - (fceiling first second)) + (Assert (equal two-fceiling-result (multiple-value-list + (fceiling first second))) (format "checking (fceiling %S %S) gives %S" first second two-fceiling-result)) - (Assert-equal one-round-result (multiple-value-list - (round first)) + (Assert (equal one-round-result (multiple-value-list + (round first))) (format "checking (round %S) gives %S" first one-round-result)) - (Assert-equal one-round-result (multiple-value-list - (round first 1)) + (Assert (equal one-round-result (multiple-value-list + (round first 1))) (format "checking (round %S 1) gives %S" first one-round-result)) (Check-Error arith-error (round first 0)) (Check-Error arith-error (round first 0.0)) - (Assert-equal two-round-result (multiple-value-list - (round first second)) + (Assert (equal two-round-result (multiple-value-list + (round first second))) (format "checking (round %S %S) gives %S" first second two-round-result)) - (Assert-equal one-fround-result (multiple-value-list - (fround first)) + (Assert (equal one-fround-result (multiple-value-list + (fround first))) (format "checking (fround %S) gives %S" first one-fround-result)) - (Assert-equal one-fround-result (multiple-value-list - (fround first 1)) + (Assert (equal one-fround-result (multiple-value-list + (fround first 1))) (format "checking (fround %S 1) gives %S" first one-fround-result)) (Check-Error arith-error (fround first 0)) (Check-Error arith-error (fround first 0.0)) - (Assert-equal two-fround-result (multiple-value-list - (fround first second)) + (Assert (equal two-fround-result (multiple-value-list + (fround first second))) (format "checking (fround %S %S) gives %S" first second two-fround-result)) - (Assert-equal (cl-round first second) - (multiple-value-list (round first second)) + (Assert (equal (cl-round first second) + (multiple-value-list (round first second))) (format "checking (round %S %S) gives the same as the old code" first second)) - (Assert-equal one-truncate-result (multiple-value-list - (truncate first)) + (Assert (equal one-truncate-result (multiple-value-list + (truncate first))) (format "checking (truncate %S) gives %S" first one-truncate-result)) - (Assert-equal one-truncate-result (multiple-value-list - (truncate first 1)) + (Assert (equal one-truncate-result (multiple-value-list + (truncate first 1))) (format "checking (truncate %S 1) gives %S" first one-truncate-result)) (Check-Error arith-error (truncate first 0)) (Check-Error arith-error (truncate first 0.0)) - (Assert-equal two-truncate-result (multiple-value-list - (truncate first second)) + (Assert (equal two-truncate-result (multiple-value-list + (truncate first second))) (format "checking (truncate %S %S) gives %S" first second two-truncate-result)) - (Assert-equal (cl-truncate first second) - (multiple-value-list (truncate first second)) + (Assert (equal (cl-truncate first second) + (multiple-value-list (truncate first second))) (format "checking (truncate %S %S) gives the same as the old code" first second)) - (Assert-equal one-ftruncate-result (multiple-value-list - (ftruncate first)) + (Assert (equal one-ftruncate-result (multiple-value-list + (ftruncate first))) (format "checking (ftruncate %S) gives %S" first one-ftruncate-result)) - (Assert-equal one-ftruncate-result (multiple-value-list - (ftruncate first 1)) + (Assert (equal one-ftruncate-result (multiple-value-list + (ftruncate first 1))) (format "checking (ftruncate %S 1) gives %S" first one-ftruncate-result)) (Check-Error arith-error (ftruncate first 0)) (Check-Error arith-error (ftruncate first 0.0)) - (Assert-equal two-ftruncate-result (multiple-value-list - (ftruncate first second)) + (Assert (equal two-ftruncate-result (multiple-value-list + (ftruncate first second))) (format "checking (ftruncate %S %S) gives %S" first second two-ftruncate-result))) (Assert-rounding-floating (pie ee) @@ -1957,34 +2127,34 @@ (foo-zero 400 (1+ most-positive-fixnum))))) "Checking multiple values are discarded correctly when forced") (Check-Error setting-constant (setq multiple-values-limit 20)) - (Assert-equal '(-1 1) - (multiple-value-list (floor -3 4)) - "Checking #'multiple-value-list gives a sane result") + (Assert (equal '(-1 1) + (multiple-value-list (floor -3 4))) + "Checking #'multiple-value-list gives a sane result") (let ((ey 40000) (bee "this is a string") (cee #s(hash-table size 256 data (969 ?\xF9)))) - (Assert-equal - (multiple-value-list (values ey bee cee)) - (multiple-value-list (values-list (list ey bee cee))) - "Checking that #'values and #'values-list are correctly related") - (Assert-equal - (multiple-value-list (values-list (list ey bee cee))) - (multiple-value-list (apply #'values (list ey bee cee))) - "Checking #'values-list and #'apply with #values are correctly related")) - (Assert= (multiple-value-call #'+ (floor 5 3) (floor 19 4)) 10 - "Checking #'multiple-value-call gives reasonable results.") - (Assert= (multiple-value-call (values '+ '*) (floor 5 3) (floor 19 4)) 10 - "Checking #'multiple-value-call correct when first arg multiple.") - (Assert= 1 (length (multiple-value-list (prog1 (floor pi) "hi there"))) - "Checking #'prog1 does not pass back multiple values") - (Assert= 2 (length (multiple-value-list - (multiple-value-prog1 (floor pi) "hi there"))) - "Checking #'multiple-value-prog1 passes back multiple values") + (Assert (equal + (multiple-value-list (values ey bee cee)) + (multiple-value-list (values-list (list ey bee cee)))) + "Checking that #'values and #'values-list are correctly related") + (Assert (equal + (multiple-value-list (values-list (list ey bee cee))) + (multiple-value-list (apply #'values (list ey bee cee)))) + "Checking #'values-list and #'apply with #values are correctly related")) + (Assert (= (multiple-value-call #'+ (floor 5 3) (floor 19 4)) 10) + "Checking #'multiple-value-call gives reasonable results.") + (Assert (= (multiple-value-call (values '+ '*) (floor 5 3) (floor 19 4)) 10) + "Checking #'multiple-value-call correct when first arg multiple.") + (Assert (= 1 (length (multiple-value-list (prog1 (floor pi) "hi there")))) + "Checking #'prog1 does not pass back multiple values") + (Assert (= 2 (length (multiple-value-list + (multiple-value-prog1 (floor pi) "hi there")))) + "Checking #'multiple-value-prog1 passes back multiple values") (multiple-value-bind (floored remainder this-is-nil) (floor pi 1.0) - (Assert= floored 3 + (Assert (= floored 3) "Checking floored bound correctly") - (Assert-eql remainder (- pi 3.0) + (Assert (eql remainder (- pi 3.0)) "Checking remainder bound correctly") (Assert (null this-is-nil) "Checking trailing arg bound but nil")) @@ -1993,62 +2163,62 @@ (cee #s(hash-table size 256 data (969 ?\xF9)))) (multiple-value-setq (ey bee cee) (ffloor e 1.0)) - (Assert-eql 2.0 ey "Checking ey set correctly") - (Assert-eql bee (- e 2.0) "Checking bee set correctly") + (Assert (eql 2.0 ey) "Checking ey set correctly") + (Assert (eql bee (- e 2.0)) "Checking bee set correctly") (Assert (null cee) "Checking cee set to nil correctly")) - (Assert= 3 (length (multiple-value-list (eval '(values nil t pi)))) - "Checking #'eval passes back multiple values") - (Assert= 2 (length (multiple-value-list (apply #'floor '(5 3)))) - "Checking #'apply passes back multiple values") - (Assert= 2 (length (multiple-value-list (funcall #'floor 5 3))) - "Checking #'funcall passes back multiple values") - (Assert-equal '(1 2) (multiple-value-list - (multiple-value-call #'floor (values 5 3))) - "Checking #'multiple-value-call passes back multiple values correctly") - (Assert= 1 (length (multiple-value-list - (and (multiple-value-function-returning-nil) t))) - "Checking multiple values from non-trailing forms discarded by #'and") - (Assert= 5 (length (multiple-value-list - (and t (multiple-value-function-returning-nil)))) - "Checking multiple values from final forms not discarded by #'and") - (Assert= 1 (length (multiple-value-list - (or (multiple-value-function-returning-t) t))) - "Checking multiple values from non-trailing forms discarded by #'and") - (Assert= 5 (length (multiple-value-list - (or nil (multiple-value-function-returning-t)))) - "Checking multiple values from final forms not discarded by #'and") - (Assert= 1 (length (multiple-value-list - (cond ((multiple-value-function-returning-t))))) - "Checking cond doesn't pass back multiple values in tests.") - (Assert-equal (list nil pi e radians-to-degrees degrees-to-radians) + (Assert (= 3 (length (multiple-value-list (eval '(values nil t pi))))) + "Checking #'eval passes back multiple values") + (Assert (= 2 (length (multiple-value-list (apply #'floor '(5 3))))) + "Checking #'apply passes back multiple values") + (Assert (= 2 (length (multiple-value-list (funcall #'floor 5 3)))) + "Checking #'funcall passes back multiple values") + (Assert (equal '(1 2) (multiple-value-list + (multiple-value-call #'floor (values 5 3)))) + "Checking #'multiple-value-call passes back multiple values correctly") + (Assert (= 1 (length (multiple-value-list + (and (multiple-value-function-returning-nil) t)))) + "Checking multiple values from non-trailing forms discarded by #'and") + (Assert (= 5 (length (multiple-value-list + (and t (multiple-value-function-returning-nil))))) + "Checking multiple values from final forms not discarded by #'and") + (Assert (= 1 (length (multiple-value-list + (or (multiple-value-function-returning-t) t)))) + "Checking multiple values from non-trailing forms discarded by #'and") + (Assert (= 5 (length (multiple-value-list + (or nil (multiple-value-function-returning-t))))) + "Checking multiple values from final forms not discarded by #'and") + (Assert (= 1 (length (multiple-value-list + (cond ((multiple-value-function-returning-t)))))) + "Checking cond doesn't pass back multiple values in tests.") + (Assert (equal (list nil pi e radians-to-degrees degrees-to-radians) + (multiple-value-list + (cond (t (multiple-value-function-returning-nil))))) + "Checking cond passes back multiple values in clauses.") + (Assert (= 1 (length (multiple-value-list + (prog1 (multiple-value-function-returning-nil))))) + "Checking prog1 discards multiple values correctly.") + (Assert (= 5 (length (multiple-value-list + (multiple-value-prog1 + (multiple-value-function-returning-nil))))) + "Checking multiple-value-prog1 passes back multiple values correctly.") + (Assert (equal (list t pi e degrees-to-radians radians-to-degrees) (multiple-value-list - (cond (t (multiple-value-function-returning-nil)))) - "Checking cond passes back multiple values in clauses.") - (Assert= 1 (length (multiple-value-list - (prog1 (multiple-value-function-returning-nil)))) - "Checking prog1 discards multiple values correctly.") - (Assert= 5 (length (multiple-value-list - (multiple-value-prog1 - (multiple-value-function-returning-nil)))) - "Checking multiple-value-prog1 passes back multiple values correctly.") - (Assert-equal (list t pi e degrees-to-radians radians-to-degrees) - (multiple-value-list - (catch 'VoN61Lo4Y (function-throwing-multiple-values)))) - (Assert-equal (list t pi e degrees-to-radians radians-to-degrees) + (catch 'VoN61Lo4Y (function-throwing-multiple-values))))) + (Assert (equal (list t pi e degrees-to-radians radians-to-degrees) (multiple-value-list (loop for eye in `(a b c d ,e f g ,nil ,pi) do (when (null eye) - (return (multiple-value-function-returning-t))))) + (return (multiple-value-function-returning-t)))))) "Checking #'loop passes back multiple values correctly.") (Assert (null (or)) "Checking #'or behaves correctly with zero arguments.") - (Assert-eq t (and) + (Assert (eq t (and)) "Checking #'and behaves correctly with zero arguments.") - (Assert= (* 3.0 (- pi 3.0)) + (Assert (= (* 3.0 (- pi 3.0)) (letf (((values three one-four-one-five-nine) (floor pi))) - (* three one-four-one-five-nine)) + (* three one-four-one-five-nine))) "checking letf handles #'values in a basic sense")) ;; #'equalp tests. @@ -2061,100 +2231,132 @@ for char being each element in-ref res do (setf char (int-to-char int-char)) finally return res))) - (let ((equal-lists - '((111111111111111111111111111111111111111111111111111 - 111111111111111111111111111111111111111111111111111.0) - (0 0.0 0.000 -0 -0.0 -0.000 #b0 0/5 -0/5) - (21845 #b101010101010101 #x5555) - (1.5 1.500000000000000000000000000000000000000000000000000000000 - 3/2) - (-55 -110/2) - ;; Can't use this, these values aren't `='. - ;;(-12345678901234567890123457890123457890123457890123457890123457890 - ;; -12345678901234567890123457890123457890123457890123457890123457890.0) - ))) - (loop for li in equal-lists do - (loop for (x . tail) on li do - (loop for y in tail do - (Assert-equalp x y) - (Assert-equalp y x))))) - (let ((diff-list - `(0 1 2 3 1000 5000000000 5555555555555555555555555555555555555 - -1 -2 -3 -1000 -5000000000 -5555555555555555555555555555555555555 - 1/2 1/3 2/3 8/2 355/113 (/ 3/2 0.2) (/ 3/2 0.7) - 55555555555555555555555555555555555555555/2718281828459045 - 0.111111111111111111111111111111111111111111111111111111111111111 - 1e+300 1e+301 -1e+300 -1e+301))) - (loop for (x . tail) on diff-list do - (loop for y in tail do - (Assert-not-equalp x y) - (Assert-not-equalp y x)))) + (macrolet + ((equalp-equal-list-tests (equal-list) + (let (res) + (setq equal-lists (eval equal-list)) + (loop for li in equal-lists do + (loop for (x . tail) on li do + (loop for y in tail do + (push `(Assert (equalp ,(quote-maybe x) + ,(quote-maybe y))) res) + (push `(Assert (equalp ,(quote-maybe y) + ,(quote-maybe x))) res) + (push `(Assert (eql (equalp-hash ,(quote-maybe y)) + (equalp-hash ,(quote-maybe x)))) + res)))) + (cons 'progn (nreverse res)))) + (equalp-diff-list-tests (diff-list) + (let (res) + (setq diff-list (eval diff-list)) + (loop for (x . tail) on diff-list do + (loop for y in tail do + (push `(Assert (not (equalp ,(quote-maybe x) + ,(quote-maybe y)))) res) + (push `(Assert (not (equalp ,(quote-maybe y) + ,(quote-maybe x)))) res))) + (cons 'progn (nreverse res)))) + (Assert-equalp (object-one object-two &optional failing-case description) + `(progn + (Assert (equalp ,object-one ,object-two) + ,@(if failing-case + (list failing-case description))) + (Assert (eql (equalp-hash ,object-one) (equalp-hash ,object-two)))))) + (equalp-equal-list-tests + `(,@(when (featurep 'bignum) + (read "((111111111111111111111111111111111111111111111111111 + 111111111111111111111111111111111111111111111111111.0))")) + (0 0.0 0.000 -0 -0.0 -0.000 #b0 ,@(when (featurep 'ratio) '(0/5 -0/5))) + (21845 #b101010101010101 #x5555) + (1.5 1.500000000000000000000000000000000000000000000000000000000 + ,@(when (featurep 'ratio) '(3/2))) + ;; Can't use this, these values aren't `='. + ;;(-12345678901234567890123457890123457890123457890123457890123457890 + ;; -12345678901234567890123457890123457890123457890123457890123457890.0) + (-55 -55.000 ,@(when (featurep 'ratio) '(-110/2))))) + (equalp-diff-list-tests + `(0 1 2 3 1000 5000000000 + ,@(when (featurep 'bignum) + (read "(5555555555555555555555555555555555555 + -5555555555555555555555555555555555555)")) + -1 -2 -3 -1000 -5000000000 + 1/2 1/3 2/3 8/2 355/113 + ,@(when (featurep 'ratio) (mapcar* #'/ '(3/2 3/2) '(0.2 0.7))) + 55555555555555555555555555555555555555555/2718281828459045 + 0.111111111111111111111111111111111111111111111111111111111111111 + 1e+300 1e+301 -1e+300 -1e+301)) - (Assert-equalp "hi there" "Hi There" - "checking equalp isn't case-sensitive") - (Assert-equalp 99 99.0 - "checking equalp compares numerical values of different types") - (Assert (null (equalp 99 ?c)) - "checking equalp does not convert characters to numbers") - ;; Fixed in Hg d0ea57eb3de4. - (Assert (null (equalp "hi there" [hi there])) - "checking equalp doesn't error with string and non-string") - (Assert-equalp "ABCDEEFGH\u00CDJ" string-variable - "checking #'equalp is case-insensitive with an upcased constant") - (Assert-equalp "abcdeefgh\xedj" string-variable - "checking #'equalp is case-insensitive with a downcased constant") - (Assert-equalp string-variable string-variable - "checking #'equalp works when handed the same string twice") - (Assert-equalp string-variable "aBcDeeFgH\u00Edj" - "check #'equalp is case-insensitive with a variable-cased constant") - (Assert-equalp "" (bit-vector) - "check empty string and empty bit-vector are #'equalp.") - (Assert-equalp (string) (bit-vector) - "check empty string and empty bit-vector are #'equalp, no constants") - (Assert-equalp "hi there" (vector ?h ?i ?\ ?t ?h ?e ?r ?e) - "check string and vector with same contents #'equalp") - (Assert-equalp (string ?h ?i ?\ ?t ?h ?e ?r ?e) - (vector ?h ?i ?\ ?t ?h ?e ?r ?e) - "check string and vector with same contents #'equalp, no constants") - (Assert-equalp [?h ?i ?\ ?t ?h ?e ?r ?e] - (string ?h ?i ?\ ?t ?h ?e ?r ?e) - "check string and vector with same contents #'equalp, vector constant") - (Assert-equalp [0 1.0 0.0 0 1] - (bit-vector 0 1 0 0 1) - "check vector and bit-vector with same contents #'equalp,\ + (Assert-equalp "hi there" "Hi There" + "checking equalp isn't case-sensitive") + (Assert-equalp + 99 99.0 + "checking equalp compares numerical values of different types") + (Assert (null (equalp 99 ?c)) + "checking equalp does not convert characters to numbers") + ;; Fixed in Hg d0ea57eb3de4. + (Assert (null (equalp "hi there" [hi there])) + "checking equalp doesn't error with string and non-string") + (Assert-equalp + "ABCDEEFGH\u00CDJ" string-variable + "checking #'equalp is case-insensitive with an upcased constant") + (Assert-equalp + "abcdeefgh\xedj" string-variable + "checking #'equalp is case-insensitive with a downcased constant") + (Assert-equalp string-variable string-variable + "checking #'equalp works when handed the same string twice") + (Assert (equalp string-variable "aBcDeeFgH\u00Edj") + "check #'equalp is case-insensitive with a variable-cased constant") + (Assert-equalp "" (bit-vector) + "check empty string and empty bit-vector are #'equalp.") + (Assert-equalp + (string) (bit-vector) + "check empty string and empty bit-vector are #'equalp, no constants") + (Assert-equalp "hi there" (vector ?h ?i ?\ ?t ?h ?e ?r ?e) + "check string and vector with same contents #'equalp") + (Assert-equalp + (string ?h ?i ?\ ?t ?h ?e ?r ?e) + (vector ?h ?i ?\ ?t ?h ?e ?r ?e) + "check string and vector with same contents #'equalp, no constants") + (Assert-equalp + [?h ?i ?\ ?t ?h ?e ?r ?e] + (string ?h ?i ?\ ?t ?h ?e ?r ?e) + "check string and vector with same contents #'equalp, vector constant") + (Assert-equalp [0 1.0 0.0 0 1] + (bit-vector 0 1 0 0 1) + "check vector and bit-vector with same contents #'equalp,\ vector constant") - (Assert-not-equalp [0 2 0.0 0 1] - (bit-vector 0 1 0 0 1) - "check vector and bit-vector with different contents not #'equalp,\ + (Assert (not (equalp [0 2 0.0 0 1] + (bit-vector 0 1 0 0 1))) + "check vector and bit-vector with different contents not #'equalp,\ vector constant") - (Assert-equalp #*01001 - (vector 0 1.0 0.0 0 1) - "check vector and bit-vector with same contents #'equalp,\ + (Assert-equalp #*01001 + (vector 0 1.0 0.0 0 1) + "check vector and bit-vector with same contents #'equalp,\ bit-vector constant") - (Assert-equalp ?\u00E9 Eacute-character - "checking characters are case-insensitive, one constant") - (Assert-not-equalp ?\u00E9 (aref (format "%c" ?a) 0) - "checking distinct characters are not equalp, one constant") - (Assert-equalp t (and) - "checking symbols are correctly #'equalp") - (Assert-not-equalp t (or nil '#:t) - "checking distinct symbols with the same name are not #'equalp") - (Assert-equalp #s(char-table type generic data (?\u0080 "hi-there")) - (let ((aragh (make-char-table 'generic))) - (put-char-table ?\u0080 "hi-there" aragh) - aragh) - "checking #'equalp succeeds correctly, char-tables") - (Assert-equalp #s(char-table type generic data (?\u0080 "hi-there")) - (let ((aragh (make-char-table 'generic))) - (put-char-table ?\u0080 "HI-THERE" aragh) - aragh) - "checking #'equalp succeeds correctly, char-tables") - (Assert-not-equalp #s(char-table type generic data (?\u0080 "hi-there")) - (let ((aragh (make-char-table 'generic))) - (put-char-table ?\u0080 "hi there" aragh) - aragh) - "checking #'equalp fails correctly, char-tables")) + (Assert-equalp ?\u00E9 Eacute-character + "checking characters are case-insensitive, one constant") + (Assert (not (equalp ?\u00E9 (aref (format "%c" ?a) 0))) + "checking distinct characters are not equalp, one constant") + (Assert-equalp t (and) + "checking symbols are correctly #'equalp") + (Assert (not (equalp t (or nil '#:t))) + "checking distinct symbols with the same name are not #'equalp") + (Assert-equalp #s(char-table type generic data (?\u0080 "hi-there")) + (let ((aragh (make-char-table 'generic))) + (put-char-table ?\u0080 "hi-there" aragh) + aragh) + "checking #'equalp succeeds correctly, char-tables") + (Assert-equalp #s(char-table type generic data (?\u0080 "hi-there")) + (let ((aragh (make-char-table 'generic))) + (put-char-table ?\u0080 "HI-THERE" aragh) + aragh) + "checking #'equalp succeeds correctly, char-tables") + (Assert (not (equalp #s(char-table type generic data (?\u0080 "hi-there")) + (let ((aragh (make-char-table 'generic))) + (put-char-table ?\u0080 "hi there" aragh) + aragh))) + "checking #'equalp fails correctly, char-tables"))) ;; There are more tests available for equalp here: ;; @@ -2203,33 +2405,525 @@ (1- most-negative-fixnum)) (*-2-most-positive-fixnum () (* 2 most-positive-fixnum))) - (Assert-eq - (member* (1+ most-positive-fixnum) member*-list) - (member* (1+ most-positive-fixnum) member*-list :test #'eql) - "checking #'member* correct if #'eql not explicitly specified") - (Assert-eq - (assoc* (1+ most-positive-fixnum) assoc*-list) - (assoc* (1+ most-positive-fixnum) assoc*-list :test #'eql) - "checking #'assoc* correct if #'eql not explicitly specified") - (Assert-eq - (rassoc* (1- most-negative-fixnum) assoc*-list) - (rassoc* (1- most-negative-fixnum) assoc*-list :test #'eql) - "checking #'rassoc* correct if #'eql not explicitly specified") - (Assert-eql (1+most-positive-fixnum) (1+ most-positive-fixnum) - "checking #'eql handles a bignum literal properly.") - (Assert-eq - (member* (1+most-positive-fixnum) member*-list) - (member* (1+ most-positive-fixnum) member*-list :test #'equal) - "checking #'member* compiler macro correct with literal bignum") - (Assert-eq - (assoc* (1+most-positive-fixnum) assoc*-list) - (assoc* (1+ most-positive-fixnum) assoc*-list :test #'equal) - "checking #'assoc* compiler macro correct with literal bignum") + (Assert (eq + (member* (1+ most-positive-fixnum) member*-list) + (member* (1+ most-positive-fixnum) member*-list :test #'eql)) + "checking #'member* correct if #'eql not explicitly specified") + (Assert (eq + (assoc* (1+ most-positive-fixnum) assoc*-list) + (assoc* (1+ most-positive-fixnum) assoc*-list :test #'eql)) + "checking #'assoc* correct if #'eql not explicitly specified") + (Assert (eq + (rassoc* (1- most-negative-fixnum) assoc*-list) + (rassoc* (1- most-negative-fixnum) assoc*-list :test #'eql)) + "checking #'rassoc* correct if #'eql not explicitly specified") + (Assert (eql (1+most-positive-fixnum) (1+ most-positive-fixnum)) + "checking #'eql handles a bignum literal properly.") + (Assert (eq + (member* (1+most-positive-fixnum) member*-list) + (member* (1+ most-positive-fixnum) member*-list :test #'equal)) + "checking #'member* compiler macro correct with literal bignum") + (Assert (eq + (assoc* (1+most-positive-fixnum) assoc*-list) + (assoc* (1+ most-positive-fixnum) assoc*-list :test #'equal)) + "checking #'assoc* compiler macro correct with literal bignum") (puthash (setq hashed-bignum (*-2-most-positive-fixnum)) (gensym) hashing) - (Assert-eq - (gethash (* 2 most-positive-fixnum) hashing) - (gethash hashed-bignum hashing) - "checking hashing works correctly with #'eql tests and bignums")))) + (Assert (eq + (gethash (* 2 most-positive-fixnum) hashing) + (gethash hashed-bignum hashing)) + "checking hashing works correctly with #'eql tests and bignums")))) + +;; +(when (decode-char 'ucs #x0192) + (Check-Error + invalid-state + (let ((str "aaaaaaaaaaaaa") + (called 0) + modified) + (reduce #'+ str + :key #'(lambda (object) + (prog1 + object + (incf called) + (or modified + (and (> called 5) + (setq modified + (fill str (read #r"?\u0192"))))))))))) + +(Assert + (eql 55 + (let ((sequence '(1 2 3 4 5 6 7 8 9 10)) + (called 0) + modified) + (reduce #'+ + sequence + :key + #'(lambda (object) (prog1 + object + (incf called) + (and (eql called 5) + (setcdr (nthcdr 3 sequence) nil)) + (garbage-collect)))))) + "checking we can amputate lists without crashing #'reduce") + +(Assert (not (eq t (canonicalize-inst-list + `(((mswindows) . [string :data ,(make-string 20 0)]) + ((tty) . [string :data " "])) 'image t))) + "checking mswindows is always available as a specifier tag") + +(Assert (not (eq t (canonicalize-inst-list + `(((mswindows) . [nothing]) + ((tty) . [string :data " "])) + 'image t))) + "checking the correct syntax for a nothing image specifier works") + +(Check-Error-Message invalid-argument "^Invalid specifier tag set" + (canonicalize-inst-list + `(((,(gensym)) . [nothing]) + ((tty) . [string :data " "])) + 'image)) + +(Check-Error-Message invalid-argument "^Unrecognized keyword" + (canonicalize-inst-list + `(((mswindows) . [nothing :data "hi there"]) + ((tty) . [string :data " "])) 'image)) + +;; If we combine both the specifier inst list problems, we get the +;; unrecognized keyword error first, not the invalid specifier tag set +;; error. This is a little unintuitive; the specifier tag set thing is +;; processed first, and would seem to be more important. But anyone writing +;; code needs to solve both problems, it's reasonable to ask them to do it +;; in series rather than in parallel. + +(when (featurep 'ratio) + (Assert (not (eql '1/2 (read (prin1-to-string (intern "1/2"))))) + "checking symbols with ratio-like names are printed distinctly") + (Assert (not (eql '1/5 (read (prin1-to-string (intern "2/10"))))) + "checking symbol named \"2/10\" not eql to ratio 1/5 on read")) + +(let* ((count 0) + (list (map-into (make-list 2048 nil) #'(lambda () (decf count)))) + (expected (append list '(1)))) + (Assert (equal expected (merge 'list list '(1) #'<)) + "checking merge's circularity checks are sane")) + +(flet ((list-nreverse (list) + (do ((list1 list (cdr list1)) + (list2 nil (prog1 list1 (setcdr list1 list2)))) + ((atom list1) list2)))) + (let* ((integers (loop for i from 0 to 6000 collect i)) + (characters (mapcan #'(lambda (integer) + (if (char-int-p integer) + (list (int-char integer)))) integers)) + (fourth-bit #'(lambda (integer) (ash (logand #x10 integer) -4))) + (bits (mapcar fourth-bit integers)) + (vector (vconcat integers)) + (string (concat characters)) + (bit-vector (bvconcat bits))) + (Assert (equal (reverse vector) + (vconcat (list-nreverse (copy-list integers))))) + (Assert (eq vector (nreverse vector))) + (Assert (equal vector (vconcat (list-nreverse (copy-list integers))))) + (Assert (equal (reverse string) + (concat (list-nreverse (copy-list characters))))) + (Assert (eq string (nreverse string))) + (Assert (equal string (concat (list-nreverse (copy-list characters))))) + (Assert (eq bit-vector (nreverse bit-vector))) + (Assert (equal (bvconcat (list-nreverse (copy-list bits))) bit-vector)) + (Assert (not (equal bit-vector + (mapcar fourth-bit + (loop for i from 0 to 6000 collect i))))))) + +(Check-Error wrong-type-argument (self-insert-command 'self-insert-command)) +(Check-Error wrong-type-argument (make-list 'make-list 'make-list)) +(Check-Error wrong-type-argument (make-vector 'make-vector 'make-vector)) +(Check-Error wrong-type-argument (make-bit-vector 'make-bit-vector + 'make-bit-vector)) +(Check-Error wrong-type-argument (make-byte-code '(&rest ignore) "\xc0\x87" [4] + 'ignore)) +(Check-Error wrong-type-argument (make-string ?a ?a)) +(Check-Error wrong-type-argument (nth-value 'nth-value (truncate pi e))) +(Check-Error wrong-type-argument (make-hash-table :test #'eql :size :size)) +(Check-Error wrong-type-argument + (accept-process-output nil 'accept-process-output)) +(Check-Error wrong-type-argument + (accept-process-output nil 2000 'accept-process-output)) +(Check-Error wrong-type-argument + (self-insert-command 'self-insert-command)) +(Check-Error wrong-type-argument (string-to-number "16" 'string-to-number)) +(Check-Error wrong-type-argument (move-to-column 'move-to-column)) +(stop-profiling) +(Check-Error wrong-type-argument (start-profiling (float most-positive-fixnum))) +(stop-profiling) +(Check-Error wrong-type-argument + (fill '(1 2 3 4 5) 1 :start (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (fill [1 2 3 4 5] 1 :start (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (fill "1 2 3 4 5" ?1 :start (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (fill #*10101010 1 :start (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (fill '(1 2 3 4 5) 1 :end (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (fill [1 2 3 4 5] 1 :end (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (fill "1 2 3 4 5" ?1 :end (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (fill #*10101010 1 :end (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (reduce #'cons '(1 2 3 4 5) :start (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (reduce #'cons [1 2 3 4 5] :start (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (reduce #'cons "1 2 3 4 5" :start (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (reduce #'cons #*10101010 :start (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (reduce #'cons '(1 2 3 4 5) :end (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (reduce #'cons [1 2 3 4 5] :end (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (reduce #'cons "1 2 3 4 5" :end (float most-positive-fixnum))) +(Check-Error wrong-type-argument + (reduce #'cons #*10101010 :end (float most-positive-fixnum))) + +(when (featurep 'bignum) + (Check-Error args-out-of-range + (self-insert-command (* 2 most-positive-fixnum))) + (Check-Error args-out-of-range + (make-list (* 3 most-positive-fixnum) 'make-list)) + (Check-Error args-out-of-range + (make-vector (* 4 most-positive-fixnum) 'make-vector)) + (Check-Error args-out-of-range + (make-bit-vector (+ 2 most-positive-fixnum) 'make-bit-vector)) + (Check-Error args-out-of-range + (make-byte-code '(&rest ignore) "\xc0\x87" [4] + (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (make-byte-code '(&rest ignore) "\xc0\x87" [4] + #x10000)) + (Check-Error args-out-of-range + (make-string (* 4 most-positive-fixnum) ?a)) + (Check-Error args-out-of-range + (nth-value most-positive-fixnum (truncate pi e))) + (Check-Error args-out-of-range + (make-hash-table :test #'equalp :size (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (accept-process-output nil 4294967)) + (Check-Error args-out-of-range + (accept-process-output nil 10 (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (self-insert-command (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (string-to-number "16" (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (recent-keys (1+ most-positive-fixnum))) + (when (featurep 'xbm) + (Check-Error-Message + invalid-argument + "^data is too short for width and height" + (set-face-background-pixmap + 'left-margin + `[xbm :data (20 ,(* 2 most-positive-fixnum) "random-text")]))) + (Check-Error args-out-of-range + (move-to-column (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (move-to-column (1- most-negative-fixnum))) + (stop-profiling) + (when (< most-positive-fixnum (lsh 1 32)) + ;; We only support machines with integers of 32 bits or more. If + ;; most-positive-fixnum is less than 2^32, we're on a 32-bit machine, + ;; and it's appropriate to test start-profiling with a bignum. + (Assert (eq nil (start-profiling (* most-positive-fixnum 2))))) + (stop-profiling) + (Check-Error args-out-of-range + (fill '(1 2 3 4 5) 1 :start (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (fill [1 2 3 4 5] 1 :start (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (fill "1 2 3 4 5" ?1 :start (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (fill #*10101010 1 :start (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (fill '(1 2 3 4 5) 1 :end (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (fill [1 2 3 4 5] 1 :end (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (fill "1 2 3 4 5" ?1 :end (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (fill #*10101010 1 :end (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (reduce #'cons '(1 2 3 4 5) :start (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (reduce #'cons [1 2 3 4 5] :start (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (reduce #'cons "1 2 3 4 5" :start (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (reduce #'cons #*10101010 :start (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (reduce #'cons '(1 2 3 4 5) :end (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (reduce #'cons [1 2 3 4 5] :end (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (reduce #'cons "1 2 3 4 5" :end (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (reduce #'cons #*10101010 :end (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (replace '(1 2 3 4 5) [5 4 3 2 1] + :start1 (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (replace '(1 2 3 4 5) [5 4 3 2 1] + :start2 (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (replace '(1 2 3 4 5) [5 4 3 2 1] + :end1 (1+ most-positive-fixnum))) + (Check-Error args-out-of-range + (replace '(1 2 3 4 5) [5 4 3 2 1] + :end2 (1+ most-positive-fixnum)))) + +(symbol-macrolet + ((list-length 2048) (vector-length 512) (string-length (* 8192 2))) + (let ((list + ;; CIRCULAR_LIST_SUSPICION_LENGTH is 1024, it's helpful if this list + ;; is longer than that. + (make-list list-length 'make-list)) + (vector (make-vector vector-length 'make-vector)) + (bit-vector (make-bit-vector vector-length 1)) + (string (make-string string-length + (or (decode-char 'ucs #x20ac) ?\xFF))) + (item 'cons)) + (macrolet + ((construct-item-sequence-checks (&rest functions) + (cons + 'progn + (mapcan + #'(lambda (function) + `((Check-Error args-out-of-range + (,function item list + :start (1+ list-length) + :end (1+ list-length))) + (Check-Error wrong-type-argument + (,function item list :start -1 + :end list-length)) + (Check-Error args-out-of-range + (,function item list :end (* 2 list-length))) + (Check-Error args-out-of-range + (,function item vector + :start (1+ vector-length) + :end (1+ vector-length))) + (Check-Error wrong-type-argument + (,function item vector :start -1)) + (Check-Error args-out-of-range + (,function item vector + :end (* 2 vector-length))) + (Check-Error args-out-of-range + (,function item bit-vector + :start (1+ vector-length) + :end (1+ vector-length))) + (Check-Error wrong-type-argument + (,function item bit-vector :start -1)) + (Check-Error args-out-of-range + (,function item bit-vector + :end (* 2 vector-length))) + (Check-Error args-out-of-range + (,function item string + :start (1+ string-length) + :end (1+ string-length))) + (Check-Error wrong-type-argument + (,function item string :start -1)) + (Check-Error args-out-of-range + (,function item string + :end (* 2 string-length))))) + functions))) + (construct-one-sequence-checks (&rest functions) + (cons + 'progn + (mapcan + #'(lambda (function) + `((Check-Error args-out-of-range + (,function (copy-sequence list) + :start (1+ list-length) + :end (1+ list-length))) + (Check-Error wrong-type-argument + (,function (copy-sequence list) + :start -1 :end list-length)) + (Check-Error args-out-of-range + (,function (copy-sequence list) + :end (* 2 list-length))) + (Check-Error args-out-of-range + (,function (copy-sequence vector) + :start (1+ vector-length) + :end (1+ vector-length))) + (Check-Error wrong-type-argument + (,function (copy-sequence vector) :start -1)) + (Check-Error args-out-of-range + (,function (copy-sequence vector) + :end (* 2 vector-length))) + (Check-Error args-out-of-range + (,function (copy-sequence bit-vector) + :start (1+ vector-length) + :end (1+ vector-length))) + (Check-Error wrong-type-argument + (,function (copy-sequence bit-vector) + :start -1)) + (Check-Error args-out-of-range + (,function (copy-sequence bit-vector) + :end (* 2 vector-length))) + (Check-Error args-out-of-range + (,function (copy-sequence string) + :start (1+ string-length) + :end (1+ string-length))) + (Check-Error wrong-type-argument + (,function (copy-sequence string) :start -1)) + (Check-Error args-out-of-range + (,function (copy-sequence string) + :end (* 2 string-length))))) + functions))) + (construct-two-sequence-checks (&rest functions) + (cons + 'progn + (mapcan + #'(lambda (function) + `((Check-Error args-out-of-range + (,function (copy-sequence list) + (copy-sequence list) + :start1 (1+ list-length) + :end1 (1+ list-length))) + (Check-Error wrong-type-argument + (,function (copy-sequence list) + (copy-sequence list) + :start1 -1 :end1 list-length)) + (Check-Error args-out-of-range + (,function (copy-sequence list) + (copy-sequence list) + :end1 (* 2 list-length))) + (Check-Error args-out-of-range + (,function (copy-sequence vector) + (copy-sequence vector) + :start1 (1+ vector-length) + :end1 (1+ vector-length))) + (Check-Error wrong-type-argument + (,function + (copy-sequence vector) + (copy-sequence vector) :start1 -1)) + (Check-Error args-out-of-range + (,function (copy-sequence vector) + (copy-sequence vector) + :end1 (* 2 vector-length))) + (Check-Error args-out-of-range + (,function (copy-sequence bit-vector) + (copy-sequence bit-vector) + :start1 (1+ vector-length) + :end1 (1+ vector-length))) + (Check-Error wrong-type-argument + (,function (copy-sequence bit-vector) + (copy-sequence bit-vector) + :start1 -1)) + (Check-Error args-out-of-range + (,function (copy-sequence bit-vector) + (copy-sequence bit-vector) + :end1 (* 2 vector-length))) + (Check-Error args-out-of-range + (,function (copy-sequence string) + (copy-sequence string) + :start1 (1+ string-length) + :end1 (1+ string-length))) + (Check-Error wrong-type-argument + (,function (copy-sequence string) + (copy-sequence string) :start1 -1)) + (Check-Error args-out-of-range + (,function (copy-sequence string) + (copy-sequence string) + :end1 (* 2 string-length))))) + functions)))) + (construct-item-sequence-checks count position find delete* remove* + reduce) + (construct-one-sequence-checks delete-duplicates remove-duplicates) + (construct-two-sequence-checks replace mismatch search)))) + +(let* ((list (list 1 2 3 4 5 6 7 120 'hi-there '#:everyone)) + (vector (map 'vector #'identity list)) + (bit-vector (map 'bit-vector + #'(lambda (object) (if (fixnump object) 1 0)) list)) + (string (map 'string + #'(lambda (object) (or (and (fixnump object) + (int-char object)) + (decode-char 'ucs #x20ac))) list)) + (gensym (gensym))) + (Assert (null (find 'not-in-it list))) + (Assert (null (find 'not-in-it vector))) + (Assert (null (find 'not-in-it bit-vector))) + (Assert (null (find 'not-in-it string))) + (loop + for elt being each element in vector using (index position) + do + (Assert (eq elt (find elt list))) + (Assert (eq (elt list position) (find elt vector)))) + (Assert (eq gensym (find 'not-in-it list :default gensym))) + (Assert (eq gensym (find 'not-in-it vector :default gensym))) + (Assert (eq gensym (find 'not-in-it bit-vector :default gensym))) + (Assert (eq gensym (find 'not-in-it string :default gensym))) + (Assert (eq 'hi-there (find 'hi-there list))) + ;; Different uninterned symbols with the same name. + (Assert (not (eq '#1=#:everyone (find '#1# list)))) + + ;; Test concatenate. + (Assert (equal list (concatenate 'list vector))) + (Assert (equal list (concatenate 'list (subseq vector 0 4) + (subseq list 4)))) + (Assert (equal vector (concatenate 'vector list))) + (Assert (equal vector (concatenate `(vector * ,(length vector)) list))) + (Assert (equal string (concatenate `(vector character ,(length string)) + (append string nil)))) + (Assert (equal bit-vector (concatenate 'bit-vector (subseq bit-vector 0 4) + (append (subseq bit-vector 4) nil)))) + (Assert (equal bit-vector (concatenate `(vector bit ,(length bit-vector)) + (subseq bit-vector 0 4) + (append (subseq bit-vector 4) nil))))) + +;;----------------------------------------------------- +;; Test `block', `return-from' +;;----------------------------------------------------- +(Assert (eql 1 (block outer + (flet ((outtahere (n) (return-from outer n))) + (block outer (outtahere 1))) + 2)) + "checking `block' and `return-from' are lexically scoped correctly") + +;; Other tests are available in Paul Dietz' test suite, and pass. The above, +;; which we used to fail, is based on a test in the Hyperspec. We still +;; behave incorrectly when compiled for the contorted-example function of +;; CLTL2, whence the following test: + +(flet ((needs-lexical-context (first second third) + (if (eql 0 first) + (funcall second) + (block awkward + (+ 5 (needs-lexical-context + (1- first) + third + #'(lambda () (return-from awkward 0))) + first))))) + (if (compiled-function-p (symbol-function 'needs-lexical-context)) + (Known-Bug-Expect-Failure + (Assert (eql 0 (needs-lexical-context 2 nil nil)) + "the function special operator doesn't create a lexical context.")) + (Assert (eql 0 (needs-lexical-context 2 nil nil))))) + +;; Test symbol-macrolet with symbols with identical string names. + +(macrolet + ((test-symbol-macrolet () + (let* ((symbol 'my-symbol) + (copy-symbol (copy-symbol symbol)) + (third (copy-symbol copy-symbol))) + `(symbol-macrolet ((,symbol [symbol expansion]) + (,copy-symbol [copy expansion]) + (,third [third expansion])) + (list ,symbol ,copy-symbol ,third))))) + (Assert (equal '([symbol expansion] [copy expansion] [third expansion]) + (test-symbol-macrolet)))) ;;; end of lisp-tests.el diff -r 861f2601a38b -r 1f0b15040456 tests/automated/md5-tests.el --- a/tests/automated/md5-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/md5-tests.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -56,7 +54,7 @@ ;;----------------------------------------------------- (mapcar (lambda (x) - (Assert-equal (md5 (car x)) (cdr x))) + (Assert (equal (md5 (car x)) (cdr x)))) md5-tests) ;;----------------------------------------------------- @@ -66,8 +64,8 @@ (let ((large-string (mapconcat #'car md5-tests ""))) (let ((count 0)) (mapcar (lambda (x) - (Assert-equal (md5 large-string count (+ count (length (car x)))) - (cdr x)) + (Assert (equal (md5 large-string count (+ count (length (car x)))) + (cdr x))) (incf count (length (car x)))) md5-tests))) @@ -79,7 +77,7 @@ (mapcar (lambda (x) (erase-buffer) (insert (car x)) - (Assert-equal (md5 (current-buffer)) (cdr x))) + (Assert (equal (md5 (current-buffer)) (cdr x)))) md5-tests)) ;;----------------------------------------------------- @@ -90,7 +88,7 @@ (insert (mapconcat #'car md5-tests "")) (let ((point 1)) (mapcar (lambda (x) - (Assert-equal (md5 (current-buffer) point (+ point (length (car x)))) - (cdr x)) + (Assert (equal (md5 (current-buffer) point (+ point (length (car x)))) + (cdr x))) (incf point (length (car x)))) md5-tests))) diff -r 861f2601a38b -r 1f0b15040456 tests/automated/mule-tests.el --- a/tests/automated/mule-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/mule-tests.el Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,5 @@ ;; Copyright (C) 1999 Free Software Foundation, Inc. +;; Copyright (C) 2010 Ben Wing. ;; Author: Hrvoje Niksic ;; Maintainers: Hrvoje Niksic , @@ -8,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -65,7 +64,7 @@ ;; buffer. (with-temp-buffer (insert string) - (Assert-equal (buffer-string) string)) + (Assert (equal (buffer-string) string))) ;; For use without test harness: use a normal buffer, so that ;; you can also test whether redisplay works. (switch-to-buffer (get-buffer-create "test")) @@ -152,12 +151,12 @@ (dolist (coding-system '(utf-8 windows-1251 macintosh big5)) (when (find-coding-system coding-system) (find-file existing-file-name coding-system) - (Assert-eq (find-coding-system coding-system) - buffer-file-coding-system) + (Assert (eq (find-coding-system coding-system) + buffer-file-coding-system)) (kill-buffer nil) (find-file nonexistent-file-name coding-system) - (Assert-eq (find-coding-system coding-system) - buffer-file-coding-system) + (Assert (eq (find-coding-system coding-system) + buffer-file-coding-system)) (set-buffer-modified-p nil) (kill-buffer nil))) (delete-file existing-file-name)) @@ -177,9 +176,9 @@ (char2 (make-char charset2 69))) `(let ((string (make-string 1000 ,char1))) (fillarray string ,char2) - (Assert-eq (aref string 0) ,char2) - (Assert-eq (aref string (1- (length string))) ,char2) - (Assert-eq (length string) 1000))))) + (Assert (eq (aref string 0) ,char2)) + (Assert (eq (aref string (1- (length string))) ,char2)) + (Assert (eq (length string) 1000)))))) (fillarray-test ascii latin-iso8859-1) (fillarray-test ascii latin-iso8859-2) (fillarray-test latin-iso8859-1 ascii) @@ -188,7 +187,7 @@ ;; Test aset (let ((string (string (make-char 'ascii 69) (make-char 'latin-iso8859-2 69)))) (aset string 0 (make-char 'latin-iso8859-2 42)) - (Assert-eq (aref string 1) (make-char 'latin-iso8859-2 69))) + (Assert (eq (aref string 1) (make-char 'latin-iso8859-2 69)))) ;;--------------------------------------------------------------- ;; Test coding system functions @@ -210,8 +209,8 @@ (define-coding-system-alias 'mule-tests-alias 'binary) (Assert (coding-system-alias-p 'mule-tests-alias)) (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) - (Assert-eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias)) - (Assert-eq 'binary (coding-system-aliasee 'mule-tests-alias)) + (Assert (eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias))) + (Assert (eq 'binary (coding-system-aliasee 'mule-tests-alias))) (Assert (not (coding-system-alias-p 'mule-tests-alias-unix))) (Assert (not (coding-system-alias-p 'mule-tests-alias-dos))) (Assert (not (coding-system-alias-p 'mule-tests-alias-mac))) @@ -219,8 +218,8 @@ (define-coding-system-alias 'mule-tests-alias (get-coding-system 'binary)) (Assert (coding-system-alias-p 'mule-tests-alias)) (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) - (Assert-eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias)) - (Assert-eq 'binary (coding-system-aliasee 'mule-tests-alias)) + (Assert (eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias))) + (Assert (eq 'binary (coding-system-aliasee 'mule-tests-alias))) (Assert (not (coding-system-alias-p 'mule-tests-alias-unix))) (Assert (not (coding-system-alias-p 'mule-tests-alias-dos))) (Assert (not (coding-system-alias-p 'mule-tests-alias-mac))) @@ -228,9 +227,9 @@ (define-coding-system-alias 'nested-mule-tests-alias 'mule-tests-alias) (Assert (coding-system-alias-p 'nested-mule-tests-alias)) (Assert (not (coding-system-canonical-name-p 'nested-mule-tests-alias))) - (Assert-eq (get-coding-system 'binary) (get-coding-system 'nested-mule-tests-alias)) - (Assert-eq (coding-system-aliasee 'nested-mule-tests-alias) 'mule-tests-alias) - (Assert-eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias)) + (Assert (eq (get-coding-system 'binary) (get-coding-system 'nested-mule-tests-alias))) + (Assert (eq (coding-system-aliasee 'nested-mule-tests-alias) 'mule-tests-alias)) + (Assert (eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias))) (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-unix))) (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-dos))) (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-mac))) @@ -266,8 +265,8 @@ (define-coding-system-alias 'mule-tests-alias 'iso-8859-7) (Assert (coding-system-alias-p 'mule-tests-alias)) (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) - (Assert-eq (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias)) - (Assert-eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias)) + (Assert (eq (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias))) + (Assert (eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias))) (Assert (coding-system-alias-p 'mule-tests-alias-unix)) (Assert (coding-system-alias-p 'mule-tests-alias-dos)) (Assert (coding-system-alias-p 'mule-tests-alias-mac)) @@ -275,26 +274,26 @@ (define-coding-system-alias 'mule-tests-alias (get-coding-system 'iso-8859-7)) (Assert (coding-system-alias-p 'mule-tests-alias)) (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) - (Assert-eq (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias)) - (Assert-eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias)) + (Assert (eq (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias))) + (Assert (eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias))) (Assert (coding-system-alias-p 'mule-tests-alias-unix)) (Assert (coding-system-alias-p 'mule-tests-alias-dos)) (Assert (coding-system-alias-p 'mule-tests-alias-mac)) - (Assert-eq (find-coding-system 'mule-tests-alias-mac) - (find-coding-system 'iso-8859-7-mac)) + (Assert (eq (find-coding-system 'mule-tests-alias-mac) + (find-coding-system 'iso-8859-7-mac))) (define-coding-system-alias 'nested-mule-tests-alias 'mule-tests-alias) (Assert (coding-system-alias-p 'nested-mule-tests-alias)) (Assert (not (coding-system-canonical-name-p 'nested-mule-tests-alias))) - (Assert-eq (get-coding-system 'iso-8859-7) - (get-coding-system 'nested-mule-tests-alias)) - (Assert-eq (coding-system-aliasee 'nested-mule-tests-alias) 'mule-tests-alias) - (Assert-eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias)) + (Assert (eq (get-coding-system 'iso-8859-7) + (get-coding-system 'nested-mule-tests-alias))) + (Assert (eq (coding-system-aliasee 'nested-mule-tests-alias) 'mule-tests-alias)) + (Assert (eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias))) (Assert (coding-system-alias-p 'nested-mule-tests-alias-unix)) (Assert (coding-system-alias-p 'nested-mule-tests-alias-dos)) (Assert (coding-system-alias-p 'nested-mule-tests-alias-mac)) - (Assert-eq (find-coding-system 'nested-mule-tests-alias-unix) - (find-coding-system 'iso-8859-7-unix)) + (Assert (eq (find-coding-system 'nested-mule-tests-alias-unix) + (find-coding-system 'iso-8859-7-unix))) (Check-Error-Message error "Attempt to create a coding system alias loop" @@ -351,28 +350,51 @@ (loop for j from 0 below (length string) do (aset string j (aref greek-string (mod j 96)))) (loop for k in '(0 1 58 59) do - (Assert-equal (substring string (* 96 k) (* 96 (1+ k))) greek-string))) + (Assert (equal (substring string (* 96 k) (* 96 (1+ k))) greek-string)))) (let ((greek-string (charset-char-string 'greek-iso8859-7)) (string (make-string (* 96 60) ??))) (loop for j from (1- (length string)) downto 0 do (aset string j (aref greek-string (mod j 96)))) (loop for k in '(0 1 58 59) do - (Assert-equal (substring string (* 96 k) (* 96 (1+ k))) greek-string))) + (Assert (equal (substring string (* 96 k) (* 96 (1+ k))) greek-string)))) (let ((ascii-string (charset-char-string 'ascii)) (string (make-string (* 94 60) (make-char 'greek-iso8859-7 57)))) (loop for j from 0 below (length string) do (aset string j (aref ascii-string (mod j 94)))) (loop for k in '(0 1 58 59) do - (Assert-equal (substring string (* 94 k) (+ 94 (* 94 k))) ascii-string))) + (Assert (equal (substring string (* 94 k) (+ 94 (* 94 k))) ascii-string)))) (let ((ascii-string (charset-char-string 'ascii)) (string (make-string (* 94 60) (make-char 'greek-iso8859-7 57)))) (loop for j from (1- (length string)) downto 0 do (aset string j (aref ascii-string (mod j 94)))) (loop for k in '(0 1 58 59) do - (Assert-equal (substring string (* 94 k) (* 94 (1+ k))) ascii-string))) + (Assert (equal (substring string (* 94 k) (* 94 (1+ k))) ascii-string)))) + + ;;--------------------------------------------------------------- + ;; Test string character conversion + ;;--------------------------------------------------------------- + + ;; #### This should test all coding systems! + + (let ((all-octets (let ((s (make-string 256 ?\000))) + (loop for i from (1- (length s)) downto 0 do + (aset s i (int-char i))) + s)) + (escape-quoted-result (let ((schar '(27 155 142 143 14 15)) + (s (make-string 262 ?\000)) + (pos 0)) + (loop for ord from 0 to 255 do + (when (member ord schar) + (aset s pos ?\033) + (incf pos)) + (aset s pos (int-char ord)) + (incf pos)) + s))) + (Assert (string= (encode-coding-string all-octets 'escape-quoted) + escape-quoted-result))) ;;--------------------------------------------------------------- ;; Test file-system character conversion (and, en passant, file ops) @@ -415,8 +437,8 @@ (when working-symlinks (make-symbolic-link name1 name2) (Assert (file-exists-p name2)) - (Assert-equal (file-truename name2) name1) - (Assert-equal (file-truename name1) name1)) + (Assert (equal (file-truename name2) name1)) + (Assert (equal (file-truename name1) name1))) (ignore-file-errors (delete-file name1)) (ignore-file-errors (delete-file name2)) (ignore-file-errors (delete-file name3))) @@ -434,10 +456,10 @@ do (progn (set-unicode-conversion scaron code) - (Assert-eq code (char-to-unicode scaron)) - (Assert-eq scaron (unicode-to-char code '(latin-iso8859-2)))) + (Assert (eq code (char-to-unicode scaron))) + (Assert (eq scaron (unicode-to-char code '(latin-iso8859-2))))) finally (set-unicode-conversion scaron initial-unicode)) - (Check-Error wrong-type-argument (set-unicode-conversion scaron -10000))) + (Check-Error args-out-of-range (set-unicode-conversion scaron -10000))) (dolist (utf-8-char '("\xc6\x92" ;; U+0192 LATIN SMALL LETTER F WITH HOOK @@ -450,37 +472,37 @@ (let* ((xemacs-character (car (append (decode-coding-string utf-8-char 'utf-8) nil))) - (xemacs-charset (char-charset xemacs-character))) + (xemacs-charset (car (split-char xemacs-character)))) ;; Trivial test of the UTF-8 support of the escape-quoted character set. - (Assert-equal (decode-coding-string utf-8-char 'utf-8) + (Assert (equal (decode-coding-string utf-8-char 'utf-8) (decode-coding-string (concat "\033%G" utf-8-char) - 'escape-quoted)) + 'escape-quoted))) ;; Check that the reverse mapping holds. - (Assert-equal (unicode-code-point-to-utf-8-string + (Assert (equal (unicode-code-point-to-utf-8-string (encode-char xemacs-character 'ucs)) - utf-8-char) + utf-8-char)) ;; Check that, if this character has been JIT-allocated, it is encoded ;; in escape-quoted using the corresponding UTF-8 escape. (when (charset-property xemacs-charset 'encode-as-utf-8) - (Assert-equal (concat "\033%G" utf-8-char) - (encode-coding-string xemacs-character 'escape-quoted)) - (Assert-equal (concat "\033%G" utf-8-char) - (encode-coding-string xemacs-character 'ctext))))) + (Assert (equal (concat "\033%G" utf-8-char) + (encode-coding-string xemacs-character 'escape-quoted))) + (Assert (equal (concat "\033%G" utf-8-char) + (encode-coding-string xemacs-character 'ctext)))))) (loop for (code-point utf-16-big-endian utf-16-little-endian) in '((#x10000 "\xd8\x00\xdc\x00" "\x00\xd8\x00\xdc") (#x10FFFD "\xdb\xff\xdf\xfd" "\xff\xdb\xfd\xdf")) do - (Assert-equal (encode-coding-string + (Assert (equal (encode-coding-string (decode-char 'ucs code-point) 'utf-16) - utf-16-big-endian) - (Assert-equal (encode-coding-string + utf-16-big-endian)) + (Assert (equal (encode-coding-string (decode-char 'ucs code-point) 'utf-16-le) - utf-16-little-endian)) + utf-16-little-endian))) ;;--------------------------------------------------------------- @@ -497,11 +519,11 @@ (write-multibyte-character r0 r1))) "CCL program that writes two control-1 multibyte characters.") - (Assert-equal + (Assert (equal (ccl-execute-on-string 'ccl-write-two-control-1-chars ccl-vector "") (format "%c%c" (make-char 'control-1 0) - (make-char 'control-1 31))) + (make-char 'control-1 31)))) (define-ccl-program ccl-unicode-two-control-1-chars `(1 @@ -539,11 +561,11 @@ ;; (maybe we should): (eq 'lf (coding-system-eol-type coding-system))) ;; These coding systems are round-trip compatible with themselves. - (Assert-equal (encode-coding-string + (Assert (equal (encode-coding-string (decode-coding-string all-possible-octets coding-system) coding-system) - all-possible-octets + all-possible-octets) (format "checking %s is transparent" coding-system)))) ;;--------------------------------------------------------------- @@ -557,17 +579,17 @@ hebrew-iso8859-8 japanese-jisx0208 japanese-jisx0212 katakana-jisx0201 korean-ksc5601 latin-iso8859-1 latin-iso8859-2 vietnamese-viscii-lower))) - (Assert-equal + (Assert (equal ;; The sort is to make the algorithm of charsets-in-region ;; irrelevant. (sort (charsets-in-region (point-min) (point-max)) #'string<) - sorted-charsets-in-HELLO) - (Assert-equal + sorted-charsets-in-HELLO)) + (Assert (equal (sort (charsets-in-string (buffer-substring (point-min) (point-max))) #'string<) - sorted-charsets-in-HELLO))) + sorted-charsets-in-HELLO)))) ;;--------------------------------------------------------------- ;; Language environments, and whether the specified values are sane. @@ -580,7 +602,7 @@ do ;; s-l-e can call #'require, which says "Loading ..." (Silence-Message (set-language-environment language)) - (Assert-equal language current-language-environment) + (Assert (equal language current-language-environment)) (setq language-input-method (get-language-info language 'input-method)) @@ -600,7 +622,7 @@ ;; s-i-m can load files. (Silence-Message (set-input-method language-input-method)) - (Assert-equal language-input-method current-input-method))) + (Assert (equal language-input-method current-input-method)))) (dolist (charset (get-language-info language 'charset)) (Assert (charsetp (find-charset charset)))) diff -r 861f2601a38b -r 1f0b15040456 tests/automated/os-tests.el --- a/tests/automated/os-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/os-tests.el Sun May 01 18:44:03 2011 +0100 @@ -9,20 +9,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 tests/automated/query-coding-tests.el --- a/tests/automated/query-coding-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/query-coding-tests.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -70,7 +68,7 @@ :test #'eq)) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-region (point-min) (point-max) coding-system) - (Assert-eq t query-coding-succeeded + (Assert (eq t query-coding-succeeded) (format "checking query-coding-region ASCII-transparency, %s" coding-system)) (Assert (null query-coding-table) @@ -78,7 +76,7 @@ coding-system))) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-string ascii-chars-string coding-system) - (Assert-eq t query-coding-succeeded + (Assert (eq t query-coding-succeeded) (format "checking query-coding-string ASCII-transparency, %s" coding-system)) (Assert (null query-coding-table) @@ -89,19 +87,20 @@ (insert latin-1-chars-string) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-region (point-min) (point-max) 'iso-8859-1-unix) - (Assert-eq t query-coding-succeeded + (Assert (eq t query-coding-succeeded) "checking query-coding-region iso-8859-1-transparency") (Assert (null query-coding-table) "checking query-coding-region iso-8859-1-transparency")) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-string (buffer-string) 'iso-8859-1-unix) - (Assert-eq t query-coding-succeeded + (Assert (eq t query-coding-succeeded) "checking query-coding-string iso-8859-1-transparency") (Assert (null query-coding-table) "checking query-coding-string iso-8859-1-transparency")) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-string (buffer-string) 'iso-latin-1-with-esc-unix) - (Assert-eq t query-coding-succeeded + (Assert + (eq t query-coding-succeeded) "checking query-coding-region iso-latin-1-with-esc-transparency") (Assert (null query-coding-table) @@ -113,9 +112,10 @@ (Assert (null query-coding-succeeded) "checking that query-coding-region fails, U+20AC, iso-8859-1") - (Assert-equal query-coding-table + (Assert + (equal query-coding-table #s(range-table type start-closed-end-open data - ((257 258) unencodable)) + ((257 258) unencodable))) "checking query-coding-region fails correctly, U+20AC, iso-8859-1")) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-region (point-min) (point-max) @@ -159,17 +159,19 @@ (Assert (null query-coding-succeeded) "check query-coding-region fails, windows-1252, invalid-sequences") - (Assert-equal query-coding-table + (Assert + (equal query-coding-table #s(range-table type start-closed-end-open data ((130 131) invalid-sequence (142 143) invalid-sequence (144 146) invalid-sequence - (158 159) invalid-sequence)) + (158 159) invalid-sequence))) "check query-coding-region fails, windows-1252, invalid-sequences")) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-region (point-min) (point-max) 'windows-1252-unix (current-buffer) t) - (Assert-eq t query-coding-succeeded + (Assert + (eq t query-coding-succeeded) "checking that query-coding-region succeeds, U+20AC, windows-1252") (Assert (null query-coding-table) @@ -181,22 +183,24 @@ (Assert (null query-coding-succeeded) "checking that query-coding-region fails, U+0080, windows-1252") - (Assert-equal query-coding-table + (Assert + (equal query-coding-table #s(range-table type start-closed-end-open data - ((257 258) unencodable)) + ((257 258) unencodable))) "checking that query-coding-region fails, U+0080, windows-1252")) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-region (point-min) (point-max) 'windows-1252-unix) (Assert (null query-coding-succeeded) "check query-coding-region fails, U+0080, invalid-sequence, cp1252") - (Assert-equal query-coding-table + (Assert + (equal query-coding-table #s(range-table type start-closed-end-open data ((130 131) invalid-sequence (142 143) invalid-sequence (144 146) invalid-sequence (158 159) invalid-sequence - (257 258) unencodable)) + (257 258) unencodable))) "check query-coding-region fails, U+0080, invalid-sequence, cp1252")) ;; Try a similar approach with koi8-o, the koi8 variant with ;; support for Old Church Slavonic. @@ -213,7 +217,7 @@ "checking that query-coding-region succeeds, koi8-o-unix")) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-region (point-min) (point-max) 'escape-quoted) - (Assert-eq t query-coding-succeeded + (Assert (eq t query-coding-succeeded) "checking that query-coding-region succeeds, escape-quoted") (Assert (null query-coding-table) "checking that query-coding-region succeeds, escape-quoted")) @@ -277,15 +281,15 @@ (query-coding-region (point-min) (point-max) coding-system) (Assert (null query-coding-succeeded) "checking unicode coding systems fail with unmapped chars") - (Assert-equal query-coding-table + (Assert (equal query-coding-table #s(range-table type start-closed-end-open data ((173 174) unencodable (209 210) unencodable - (254 255) unencodable)) + (254 255) unencodable))) "checking unicode coding systems fail with unmapped chars")) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-region (point-min) 173 coding-system) - (Assert-eq t query-coding-succeeded + (Assert (eq t query-coding-succeeded) "checking unicode coding systems succeed sans unmapped chars") (Assert (null query-coding-table) @@ -300,7 +304,7 @@ "checking unicode coding systems succeed sans unmapped chars again")) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-region 210 254 coding-system) - (Assert-eq t query-coding-succeeded) + (Assert (eq t query-coding-succeeded)) (Assert (null query-coding-table))) ;; Check that it errors correctly. (setq text-conversion-error-signalled nil) @@ -336,11 +340,11 @@ (format "checking %s fails with unmapped chars and invalid seqs" coding-system)) - (Assert-equal query-coding-table + (Assert (equal query-coding-table #s(range-table type start-closed-end-open data ((1 5) unencodable (5 9) invalid-sequence - (9 13) unencodable)) + (9 13) unencodable))) (format "checking %s fails with unmapped chars and invalid seqs" coding-system))) @@ -383,30 +387,30 @@ (equal '(257) (unencodable-char-position (point-min) (point-max) 'iso-8859-1 1)) "check #'unencodable-char-position doesn't think latin-1 encodes U+20AC") - ;; Compatiblity, sigh: + ;; Compatibility, sigh: (Assert (equal '(257) (unencodable-char-position (point-min) (point-max) 'iso-8859-1 0)) "check #'unencodable-char-position has some borked GNU semantics") (dotimes (i 6) (insert (decode-char 'ucs #x20ac))) ;; Check if it stops at one: - (Assert-equal '(257) (unencodable-char-position (point-min) (point-max) - 'iso-8859-1 1) + (Assert (equal '(257) (unencodable-char-position (point-min) (point-max) + 'iso-8859-1 1)) "check #'unencodable-char-position stops at 1 when asked to") ;; Check if it stops at four: - (Assert-equal '(260 259 258 257) + (Assert (equal '(260 259 258 257) (unencodable-char-position (point-min) (point-max) - 'iso-8859-1 4) + 'iso-8859-1 4)) "check #'unencodable-char-position stops at 4 when asked to") ;; Check whether it stops at seven: - (Assert-equal '(263 262 261 260 259 258 257) + (Assert (equal '(263 262 261 260 259 258 257) (unencodable-char-position (point-min) (point-max) - 'iso-8859-1 7) + 'iso-8859-1 7)) "check #'unencodable-char-position stops at 7 when asked to") ;; Check that it still stops at seven: - (Assert-equal '(263 262 261 260 259 258 257) + (Assert (equal '(263 262 261 260 259 258 257) (unencodable-char-position (point-min) (point-max) - 'iso-8859-1 2000) + 'iso-8859-1 2000)) "check #'unencodable-char-position stops at 7 if 2000 asked for") ;; Now, #'check-coding-systems-region. ;; UTF-8 should certainly be able to encode these characters: diff -r 861f2601a38b -r 1f0b15040456 tests/automated/regexp-tests.el --- a/tests/automated/regexp-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/regexp-tests.el Sun May 01 18:44:03 2011 +0100 @@ -1,6 +1,7 @@ ;;; -*- coding: iso-8859-1 -*- ;; Copyright (C) 2000, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 2010 Ben Wing. ;; Author: Yoshiki Hayashi ;; Maintainer: Stephen J. Turnbull @@ -9,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -96,40 +95,40 @@ ;; forward (goto-char (point-min)) ;; Avoid trivial regexp. - (Assert-eq 2 (re-search-forward "ä\\|a" nil t)) + (Assert (eq 2 (re-search-forward "ä\\|a" nil t))) (goto-char (point-min)) - (Assert-eq 2 (re-search-forward "Ä\\|a" nil t)) + (Assert (eq 2 (re-search-forward "Ä\\|a" nil t))) (goto-char (1+ (point-min))) - (Assert-eq 3 (re-search-forward "ä\\|a" nil t)) + (Assert (eq 3 (re-search-forward "ä\\|a" nil t))) (goto-char (1+ (point-min))) - (Assert-eq 3 (re-search-forward "Ä\\|a" nil t)) + (Assert (eq 3 (re-search-forward "Ä\\|a" nil t))) ;; backward (goto-char (point-max)) - (Assert-eq 2 (re-search-backward "ä\\|a" nil t)) + (Assert (eq 2 (re-search-backward "ä\\|a" nil t))) (goto-char (point-max)) - (Assert-eq 2 (re-search-backward "Ä\\|a" nil t)) + (Assert (eq 2 (re-search-backward "Ä\\|a" nil t))) (goto-char (1- (point-max))) - (Assert-eq 1 (re-search-backward "ä\\|a" nil t)) + (Assert (eq 1 (re-search-backward "ä\\|a" nil t))) (goto-char (1- (point-max))) - (Assert-eq 1 (re-search-backward "Ä\\|a" nil t)) + (Assert (eq 1 (re-search-backward "Ä\\|a" nil t))) ;; case sensitive (setq case-fold-search nil) ;; forward (goto-char (point-min)) - (Assert-eq 2 (re-search-forward "ä\\|a" nil t)) + (Assert (eq 2 (re-search-forward "ä\\|a" nil t))) (goto-char (point-min)) - (Assert-eq 3 (re-search-forward "Ä\\|a" nil t)) + (Assert (eq 3 (re-search-forward "Ä\\|a" nil t))) (goto-char (1+ (point-min))) (Assert (not (re-search-forward "ä\\|a" nil t))) (goto-char (1+ (point-min))) - (Assert-eq 3 (re-search-forward "Ä\\|a" nil t)) + (Assert (eq 3 (re-search-forward "Ä\\|a" nil t))) ;; backward (goto-char (point-max)) - (Assert-eq 1 (re-search-backward "ä\\|a" nil t)) + (Assert (eq 1 (re-search-backward "ä\\|a" nil t))) (goto-char (point-max)) - (Assert-eq 2 (re-search-backward "Ä\\|a" nil t)) + (Assert (eq 2 (re-search-backward "Ä\\|a" nil t))) (goto-char (1- (point-max))) - (Assert-eq 1 (re-search-backward "ä\\|a" nil t)) + (Assert (eq 1 (re-search-backward "ä\\|a" nil t))) (goto-char (1- (point-max))) (Assert (not (re-search-backward "Ä\\|a" nil t)))) @@ -217,25 +216,25 @@ (forward-line 1) (Assert (not (looking-at "^[a]\\{3,5\\}$"))) (goto-char (point-min)) - (Assert= 12 (re-search-forward "a\\{4,4\\}")) + (Assert (= 12 (re-search-forward "a\\{4,4\\}"))) (goto-char (point-min)) - (Assert= 12 (re-search-forward "b?a\\{4,4\\}")) + (Assert (= 12 (re-search-forward "b?a\\{4,4\\}"))) (goto-char (point-min)) - (Assert= 31 (re-search-forward "ba\\{4,4\\}")) + (Assert (= 31 (re-search-forward "ba\\{4,4\\}"))) (goto-char (point-min)) - (Assert= 31 (re-search-forward "[b]a\\{4,4\\}")) + (Assert (= 31 (re-search-forward "[b]a\\{4,4\\}"))) (goto-char (point-min)) - (Assert= 31 (re-search-forward "\\(b\\)a\\{4,4\\}")) + (Assert (= 31 (re-search-forward "\\(b\\)a\\{4,4\\}"))) (goto-char (point-min)) - (Assert= 12 (re-search-forward "^a\\{4,4\\}")) + (Assert (= 12 (re-search-forward "^a\\{4,4\\}"))) (goto-char (point-min)) - (Assert= 12 (re-search-forward "^a\\{4,4\\}$")) + (Assert (= 12 (re-search-forward "^a\\{4,4\\}$"))) (goto-char (point-min)) - (Assert= 12 (re-search-forward "[a]\\{4,4\\}")) + (Assert (= 12 (re-search-forward "[a]\\{4,4\\}"))) (goto-char (point-min)) - (Assert= 12 (re-search-forward "^[a]\\{4,4\\}")) + (Assert (= 12 (re-search-forward "^[a]\\{4,4\\}"))) (goto-char (point-min)) - (Assert= 12 (re-search-forward "^[a]\\{4,4\\}$")) + (Assert (= 12 (re-search-forward "^[a]\\{4,4\\}$"))) ) ;; charset, charset_not @@ -315,15 +314,15 @@ (Assert (string= (match-string 1) nil))) ;; Test word boundaries -(Assert= (string-match "\\" "a ") 0) -(Assert= (string-match "\\ba" " a") 1) -(Assert= (string-match "a\\b" "a ") 0) +(Assert (= (string-match "\\" "a ") 0)) +(Assert (= (string-match "\\ba" " a") 1)) +(Assert (= (string-match "a\\b" "a ") 0)) ;; should work at target boundaries -(Assert= (string-match "\\" "a") 0) -(Assert= (string-match "\\ba" "a") 0) -(Assert= (string-match "a\\b" "a") 0) +(Assert (= (string-match "\\" "a") 0)) +(Assert (= (string-match "\\ba" "a") 0)) +(Assert (= (string-match "a\\b" "a") 0)) ;; Check for weirdness (Assert (not (string-match " \\> " " "))) (Assert (not (string-match " \\< " " "))) @@ -351,17 +350,17 @@ (ch1 (make-char 'japanese-jisx0208 51 65))) (Assert (not (string-match "A" (string ch0)))) (Assert (not (string-match "[A]" (string ch0)))) - (Assert-eq (string-match "[^A]" (string ch0)) 0) + (Assert (eq (string-match "[^A]" (string ch0)) 0)) (Assert (not (string-match "@A" (string ?@ ch0)))) (Assert (not (string-match "@[A]" (string ?@ ch0)))) - (Assert-eq (string-match "@[^A]" (string ?@ ch0)) 0) + (Assert (eq (string-match "@[^A]" (string ?@ ch0)) 0)) (Assert (not (string-match "@?A" (string ?@ ch0)))) (Assert (not (string-match "A" (string ch1)))) (Assert (not (string-match "[A]" (string ch1)))) - (Assert-eq (string-match "[^A]" (string ch1)) 0) + (Assert (eq (string-match "[^A]" (string ch1)) 0)) (Assert (not (string-match "@A" (string ?@ ch1)))) (Assert (not (string-match "@[A]" (string ?@ ch1)))) - (Assert-eq (string-match "@[^A]" (string ?@ ch1)) 0) + (Assert (eq (string-match "@[^A]" (string ?@ ch1)) 0)) (Assert (not (string-match "@?A" (string ?@ ch1)))) ) ) @@ -408,24 +407,24 @@ ;; fix submitted by sjt 2004-09-08 ;; trailing comments are values from buggy 21.4.15 (let ((text "abc")) - (Assert-eq 0 (string-match "\\(?:ab+\\)*c" text)) ; 2 - (Assert-eq 0 (string-match "^\\(?:ab+\\)*c" text)) ; nil - (Assert-eq 0 (string-match "^\\(?:ab+\\)*" text)) ; 0 - (Assert-eq 0 (string-match "^\\(?:ab+\\)c" text)) ; 0 - (Assert-eq 0 (string-match "^\\(?:ab\\)*c" text)) ; 0 - (Assert-eq 0 (string-match "^\\(?:a+\\)*b" text)) ; nil - (Assert-eq 0 (string-match "^\\(?:a\\)*b" text)) ; 0 + (Assert (eq 0 (string-match "\\(?:ab+\\)*c" text))) ; 2 + (Assert (eq 0 (string-match "^\\(?:ab+\\)*c" text))) ; nil + (Assert (eq 0 (string-match "^\\(?:ab+\\)*" text))) ; 0 + (Assert (eq 0 (string-match "^\\(?:ab+\\)c" text))) ; 0 + (Assert (eq 0 (string-match "^\\(?:ab\\)*c" text))) ; 0 + (Assert (eq 0 (string-match "^\\(?:a+\\)*b" text))) ; nil + (Assert (eq 0 (string-match "^\\(?:a\\)*b" text))) ; 0 ) ;; per Steve Youngs 2004-09-30 ;; fix submitted by sjt 2004-10-07 ;; trailing comments are values from buggy 21.4.pre16 (let ((text "abc")) - (Assert-eq 0 (string-match "\\(?:a\\(b\\)\\)" text)) ; 0 + (Assert (eq 0 (string-match "\\(?:a\\(b\\)\\)" text))) ; 0 (Assert (string= (match-string 1 text) "b")) ; ab (Assert (null (match-string 2 text))) ; b (Assert (null (match-string 3 text))) ; nil - (Assert-eq 0 (string-match "\\(?:a\\(?:b\\(c\\)\\)\\)" text)) ; 0 + (Assert (eq 0 (string-match "\\(?:a\\(?:b\\(c\\)\\)\\)" text))) ; 0 (Assert (string= (match-string 1 text) "c")) ; abc (Assert (null (match-string 2 text))) ; ab (Assert (null (match-string 3 text))) ; c @@ -440,7 +439,7 @@ (re2 "\\(?:a\\)\\(b\\)\\1") (re3 "\\(a\\)\\(?:b\\)\\1")) - (Assert-eq 0 (string-match re0 text1)) + (Assert (eq 0 (string-match re0 text1))) (Assert (string= text1 (match-string 0 text1))) (Assert (string= "a" (match-string 1 text1))) (Assert (string= "b" (match-string 2 text1))) @@ -449,14 +448,14 @@ (Check-Error-Message 'invalid-regexp "Invalid back reference" (string-match re1 text1)) - (Assert-eq 0 (string-match re2 text1)) + (Assert (eq 0 (string-match re2 text1))) (Assert (string= text1 (match-string 0 text1))) (Assert (string= "b" (match-string 1 text1))) (Assert (null (match-string 2 text1))) (Assert (null (string-match re2 text2))) (Assert (null (string-match re3 text1))) - (Assert-eq 0 (string-match re3 text2)) + (Assert (eq 0 (string-match re3 text2))) (Assert (string= text2 (match-string 0 text2))) (Assert (string= "a" (match-string 1 text2))) (Assert (null (match-string 2 text2))) @@ -531,14 +530,14 @@ "-]-----------------------------][]]------------------------" (goto-char (point-min)) (skip-chars-forward (skip-chars-quote "-[]")) - (Assert= (point) (point-max)) + (Assert (= (point) (point-max))) (skip-chars-backward (skip-chars-quote "-[]")) - (Assert= (point) (point-min)) + (Assert (= (point) (point-min))) ;; Testing in passing for an old bug in #'skip-chars-forward where I ;; thought it was impossible to call it with a string containing only ?- ;; and ?]: - (Assert= (skip-chars-forward (skip-chars-quote "-]")) - (position ?[ (buffer-string) :test #'=)) + (Assert (= (skip-chars-forward (skip-chars-quote "-]")) + (position ?[ (buffer-string) :test #'=))) ;; This used to error, incorrectly: (Assert (skip-chars-quote "[-"))) @@ -554,16 +553,16 @@ (with-string-as-buffer-contents "aáa" (goto-char (point-min)) (Assert (looking-at "\\=")) - (Assert= (re-search-forward "\\=") 1) + (Assert (= (re-search-forward "\\=") 1)) (forward-char 1) (Assert (looking-at "\\=")) - (Assert= (re-search-forward "\\=") 2) + (Assert (= (re-search-forward "\\=") 2)) (forward-char 1) (Assert (looking-at "\\=")) - (Assert= (re-search-forward "\\=") 3) + (Assert (= (re-search-forward "\\=") 3)) (forward-char 1) (Assert (looking-at "\\=")) - (Assert= (re-search-forward "\\=") 4)) + (Assert (= (re-search-forward "\\=") 4))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -584,16 +583,16 @@ ;; Control-1 characters were second-class citizens in regexp ranges ;; for a while there. Addressed in Ben's Mercurial changeset ;; 2e15c29cc2b3; attempt to ensure this doesn't happen again. -(Assert-eql (string-match "[\x00-\x7f\x80-\x9f]" "a") 0) -(Assert-eql (string-match "[\x00-\x7f\x80-\x9f]" "é") nil) +(Assert (eql (string-match "[\x00-\x7f\x80-\x9f]" "a") 0)) +(Assert (eql (string-match "[\x00-\x7f\x80-\x9f]" "é") nil)) ;; Gave nil in 21.5 for a couple of years. -(Assert-eql (string-match "[\x00-\x7f\x80-\x9f]" "\x80") 0) -(Assert-eql (string-match "[\x00-\x7f]\\|[\x80-\x9f]" "\x80") 0) +(Assert (eql (string-match "[\x00-\x7f\x80-\x9f]" "\x80") 0)) +(Assert (eql (string-match "[\x00-\x7f]\\|[\x80-\x9f]" "\x80") 0)) ;; Gave nil -(Assert-eql (string-match "[\x7f\x80-\x9f]" "\x80") 0) -(Assert-eql (string-match "[\x80-\x9f]" "\x80") 0) -(Assert-eql (string-match "[\x7f\x80-\x9e]" "\x80") 0) +(Assert (eql (string-match "[\x7f\x80-\x9f]" "\x80") 0)) +(Assert (eql (string-match "[\x80-\x9f]" "\x80") 0)) +(Assert (eql (string-match "[\x7f\x80-\x9e]" "\x80") 0)) ;; Used to succeed even with the bug. -(Assert-eql (string-match "[\x7f\x80\x9f]" "\x80") 0) -(Assert-eql (string-match "[\x7e\x80-\x9f]" "\x80") 0) -(Assert-eql (string-match "[\x7f\x81-\x9f]" "\x81") 0) +(Assert (eql (string-match "[\x7f\x80\x9f]" "\x80") 0)) +(Assert (eql (string-match "[\x7e\x80-\x9f]" "\x80") 0)) +(Assert (eql (string-match "[\x7f\x81-\x9f]" "\x81") 0)) diff -r 861f2601a38b -r 1f0b15040456 tests/automated/region-tests.el --- a/tests/automated/region-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/region-tests.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -71,7 +69,7 @@ ;; Region not active in this second temp buffer (Assert (not (region-active-p))) ;; Region still active in first temp buffer - (Assert-eq (zmacs-region-buffer) first-buffer) + (Assert (eq (zmacs-region-buffer) first-buffer)) ;; Activate region in second temp buffer (Silence-Message (mark-whole-buffer)) diff -r 861f2601a38b -r 1f0b15040456 tests/automated/search-tests.el --- a/tests/automated/search-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/search-tests.el Sun May 01 18:44:03 2011 +0100 @@ -10,20 +10,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -45,11 +43,11 @@ (insert "Test Buffer") (let ((case-fold-search t)) (goto-char (point-min)) - (Assert-eq (search-forward "test buffer" nil t) 12) + (Assert (eq (search-forward "test buffer" nil t) 12)) (goto-char (point-min)) - (Assert-eq (search-forward "Test buffer" nil t) 12) + (Assert (eq (search-forward "Test buffer" nil t) 12)) (goto-char (point-min)) - (Assert-eq (search-forward "Test Buffer" nil t) 12) + (Assert (eq (search-forward "Test Buffer" nil t) 12)) (setq case-fold-search nil) (goto-char (point-min)) @@ -57,51 +55,51 @@ (goto-char (point-min)) (Assert (not (search-forward "Test buffer" nil t))) (goto-char (point-min)) - (Assert-eq (search-forward "Test Buffer" nil t) 12))) + (Assert (eq (search-forward "Test Buffer" nil t) 12)))) (with-temp-buffer (insert "abcdefghijklmnäopqrstuÄvwxyz") ;; case insensitive (Assert (not (search-forward "ö" nil t))) (goto-char (point-min)) - (Assert-eq 16 (search-forward "ä" nil t)) - (Assert-eq 24 (search-forward "ä" nil t)) + (Assert (eq 16 (search-forward "ä" nil t))) + (Assert (eq 24 (search-forward "ä" nil t))) (goto-char (point-min)) - (Assert-eq 16 (search-forward "Ä" nil t)) - (Assert-eq 24 (search-forward "Ä" nil t)) + (Assert (eq 16 (search-forward "Ä" nil t))) + (Assert (eq 24 (search-forward "Ä" nil t))) (goto-char (point-max)) - (Assert-eq 23 (search-backward "ä" nil t)) - (Assert-eq 15 (search-backward "ä" nil t)) + (Assert (eq 23 (search-backward "ä" nil t))) + (Assert (eq 15 (search-backward "ä" nil t))) (goto-char (point-max)) - (Assert-eq 23 (search-backward "Ä" nil t)) - (Assert-eq 15 (search-backward "Ä" nil t)) + (Assert (eq 23 (search-backward "Ä" nil t))) + (Assert (eq 15 (search-backward "Ä" nil t))) ;; case sensitive (setq case-fold-search nil) (goto-char (point-min)) (Assert (not (search-forward "ö" nil t))) (goto-char (point-min)) - (Assert-eq 16 (search-forward "ä" nil t)) + (Assert (eq 16 (search-forward "ä" nil t))) (Assert (not (search-forward "ä" nil t))) (goto-char (point-min)) - (Assert-eq 24 (search-forward "Ä" nil t)) + (Assert (eq 24 (search-forward "Ä" nil t))) (goto-char 16) - (Assert-eq 24 (search-forward "Ä" nil t)) + (Assert (eq 24 (search-forward "Ä" nil t))) (goto-char (point-max)) - (Assert-eq 15 (search-backward "ä" nil t)) + (Assert (eq 15 (search-backward "ä" nil t))) (goto-char 15) (Assert (not (search-backward "ä" nil t))) (goto-char (point-max)) - (Assert-eq 23 (search-backward "Ä" nil t)) + (Assert (eq 23 (search-backward "Ä" nil t))) (Assert (not (search-backward "Ä" nil t)))) (with-temp-buffer (insert "aaaaäÄäÄäÄäÄäÄbbbb") (goto-char (point-min)) - (Assert-eq 15 (search-forward "ää" nil t 5)) + (Assert (eq 15 (search-forward "ää" nil t 5))) (goto-char (point-min)) (Assert (not (search-forward "ää" nil t 6))) (goto-char (point-max)) - (Assert-eq 5 (search-backward "ää" nil t 5)) + (Assert (eq 5 (search-backward "ää" nil t 5))) (goto-char (point-max)) (Assert (not (search-backward "ää" nil t 6)))) @@ -120,26 +118,26 @@ (goto-char (point-min)) (Assert (not (search-forward "ö" nil t))) (goto-char (point-min)) - (Assert-eq 2 (search-forward str-hiragana-a nil t)) + (Assert (eq 2 (search-forward str-hiragana-a nil t))) (goto-char (point-min)) - (Assert-eq 2 (search-forward str-a-diaeresis nil t)) + (Assert (eq 2 (search-forward str-a-diaeresis nil t))) (goto-char (1+ (point-min))) - (Assert-eq (point-max) - (search-forward str-hiragana-a nil t)) + (Assert (eq (point-max) + (search-forward str-hiragana-a nil t))) (goto-char (1+ (point-min))) - (Assert-eq (point-max) - (search-forward str-a-diaeresis nil t)) + (Assert (eq (point-max) + (search-forward str-a-diaeresis nil t))) ;; backward (goto-char (point-max)) (Assert (not (search-backward "ö" nil t))) (goto-char (point-max)) - (Assert-eq (1- (point-max)) (search-backward str-hiragana-a nil t)) + (Assert (eq (1- (point-max)) (search-backward str-hiragana-a nil t))) (goto-char (point-max)) - (Assert-eq (1- (point-max)) (search-backward str-a-diaeresis nil t)) + (Assert (eq (1- (point-max)) (search-backward str-a-diaeresis nil t))) (goto-char (1- (point-max))) - (Assert-eq 1 (search-backward str-hiragana-a nil t)) + (Assert (eq 1 (search-backward str-hiragana-a nil t))) (goto-char (1- (point-max))) - (Assert-eq 1 (search-backward str-a-diaeresis nil t)) + (Assert (eq 1 (search-backward str-a-diaeresis nil t))) (replace-match "a") (Assert (looking-at (format "abcdefg%c" a-diaeresis)))) (with-temp-buffer @@ -150,11 +148,11 @@ (insert string) (insert string) (goto-char (point-min)) - (Assert-eq 11 (search-forward string nil t 5)) + (Assert (eq 11 (search-forward string nil t 5))) (goto-char (point-min)) (Assert (not (search-forward string nil t 6))) (goto-char (point-max)) - (Assert-eq 1 (search-backward string nil t 5)) + (Assert (eq 1 (search-backward string nil t 5))) (goto-char (point-max)) (Assert (not (search-backward string nil t 6)))))) @@ -166,7 +164,7 @@ (with-temp-buffer (let ((target "M\xe9zard") - (debug-xemacs-searches 1)) + (debug-searches 1)) (Assert (not (search-forward target nil t))) (insert target) (goto-char (point-min)) @@ -177,13 +175,13 @@ ;; But searches for ASCII strings in buffers with nothing above ?\xFF ;; use Boyer Moore with the current implementation, which is the ;; important thing for the Gnus use case. - (Assert= (1+ (length target)) (search-forward target nil t)))) + (Assert (= (1+ (length target)) (search-forward target nil t))))) (Skip-Test-Unless - (boundp 'debug-xemacs-searches) ; normal when we have DEBUG_XEMACS + (boundp 'debug-searches) ; normal when we have DEBUG_XEMACS "not a DEBUG_XEMACS build" "checks that the algorithm chosen by #'search-forward is relatively sane" - (let ((debug-xemacs-searches 1) + (let ((debug-searches 1) newcase) (with-temp-buffer (insert "\n\nDer beruehmte deutsche Fleiss\n\n") @@ -193,7 +191,7 @@ (insert "\n\nDer ber\xfchmte deutsche Flei\xdf\n\n") (goto-char (point-min)) (Assert (search-forward "Flei\xdf")) - (Assert-eq 'boyer-moore search-algorithm-used) + (Assert (eq 'boyer-moore search-algorithm-used)) (delete-region (point-min) (point-max)) (when (featurep 'mule) (insert "\n\nDer ber\xfchmte deutsche Flei\xdf\n\n") @@ -201,15 +199,15 @@ (Assert (search-forward (format "Fle%c\xdf" (make-char 'latin-iso8859-9 #xfd)))) - (Assert-eq 'boyer-moore search-algorithm-used) + (Assert (eq 'boyer-moore search-algorithm-used)) (insert (make-char 'latin-iso8859-9 #xfd)) (goto-char (point-min)) (Assert (search-forward "Flei\xdf")) - (Assert-eq 'simple-search search-algorithm-used) + (Assert (eq 'simple-search search-algorithm-used)) (goto-char (point-min)) (Assert (search-forward (format "Fle%c\xdf" (make-char 'latin-iso8859-9 #xfd)))) - (Assert-eq 'simple-search search-algorithm-used) + (Assert (eq 'simple-search search-algorithm-used)) (setq newcase (copy-case-table (standard-case-table))) (put-case-table-pair (make-char 'ethiopic #x23 #x23) (make-char 'ethiopic #x23 #x25) @@ -225,21 +223,21 @@ (insert (make-char 'ethiopic #x23 #x23)) (insert ?1) (goto-char (point-min)) - (Assert-eql (search-forward + (Assert (eql (search-forward (string (make-char 'ethiopic #x23 #x25)) nil t) - 3) - (Assert-eq 'simple-search search-algorithm-used) + 3)) + (Assert (eq 'simple-search search-algorithm-used)) (goto-char (point-min)) - (Assert-eql (search-forward + (Assert (eql (search-forward (string (make-char 'ethiopic #x23 #x27)) nil t) - nil) - (Assert-eq 'boyer-moore search-algorithm-used)))))) + nil)) + (Assert (eq 'boyer-moore search-algorithm-used))))))) ;; XEmacs bug of long standing. (with-temp-buffer (insert "foo\201bar") (goto-char (point-min)) - (Assert-eq (search-forward "\201" nil t) 5)) + (Assert (eq (search-forward "\201" nil t) 5))) diff -r 861f2601a38b -r 1f0b15040456 tests/automated/symbol-tests.el --- a/tests/automated/symbol-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/symbol-tests.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -63,8 +61,8 @@ (uninterned (make-symbol name))) (Assert (symbolp interned)) (Assert (symbolp uninterned)) - (Assert-equal (symbol-name interned) name) - (Assert-equal (symbol-name uninterned) name) + (Assert (equal (symbol-name interned) name)) + (Assert (equal (symbol-name uninterned) name)) (Assert (not (eq interned uninterned))) (Assert (not (equal interned uninterned))))) @@ -76,12 +74,12 @@ (Implementation-Incomplete-Expect-Failure (Assert (not (zerop len))) (garbage-collect) - (Assert-eq (length (weak-list-list weak-list)) - (if (not reversep) 0 len))) + (Assert (eq (length (weak-list-list weak-list)) + (if (not reversep) 0 len)))) (Assert (not (zerop len))) (garbage-collect) - (Assert-eq (length (weak-list-list weak-list)) - (if (not reversep) 0 len)))))) + (Assert (eq (length (weak-list-list weak-list)) + (if (not reversep) 0 len))))))) (let ((weak-list (make-weak-list)) (gc-cons-threshold most-positive-fixnum)) ;; Symbols created with `make-symbol' and `gensym' should be fresh @@ -112,7 +110,7 @@ string (read (concat "\"" string "\""))) (Assert (intern-soft string)) (Assert (intern-soft symbol)) - (Assert-eq (intern-soft string) (intern-soft symbol))) + (Assert (eq (intern-soft string) (intern-soft symbol)))) (let ((fresh (read (concat "#:" (ts-fresh-symbol-name "foo"))))) (Assert (not (intern-soft fresh)))) @@ -127,15 +125,15 @@ (bar3 (nth 5 list))) (Assert (symbolp foo)) (Assert (not (intern-soft foo))) - (Assert-equal (symbol-name foo) "foo") + (Assert (equal (symbol-name foo) "foo")) (Assert (symbolp bar)) (Assert (not (intern-soft bar))) - (Assert-equal (symbol-name bar) "bar") + (Assert (equal (symbol-name bar) "bar")) - (Assert-eq foo foo2) - (Assert-eq foo2 foo3) - (Assert-eq bar bar2) - (Assert-eq bar2 bar3)) + (Assert (eq foo foo2)) + (Assert (eq foo2 foo3)) + (Assert (eq bar bar2)) + (Assert (eq bar2 bar3))) ;; Check #N=OBJECT and #N# print syntax. (let* ((foo (make-symbol "foo")) @@ -143,10 +141,10 @@ (list (list foo foo bar bar foo bar))) (let* ((print-gensym nil) (printed-list (prin1-to-string list))) - (Assert-equal printed-list "(foo foo bar bar foo bar)")) + (Assert (equal printed-list "(foo foo bar bar foo bar)"))) (let* ((print-gensym t) (printed-list (prin1-to-string list))) - (Assert-equal printed-list "(#1=#:foo #1# #2=#:bar #2# #1# #2#)"))) + (Assert (equal printed-list "(#1=#:foo #1# #2=#:bar #2# #1# #2#)")))) ;;----------------------------------------------------- ;; Read-only symbols @@ -164,18 +162,18 @@ (let ((foo 0) (bar 1)) (defvaralias 'foo 'bar) - (Assert-eq foo bar) - (Assert-eq foo 1) - (Assert-eq (variable-alias 'foo) 'bar) + (Assert (eq foo bar)) + (Assert (eq foo 1)) + (Assert (eq (variable-alias 'foo) 'bar)) (defvaralias 'bar 'foo) (Check-Error cyclic-variable-indirection (symbol-value 'foo)) (Check-Error cyclic-variable-indirection (symbol-value 'bar)) (defvaralias 'foo nil) - (Assert-eq foo 0) + (Assert (eq foo 0)) (defvaralias 'bar nil) - (Assert-eq bar 1)) + (Assert (eq bar 1))) ;;----------------------------------------------------- ;; Keywords @@ -187,10 +185,10 @@ ;; that is interned in the global obarray. ;; In Elisp, a keyword is interned as any other symbol. -(Assert-eq (read ":foo") (intern ":foo")) +(Assert (eq (read ":foo") (intern ":foo"))) ;; A keyword is self-quoting and evaluates to itself. -(Assert-eq (eval (intern ":foo")) :foo) +(Assert (eq (eval (intern ":foo")) :foo)) ;; Keywords are recognized as such only if interned in the global ;; obarray, and `keywordp' is aware of that. @@ -208,14 +206,14 @@ ;; keyword. (let* ((fresh-keyword-name (ts-fresh-symbol-name ":foo")) (fresh-keyword (intern fresh-keyword-name))) - (Assert-eq (symbol-value fresh-keyword) fresh-keyword) + (Assert (eq (symbol-value fresh-keyword) fresh-keyword)) (Assert (keywordp fresh-keyword))) ;; Likewise, reading a fresh keyword string should produce a regular ;; keyword. (let* ((fresh-keyword-name (ts-fresh-symbol-name ":foo")) (fresh-keyword (read fresh-keyword-name))) - (Assert-eq (symbol-value fresh-keyword) fresh-keyword) + (Assert (eq (symbol-value fresh-keyword) fresh-keyword)) (Assert (keywordp fresh-keyword))) ;;; Assigning to keywords @@ -236,19 +234,19 @@ ;; But symbols not interned in the global obarray are not real ;; keywords (in elisp): -(Assert-eq (set (intern ":foo" [0]) 5) 5) +(Assert (eq (set (intern ":foo" [0]) 5) 5)) ;;; Printing keywords (let ((print-gensym t)) - (Assert-equal (prin1-to-string :foo) ":foo") - (Assert-equal (prin1-to-string (intern ":foo")) ":foo") - (Assert-equal (prin1-to-string (intern ":foo" [0])) "#::foo")) + (Assert (equal (prin1-to-string :foo) ":foo")) + (Assert (equal (prin1-to-string (intern ":foo")) ":foo")) + (Assert (equal (prin1-to-string (intern ":foo" [0])) "#::foo"))) (let ((print-gensym nil)) - (Assert-equal (prin1-to-string :foo) ":foo") - (Assert-equal (prin1-to-string (intern ":foo")) ":foo") - (Assert-equal (prin1-to-string (intern ":foo" [0])) ":foo")) + (Assert (equal (prin1-to-string :foo) ":foo")) + (Assert (equal (prin1-to-string (intern ":foo")) ":foo")) + (Assert (equal (prin1-to-string (intern ":foo" [0])) ":foo"))) ;; #### Add many more tests for printing and reading symbols, as well ;; as print-gensym and print-gensym-alist! @@ -270,17 +268,17 @@ (lambda (&rest args) (throw 'test-tag args))) (Assert (not (boundp mysym))) - (Assert-equal (catch 'test-tag + (Assert (equal (catch 'test-tag (set mysym 'foo)) - `(,mysym (foo) set nil nil)) + `(,mysym (foo) set nil nil))) (Assert (not (boundp mysym))) (dontusethis-set-symbol-value-handler mysym 'set-value (lambda (&rest args) (setq save (nth 1 args)))) (set mysym 'foo) - (Assert-equal save '(foo)) - (Assert-eq (symbol-value mysym) 'foo) + (Assert (equal save '(foo))) + (Assert (eq (symbol-value mysym) 'foo)) ) (let ((mysym (make-symbol "test-symbol")) @@ -290,9 +288,9 @@ 'make-unbound (lambda (&rest args) (throw 'test-tag args))) - (Assert-equal (catch 'test-tag + (Assert (equal (catch 'test-tag (makunbound mysym)) - `(,mysym nil makunbound nil nil)) + `(,mysym nil makunbound nil nil))) (dontusethis-set-symbol-value-handler mysym 'make-unbound @@ -300,27 +298,27 @@ (Assert (not (boundp mysym))) (set mysym 'bar) (Assert (null save)) - (Assert-eq (symbol-value mysym) 'bar) + (Assert (eq (symbol-value mysym) 'bar)) (makunbound mysym) (Assert (not (boundp mysym))) - (Assert-eq save 'makunbound) + (Assert (eq save 'makunbound)) ) ;; pathname-coding-system is no more. ; (when (featurep 'file-coding) -; (Assert-eq pathname-coding-system file-name-coding-system) +; (Assert (eq pathname-coding-system file-name-coding-system)) ; (let ((val1 file-name-coding-system) ; (val2 pathname-coding-system)) -; (Assert-eq val1 val2) +; (Assert (eq val1 val2)) ; (let ((file-name-coding-system 'no-conversion-dos)) -; (Assert-eq file-name-coding-system 'no-conversion-dos) -; (Assert-eq pathname-coding-system file-name-coding-system)) +; (Assert (eq file-name-coding-system 'no-conversion-dos)) +; (Assert (eq pathname-coding-system file-name-coding-system))) ; (let ((pathname-coding-system 'no-conversion-mac)) -; (Assert-eq file-name-coding-system 'no-conversion-mac) -; (Assert-eq pathname-coding-system file-name-coding-system)) -; (Assert-eq file-name-coding-system pathname-coding-system) -; (Assert-eq val1 file-name-coding-system)) -; (Assert-eq pathname-coding-system file-name-coding-system)) +; (Assert (eq file-name-coding-system 'no-conversion-mac)) +; (Assert (eq pathname-coding-system file-name-coding-system))) +; (Assert (eq file-name-coding-system pathname-coding-system)) +; (Assert (eq val1 file-name-coding-system))) +; (Assert (eq pathname-coding-system file-name-coding-system))) ;(let ((mysym (make-symbol "test-symbol"))) diff -r 861f2601a38b -r 1f0b15040456 tests/automated/syntax-tests.el --- a/tests/automated/syntax-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/syntax-tests.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -49,7 +47,7 @@ (insert string) (goto-char point) (forward-word 1) - (Assert-eq (point) (+ point stop)))) + (Assert (eq (point) (+ point stop))))) (with-temp-buffer ;; -!- W NW @@ -77,7 +75,7 @@ (insert string) (let ((point (point))) (backward-word 1) - (Assert-eq (point) (- point stop)))) + (Assert (eq (point) (- point stop))))) (with-temp-buffer ;; NW W -!- @@ -120,7 +118,7 @@ 'syntax-table apply-syntax) (goto-char point) (forward-word 1) - (Assert-eq (point) (+ point stop))))) + (Assert (eq (point) (+ point stop)))))) ;; test syntax-table extents (with-temp-buffer @@ -143,7 +141,7 @@ (with-syntax-table (make-syntax-table) (insert "foo bar") (backward-sexp 1) - (Assert-eql (point) 5))) + (Assert (eql (point) 5)))) ;; Test forward-comment at buffer boundaries ;; #### The second Assert fails (once interpreted, once compiled) on 21.4.9 @@ -156,13 +154,13 @@ (insert "// comment\n") (forward-comment -2) - (Assert-eq (point) (point-min)) + (Assert (eq (point) (point-min))) (let ((point (point))) (insert "/* comment */") (goto-char point) (forward-comment 2) - (Assert-eq (point) (point-max)) + (Assert (eq (point) (point-max))) ;; this last used to crash (parse-partial-sexp point (point-max))))) @@ -192,8 +190,9 @@ (Assert (backward-up-list-moves-point-from-to 20 3)) (Known-Bug-Expect-Failure (Assert (backward-up-list-moves-point-from-to 22 3))) - (Known-Bug-Expect-Failure - (Assert (backward-up-list-moves-point-from-to 23 3))) + (Known-Bug-Expect-Error scan-error + (Assert (backward-up-list-moves-point-from-to 23 3)) + ) (Assert (backward-up-list-moves-point-from-to 24 3)) ;; This is maybe a little tricky, since we don't expect the position ;; check to happen -- so use an illegal expected position @@ -203,7 +202,7 @@ "Unbalanced parentheses" (backward-up-list-moves-point-from-to 25 nil)) ;; special-case check that point didn't move - (Assert= (point) 25))) + (Assert (= (point) 25)))) (loop with envvar-not-existing = (symbol-name (gensym "whatever")) diff -r 861f2601a38b -r 1f0b15040456 tests/automated/tag-tests.el --- a/tests/automated/tag-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/tag-tests.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -70,7 +68,7 @@ ;; Search for the tag "mystruct"; this should succeed (Silence-Message (find-tag "mystruct")) - (Assert-eq (point) 2) + (Assert (eq (point) 2)) ;; Search again. The search should fail, based on the patch that ;; Sven Grundmann submitted for 21.4.16. @@ -86,7 +84,7 @@ (Silence-Message (find-tag "require")) (t t)) - (Assert-eq (point) 52)) + (Assert (eq (point) 52))) (kill-buffer testfile) (delete-file testfile) diff -r 861f2601a38b -r 1f0b15040456 tests/automated/test-harness.el --- a/tests/automated/test-harness.el Sat Feb 20 06:03:00 2010 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,732 +0,0 @@ -;; test-harness.el --- Run Emacs Lisp test suites. - -;;; Copyright (C) 1998, 2002, 2003 Free Software Foundation, Inc. -;;; Copyright (C) 2002, 2010 Ben Wing. - -;; Author: Martin Buchholz -;; Maintainer: Stephen J. Turnbull -;; Keywords: testing - -;; This file is part of XEmacs. - -;; XEmacs is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; XEmacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: Not in FSF. - -;;; Commentary: - -;;; A test suite harness for testing XEmacs. -;;; The actual tests are in other files in this directory. -;;; Basically you just create files of emacs-lisp, and use the -;;; Assert, Check-Error, Check-Message, and Check-Error-Message functions -;;; to create tests. See `test-harness-from-buffer' below. -;;; Don't suppress tests just because they're due to known bugs not yet -;;; fixed -- use the Known-Bug-Expect-Failure and -;;; Implementation-Incomplete-Expect-Failure wrapper macros to mark them. -;;; A lot of the tests we run push limits; suppress Ebola message with the -;;; Ignore-Ebola wrapper macro. -;;; Some noisy code will call `message'. Output from `message' can be -;;; suppressed with the Silence-Message macro. Functions that are known to -;;; issue messages include `write-region', `find-tag', `tag-loop-continue', -;;; `insert', and `mark-whole-buffer'. N.B. The Silence-Message macro -;;; currently does not suppress the newlines printed by `message'. -;;; Definitely do not use Silence-Message with Check-Message. -;;; In general it should probably only be used on code that prepares for a -;;; test, not on tests. -;;; -;;; You run the tests using M-x test-emacs-test-file, -;;; or $(EMACS) -batch -l .../test-harness.el -f batch-test-emacs file ... -;;; which is run for you by the `make check' target in the top-level Makefile. - -(require 'bytecomp) - -(defvar unexpected-test-suite-failures 0 - "Cumulative number of unexpected failures since test-harness was loaded. - -\"Unexpected failures\" are those caught by a generic handler established -outside of the test context. As such they involve an abort of the test -suite for the file being tested. - -They often occur during preparation of a test or recording of the results. -For example, an executable used to generate test data might not be present -on the system, or a system error might occur while reading a data file.") - -(defvar unexpected-test-suite-failure-files nil - "List of test files causing unexpected failures.") - -;; Declared for dynamic scope; _do not_ initialize here. -(defvar unexpected-test-file-failures) - -(defvar test-harness-test-compiled nil - "Non-nil means the test code was compiled before execution. - -You probably should not make tests depend on compilation. -However, it can be useful to conditionally change messages based on whether -the code was compiled or not. For example, the case that motivated the -implementation of this variable: - -\(when test-harness-test-compiled - ;; this ha-a-ack depends on the failing compiled test coming last - \(setq test-harness-failure-tag - \"KNOWN BUG - fix reverted; after 2003-10-31 notify stephen\n\"))") - -(defvar test-harness-verbose - (and (not noninteractive) (> (device-baud-rate) search-slow-speed)) - "*Non-nil means print messages describing progress of emacs-tester.") - -(defvar test-harness-file-results-alist nil - "Each element is a list (FILE SUCCESSES TESTS). -The order is the reverse of the order in which tests are run. - -FILE is a string naming the test file. -SUCCESSES is a non-negative integer, the number of successes. -TESTS is a non-negative integer, the number of tests run.") - -(defvar test-harness-risk-infloops nil - "*Non-nil to run tests that may loop infinitely in buggy implementations.") - -(defvar test-harness-current-file nil) - -(defvar emacs-lisp-file-regexp (purecopy "\\.el\\'") - "*Regexp which matches Emacs Lisp source files.") - -(defconst test-harness-file-summary-template - (format "%%-%ds %%%dd of %%%dd tests successful (%%3d%%%%)." - (length "byte-compiler-tests.el:") ; use the longest file name - 5 - 5) - "Format for summary lines printed after each file is run.") - -(defconst test-harness-null-summary-template - (format "%%-%ds No tests run." - (length "byte-compiler-tests.el:")) ; use the longest file name - "Format for \"No tests\" lines printed after a file is run.") - -(defconst test-harness-aborted-summary-template - (format "%%-%ds %%%dd tests completed (aborted)." - (length "byte-compiler-tests.el:") ; use the longest file name - 5) - "Format for summary lines printed after a test run on a file was aborted.") - -;;;###autoload -(defun test-emacs-test-file (filename) - "Test a file of Lisp code named FILENAME. -The output file's name is made by appending `c' to the end of FILENAME." - (interactive - (let ((file buffer-file-name) - (file-name nil) - (file-dir nil)) - (and file - (eq (cdr (assq 'major-mode (buffer-local-variables))) - 'emacs-lisp-mode) - (setq file-name (file-name-nondirectory file) - file-dir (file-name-directory file))) - (list (read-file-name "Test file: " file-dir nil nil file-name)))) - ;; Expand now so we get the current buffer's defaults - (setq filename (expand-file-name filename)) - - ;; If we're testing a file that's in a buffer and is modified, offer - ;; to save it first. - (or noninteractive - (let ((b (get-file-buffer (expand-file-name filename)))) - (if (and b (buffer-modified-p b) - (y-or-n-p (format "save buffer %s first? " (buffer-name b)))) - (save-excursion (set-buffer b) (save-buffer))))) - - (if (or noninteractive test-harness-verbose) - (message "Testing %s..." filename)) - (let ((test-harness-current-file filename) - input-buffer) - (save-excursion - (setq input-buffer (get-buffer-create " *Test Input*")) - (set-buffer input-buffer) - (erase-buffer) - (insert-file-contents filename) - ;; Run hooks including the uncompression hook. - ;; If they change the file name, then change it for the output also. - (let ((buffer-file-name filename) - (default-major-mode 'emacs-lisp-mode) - (enable-local-eval nil)) - (normal-mode) - (setq filename buffer-file-name))) - (test-harness-from-buffer input-buffer filename) - (kill-buffer input-buffer) - )) - -(defun test-harness-read-from-buffer (buffer) - "Read forms from BUFFER, and turn it into a lambda test form." - (let ((body nil)) - (goto-char (point-min) buffer) - (condition-case error-info - (while t - (setq body (cons (read buffer) body))) - (end-of-file nil) - (error - (incf unexpected-test-file-failures) - (princ (format "Unexpected error %S reading forms from buffer\n" - error-info)))) - `(lambda () - (defvar passes) - (defvar assertion-failures) - (defvar no-error-failures) - (defvar wrong-error-failures) - (defvar missing-message-failures) - (defvar other-failures) - - (defvar trick-optimizer) - - ,@(nreverse body)))) - -(defun test-harness-from-buffer (inbuffer filename) - "Run tests in buffer INBUFFER, visiting FILENAME." - (defvar trick-optimizer) - (let ((passes 0) - (assertion-failures 0) - (no-error-failures 0) - (wrong-error-failures 0) - (missing-message-failures 0) - (other-failures 0) - (unexpected-test-file-failures 0) - - ;; #### perhaps this should be a defvar, and output at the very end - ;; OTOH, this way AC types can use a null EMACSPACKAGEPATH to find - ;; what stuff is needed, and ways to avoid using them - (skipped-test-reasons (make-hash-table :test 'equal)) - - (trick-optimizer nil) - (debug-on-error t) - (pass-stream nil)) - (with-output-to-temp-buffer "*Test-Log*" - (princ (format "Testing %s...\n\n" filename)) - - (defconst test-harness-failure-tag "FAIL") - (defconst test-harness-success-tag "PASS") - -;;;;; BEGIN DEFINITION OF MACROS USEFUL IN TEST CODE - - (defmacro Known-Bug-Expect-Failure (&rest body) - "Wrap a BODY that consists of tests that are known to fail. -This causes messages to be printed on failure indicating that this is expected, -and on success indicating that this is unexpected." - `(let ((test-harness-failure-tag "KNOWN BUG") - (test-harness-success-tag "PASS (FAILURE EXPECTED)")) - ,@body)) - - (defmacro Known-Bug-Expect-Error (expected-error &rest body) - "Wrap a BODY that consists of tests that are known to trigger an error. -This causes messages to be printed on failure indicating that this is expected, -and on success indicating that this is unexpected." - (let ((quoted-body (if (= 1 (length body)) - `(quote ,(car body)) `(quote (progn ,@body))))) - `(let ((test-harness-failure-tag "KNOWN BUG") - (test-harness-success-tag "PASS (FAILURE EXPECTED)")) - (condition-case error-info - (progn - (setq trick-optimizer (progn ,@body)) - (Print-Pass - "%S executed successfully, but expected error %S" - ,quoted-body - ',expected-error) - (incf passes)) - (,expected-error - (Print-Failure "%S ==> error %S, as expected" - ,quoted-body ',expected-error) - (incf no-error-failures)) - (error - (Print-Failure "%S ==> expected error %S, got error %S instead" - ,quoted-body ',expected-error error-info) - (incf wrong-error-failures)))))) - - (defmacro Implementation-Incomplete-Expect-Failure (&rest body) - "Wrap a BODY containing tests that are known to fail due to incomplete code. -This causes messages to be printed on failure indicating that the -implementation is incomplete (and hence the failure is expected); and on -success indicating that this is unexpected." - `(let ((test-harness-failure-tag "IMPLEMENTATION INCOMPLETE") - (test-harness-success-tag "PASS (FAILURE EXPECTED)")) - ,@body)) - - (defun Print-Failure (fmt &rest args) - (setq fmt (format "%s: %s" test-harness-failure-tag fmt)) - (if (noninteractive) (apply #'message fmt args)) - (princ (concat (apply #'format fmt args) "\n"))) - - (defun Print-Pass (fmt &rest args) - (setq fmt (format "%s: %s" test-harness-success-tag fmt)) - (and test-harness-verbose - (princ (concat (apply #'format fmt args) "\n")))) - - (defun Print-Skip (test reason &optional fmt &rest args) - (setq fmt (concat "SKIP: %S BECAUSE %S" fmt)) - (princ (concat (apply #'format fmt test reason args) "\n"))) - - (defmacro Skip-Test-Unless (condition reason description &rest body) - "Unless CONDITION is satisfied, skip test BODY. -REASON is a description of the condition failure, and must be unique (it -is used as a hash key). DESCRIPTION describes the tests that were skipped. -BODY is a sequence of expressions and may contain several tests." - `(if (not ,condition) - (let ((count (gethash ,reason skipped-test-reasons))) - (puthash ,reason (if (null count) 1 (1+ count)) - skipped-test-reasons) - (Print-Skip ,description ,reason)) - ,@body)) - - (defmacro Assert (assertion &optional failing-case description) - "Test passes if ASSERTION is true. -Optional FAILING-CASE describes the particular failure. Optional -DESCRIPTION describes the assertion; by default, the unevalated assertion -expression is given. FAILING-CASE and DESCRIPTION are useful when Assert -is used in a loop." - (let ((description - (or description `(quote ,assertion)))) - `(condition-case error-info - (progn - (assert ,assertion) - (Print-Pass "%S" ,description) - (incf passes)) - (cl-assertion-failed - (Print-Failure (if ,failing-case - "Assertion failed: %S; failing case = %S" - "Assertion failed: %S") - ,description ,failing-case) - (incf assertion-failures)) - (t (Print-Failure (if ,failing-case - "%S ==> error: %S; failing case = %S" - "%S ==> error: %S") - ,description error-info ,failing-case) - (incf other-failures) - )))) - -;;;;; BEGIN DEFINITION OF SPECIFIC KINDS OF ASSERT MACROS - - (defmacro Assert-test (test testval expected &optional failing-case - description) - "Test passes if TESTVAL compares correctly to EXPECTED using TEST. -TEST should be a two-argument predicate (i.e. a function of two arguments -that returns t or nil), such as `eq', `eql', `equal', `equalp', `=', `<=', -'>', 'file-newer-than-file-p' etc. Optional FAILING-CASE describes the -particular failure; any value given here will be concatenated with a phrase -describing the expected and actual values of the comparison. Optional -DESCRIPTION describes the assertion; by default, the unevalated comparison -expressions are given. FAILING-CASE and DESCRIPTION are useful when Assert -is used in a loop." - (let* ((assertion `(,test ,testval ,expected)) - (failmsg `(format "%S should be `%s' to %S but isn't" - ,testval ',test ,expected)) - (failmsg2 (if failing-case `(concat - (format "%S, " ,failing-case) - ,failmsg) - failmsg))) - `(Assert ,assertion ,failmsg2 ,description))) - - (defmacro Assert-test-not (test testval expected &optional failing-case - description) - "Test passes if TESTVAL does not compare correctly to EXPECTED using TEST. -TEST should be a two-argument predicate (i.e. a function of two arguments -that returns t or nil), such as `eq', `eql', `equal', `equalp', `=', `<=', -'>', 'file-newer-than-file-p' etc. Optional FAILING-CASE describes the -particular failure; any value given here will be concatenated with a phrase -describing the expected and actual values of the comparison. Optional -DESCRIPTION describes the assertion; by default, the unevalated comparison -expressions are given. FAILING-CASE and DESCRIPTION are useful when Assert -is used in a loop." - (let* ((assertion `(not (,test ,testval ,expected))) - (failmsg `(format "%S shouldn't be `%s' to %S but is" - ,testval ',test ,expected)) - (failmsg2 (if failing-case `(concat - (format "%S, " ,failing-case) - ,failmsg) - failmsg))) - `(Assert ,assertion ,failmsg2 ,description))) - - ;; Specific versions of `Assert-test'. These are just convenience - ;; functions, functioning identically to `Assert-test', and duplicating - ;; the doc string for each would be too annoying. - (defmacro Assert-eq (testval expected &optional failing-case - description) - `(Assert-test eq ,testval ,expected ,failing-case ,description)) - (defmacro Assert-eql (testval expected &optional failing-case - description) - `(Assert-test eql ,testval ,expected ,failing-case ,description)) - (defmacro Assert-equal (testval expected &optional failing-case - description) - `(Assert-test equal ,testval ,expected ,failing-case ,description)) - (defmacro Assert-equalp (testval expected &optional failing-case - description) - `(Assert-test equalp ,testval ,expected ,failing-case ,description)) - (defmacro Assert-string= (testval expected &optional failing-case - description) - `(Assert-test string= ,testval ,expected ,failing-case ,description)) - (defmacro Assert= (testval expected &optional failing-case - description) - `(Assert-test = ,testval ,expected ,failing-case ,description)) - (defmacro Assert<= (testval expected &optional failing-case - description) - `(Assert-test <= ,testval ,expected ,failing-case ,description)) - - ;; Specific versions of `Assert-test-not'. These are just convenience - ;; functions, functioning identically to `Assert-test-not', and - ;; duplicating the doc string for each would be too annoying. - (defmacro Assert-not-eq (testval expected &optional failing-case - description) - `(Assert-test-not eq ,testval ,expected ,failing-case ,description)) - (defmacro Assert-not-eql (testval expected &optional failing-case - description) - `(Assert-test-not eql ,testval ,expected ,failing-case ,description)) - (defmacro Assert-not-equal (testval expected &optional failing-case - description) - `(Assert-test-not equal ,testval ,expected ,failing-case ,description)) - (defmacro Assert-not-equalp (testval expected &optional failing-case - description) - `(Assert-test-not equalp ,testval ,expected ,failing-case ,description)) - (defmacro Assert-not-string= (testval expected &optional failing-case - description) - `(Assert-test-not string= ,testval ,expected ,failing-case ,description)) - (defmacro Assert-not= (testval expected &optional failing-case - description) - `(Assert-test-not = ,testval ,expected ,failing-case ,description)) - - (defmacro Check-Error (expected-error &rest body) - (let ((quoted-body (if (= 1 (length body)) - `(quote ,(car body)) `(quote (progn ,@body))))) - `(condition-case error-info - (progn - (setq trick-optimizer (progn ,@body)) - (Print-Failure "%S executed successfully, but expected error %S" - ,quoted-body - ',expected-error) - (incf no-error-failures)) - (,expected-error - (Print-Pass "%S ==> error %S, as expected" - ,quoted-body ',expected-error) - (incf passes)) - (error - (Print-Failure "%S ==> expected error %S, got error %S instead" - ,quoted-body ',expected-error error-info) - (incf wrong-error-failures))))) - - (defmacro Check-Error-Message (expected-error expected-error-regexp - &rest body) - (let ((quoted-body (if (= 1 (length body)) - `(quote ,(car body)) `(quote (progn ,@body))))) - `(condition-case error-info - (progn - (setq trick-optimizer (progn ,@body)) - (Print-Failure "%S executed successfully, but expected error %S" - ,quoted-body ',expected-error) - (incf no-error-failures)) - (,expected-error - ;; #### Damn, this binding doesn't capture frobs, eg, for - ;; invalid_argument() ... you only get the REASON. And for - ;; wrong_type_argument(), there's no reason only FROBs. - ;; If this gets fixed, fix tests in regexp-tests.el. - (let ((error-message (second error-info))) - (if (string-match ,expected-error-regexp error-message) - (progn - (Print-Pass "%S ==> error %S %S, as expected" - ,quoted-body error-message ',expected-error) - (incf passes)) - (Print-Failure "%S ==> got error %S as expected, but error message %S did not match regexp %S" - ,quoted-body ',expected-error error-message ,expected-error-regexp) - (incf wrong-error-failures)))) - (error - (Print-Failure "%S ==> expected error %S, got error %S instead" - ,quoted-body ',expected-error error-info) - (incf wrong-error-failures))))) - - ;; Do not use this with Silence-Message. - (defmacro Check-Message (expected-message-regexp &rest body) - (Skip-Test-Unless (fboundp 'defadvice) - "can't defadvice" - expected-message-regexp - (let ((quoted-body (if (= 1 (length body)) - `(quote ,(car body)) - `(quote (progn ,@body))))) - `(let ((messages "")) - (defadvice message (around collect activate) - (defvar messages) - (let ((msg-string (apply 'format (ad-get-args 0)))) - (setq messages (concat messages msg-string)) - msg-string)) - (condition-case error-info - (progn - (setq trick-optimizer (progn ,@body)) - (if (string-match ,expected-message-regexp messages) - (progn - (Print-Pass "%S ==> value %S, message %S, matching %S, as expected" - ,quoted-body trick-optimizer messages ',expected-message-regexp) - (incf passes)) - (Print-Failure "%S ==> value %S, message %S, NOT matching expected %S" - ,quoted-body trick-optimizer messages - ',expected-message-regexp) - (incf missing-message-failures))) - (error - (Print-Failure "%S ==> unexpected error %S" - ,quoted-body error-info) - (incf other-failures))) - (ad-unadvise 'message))))) - - ;; #### Perhaps this should override `message' itself, too? - (defmacro Silence-Message (&rest body) - `(flet ((append-message (&rest args) ()) - (clear-message (&rest args) ())) - ,@body)) - - (defmacro Ignore-Ebola (&rest body) - `(let ((debug-issue-ebola-notices -42)) ,@body)) - - (defun Int-to-Marker (pos) - (save-excursion - (set-buffer standard-output) - (save-excursion - (goto-char pos) - (point-marker)))) - - (princ "Testing Interpreted Lisp\n\n") - (condition-case error-info - (funcall (test-harness-read-from-buffer inbuffer)) - (error - (incf unexpected-test-file-failures) - (princ (format "Unexpected error %S while executing interpreted code\n" - error-info)) - (message "Unexpected error %S while executing interpreted code." error-info) - (message "Test suite execution aborted.") - )) - (princ "\nTesting Compiled Lisp\n\n") - (let (code - (test-harness-test-compiled t)) - (condition-case error-info - (setq code - ;; our lisp code is often intentionally dubious, - ;; so throw away _all_ the byte compiler warnings. - (letf (((symbol-function 'byte-compile-warn) 'ignore)) - (byte-compile (test-harness-read-from-buffer inbuffer)))) - (error - (princ (format "Unexpected error %S while byte-compiling code\n" - error-info)))) - (condition-case error-info - (if code (funcall code)) - (error - (incf unexpected-test-file-failures) - (princ (format "Unexpected error %S while executing byte-compiled code\n" - error-info)) - (message "Unexpected error %S while executing byte-compiled code." error-info) - (message "Test suite execution aborted.") - ))) - (princ (format "\nSUMMARY for %s:\n" filename)) - (princ (format "\t%5d passes\n" passes)) - (princ (format "\t%5d assertion failures\n" assertion-failures)) - (princ (format "\t%5d errors that should have been generated, but weren't\n" no-error-failures)) - (princ (format "\t%5d wrong-error failures\n" wrong-error-failures)) - (princ (format "\t%5d missing-message failures\n" missing-message-failures)) - (princ (format "\t%5d other failures\n" other-failures)) - (let* ((total (+ passes - assertion-failures - no-error-failures - wrong-error-failures - missing-message-failures - other-failures)) - (basename (file-name-nondirectory filename)) - (summary-msg - (cond ((> unexpected-test-file-failures 0) - (format test-harness-aborted-summary-template - (concat basename ":") total)) - ((> total 0) - (format test-harness-file-summary-template - (concat basename ":") - passes total (/ (* 100 passes) total))) - (t - (format test-harness-null-summary-template - (concat basename ":"))))) - (reasons "")) - (maphash (lambda (key value) - (setq reasons - (concat reasons - (format "\n %d tests skipped because %s." - value key)))) - skipped-test-reasons) - (when (> (length reasons) 1) - (setq summary-msg (concat summary-msg reasons " - It may be that XEmacs cannot find your installed packages. Set - EMACSPACKAGEPATH to the package hierarchy root or configure with - --package-path to enable the skipped tests."))) - (setq test-harness-file-results-alist - (cons (list filename passes total) - test-harness-file-results-alist)) - (message "%s" summary-msg)) - (when (> unexpected-test-file-failures 0) - (setq unexpected-test-suite-failure-files - (cons filename unexpected-test-suite-failure-files)) - (setq unexpected-test-suite-failures - (+ unexpected-test-suite-failures unexpected-test-file-failures)) - (message "Test suite execution failed unexpectedly.")) - (fmakunbound 'Assert) - (fmakunbound 'Check-Error) - (fmakunbound 'Check-Message) - (fmakunbound 'Check-Error-Message) - (fmakunbound 'Ignore-Ebola) - (fmakunbound 'Int-to-Marker) - (and noninteractive - (message "%s" (buffer-substring-no-properties - nil nil "*Test-Log*"))) - ))) - -(defvar test-harness-results-point-max nil) -(defmacro displaying-emacs-test-results (&rest body) - `(let ((test-harness-results-point-max test-harness-results-point-max)) - ;; Log the file name. - (test-harness-log-file) - ;; Record how much is logged now. - ;; We will display the log buffer if anything more is logged - ;; before the end of BODY. - (or test-harness-results-point-max - (save-excursion - (set-buffer (get-buffer-create "*Test-Log*")) - (setq test-harness-results-point-max (point-max)))) - (unwind-protect - (condition-case error-info - (progn ,@body) - (error - (test-harness-report-error error-info))) - (save-excursion - ;; If there were compilation warnings, display them. - (set-buffer "*Test-Log*") - (if (= test-harness-results-point-max (point-max)) - nil - (if temp-buffer-show-function - (let ((show-buffer (get-buffer-create "*Test-Log-Show*"))) - (save-excursion - (set-buffer show-buffer) - (setq buffer-read-only nil) - (erase-buffer)) - (copy-to-buffer show-buffer - (save-excursion - (goto-char test-harness-results-point-max) - (forward-line -1) - (point)) - (point-max)) - (funcall temp-buffer-show-function show-buffer)) - (select-window - (prog1 (selected-window) - (select-window (display-buffer (current-buffer))) - (goto-char test-harness-results-point-max) - (recenter 1))))))))) - -(defun batch-test-emacs-1 (file) - (condition-case error-info - (progn (test-emacs-test-file file) t) - (error - (princ ">>Error occurred processing ") - (princ file) - (princ ": ") - (display-error error-info nil) - (terpri) - nil))) - -(defun batch-test-emacs () - "Run `test-harness' on the files remaining on the command line. -Use this from the command line, with `-batch'; -it won't work in an interactive Emacs. -Each file is processed even if an error occurred previously. -A directory can be given as well, and all files will be processed -- -however, the file test-harness.el, which implements the test harness, -will be skipped. -For example, invoke \"xemacs -batch -f batch-test-emacs tests\"" - ;; command-line-args-left is what is left of the command line (from - ;; startup.el) - (defvar command-line-args-left) ;Avoid 'free variable' warning - (defvar debug-issue-ebola-notices) - (if (not noninteractive) - (error "`batch-test-emacs' is to be used only with -batch")) - (let ((error nil)) - (dolist (file command-line-args-left) - (if (file-directory-p file) - (dolist (file-in-dir (directory-files file t)) - (when (and (string-match emacs-lisp-file-regexp file-in-dir) - (not (or (auto-save-file-name-p file-in-dir) - (backup-file-name-p file-in-dir) - (equal (file-name-nondirectory file-in-dir) - "test-harness.el")))) - (or (batch-test-emacs-1 file-in-dir) - (setq error t)))) - (or (batch-test-emacs-1 file) - (setq error t)))) - (let ((namelen 0) - (succlen 0) - (testlen 0) - (results test-harness-file-results-alist)) - ;; compute maximum lengths of variable components of report - ;; probably should just use (length "byte-compiler-tests.el") - ;; and 5-place sizes -- this will also work for the file-by-file - ;; printing when Adrian's kludge gets reverted - (flet ((print-width (i) - (let ((x 10) (y 1)) - (while (>= i x) - (setq x (* 10 x) y (1+ y))) - y))) - (while results - (let* ((head (car results)) - (nn (length (file-name-nondirectory (first head)))) - (ss (print-width (second head))) - (tt (print-width (third head)))) - (when (> nn namelen) (setq namelen nn)) - (when (> ss succlen) (setq succlen ss)) - (when (> tt testlen) (setq testlen tt))) - (setq results (cdr results)))) - ;; create format and print - (let ((results (reverse test-harness-file-results-alist))) - (while results - (let* ((head (car results)) - (basename (file-name-nondirectory (first head))) - (nsucc (second head)) - (ntest (third head))) - (cond ((member (first head) unexpected-test-suite-failure-files) - (message test-harness-aborted-summary-template - (concat basename ":") - ntest)) - ((> ntest 0) - (message test-harness-file-summary-template - (concat basename ":") - nsucc - ntest - (/ (* 100 nsucc) ntest))) - (t - (message test-harness-null-summary-template - (concat basename ":")))) - (setq results (cdr results))))) - (when (> unexpected-test-suite-failures 0) - (message "\n***** There %s %d unexpected test suite %s in %s:" - (if (= unexpected-test-suite-failures 1) "was" "were") - unexpected-test-suite-failures - (if (= unexpected-test-suite-failures 1) "failure" "failures") - (if (= (length unexpected-test-suite-failure-files) 1) - "file" - "files")) - (while unexpected-test-suite-failure-files - (let ((line (pop unexpected-test-suite-failure-files))) - (while (and (< (length line) 61) - unexpected-test-suite-failure-files) - (setq line - (concat line " " - (pop unexpected-test-suite-failure-files)))) - (message line))))) - (message "\nDone") - (kill-emacs (if error 1 0)))) - -(provide 'test-harness) - -;;; test-harness.el ends here diff -r 861f2601a38b -r 1f0b15040456 tests/automated/weak-tests.el --- a/tests/automated/weak-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/automated/weak-tests.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -40,7 +38,7 @@ ;; tests for weak-boxes (let ((w (make-weak-box (cons 2 3)))) - (Assert-equal (cons 2 3) (weak-box-ref w)) + (Assert (equal (cons 2 3) (weak-box-ref w))) (garbage-collect) (Assert (not (weak-box-ref w)))) @@ -53,7 +51,7 @@ #'(lambda (value) (setq finalized-p t)))) (eph2 (make-ephemeron p p))) - (Assert-eq p (ephemeron-ref (make-ephemeron (cons 1 2) p))) + (Assert (eq p (ephemeron-ref (make-ephemeron (cons 1 2) p)))) (Assert (ephemeron-p (make-ephemeron (cons 1 2) p))) (garbage-collect) @@ -64,7 +62,7 @@ (garbage-collect) - (Assert-eq p (ephemeron-ref eph2))) + (Assert (eq p (ephemeron-ref eph2)))) (garbage-collect) @@ -81,20 +79,20 @@ (set-weak-list-list weaklist3 (list a (cons 1 2) b)) (set-weak-list-list weaklist4 (list a b (cons 1 2))) (Assert (weak-list-p weaklist1)) - (Assert-eq (weak-list-type weaklist1) 'simple) + (Assert (eq (weak-list-type weaklist1) 'simple)) (Assert (weak-list-p weaklist2)) - (Assert-eq (weak-list-type weaklist2) 'simple) + (Assert (eq (weak-list-type weaklist2) 'simple)) (Assert (weak-list-p weaklist3)) - (Assert-eq (weak-list-type weaklist3) 'simple) + (Assert (eq (weak-list-type weaklist3) 'simple)) (Assert (weak-list-p weaklist4)) - (Assert-eq (weak-list-type weaklist4) 'simple) + (Assert (eq (weak-list-type weaklist4) 'simple)) (garbage-collect) - (Assert-eq (weak-list-list weaklist1) testlist) - (Assert-equal (weak-list-list weaklist2) testlist) - (Assert-equal (weak-list-list weaklist3) testlist) - (Assert-equal (weak-list-list weaklist4) testlist)) + (Assert (eq (weak-list-list weaklist1) testlist)) + (Assert (equal (weak-list-list weaklist2) testlist)) + (Assert (equal (weak-list-list weaklist3) testlist)) + (Assert (equal (weak-list-list weaklist4) testlist))) (garbage-collect) @@ -111,20 +109,20 @@ (set-weak-list-list weaklist3 (list b (cons a (cons 1 2)) b)) (set-weak-list-list weaklist4 (list b (cons (cons 1 2) (cons 3 4)) b)) (Assert (weak-list-p weaklist1)) - (Assert-eq (weak-list-type weaklist1) 'assoc) + (Assert (eq (weak-list-type weaklist1) 'assoc)) (Assert (weak-list-p weaklist2)) - (Assert-eq (weak-list-type weaklist2) 'assoc) + (Assert (eq (weak-list-type weaklist2) 'assoc)) (Assert (weak-list-p weaklist3)) - (Assert-eq (weak-list-type weaklist3) 'assoc) + (Assert (eq (weak-list-type weaklist3) 'assoc)) (Assert (weak-list-p weaklist4)) - (Assert-eq (weak-list-type weaklist4) 'assoc) + (Assert (eq (weak-list-type weaklist4) 'assoc)) (garbage-collect) - (Assert-eq (weak-list-list weaklist1) testlist) - (Assert-equal (weak-list-list weaklist2) testlist) - (Assert-equal (weak-list-list weaklist3) testlist) - (Assert-equal (weak-list-list weaklist4) testlist)) + (Assert (eq (weak-list-list weaklist1) testlist)) + (Assert (equal (weak-list-list weaklist2) testlist)) + (Assert (equal (weak-list-list weaklist3) testlist)) + (Assert (equal (weak-list-list weaklist4) testlist))) (garbage-collect) @@ -141,20 +139,20 @@ (set-weak-list-list weaklist3 (list b (cons a (cons 1 2)) b)) (set-weak-list-list weaklist4 (list b (cons (cons 1 2) (cons 3 4)) b)) (Assert (weak-list-p weaklist1)) - (Assert-eq (weak-list-type weaklist1) 'key-assoc) + (Assert (eq (weak-list-type weaklist1) 'key-assoc)) (Assert (weak-list-p weaklist2)) - (Assert-eq (weak-list-type weaklist2) 'key-assoc) + (Assert (eq (weak-list-type weaklist2) 'key-assoc)) (Assert (weak-list-p weaklist3)) - (Assert-eq (weak-list-type weaklist3) 'key-assoc) + (Assert (eq (weak-list-type weaklist3) 'key-assoc)) (Assert (weak-list-p weaklist4)) - (Assert-eq (weak-list-type weaklist4) 'key-assoc) + (Assert (eq (weak-list-type weaklist4) 'key-assoc)) (garbage-collect) - (Assert-eq (weak-list-list weaklist1) testlist) - (Assert-equal (weak-list-list weaklist2) testlist) - (Assert-equal (weak-list-list weaklist3) (list b (cons a (cons 1 2)) b)) - (Assert-equal (weak-list-list weaklist4) testlist)) + (Assert (eq (weak-list-list weaklist1) testlist)) + (Assert (equal (weak-list-list weaklist2) testlist)) + (Assert (equal (weak-list-list weaklist3) (list b (cons a (cons 1 2)) b))) + (Assert (equal (weak-list-list weaklist4) testlist))) (garbage-collect) @@ -171,20 +169,20 @@ (set-weak-list-list weaklist3 (list b (cons a (cons 1 2)) b)) (set-weak-list-list weaklist4 (list b (cons (cons 1 2) (cons 3 4)) b)) (Assert (weak-list-p weaklist1)) - (Assert-eq (weak-list-type weaklist1) 'value-assoc) + (Assert (eq (weak-list-type weaklist1) 'value-assoc)) (Assert (weak-list-p weaklist2)) - (Assert-eq (weak-list-type weaklist2) 'value-assoc) + (Assert (eq (weak-list-type weaklist2) 'value-assoc)) (Assert (weak-list-p weaklist3)) - (Assert-eq (weak-list-type weaklist3) 'value-assoc) + (Assert (eq (weak-list-type weaklist3) 'value-assoc)) (Assert (weak-list-p weaklist4)) - (Assert-eq (weak-list-type weaklist4) 'value-assoc) + (Assert (eq (weak-list-type weaklist4) 'value-assoc)) (garbage-collect) - (Assert-eq (weak-list-list weaklist1) testlist) - (Assert-equal (weak-list-list weaklist2) (list b (cons (cons 1 2) a) b)) - (Assert-equal (weak-list-list weaklist3) testlist) - (Assert-equal (weak-list-list weaklist4) testlist)) + (Assert (eq (weak-list-list weaklist1) testlist)) + (Assert (equal (weak-list-list weaklist2) (list b (cons (cons 1 2) a) b))) + (Assert (equal (weak-list-list weaklist3) testlist)) + (Assert (equal (weak-list-list weaklist4) testlist))) (garbage-collect) @@ -201,20 +199,20 @@ (set-weak-list-list weaklist3 (list b (cons a (cons 1 2)) b)) (set-weak-list-list weaklist4 (list b (cons (cons 1 2) (cons 3 4)) b)) (Assert (weak-list-p weaklist1)) - (Assert-eq (weak-list-type weaklist1) 'full-assoc) + (Assert (eq (weak-list-type weaklist1) 'full-assoc)) (Assert (weak-list-p weaklist2)) - (Assert-eq (weak-list-type weaklist2) 'full-assoc) + (Assert (eq (weak-list-type weaklist2) 'full-assoc)) (Assert (weak-list-p weaklist3)) - (Assert-eq (weak-list-type weaklist3) 'full-assoc) + (Assert (eq (weak-list-type weaklist3) 'full-assoc)) (Assert (weak-list-p weaklist4)) - (Assert-eq (weak-list-type weaklist4) 'full-assoc) + (Assert (eq (weak-list-type weaklist4) 'full-assoc)) (garbage-collect) - (Assert-eq (weak-list-list weaklist1) testlist) - (Assert-equal (weak-list-list weaklist2) (list b (cons (cons 1 2) a) b)) - (Assert-equal (weak-list-list weaklist3) (list b (cons a (cons 1 2)) b)) - (Assert-equal (weak-list-list weaklist4) testlist)) + (Assert (eq (weak-list-list weaklist1) testlist)) + (Assert (equal (weak-list-list weaklist2) (list b (cons (cons 1 2) a) b))) + (Assert (equal (weak-list-list weaklist3) (list b (cons a (cons 1 2)) b))) + (Assert (equal (weak-list-list weaklist4) testlist))) (garbage-collect) diff -r 861f2601a38b -r 1f0b15040456 tests/frame.el --- a/tests/frame.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/frame.el Sun May 01 18:44:03 2011 +0100 @@ -2,22 +2,20 @@ ;;; ;;; Copyright (C) 1997 Martin Buchholz ;;; -;;; This file is part of XEmacs. -;;; -;;; XEmacs is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your -;;; option) any later version. -;;; -;;; XEmacs is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with XEmacs; see the file COPYING. If not, write to the Free -;;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;;; Boston, MA 02110-1301, USA. +;; 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 3 of the License, 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. If not, see . (defmacro check-frame-geometry (xx yy) `(loop for frame in (list nil (selected-frame)) diff -r 861f2601a38b -r 1f0b15040456 tests/glyph-test.el --- a/tests/glyph-test.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/glyph-test.el Sun May 01 18:44:03 2011 +0100 @@ -1,21 +1,19 @@ ;;; Copyright (C) 1998 Andy Piper -;;; This file is part of XEmacs. - -;;; XEmacs is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your -;;; option) any later version. - -;;; XEmacs is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; General Public License for more details. - -;;; You should have received a copy of the GNU General Public License -;;; along with XEmacs; see the file COPYING. If not, write to the Free -;;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;;; Boston, MA 02110-1301, USA. +;; 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 3 of the License, 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. If not, see . (set-extent-begin-glyph (make-extent (point) (point)) diff -r 861f2601a38b -r 1f0b15040456 tests/gtk/event-stream-tests.el --- a/tests/gtk/event-stream-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/gtk/event-stream-tests.el Sun May 01 18:44:03 2011 +0100 @@ -1,19 +1,22 @@ -;; This file is part of XEmacs. +;; event-stream-tests.el --- test the GTK event stream ;; -;; XEmacs is free software; you can redistribute it and/or modify it +;; Copyright 2000, 2001 William Perry +;; Seems to be based on the comment at the end of src/event-stream.c. +;; +;; 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. -;; +;; Free Software Foundation, either version 3 of the License, or (at your +;; option) any later version. + ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;; for more details. -;; + ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -;; Boston, MA 02111-1301, USA. */ +;; along with XEmacs. If not, see . ;also do this: make two frames, one viewing "*scratch*", the other "foo". ;in *scratch*, type (sit-for 20)^J @@ -38,7 +41,7 @@ (tst)^Jabc^G ==> ((quit) 97) with no signal, and "bc" inserted in buffer ; with sit-for only do the 2nd test. -; Do all 3 tests with (accept-proccess-output nil 20) +; Do all 3 tests with (accept-process-output nil 20) /* Additional test cases for accept-process-output, sleep-for, sit-for. diff -r 861f2601a38b -r 1f0b15040456 tests/gtk/gnome-test.el --- a/tests/gtk/gnome-test.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/gtk/gnome-test.el Sun May 01 18:44:03 2011 +0100 @@ -1,19 +1,21 @@ -;; This file is part of XEmacs. +;; gnome-test.el --- test GNOME integration +;; +;; Copyright 2000, 2001 William Perry ;; -;; XEmacs is free software; you can redistribute it and/or modify it +;; 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. -;; +;; Free Software Foundation, either version 3 of the License, or (at your +;; option) any later version. + ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;; for more details. -;; + ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -;; Boston, MA 02111-1301, USA. */ +;; along with XEmacs. If not, see . (require 'gnome) diff -r 861f2601a38b -r 1f0b15040456 tests/gtk/gtk-embedded-test.el --- a/tests/gtk/gtk-embedded-test.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/gtk/gtk-embedded-test.el Sun May 01 18:44:03 2011 +0100 @@ -1,19 +1,21 @@ -;; This file is part of XEmacs. +;; gtk-embedded-test.el --- test GTK embedding in another window +;; +;; Copyright 2000, 2001 William Perry ;; -;; XEmacs is free software; you can redistribute it and/or modify it +;; 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. -;; +;; Free Software Foundation, either version 3 of the License, or (at your +;; option) any later version. + ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;; for more details. -;; + ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -;; Boston, MA 02111-1301, USA. */ +;; along with XEmacs. If not, see . (gtk-define-test "Embedded XEmacs frame" xemacs-frame t diff -r 861f2601a38b -r 1f0b15040456 tests/gtk/gtk-extra-test.el --- a/tests/gtk/gtk-extra-test.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/gtk/gtk-extra-test.el Sun May 01 18:44:03 2011 +0100 @@ -1,19 +1,21 @@ -;; This file is part of XEmacs. +;; gtk-extra-test.el --- test extra GTK widgets +;; +;; Copyright 2000, 2001 William Perry ;; -;; XEmacs is free software; you can redistribute it and/or modify it +;; 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. -;; +;; Free Software Foundation, either version 3 of the License, or (at your +;; option) any later version. + ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;; for more details. -;; + ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -;; Boston, MA 02111-1301, USA. */ +;; along with XEmacs. If not, see . (require 'gtk-extra) diff -r 861f2601a38b -r 1f0b15040456 tests/gtk/gtk-test.el --- a/tests/gtk/gtk-test.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/gtk/gtk-test.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF @@ -1976,7 +1974,7 @@ close-button (gtk-button-new-with-label "Quit")) (gtk-window-set-title window (format "%s/GTK %d.%d.%d" - (if (featurep 'infodock) "InfoDock" "XEmacs") + "XEmacs" emacs-major-version emacs-minor-version (or emacs-patch-level emacs-beta-version))) diff -r 861f2601a38b -r 1f0b15040456 tests/gtk/gtk-test.glade --- a/tests/gtk/gtk-test.glade Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/gtk/gtk-test.glade Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,25 @@ + + + diff -r 861f2601a38b -r 1f0b15040456 tests/gtk/statusbar-test.el --- a/tests/gtk/statusbar-test.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/gtk/statusbar-test.el Sun May 01 18:44:03 2011 +0100 @@ -1,19 +1,21 @@ -;; This file is part of XEmacs. +;; statusbar-test.el --- test the GTK status bar +;; +;; Copyright 2000, 2001 William Perry ;; -;; XEmacs is free software; you can redistribute it and/or modify it +;; 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. -;; +;; Free Software Foundation, either version 3 of the License, or (at your +;; option) any later version. + ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;; for more details. -;; + ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -;; Boston, MA 02111-1301, USA. */ +;; along with XEmacs. If not, see . (defvar statusbar-hashtable (make-hashtable 29)) (defvar statusbar-gnome-p nil) diff -r 861f2601a38b -r 1f0b15040456 tests/gtk/toolbar-test.el --- a/tests/gtk/toolbar-test.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/gtk/toolbar-test.el Sun May 01 18:44:03 2011 +0100 @@ -1,19 +1,21 @@ -;; This file is part of XEmacs. +;; toolbar-test.el --- test the GTK toolbar +;; +;; Copyright 2000, 2001 William Perry ;; -;; XEmacs is free software; you can redistribute it and/or modify it +;; 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. -;; +;; Free Software Foundation, either version 3 of the License, or (at your +;; option) any later version. + ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;; for more details. -;; + ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -;; Boston, MA 02111-1301, USA. */ +;; along with XEmacs. If not, see . (require 'gtk-widgets) (require 'gnome-widgets) diff -r 861f2601a38b -r 1f0b15040456 tests/gtk/xemacs-toolbar.el --- a/tests/gtk/xemacs-toolbar.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/gtk/xemacs-toolbar.el Sun May 01 18:44:03 2011 +0100 @@ -1,19 +1,21 @@ -;; This file is part of XEmacs. +;; xemacs-toolbar.el --- test the XEmacs toolbar under GTK +;; +;; Copyright 2000, 2001 William Perry ;; -;; XEmacs is free software; you can redistribute it and/or modify it +;; 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. -;; +;; Free Software Foundation, either version 3 of the License, or (at your +;; option) any later version. + ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;; for more details. -;; + ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -;; Boston, MA 02111-1301, USA. */ +;; along with XEmacs. If not, see . (defvar gtk-torture-test-toolbar-open-active-p t) diff -r 861f2601a38b -r 1f0b15040456 tests/gutter-test.el --- a/tests/gutter-test.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/gutter-test.el Sun May 01 18:44:03 2011 +0100 @@ -1,21 +1,19 @@ ;;; Copyright (C) 1998 Andy Piper -;;; This file is part of XEmacs. - -;;; XEmacs is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your -;;; option) any later version. - -;;; XEmacs is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; General Public License for more details. - -;;; You should have received a copy of the GNU General Public License -;;; along with XEmacs; see the file COPYING. If not, write to the Free -;;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;;; Boston, MA 02110-1301, USA. +;; 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 3 of the License, 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. If not, see . (setq str "Hello\nAgain") (setq str-ext (make-extent 0 5 str)) diff -r 861f2601a38b -r 1f0b15040456 tests/mule/match.el --- a/tests/mule/match.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/mule/match.el Sun May 01 18:44:03 2011 +0100 @@ -4,20 +4,18 @@ ;; 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 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 3 of the License, 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. +;; 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. +;; along with XEmacs. If not, see . ;;; Just load the file to run the test. diff -r 861f2601a38b -r 1f0b15040456 tests/redisplay-tests.el --- a/tests/redisplay-tests.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/redisplay-tests.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. diff -r 861f2601a38b -r 1f0b15040456 tests/reproduce-crashes.el --- a/tests/reproduce-crashes.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/reproduce-crashes.el Sun May 01 18:44:03 2011 +0100 @@ -7,20 +7,18 @@ ;; This file is part of XEmacs. -;; This file 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 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 3 of the License, 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. +;; XEmacs is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs. If not, see . ;;; Synched up with: Not in FSF. @@ -206,7 +204,7 @@ (defbug 8 current "Crashes in debug version only -Fatal error: assertion failed, file src/objects.h, line 149, +Fatal error: assertion failed, file src/fontcolor.h, line 149, RECORD_TYPEP (_obj, lrecord_font_instance) || MARKED_RECORD_P (_obj)" (let (glyph ext) (make-face 'adobe-symbol-face) diff -r 861f2601a38b -r 1f0b15040456 tests/sigpipe.c --- a/tests/sigpipe.c Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/sigpipe.c Sun May 01 18:44:03 2011 +0100 @@ -4,10 +4,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +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. +Free Software Foundation, either version 3 of the License, 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 @@ -15,10 +15,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to the Free -Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -02110-1301, USA. - +along with XEmacs. If not, see . Commentary: Compile this file. Run it in the background giving it a command line diff -r 861f2601a38b -r 1f0b15040456 tests/tooltalk/Makefile --- a/tests/tooltalk/Makefile Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/tooltalk/Makefile Sun May 01 18:44:03 2011 +0100 @@ -7,6 +7,21 @@ # Copyright (C) 1995 Sun Microsystems, Inc +# 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 3 of the License, 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. If not, see + ### Commentary: # This is SPARCworks & Solaris 2.x-centric. diff -r 861f2601a38b -r 1f0b15040456 tests/tooltalk/emacs-eval.c --- a/tests/tooltalk/emacs-eval.c Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/tooltalk/emacs-eval.c Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,22 @@ -/* emacs-eval.c - send an s-expression to XEmacs for evaluation via ToolTalk */ +/* emacs-eval.c - send an s-expression to XEmacs for evaluation via ToolTalk + Copyright (C) 1995 Sun Microsystems, Inc + + Author: Vladimir Ivanovic + +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 3 of the License, 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. If not, see . */ /* See `tooltalk-eval-handler' in the file lisp/tooltalk/tooltalk-init.el for the receiver side. */ diff -r 861f2601a38b -r 1f0b15040456 tests/tooltalk/load-file.c --- a/tests/tooltalk/load-file.c Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/tooltalk/load-file.c Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,22 @@ -/* load-file.c - load & execute an Emacs Lisp file in XEmacs using ToolTalk */ +/* load-file.c - load & execute an Emacs Lisp file in XEmacs using ToolTalk + Copyright (C) 1995 Sun Microsystems, Inc + + Author: Vladimir Ivanovic + +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 3 of the License, 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. If not, see . */ /* See `tooltalk-load-file-handler' in the file lisp/tooltalk/tooltalk-init.el for the receiver side. */ diff -r 861f2601a38b -r 1f0b15040456 tests/tooltalk/make-client-frame.c --- a/tests/tooltalk/make-client-frame.c Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/tooltalk/make-client-frame.c Sun May 01 18:44:03 2011 +0100 @@ -1,4 +1,22 @@ -/* make-client-frame.c - create a new frame in XEmacs using ToolTalk */ +/* make-client-frame.c - create a new frame in XEmacs using ToolTalk + Copyright (C) 1995 Sun Microsystems, Inc + + Author: Vladimir Ivanovic + +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 3 of the License, 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. If not, see . */ /* See `tooltalk-make-client-frame-handler' in the file lisp/tooltalk/tooltalk-init.el for the receiver side. */ diff -r 861f2601a38b -r 1f0b15040456 tests/tooltalk/simple.el --- a/tests/tooltalk/simple.el Sat Feb 20 06:03:00 2010 -0600 +++ b/tests/tooltalk/simple.el Sun May 01 18:44:03 2011 +0100 @@ -1,5 +1,24 @@ ;;; Example of Sending Messages +;; Copyright (C) 1995 Sun Microsystems, Inc + +;; Author: Vladimir Ivanovic + +;; 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 3 of the License, 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. If not, see . + (defun tooltalk-random-query-handler (msg pat) (let ((state (get-tooltalk-message-attribute msg 'state))) (cond diff -r 861f2601a38b -r 1f0b15040456 version.sh.in --- a/version.sh.in Sat Feb 20 06:03:00 2010 -0600 +++ b/version.sh.in Sun May 01 18:44:03 2011 +0100 @@ -2,11 +2,11 @@ emacs_is_beta=t emacs_major_version=21 emacs_minor_version=5 -emacs_beta_version=29 -xemacs_codename="garbanzo" +emacs_beta_version=31 +xemacs_codename="ginger" emacs_kit_version= -infodock_major_version=4 -infodock_minor_version=0 -infodock_build_version=8 -xemacs_release_date="2009-05-18" +infodock_major_version= +infodock_minor_version= +infodock_build_version= +xemacs_release_date="2011-04-29" xemacs_extra_name= \ No newline at end of file