XEmacs-Beta December 2005

xemacs-beta@xemacs.org

80 participants
173 discussions

21.4.18 easymenu.el change breaks html-helper-mode? 19 years

Charles Hines

Howdy all. I was using the new(ish) 21.4.18 today, and apparently I haven't edited any HTML files since I switched to it because it appears to me that this: http://cvs.xemacs.org/viewcvs.cgi/XEmacs/xemacs/lisp/easymenu.el.diff?r1=... change to easymenu.el that was included in it breaks the old ("beta" version 2.19.1.1) html-helper-mode that I use available here: http://www.santafe.edu/~nelson/hhm-beta/ It gives the following stack trace: Debugger entered--Lisp error: (wrong-type-argument stringp nil) normalize-menu-item-name(nil) easy-menu-remove(("HTML" ["Insert Paragraph" tempo-template-html-paragraph t] ["Insert Hyperlink" tempo-template-html-hyperlink t] ["Insert Big Header" tempo-template-html-header-2 t] ["Insert Unordered List" tempo-template-html-unordered-list t] ["Insert List Item" html-helper-smart-insert-item t] ["Insert Inlined Image" tempo-template-html-image-with-alternate-text t] ["Turn on Expert Menu" html-helper-toggle-expert-menu t] ["Load This Buffer in Browser" browse-url-of-file t])) (let ((menu ...)) (easy-menu-remove menu) (easy-menu-define html-helper-mode-menu-symbol html-helper-mode-map "HTML menus" menu) (easy-menu-add menu html-helper-mode-map)) html-helper-rebuild-menu() If I revert to the 21.4.17 version of easymenu.el it loads and runs fine however. Anyone have an idea as to why it might be croaking, whether it's a bug in html-helper-mode (where it needs to catch and ignore the error perhaps) or something in the easymenu code itself that has been revealed by the above change? Thanks, Chuck -- Charles K. Hines <chuck.hines(a)baesystems.com> "When things don't sound evil enough on their own I like to toss in a BU-WHA-HA-HA-HA". - Catbert (from Dilbert)

1 participants
0 comments

[Success] XEmacs 21.5-b24 "dandelion" (+CVS-20051219) i586-pc-win32 19 years

Adrian Aichner

Builds and test OK with OPTIMIZED_BUILD=0 Crashes on C-c p (toggle-profiling) with following signature. BTW, the XEmacs whose build report I mailed to xemacs-build-reports yesterday crash with this minimal test case too! assert_failed(const char * 0x012bf068, int 431, const char * 0x012bf060) line 3978 ichar_leading_byte(int 67010312) line 431 + 20 bytes breakup_ichar_1(int 67010312, long * 0x0082e144, int * 0x0082e150, int * 0x0082e14c) line 536 + 9 bytes non_ascii_set_itext_ichar(unsigned char * 0x0082e1a5, int 67010312) line 4650 + 21 bytes set_itext_ichar(unsigned char * 0x0082e1a5, int 67010312) line 941 + 39 bytes print_internal(long 268041250, long 92413456, int 0) line 1659 + 13 bytes Fprin1_to_string(long 268041250, long 38296408) line 887 + 28 bytes emacs_doprnt_1(long 92413216, const unsigned char * 0x0585b104, long 2, long 92647136, int 1, const long * 0x0082e4d0, char * 0x0082e3ec) line 570 + 15 bytes emacs_doprnt(long 92413216, const unsigned char * 0x00000000, long 0, long 92647136, int 1, const long * 0x0082e4d0) line 866 + 33 bytes emacs_vsprintf_string_lisp(const char * 0x00000000, long 92647136, int 1, const long * 0x0082e4d0) line 899 + 59 bytes Fformat(int 2, long * 0x0082e4cc) line 2219 + 27 bytes Ffuncall(int 3, long * 0x0082e4c8) line 3913 + 14 bytes execute_optimized_program(const unsigned char * 0x05809b68, int 4, long * 0x05809368) line 862 + 16 bytes funcall_compiled_function(long 92157224, int 1, long * 0x0082e820) line 3495 + 35 bytes Ffuncall(int 2, long * 0x0082e81c) line 3929 + 17 bytes mapcar1(long 337, long * 0x0082e840, long 92157224, long 92791636) line 3195 + 11 bytes Fmapcar(long 92157224, long 92791636) line 3303 + 21 bytes Ffuncall(int 3, long * 0x0082ee44) line 3890 + 93 bytes execute_optimized_program(const unsigned char * 0x01f1ed00, int 15, long * 0x028148b4) line 862 + 16 bytes funcall_compiled_function(long 92157356, int 3, long * 0x0082f150) line 3495 + 35 bytes Ffuncall(int 4, long * 0x0082f14c) line 3929 + 17 bytes execute_optimized_program(const unsigned char * 0x01f1ed00, int 15, long * 0x028148b4) line 862 + 16 bytes funcall_compiled_function(long 92157356, int 0, long * 0x0082f3c8) line 3495 + 35 bytes Feval(long 32405340) line 3707 + 20 bytes Fprogn(long 32405292) line 954 + 9 bytes Feval(long 32405268) line 3618 + 13 bytes Fif(long 32405256) line 870 + 9 bytes Feval(long 32405232) line 3618 + 13 bytes Fprogn(long 32405184) line 954 + 9 bytes funcall_lambda(long 32405472, int 0, long * 0x0082f9dc) line 4246 + 9 bytes Ffuncall(int 1, long * 0x0082f9d8) line 3939 + 17 bytes apply1(long 32405472, long 38297320) line 4511 + 11 bytes Fcall_interactively(long 48827344, long 38297320, long 38297320) line 459 + 13 bytes Fcommand_execute(long 48827344, long 38297320, long 38297320) line 3116 + 17 bytes execute_command_event(command_builder * 0x02e76948, long 61070624) line 4286 + 25 bytes Fdispatch_event(long 61070624) line 4598 + 80 bytes Fcommand_loop_1() line 600 + 9 bytes command_loop_1(long 38297320) line 511 condition_case_1(long 38295016, long (long)* 0x01086435 command_loop_1(long), long 38297320, long (long, long)* 0x0108613d cmd_error(long, long), long 38297320) line 1924 + 7 bytes command_loop_3() line 262 + 35 bytes command_loop_2(long 38297320) line 277 internal_catch(long 38046024, long (long)* 0x0108628d command_loop_2(long), long 38297320, int * volatile 0x00000000, long * volatile 0x00000000, long * volatile 0x00000000) line 1530 + 7 bytes initial_command_loop(long 38297320) line 313 + 29 bytes xemacs_21_5_b24_i586_pc_win32(int 1, unsigned short * * 0x0082ff1c, unsigned short * * 0x00000000, int 0) line 2665 main(int 1, char * * 0x00f64268, char * * 0x00f62e50) line 3110 mainCRTStartup() line 338 + 17 bytes KERNEL32! 7c816d4f() Best regards, Adrian > XEmacs Build Report generated by emacs-version > 21.5 (beta24) "dandelion" (+CVS-20051218) XEmacs Lucid > with system-configuration > i586-pc-win32 > follows: > Contents of c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\Installation: > (Output from most recent run of ./configure) OS version: Microsoft Windows XP [Version 5.1.2600] OS: Windows_NT XEmacs 21.5-b24 "dandelion" (+CVS-20051219) configured for `i586-pc-win32'. Building XEmacs using "NMAKE". Building XEmacs using make flags " ". Building XEmacs in source tree "c:\\Hacking\\cvs.xemacs.org\\XEmacs\\xemacs-21.5-clean". For src, using compiler "cl -nologo -W3 -DSTRICT -Zi -Od -MDd -c -Ic:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\nt\inc -Ic:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\src -I"c:\Hacking\libs4xemacs\xpm-3.4k" -I"c:\Hacking\libs4xemacs\xpm-3.4k\lib" -I"c:\Hacking\libs4xemacs\libpng-1.0.2" -I"c:\Hacking\libs4xemacs\zlib" -I"c:\Hacking\libs4xemacs\tiff-v3.4\libtiff" -I"c:\Hacking\libs4xemacs\jpeg-6b" -I"c:\Hacking\libs4xemacs\compface" -I"c:\Hacking\libs4xemacs\zlib" -DHAVE_MS_WINDOWS -DHAVE_MENUBARS -DHAVE_SCROLLBARS -DHAVE_TOOLBARS -DHAVE_WIDGETS -DHAVE_DIALOGS -DHAVE_XPM -DFOR_MSW -DHAVE_GIF -DHAVE_PNG -DHAVE_TIFF -DHAVE_JPEG -DHAVE_XFACE -DHAVE_ZLIB -DHAVE_NATIVE_SOUND -DMULE -DPDUMP -DNEW_GC -DUSE_KKCC -DMC_ALLOC -DSYSTEM_MALLOC -DDEBUG_XEMACS -D_DEBUG -DWIN32_LEAN_AND_MEAN -DWIN32_NATIVE -Demacs -DHAVE_CONFIG_H -DPATH_VERSION=\"21.5-b24\" -DPATH_PROGNAME=\"xemacs\" -DEMACS_VERSION=\"21.5-b24\" -DEMACS_PROGNAME=\"xemacs\" -DSTACK_TRACE_EYE_CATCHER! =xemacs_21_5_b24_i586_pc_win32 -DPATH_PREFIX=\"..\" -DEMACS_MAJOR_VERSION=21 -DEMACS_MINOR_VERSION=5 -DEMACS_BETA_VERSION=24 -DXEMACS_CODENAME=\""dandelion"\" -DXEMACS_EXTRA_NAME=\"(+CVS-20051219)\" -DEMACS_CONFIGURATION=\"i586-pc-win32\" -DPATH_PACKAGEPATH=\""~\\.xemacs;;c:\\Program Files\\XEmacs\\site-packages;c:\\Program Files\\XEmacs\\mule-packages;c:\\Program Files\\XEmacs\\xemacs-packages"\"". For lib-src, using compiler "cl -nologo -W3 -DSTRICT -Zi -Od -MDd -Ic:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lib-src -Ic:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\src -DHAVE_CONFIG_H -DWIN32_NATIVE". Installing XEmacs in "c:\\Program Files\\XEmacs\\XEmacs-21.5-b24". Package path is "~\\.xemacs;;c:\\Program Files\\XEmacs\\site-packages;c:\\Program Files\\XEmacs\\mule-packages;c:\\Program Files\\XEmacs\\xemacs-packages". Compiling in support for Microsoft Windows native GUI. Compiling in international (MULE) support. Compiling in support for XPM images. Compiling in support for GIF images. Compiling in support for PNG images. Compiling in support for TIFF images. Compiling in support for JPEG images. Compiling in support for X-Face message headers. Compiling in support for GZIP compression/decompression. Compiling in support for toolbars. Compiling in support for dialogs. Compiling in support for widgets. Compiling in support for native sounds. Using portable dumper. Using system malloc. Using DLL version of C runtime library. Compiling in debugging support (no slowdown). Using new experimental GC algorithms. Using new experimental allocator. Using new experimental incremental garbage collector. > Contents of c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\xemacs-21.5-clean-cvs-update.err > keeping lines matching > "^--\[\[\|\]\]$\|^$cd\|n?make$\s-\|errors?\|warnings?\|pure.*$space\|size$\|hides\b\|strange\|shadowings\|^Compil$ing\s-+in\|ation$\|^Using\|not\s-+found\|^While\s-+compiling.*$ \s-+.+$*\|^Note:\|Installing\|[Ff]ile(s) copied\|\s-+tests\s-+\|^[A-Z] [^ ]+$\|^Wrong number of arguments:\|^ \*\* " > and then deleting lines matching > "confl.*with.*auto-inlining\|^Formatting:" cd c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\ Compilation started at Tue Dec 20 21:58:40 2005 +0100 (W. Europe Standard Time) ? gunzip-error.txt ? man/lispref/errors.texi.new ? nt/xemacs-21.5-clean-make-all-texinfo-error.err P version.sh M lisp/cmdloop.el M src/frame-msw.c cvs server: Updating tests cvs server: Updating tests/DLL M tests/automated/region-tests.el Compilation finished at Tue Dec 20 21:59:41 > Contents of c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\nt\xemacs-21.5-clean-make-all.err > keeping lines matching > "^--\[\[\|\]\]$\|^$cd\|n?make$\s-\|errors?\|warnings?\|pure.*$space\|size$\|hides\b\|strange\|shadowings\|^Compil$ing\s-+in\|ation$\|^Using\|not\s-+found\|^While\s-+compiling.*$ \s-+.+$*\|^Note:\|Installing\|[Ff]ile(s) copied\|\s-+tests\s-+\|^[A-Z] [^ ]+$\|^Wrong number of arguments:\|^ \*\* " > and then deleting lines matching > "confl.*with.*auto-inlining\|^Formatting:" cd c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\nt\ nmake /f xemacs.mak all Compilation started at Tue Dec 20 22:24:45 2005 +0100 (W. Europe Standard Time) Installing XEmacs in "c:\\Program Files\\XEmacs\\XEmacs-21.5-b24". 1 file(s) copied. 1 File(s) copied 1 File(s) copied Using load-path (c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lisp\) Using module-load-path (c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\modules) Generating autoloads for lisp/next-error.el... While compiling describe-register-1 in file c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lisp\register.el: ** reference to free variable yank-excluded-properties While compiling the end of the data: ** the function remove-list-of-text-properties is not known to be defined. While compiling the end of the data in file c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lisp\diagnose.el: ** The following functions are not known to be defined: sort-numeric-fields, gc-stats While compiling the end of the data in file c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lisp\mule\mule-cmds.el: ** the function set-console-tty-coding-system is not known to be defined. While compiling forward-paragraph in file c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lisp\paragraphs.el: ** variable multiple-lines bound but not referenced While compiling the end of the data: ** the function constrain-to-field is not known to be defined. Using load-path (c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lisp\) Using module-load-path (c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\modules) While compiling the end of the data in file c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lisp\x-init.el: ** the function x-keysym-hash-table is not known to be defined. While compiling x-font-menu-load-font-xft in file c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lisp\x-font-menu.el: ** reference to free variable fc-font-name-property-family ** reference to free variable fc-font-name-property-weight ** reference to free variable fc-font-name-property-size ** reference to free variable fc-font-name-property-slant While compiling the end of the data: ** The following functions are not known to be defined: fc-find-available-weights-for-family, fc-find-available-font-families, xlfd-font-name-p, fc-font-real-pattern, fc-pattern-get-family, fc-pattern-get-successp, fc-pattern-get-weight, fc-pattern-get-size, fc-pattern-get-slant, fc-font-weight-translate-to-string, fc-font-slant-translate-to-string, make-fc-pattern, fc-pattern-add, fc-font-weight-translate-from-string, fc-font-slant-translate-from-string, fc-name-unparse While compiling the end of the data in file c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lisp\x-faces.el: ** The following functions are not known to be defined: fc-font-real-pattern, default-x-device, fc-pattern-get, fc-pattern-del, fc-pattern-duplicate, fc-pattern-add, fc-name-unparse Requiring next-error... While compiling multi-occur in file c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lisp\occur.el: ** variable ido-ignore-item-temp-list bound but not referenced ** misplaced interactive spec: (interactive (cons (let* ((bufs (list (read-buffer "First buffer to search: " (current-buffer) t))) (buf nil) (ido-ignore-item-temp-list bufs)) (while (not (string-equal (setq buf (read-buffer (if (and-boundp (quote read-buffer-function) (quote (eq read-buffer-function (quote ido-read-buffer)))) "Next buffer to search (C-j to end): " "Next buffer to search (RET to end): ") nil t)) "")) (add-to-list (quote bufs) buf) (setq ido-ignore-item-temp-list bufs)) (nreverse (mapcar (function get-buffer) bufs))) (occur-read-primary-args))) While compiling occur-engine: ** reference to free variable jit-lock-mode While compiling the end of the data: ** the function jit-lock-fontify-now is not known to be defined. Compiling c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lisp\next-error.el... Wrote c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lisp\next-error.elc While compiling the end of the data in file c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lisp\gtk.el: ** the function gtk-import-function is not known to be defined. While compiling toplevel forms in file c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lisp\gtk-iso8859-1.el: ** assignment to free variable character-set-property While compiling the end of the data in file c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lisp\fontconfig.el: ** The following functions are not known to be defined: fc-pattern-get, fc-pattern-add, fc-list-fonts-pattern-objects, default-x-device, fc-pattern-p, fc-name-parse While compiling toplevel forms in file c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lisp\font.el: ** reference to free variable xft-font-regexp While compiling the end of the data: ** The following functions are not known to be defined: default-x-device, fc-font-real-pattern, fc-pattern-get, fc-pattern-add, fc-name-unparse While compiling toplevel forms in file c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lisp\mule\thai-util.el: ** define-category called with 3 arguments, but accepts only 2 ** define-category called with 3 arguments, but accepts only 2 ** define-category called with 3 arguments, but accepts only 2 While compiling the end of the data: ** the function make-category-table is not known to be defined. While compiling toplevel forms in file c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lisp\mule\lao-util.el: ** define-category called with 3 arguments, but accepts only 2 ** define-category called with 3 arguments, but accepts only 2 ** define-category called with 3 arguments, but accepts only 2 ** define-category called with 3 arguments, but accepts only 2 While compiling the end of the data: ** the function make-category-table is not known to be defined. While compiling ethio-modify-vowel in file c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lisp\mule\ethio-util.el: ** decompose-composite-char is an obsolete function; use char-to-string instead. Computing custom-loads for next-error... Compilation finished at Tue Dec 20 22:27:46 > Contents of c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\nt\xemacs-21.5-clean-make-check-temacs.err > keeping lines matching > "^--\[\[\|\]\]$\|^$cd\|n?make$\s-\|errors?\|warnings?\|pure.*$space\|size$\|hides\b\|strange\|shadowings\|^Compil$ing\s-+in\|ation$\|^Using\|not\s-+found\|^While\s-+compiling.*$ \s-+.+$*\|^Note:\|Installing\|[Ff]ile(s) copied\|\s-+tests\s-+\|^[A-Z] [^ ]+$\|^Wrong number of arguments:\|^ \*\* " > and then deleting lines matching > "confl.*with.*auto-inlining\|^Formatting:" cd c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\nt\ nmake /f xemacs.mak check-temacs Compilation started at Tue Dec 20 22:34:04 2005 +0100 (W. Europe Standard Time) Using load-path (c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lisp\) Using module-load-path (c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\modules) base64-tests.el: 1234 of 1234 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures byte-compiler-tests.el: 66 of 66 tests successful (100%). 38 tests skipped because can't defadvice. 0 errors that should have been generated, but weren't 0 wrong-error failures c-tests.el: 4 of 4 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures case-tests.el: 1148 of 1148 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures ccl-tests.el: 4570 of 4570 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures database-tests.el: No tests run. 0 errors that should have been generated, but weren't 0 wrong-error failures extent-tests.el: 194 of 194 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures hash-table-tests.el: 9866 of 9866 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures lisp-tests.el: 3672 of 3672 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures md5-tests.el: 56 of 56 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures mule-tests.el: 232 of 236 tests successful ( 98%). 0 errors that should have been generated, but weren't 0 wrong-error failures Unexpected error (void-function executable-find) while executing interpreted code. Unexpected error (void-function executable-find) while executing byte-compiled code. os-tests.el: No tests run. Unexpected error (void-function executable-find) while executing interpreted code Unexpected error (void-function executable-find) while executing byte-compiled code 0 errors that should have been generated, but weren't 0 wrong-error failures regexp-tests.el: 350 of 350 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures region-tests-1-1.el: 28 of 28 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures region-tests.el: 38 of 38 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures symbol-tests.el: 246 of 246 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures KNOWN BUG: (backward-up-list-moves-point-from-to 23 3) ==> error: (syntax-error "Unbalanced parentheses") KNOWN BUG: (backward-up-list-moves-point-from-to 23 3) ==> error: (syntax-error "Unbalanced parentheses") syntax-tests.el: 66 of 72 tests successful ( 91%). 2 tests skipped because c-mode unavailable. KNOWN BUG: (backward-up-list-moves-point-from-to 23 3) ==> error: (syntax-error "Unbalanced parentheses") KNOWN BUG: (backward-up-list-moves-point-from-to 23 3) ==> error: (syntax-error "Unbalanced parentheses") 0 errors that should have been generated, but weren't 0 wrong-error failures tag-tests.el: 6 of 6 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures weak-tests.el: 140 of 140 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures base64-tests.el: 1234 of 1234 tests successful (100%). byte-compiler-tests.el: 66 of 66 tests successful (100%). c-tests.el: 4 of 4 tests successful (100%). case-tests.el: 1148 of 1148 tests successful (100%). ccl-tests.el: 4570 of 4570 tests successful (100%). database-tests.el: No tests run. extent-tests.el: 194 of 194 tests successful (100%). hash-table-tests.el: 9866 of 9866 tests successful (100%). lisp-tests.el: 3672 of 3672 tests successful (100%). md5-tests.el: 56 of 56 tests successful (100%). mule-tests.el: 232 of 236 tests successful ( 98%). os-tests.el: No tests run. regexp-tests.el: 350 of 350 tests successful (100%). region-tests-1-1.el: 28 of 28 tests successful (100%). region-tests.el: 38 of 38 tests successful (100%). symbol-tests.el: 246 of 246 tests successful (100%). syntax-tests.el: 66 of 72 tests successful ( 91%). tag-tests.el: 6 of 6 tests successful (100%). weak-tests.el: 140 of 140 tests successful (100%). Compilation finished at Tue Dec 20 22:34:52 > Contents of c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\nt\xemacs-21.5-clean-make-check.err > keeping lines matching > "^--\[\[\|\]\]$\|^$cd\|n?make$\s-\|errors?\|warnings?\|pure.*$space\|size$\|hides\b\|strange\|shadowings\|^Compil$ing\s-+in\|ation$\|^Using\|not\s-+found\|^While\s-+compiling.*$ \s-+.+$*\|^Note:\|Installing\|[Ff]ile(s) copied\|\s-+tests\s-+\|^[A-Z] [^ ]+$\|^Wrong number of arguments:\|^ \*\* " > and then deleting lines matching > "confl.*with.*auto-inlining\|^Formatting:" cd c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\nt\ nmake /f xemacs.mak check Compilation started at Tue Dec 20 22:35:26 2005 +0100 (W. Europe Standard Time) base64-tests.el: 1234 of 1234 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures byte-compiler-tests.el: 104 of 104 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures c-tests.el: 4 of 4 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures case-tests.el: 1148 of 1148 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures ccl-tests.el: 4570 of 4570 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures database-tests.el: No tests run. 0 errors that should have been generated, but weren't 0 wrong-error failures extent-tests.el: 194 of 194 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures hash-table-tests.el: 9866 of 9866 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures lisp-tests.el: 3672 of 3672 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures md5-tests.el: 56 of 56 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures mule-tests.el: 232 of 236 tests successful ( 98%). 0 errors that should have been generated, but weren't 0 wrong-error failures os-tests.el: 20 of 20 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures regexp-tests.el: 350 of 350 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures region-tests-1-1.el: 28 of 28 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures region-tests.el: 38 of 38 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures symbol-tests.el: 246 of 246 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures KNOWN BUG: (backward-up-list-moves-point-from-to 23 3) ==> error: (syntax-error "Unbalanced parentheses") KNOWN BUG: (backward-up-list-moves-point-from-to 23 3) ==> error: (syntax-error "Unbalanced parentheses") syntax-tests.el: 70 of 76 tests successful ( 92%). KNOWN BUG: (backward-up-list-moves-point-from-to 23 3) ==> error: (syntax-error "Unbalanced parentheses") KNOWN BUG: (backward-up-list-moves-point-from-to 23 3) ==> error: (syntax-error "Unbalanced parentheses") 0 errors that should have been generated, but weren't 0 wrong-error failures tag-tests.el: 6 of 6 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures weak-tests.el: 140 of 140 tests successful (100%). 0 errors that should have been generated, but weren't 0 wrong-error failures base64-tests.el: 1234 of 1234 tests successful (100%). byte-compiler-tests.el: 104 of 104 tests successful (100%). c-tests.el: 4 of 4 tests successful (100%). case-tests.el: 1148 of 1148 tests successful (100%). ccl-tests.el: 4570 of 4570 tests successful (100%). database-tests.el: No tests run. extent-tests.el: 194 of 194 tests successful (100%). hash-table-tests.el: 9866 of 9866 tests successful (100%). lisp-tests.el: 3672 of 3672 tests successful (100%). md5-tests.el: 56 of 56 tests successful (100%). mule-tests.el: 232 of 236 tests successful ( 98%). os-tests.el: 20 of 20 tests successful (100%). regexp-tests.el: 350 of 350 tests successful (100%). region-tests-1-1.el: 28 of 28 tests successful (100%). region-tests.el: 38 of 38 tests successful (100%). symbol-tests.el: 246 of 246 tests successful (100%). syntax-tests.el: 70 of 76 tests successful ( 92%). tag-tests.el: 6 of 6 tests successful (100%). weak-tests.el: 140 of 140 tests successful (100%). Compilation finished at Tue Dec 20 22:36:13 -- Adrian Aichner mailto:adrian＠xemacs.org http://www.xemacs.org/

1 participants
0 comments

[Failure] XEmacs 21.5-b24 "dandelion" (+CVS-20051219) i586-pc-win32 19 years

Adrian Aichner

temacs crashes as follows for me with this configuration. Lstream_really_write(lstream * 0x0113bca4, const unsigned char * 0x02aca240, int 0) line 402 + 9 bytes Lstream_flush(lstream * 0x02aca240) line 442 + 20 bytes coding_flusher(lstream * 0x02a42b60) line 1967 + 13 bytes Lstream_really_write(lstream * 0x0113b881, const unsigned char * 0x02a42b60, int 0) line 403 + 3 bytes finalize_lstream(void * 0x01043e30, int 44313440) line 95 mc_finalize() line 1565 + 461 bytes gc_incremental() line 1945 + 737 bytes Ffuncall(int 17123518, long * 0x00000002) line 3826 execute_optimized_program(const unsigned char * 0x0082cbd4, int 174, long * 0x026ce55c) line 862 + 11 bytes Ffuncall(int 17123518, long * 0x00000001) line 3929 + 846 bytes execute_optimized_program(const unsigned char * 0x0082cc98, int 172, long * 0x027cb1dc) line 862 + 11 bytes Ffuncall(int 17123518, long * 0x00000001) line 3929 + 846 bytes execute_optimized_program(const unsigned char * 0x0082cd58, int 171, long * 0x029c4008) line 862 + 11 bytes Ffuncall(int 17123518, long * 0x00000001) line 3929 + 846 bytes execute_optimized_program(const unsigned char * 0x0082ce18, int 168, long * 0x026ce55c) line 862 + 11 bytes Ffuncall(int 17123518, long * 0x00000002) line 3929 + 846 bytes execute_optimized_program(const unsigned char * 0x0082cedc, int 164, long * 0x02a3337c) line 862 + 11 bytes Ffuncall(int 17123518, long * 0x00000001) line 3929 + 846 bytes execute_optimized_program(const unsigned char * 0x0082cf9c, int 161, long * 0x026ce55c) line 862 + 11 bytes Ffuncall(int 17123518, long * 0x00000002) line 3929 + 846 bytes execute_optimized_program(const unsigned char * 0x0082d060, int 153, long * 0x027c2a94) line 862 + 11 bytes Ffuncall(int 17123518, long * 0x00000003) line 3929 + 846 bytes execute_optimized_program(const unsigned char * 0x0082d130, int 150, long * 0x027cad28) line 862 + 11 bytes Ffuncall(int 17123518, long * 0x00000002) line 3929 + 846 bytes execute_optimized_program(const unsigned char * 0x0082d1f8, int 148, long * 0x02230b30) line 862 + 11 bytes Ffuncall(int 17123518, long * 0x00000001) line 3929 + 846 bytes execute_optimized_program(const unsigned char * 0x0082d2bc, int 145, long * 0x026ce55c) line 862 + 11 bytes Ffuncall(int 17123518, long * 0x00000002) line 3929 + 846 bytes execute_optimized_program(const unsigned char * 0x01e1ce70, int 31575712, long * 0x01edc540) line 862 + 11 bytes 01ec6bb8() 01d5c888() Best regards, Adrian > XEmacs Build Report generated by emacs-version > 21.5 (beta24) "dandelion" (+CVS-20051218) XEmacs Lucid > with system-configuration > i586-pc-win32 > follows: > Contents of c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\Installation: > (Output from most recent run of ./configure) OS version: Microsoft Windows XP [Version 5.1.2600] OS: Windows_NT XEmacs 21.5-b24 "dandelion" (+CVS-20051219) configured for `i586-pc-win32'. Building XEmacs using "NMAKE". Building XEmacs using make flags " ". Building XEmacs in source tree "c:\\Hacking\\cvs.xemacs.org\\XEmacs\\xemacs-21.5-clean". For src, using compiler "cl -nologo -W3 -DSTRICT -Zi -O2 -G5 -Ob2 -MDd -c -Ic:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\nt\inc -Ic:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\src -I"c:\Hacking\libs4xemacs\xpm-3.4k" -I"c:\Hacking\libs4xemacs\xpm-3.4k\lib" -I"c:\Hacking\libs4xemacs\libpng-1.0.2" -I"c:\Hacking\libs4xemacs\zlib" -I"c:\Hacking\libs4xemacs\tiff-v3.4\libtiff" -I"c:\Hacking\libs4xemacs\jpeg-6b" -I"c:\Hacking\libs4xemacs\compface" -I"c:\Hacking\libs4xemacs\zlib" -DHAVE_MS_WINDOWS -DHAVE_MENUBARS -DHAVE_SCROLLBARS -DHAVE_TOOLBARS -DHAVE_WIDGETS -DHAVE_DIALOGS -DHAVE_XPM -DFOR_MSW -DHAVE_GIF -DHAVE_PNG -DHAVE_TIFF -DHAVE_JPEG -DHAVE_XFACE -DHAVE_ZLIB -DHAVE_NATIVE_SOUND -DMULE -DPDUMP -DNEW_GC -DUSE_KKCC -DMC_ALLOC -DSYSTEM_MALLOC -DDEBUG_XEMACS -D_DEBUG -DWIN32_LEAN_AND_MEAN -DWIN32_NATIVE -Demacs -DHAVE_CONFIG_H -DPATH_VERSION=\"21.5-b24\" -DPATH_PROGNAME=\"xemacs\" -DEMACS_VERSION=\"21.5-b24\" -DEMACS_PROGNAME=\"xemacs\" -DSTACK_TRACE_EYE_CATCHER=xemacs_21_5_b24_i586_pc_win32 -DPATH_PREFIX=\"..\" -DEMACS_MAJOR_VERSION=21 -DEMACS_MINOR_VERSION=5 -DEMACS_BETA_VERSION=24 -DXEMACS_CODENAME=\""dandelion"\" -DXEMACS_EXTRA_NAME=\"(+CVS-20051219)\" -DEMACS_CONFIGURATION=\"i586-pc-win32\" -DPATH_PACKAGEPATH=\""~\\.xemacs;;c:\\Program Files\\XEmacs\\site-packages;c:\\Program Files\\XEmacs\\mule-packages;c:\\Program Files\\XEmacs\\xemacs-packages"\"". For lib-src, using compiler "cl -nologo -W3 -DSTRICT -Zi -O2 -G5 -Ob2 -MDd -Ic:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lib-src -Ic:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\src -DHAVE_CONFIG_H -DWIN32_NATIVE". Installing XEmacs in "c:\\Program Files\\XEmacs\\XEmacs-21.5-b24". Package path is "~\\.xemacs;;c:\\Program Files\\XEmacs\\site-packages;c:\\Program Files\\XEmacs\\mule-packages;c:\\Program Files\\XEmacs\\xemacs-packages". Compiling in support for Microsoft Windows native GUI. Compiling in international (MULE) support. Compiling in support for XPM images. Compiling in support for GIF images. Compiling in support for PNG images. Compiling in support for TIFF images. Compiling in support for JPEG images. Compiling in support for X-Face message headers. Compiling in support for GZIP compression/decompression. Compiling in support for toolbars. Compiling in support for dialogs. Compiling in support for widgets. Compiling in support for native sounds. Using portable dumper. Using system malloc. Using DLL version of C runtime library. Compiling in debugging support (no slowdown). Compiling with optimization. Using new experimental GC algorithms. Using new experimental allocator. Using new experimental incremental garbage collector. > Contents of c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\xemacs-21.5-clean-cvs-update.err > keeping lines matching > "^--\[\[\|\]\]$\|^$cd\|n?make$\s-\|errors?\|warnings?\|pure.*$space\|size$\|hides\b\|strange\|shadowings\|^Compil$ing\s-+in\|ation$\|^Using\|not\s-+found\|^While\s-+compiling.*$ \s-+.+$*\|^Note:\|Installing\|[Ff]ile(s) copied\|\s-+tests\s-+\|^[A-Z] [^ ]+$\|^Wrong number of arguments:\|^ \*\* " > and then deleting lines matching > "confl.*with.*auto-inlining\|^Formatting:" cd c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\ Compilation started at Tue Dec 20 21:58:40 2005 +0100 (W. Europe Standard Time) ? gunzip-error.txt ? man/lispref/errors.texi.new ? nt/xemacs-21.5-clean-make-all-texinfo-error.err P version.sh M lisp/cmdloop.el M src/frame-msw.c cvs server: Updating tests cvs server: Updating tests/DLL M tests/automated/region-tests.el Compilation finished at Tue Dec 20 21:59:41 > Contents of c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\nt\xemacs-21.5-clean-make-all.err > keeping lines matching > "^--\[\[\|\]\]$\|^$cd\|n?make$\s-\|errors?\|warnings?\|pure.*$space\|size$\|hides\b\|strange\|shadowings\|^Compil$ing\s-+in\|ation$\|^Using\|not\s-+found\|^While\s-+compiling.*$ \s-+.+$*\|^Note:\|Installing\|[Ff]ile(s) copied\|\s-+tests\s-+\|^[A-Z] [^ ]+$\|^Wrong number of arguments:\|^ \*\* " > and then deleting lines matching > "confl.*with.*auto-inlining\|^Formatting:" cd c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\nt\ nmake /f xemacs.mak all Compilation started at Tue Dec 20 22:12:18 2005 +0100 (W. Europe Standard Time) Installing XEmacs in "c:\\Program Files\\XEmacs\\XEmacs-21.5-b24". 1 file(s) copied. 1 File(s) copied 1 File(s) copied Using load-path (c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\lisp\) Using module-load-path (c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\modules) Generating autoloads for lisp/next-error.el... Fatal error. byte-compile-unwind-protect((unwind-protect (progn (fset (quote frob-face-inst-list) (function (lambda (locale inst-list prop devtype-spec) "\nCommon Lisp lambda list:\n (lambda LOCALE INST-LIST PROP DEVTYPE-SPEC)\n\n" (block frob-face-inst-list (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results:test (function equal))))))) (let* ((--letf-bound--25565 (fboundp (quote frob-locale))) (--letf-save--25564 (and --letf-bound--25565 (symbol-function (quote frob-locale))))) (unwind-protect (progn (fset (quote frob-locale) (function (lambda (sp locale inst-list thunk) "\nCommon Lisp lambda list:\n (lambda SP LOCALE INST-LIST THUNK)\n\n" (block frob-locale (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil)))) (let* ((--letf-bound--25569 (fboundp (quote map-over-locales))) (--letf-save--25568 (and --letf-bound--25569 (symbol-function (quote map-over-locales))))) (unwind-protect (progn (fset (quote map-over-locales) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block map-over-locales (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (if do-later-stages (progn (if (global-locale locale) (setq locale (quote global))) (let (do-something) (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G25570 (cons win-prop tty-props)) (prop nil) (propspec nil) (devtype-spec nil)) (while (consp G25570) (setq prop (car G25570)) (setq propspec (get face prop)) (setq devtype-spec (if (eq prop win-prop) (quote window-system) (quote tty))) (if propspec (progn (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t)))))) (setq G25570 (cdr G25570))) nil))) (if do-something (map-over-locales (or (global-locale locale) locale)))) (if (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) (if --letf-bound--25569 (fset (quote map-over-locales) --letf-save--25568) (fmakunbound (quote map-over-locales)))))) (if --letf-bound--25565 (fset (quote frob-locale) --letf-save--25564) (fmakunbound (quote frob-locale)))))) (if --letf-bound--25561 (fset (quote frob-face-inst-list) --letf-save--25560) (fmakunbound (quote frob-face-inst-list))))) byte-compile-form((unwind-protect (progn (fset (quote frob-face-inst-list) (function (lambda (locale inst-list prop devtype-spec) "\nCommon Lisp lambda list:\n (lambda LOCALE INST-LIST PROP DEVTYPE-SPEC)\n\n" (block frob-face-inst-list (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results :test (function equal))))))) (let* ((--letf-bound--25565 (fboundp (quote frob-locale))) (--letf-save--25564 (and --letf-bound--25565 (symbol-function (quote frob-locale))))) (unwind-protect (progn (fset (quote frob-locale) (function (lambda (sp locale inst-list thunk) "\nCommon Lisp lambda list:\n (lambda SP LOCALE INST-LIST THUNK)\n\n" (block frob-locale (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil)))) (let* ((--letf-bound--25569 (fboundp (quote map-over-locales))) (--letf-save--25568 (and --letf-bound--25569 (symbol-function (quote map-over-locales))))) (unwind-protect (progn (fset (quote map-over-locales) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block map-over-locales (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (if do-later-stages (progn (if (global-locale locale) (setq locale (quote global))) (let (do-something) (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G25570 (cons win-prop tty-props)) (prop nil) (propspec nil) (devtype-spec nil)) (while (consp G25570) (setq prop (car G25570)) (setq propspec (get face prop)) (setq devtype-spec (if (eq prop win-prop) (quote window-system) (quote tty))) (if propspec (progn (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t)))))) (setq G25570 (cdr G25570))) nil))) (if do-something (map-over-locales (or (global-locale locale) locale)))) (if (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) (if --letf-bound--25569 (fset (quote map-over-locales) --letf-save--25568) (fmakunbound (quote map-over-locales)))))) (if --letf-bound--25565 (fset (quote frob-locale) --letf-save--25564) (fmakunbound (quote frob-locale)))))) (if --letf-bound--25561 (fset (quote frob-face-inst-list) --letf-save--25560) (fmakunbound (quote frob-face-inst-list)))) nil) byte-compile-body(((unwind-protect (progn (fset (quote frob-face-inst-list) (function (lambda (locale inst-list prop devtype-spec) "\nCommon Lisp lambda list:\n (lambda LOCALE INST-LIST PROP DEVTYPE-SPEC)\n\n" (block frob-face-inst-list (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results :test (function equal))))))) (let* ((--letf-bound--25565 (fboundp (quote frob-locale))) (--letf-save--25564 (and --letf-bound--25565 (symbol-function (quote frob-locale))))) (unwind-protect (progn (fset (quote frob-locale) (function (lambda (sp locale inst-list thunk) "\nCommon Lisp lambda list:\n (lambda SP LOCALE INST-LIST THUNK)\n\n" (block frob-locale (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil)))) (let* ((--letf-bound--25569 (fboundp (quote map-over-locales))) (--letf-save--25568 (and --letf-bound--25569 (symbol-function (quote map-over-locales))))) (unwind-protect (progn (fset (quote map-over-locales) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block map-over-locales (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (if do-later-stages (progn (if (global-locale locale) (setq locale (quote global))) (let (do-something) (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G25570 (cons win-prop tty-props)) (prop nil) (propspec nil) (devtype-spec nil)) (while (consp G25570) (setq prop (car G25570)) (setq propspec (get face prop)) (setq devtype-spec (if (eq prop win-prop) (quote window-system) (quote tty))) (if propspec (progn (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t)))))) (setq G25570 (cdr G25570))) nil))) (if do-something (map-over-locales (or (global-locale locale) locale)))) (if (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) (if --letf-bound--25569 (fset (quote map-over-locales) --letf-save--25568) (fmakunbound (quote map-over-locales)))))) (if --letf-bound--25565 (fset (quote frob-locale) --letf-save--25564) (fmakunbound (quote frob-locale)))))) (if --letf-bound--25561 (fset (quote frob-face-inst-list) --letf-save--25560) (fmakunbound (quote frob-face-inst-list))))) nil) byte-compile-let*((let* ((--letf-bound--25561 (fboundp (quote frob-face-inst-list))) (--letf-save--25560 (and --letf-bound--25561 (symbol-function (quote frob-face-inst-list))))) (unwind-protect (progn (fset (quote frob-face-inst-list) (function (lambda (locale inst-list prop devtype-spec) "\nCommon Lisp lambda list:\n (lambda LOCALE INST-LIST PROP DEVTYPE-SPEC)\n\n" (block frob-face-inst-list (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results:test (function equal))))))) (let* ((--letf-bound--25565 (fboundp (quote frob-locale))) (--letf-save--25564 (and --letf-bound--25565 (symbol-function (quote frob-locale))))) (unwind-protect (progn (fset (quote frob-locale) (function (lambda (sp locale inst-list thunk) "\nCommon Lisp lambda list:\n (lambda SP LOCALE INST-LIST THUNK)\n\n" (block frob-locale (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil)))) (let* ((--letf-bound--25569 (fboundp (quote map-over-locales))) (--letf-save--25568 (and --letf-bound--25569 (symbol-function (quote map-over-locales))))) (unwind-protect (progn (fset (quote map-over-locales) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block map-over-locales (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (if do-later-stages (progn (if (global-locale locale) (setq locale (quote global))) (let (do-something) (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G25570 (cons win-prop tty-props)) (prop nil) (propspec nil) (devtype-spec nil)) (while (consp G25570) (setq prop (car G25570)) (setq propspec (get face prop)) (setq devtype-spec (if (eq prop win-prop) (quote window-system) (quote tty))) (if propspec (progn (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t)))))) (setq G25570 (cdr G25570))) nil))) (if do-something (map-over-locales (or (global-locale locale) locale)))) (if (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) (if --letf-bound--25569 (fset (quote map-over-locales) --letf-save--25568) (fmakunbound (quote map-over-locales)))))) (if --letf-bound--25565 (fset (quote frob-locale) --letf-save--25564) (fmakunbound (quote frob-locale)))))) (if --letf-bound--25561 (fset (quote frob-face-inst-list) --letf-save--25560) (fmakunbound (quote frob-face-inst-list)))))) byte-compile-form((let* ((--letf-bound--25561 (fboundp (quote frob-face-inst-list))) (--letf-save--25560 (and --letf-bound--25561 (symbol-function (quote frob-face-inst-list))))) (unwind-protect (progn (fset (quote frob-face-inst-list) (function (lambda (locale inst-list prop devtype-spec) "\nCommon Lisp lambda list:\n (lambda LOCALE INST-LIST PROP DEVTYPE-SPEC)\n\n" (block frob-face-inst-list (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results:test (function equal))))))) (let* ((--letf-bound--25565 (fboundp (quote frob-locale))) (--letf-save--25564 (and --letf-bound--25565 (symbol-function (quote frob-locale))))) (unwind-protect (progn (fset (quote frob-locale) (function (lambda (sp locale inst-list thunk) "\nCommon Lisp lambda list:\n (lambda SP LOCALE INST-LIST THUNK)\n\n" (block frob-locale (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil)))) (let* ((--letf-bound--25569 (fboundp (quote map-over-locales))) (--letf-save--25568 (and --letf-bound--25569 (symbol-function (quote map-over-locales))))) (unwind-protect (progn (fset (quote map-over-locales) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block map-over-locales (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (if do-later-stages (progn (if (global-locale locale) (setq locale (quote global))) (let (do-something) (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G25570 (cons win-prop tty-props)) (prop nil) (propspec nil) (devtype-spec nil)) (while (consp G25570) (setq prop (car G25570)) (setq propspec (get face prop)) (setq devtype-spec (if (eq prop win-prop) (quote window-system) (quote tty))) (if propspec (progn (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t)))))) (setq G25570 (cdr G25570))) nil))) (if do-something (map-over-locales (or (global-locale locale) locale)))) (if (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) (if --letf-bound--25569 (fset (quote map-over-locales) --letf-save--25568) (fmakunbound (quote map-over-locales)))))) (if --letf-bound--25565 (fset (quote frob-locale) --letf-save--25564) (fmakunbound (quote frob-locale)))))) (if --letf-bound--25561 (fset (quote frob-face-inst-list) --letf-save--25560) (fmakunbound (quote frob-face-inst-list))))) nil) byte-compile-body(((fset (quote global-locale) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block global-locale (and (memq locale (quote (all nil global))) (quote global)))))) (let* ((--letf-bound--25561 (fboundp (quote frob-face-inst-list))) (--letf-save--25560 (and --letf-bound--25561 (symbol-function (quote frob-face-inst-list))))) (unwind-protect (progn (fset (quote frob-face-inst-list) (function (lambda (locale inst-list prop devtype-spec) "\nCommon Lisp lambda list:\n (lambda LOCALE INST-LIST PROP DEVTYPE-SPEC)\n\n" (block frob-face-inst-list (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results :test (function equal))))))) (let* ((--letf-bound--25565 (fboundp (quote frob-locale))) (--letf-save--25564 (and --letf-bound--25565 (symbol-function (quote frob-locale))))) (unwind-protect (progn (fset (quote frob-locale) (function (lambda (sp locale inst-list thunk) "\nCommon Lisp lambda list:\n (lambda SP LOCALE INST-LIST THUNK)\n\n" (block frob-locale (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil)))) (let* ((--letf-bound--25569 (fboundp (quote map-over-locales))) (--letf-save--25568 (and --letf-bound--25569 (symbol-function (quote map-over-locales))))) (unwind-protect (progn (fset (quote map-over-locales) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block map-over-locales (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (if do-later-stages (progn (if (global-locale locale) (setq locale (quote global))) (let (do-something) (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G25570 (cons win-prop tty-props)) (prop nil) (propspec nil) (devtype-spec nil)) (while (consp G25570) (setq prop (car G25570)) (setq propspec (get face prop)) (setq devtype-spec (if (eq prop win-prop) (quote window-system) (quote tty))) (if propspec (progn (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t)))))) (setq G25570 (cdr G25570))) nil))) (if do-something (map-over-locales (or (global-locale locale) locale)))) (if (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) (if --letf-bound--25569 (fset (quote map-over-locales) --letf-save--25568) (fmakunbound (quote map-over-locales)))))) (if --letf-bound--25565 (fset (quote frob-locale) --letf-save--25564) (fmakunbound (quote frob-locale)))))) (if --letf-bound--25561 (fset (quote frob-face-inst-list) --letf-save--25560) (fmakunbound (quote frob-face-inst-list)))))) nil) byte-compile-progn((progn (fset (quote global-locale) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block global-locale (and (memq locale (quote (all nil global))) (quote global)))))) (let* ((--letf-bound--25561 (fboundp (quote frob-face-inst-list))) (--letf-save--25560 (and --letf-bound--25561 (symbol-function (quote frob-face-inst-list))))) (unwind-protect (progn (fset (quote frob-face-inst-list) (function (lambda (locale inst-list prop devtype-spec) "\nCommon Lisp lambda list:\n (lambda LOCALE INST-LIST PROP DEVTYPE-SPEC)\n\n" (block frob-face-inst-list (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results :test (function equal))))))) (let* ((--letf-bound--25565 (fboundp (quote frob-locale))) (--letf-save--25564 (and --letf-bound--25565 (symbol-function (quote frob-locale))))) (unwind-protect (progn (fset (quote frob-locale) (function (lambda (sp locale inst-list thunk) "\nCommon Lisp lambda list:\n (lambda SP LOCALE INST-LIST THUNK)\n\n" (block frob-locale (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil)))) (let* ((--letf-bound--25569 (fboundp (quote map-over-locales))) (--letf-save--25568 (and --letf-bound--25569 (symbol-function (quote map-over-locales))))) (unwind-protect (progn (fset (quote map-over-locales) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block map-over-locales (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (if do-later-stages (progn (if (global-locale locale) (setq locale (quote global))) (let (do-something) (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G25570 (cons win-prop tty-props)) (prop nil) (propspec nil) (devtype-spec nil)) (while (consp G25570) (setq prop (car G25570)) (setq propspec (get face prop)) (setq devtype-spec (if (eq prop win-prop) (quote window-system) (quote tty))) (if propspec (progn (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t)))))) (setq G25570 (cdr G25570))) nil))) (if do-something (map-over-locales (or (global-locale locale) locale)))) (if (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) (if --letf-bound--25569 (fset (quote map-over-locales) --letf-save--25568) (fmakunbound (quote map-over-locales)))))) (if --letf-bound--25565 (fset (quote frob-locale) --letf-save--25564) (fmakunbound (quote frob-locale)))))) (if --letf-bound--25561 (fset (quote frob-face-inst-list) --letf-save--25560) (fmakunbound (quote frob-face-inst-list))))))) byte-compile-form((progn (fset (quote global-locale) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block global-locale (and (memq locale (quote (all nil global))) (quote global)))))) (let* ((--letf-bound--25561 (fboundp (quote frob-face-inst-list))) (--letf-save--25560 (and --letf-bound--25561 (symbol-function (quote frob-face-inst-list))))) (unwind-protect (progn (fset (quote frob-face-inst-list) (function (lambda (locale inst-list prop devtype-spec) "\nCommon Lisp lambda list:\n (lambda LOCALE INST-LIST PROP DEVTYPE-SPEC)\n\n" (block frob-face-inst-list (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results :test (function equal))))))) (let* ((--letf-bound--25565 (fboundp (quote frob-locale))) (--letf-save--25564 (and --letf-bound--25565 (symbol-function (quote frob-locale))))) (unwind-protect (progn (fset (quote frob-locale) (function (lambda (sp locale inst-list thunk) "\nCommon Lisp lambda list:\n (lambda SP LOCALE INST-LIST THUNK)\n\n" (block frob-locale (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil)))) (let* ((--letf-bound--25569 (fboundp (quote map-over-locales))) (--letf-save--25568 (and --letf-bound--25569 (symbol-function (quote map-over-locales))))) (unwind-protect (progn (fset (quote map-over-locales) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block map-over-locales (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (if do-later-stages (progn (if (global-locale locale) (setq locale (quote global))) (let (do-something) (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G25570 (cons win-prop tty-props)) (prop nil) (propspec nil) (devtype-spec nil)) (while (consp G25570) (setq prop (car G25570)) (setq propspec (get face prop)) (setq devtype-spec (if (eq prop win-prop) (quote window-system) (quote tty))) (if propspec (progn (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t)))))) (setq G25570 (cdr G25570))) nil))) (if do-something (map-over-locales (or (global-locale locale) locale)))) (if (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) (if --letf-bound--25569 (fset (quote map-over-locales) --letf-save--25568) (fmakunbound (quote map-over-locales)))))) (if --letf-bound--25565 (fset (quote frob-locale) --letf-save--25564) (fmakunbound (quote frob-locale)))))) (if --letf-bound--25561 (fset (quote frob-face-inst-list) --letf-save--25560) (fmakunbound (quote frob-face-inst-list)))))) nil) byte-compile-unwind-protect((unwind-protect (progn (fset (quote global-locale) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block global-locale (and (memq locale (quote (all nil global))) (quote global)))))) (let* ((--letf-bound--25561 (fboundp (quote frob-face-inst-list))) (--letf-save--25560 (and --letf-bound--25561 (symbol-function (quote frob-face-inst-list))))) (unwind-protect (progn (fset (quote frob-face-inst-list) (function (lambda (locale inst-list prop devtype-spec) "\nCommon Lisp lambda list:\n (lambda LOCALE INST-LIST PROP DEVTYPE-SPEC)\n\n" (block frob-face-inst-list (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results:test (function equal))))))) (let* ((--letf-bound--25565 (fboundp (quote frob-locale))) (--letf-save--25564 (and --letf-bound--25565 (symbol-function (quote frob-locale))))) (unwind-protect (progn (fset (quote frob-locale) (function (lambda (sp locale inst-list thunk) "\nCommon Lisp lambda list:\n (lambda SP LOCALE INST-LIST THUNK)\n\n" (block frob-locale (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil)))) (let* ((--letf-bound--25569 (fboundp (quote map-over-locales))) (--letf-save--25568 (and --letf-bound--25569 (symbol-function (quote map-over-locales))))) (unwind-protect (progn (fset (quote map-over-locales) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block map-over-locales (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (if do-later-stages (progn (if (global-locale locale) (setq locale (quote global))) (let (do-something) (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G25570 (cons win-prop tty-props)) (prop nil) (propspec nil) (devtype-spec nil)) (while (consp G25570) (setq prop (car G25570)) (setq propspec (get face prop)) (setq devtype-spec (if (eq prop win-prop) (quote window-system) (quote tty))) (if propspec (progn (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t)))))) (setq G25570 (cdr G25570))) nil))) (if do-something (map-over-locales (or (global-locale locale) locale)))) (if (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) (if --letf-bound--25569 (fset (quote map-over-locales) --letf-save--25568) (fmakunbound (quote map-over-locales)))))) (if --letf-bound--25565 (fset (quote frob-locale) --letf-save--25564) (fmakunbound (quote frob-locale)))))) (if --letf-bound--25561 (fset (quote frob-face-inst-list) --letf-save--25560) (fmakunbound (quote frob-face-inst-list)))))) (if --letf-bound--25557 (fset (quote global-locale) --letf-save--25556) (fmakunbound (quote global-locale))))) byte-compile-form((unwind-protect (progn (fset (quote global-locale) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block global-locale (and (memq locale (quote (all nil global))) (quote global)))))) (let* ((--letf-bound--25561 (fboundp (quote frob-face-inst-list))) (--letf-save--25560 (and --letf-bound--25561 (symbol-function (quote frob-face-inst-list))))) (unwind-protect (progn (fset (quote frob-face-inst-list) (function (lambda (locale inst-list prop devtype-spec) "\nCommon Lisp lambda list:\n (lambda LOCALE INST-LIST PROP DEVTYPE-SPEC)\n\n" (block frob-face-inst-list (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results :test (function equal))))))) (let* ((--letf-bound--25565 (fboundp (quote frob-locale))) (--letf-save--25564 (and --letf-bound--25565 (symbol-function (quote frob-locale))))) (unwind-protect (progn (fset (quote frob-locale) (function (lambda (sp locale inst-list thunk) "\nCommon Lisp lambda list:\n (lambda SP LOCALE INST-LIST THUNK)\n\n" (block frob-locale (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil)))) (let* ((--letf-bound--25569 (fboundp (quote map-over-locales))) (--letf-save--25568 (and --letf-bound--25569 (symbol-function (quote map-over-locales))))) (unwind-protect (progn (fset (quote map-over-locales) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block map-over-locales (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (if do-later-stages (progn (if (global-locale locale) (setq locale (quote global))) (let (do-something) (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G25570 (cons win-prop tty-props)) (prop nil) (propspec nil) (devtype-spec nil)) (while (consp G25570) (setq prop (car G25570)) (setq propspec (get face prop)) (setq devtype-spec (if (eq prop win-prop) (quote window-system) (quote tty))) (if propspec (progn (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t)))))) (setq G25570 (cdr G25570))) nil))) (if do-something (map-over-locales (or (global-locale locale) locale)))) (if (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) (if --letf-bound--25569 (fset (quote map-over-locales) --letf-save--25568) (fmakunbound (quote map-over-locales)))))) (if --letf-bound--25565 (fset (quote frob-locale) --letf-save--25564) (fmakunbound (quote frob-locale)))))) (if --letf-bound--25561 (fset (quote frob-face-inst-list) --letf-save--25560) (fmakunbound (quote frob-face-inst-list)))))) (if --letf-bound--25557 (fset (quote global-locale) --letf-save--25556) (fmakunbound (quote global-locale)))) nil) byte-compile-body(((unwind-protect (progn (fset (quote global-locale) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block global-locale (and (memq locale (quote (all nil global))) (quote global)))))) (let* ((--letf-bound--25561 (fboundp (quote frob-face-inst-list))) (--letf-save--25560 (and --letf-bound--25561 (symbol-function (quote frob-face-inst-list))))) (unwind-protect (progn (fset (quote frob-face-inst-list) (function (lambda (locale inst-list prop devtype-spec) "\nCommon Lisp lambda list:\n (lambda LOCALE INST-LIST PROP DEVTYPE-SPEC)\n\n" (block frob-face-inst-list (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results :test (function equal))))))) (let* ((--letf-bound--25565 (fboundp (quote frob-locale))) (--letf-save--25564 (and --letf-bound--25565 (symbol-function (quote frob-locale))))) (unwind-protect (progn (fset (quote frob-locale) (function (lambda (sp locale inst-list thunk) "\nCommon Lisp lambda list:\n (lambda SP LOCALE INST-LIST THUNK)\n\n" (block frob-locale (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil)))) (let* ((--letf-bound--25569 (fboundp (quote map-over-locales))) (--letf-save--25568 (and --letf-bound--25569 (symbol-function (quote map-over-locales))))) (unwind-protect (progn (fset (quote map-over-locales) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block map-over-locales (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (if do-later-stages (progn (if (global-locale locale) (setq locale (quote global))) (let (do-something) (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G25570 (cons win-prop tty-props)) (prop nil) (propspec nil) (devtype-spec nil)) (while (consp G25570) (setq prop (car G25570)) (setq propspec (get face prop)) (setq devtype-spec (if (eq prop win-prop) (quote window-system) (quote tty))) (if propspec (progn (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t)))))) (setq G25570 (cdr G25570))) nil))) (if do-something (map-over-locales (or (global-locale locale) locale)))) (if (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) (if --letf-bound--25569 (fset (quote map-over-locales) --letf-save--25568) (fmakunbound (quote map-over-locales)))))) (if --letf-bound--25565 (fset (quote frob-locale) --letf-save--25564) (fmakunbound (quote frob-locale)))))) (if --letf-bound--25561 (fset (quote frob-face-inst-list) --letf-save--25560) (fmakunbound (quote frob-face-inst-list)))))) (if --letf-bound--25557 (fset (quote global-locale) --letf-save--25556) (fmakunbound (quote global-locale))))) nil) byte-compile-let*((let* ((--letf-bound--25557 (fboundp (quote global-locale))) (--letf-save--25556 (and --letf-bound--25557 (symbol-function (quote global-locale))))) (unwind-protect (progn (fset (quote global-locale) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block global-locale (and (memq locale (quote (all nil global))) (quote global)))))) (let* ((--letf-bound--25561 (fboundp (quote frob-face-inst-list))) (--letf-save--25560 (and --letf-bound--25561 (symbol-function (quote frob-face-inst-list))))) (unwind-protect (progn (fset (quote frob-face-inst-list) (function (lambda (locale inst-list prop devtype-spec) "\nCommon Lisp lambda list:\n (lambda LOCALE INST-LIST PROP DEVTYPE-SPEC)\n\n" (block frob-face-inst-list (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results :test (function equal))))))) (let* ((--letf-bound--25565 (fboundp (quote frob-locale))) (--letf-save--25564 (and --letf-bound--25565 (symbol-function (quote frob-locale))))) (unwind-protect (progn (fset (quote frob-locale) (function (lambda (sp locale inst-list thunk) "\nCommon Lisp lambda list:\n (lambda SP LOCALE INST-LIST THUNK)\n\n" (block frob-locale (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil)))) (let* ((--letf-bound--25569 (fboundp (quote map-over-locales))) (--letf-save--25568 (and --letf-bound--25569 (symbol-function (quote map-over-locales))))) (unwind-protect (progn (fset (quote map-over-locales) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block map-over-locales (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (if do-later-stages (progn (if (global-locale locale) (setq locale (quote global))) (let (do-something) (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G25570 (cons win-prop tty-props)) (prop nil) (propspec nil) (devtype-spec nil)) (while (consp G25570) (setq prop (car G25570)) (setq propspec (get face prop)) (setq devtype-spec (if (eq prop win-prop) (quote window-system) (quote tty))) (if propspec (progn (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t)))))) (setq G25570 (cdr G25570))) nil))) (if do-something (map-over-locales (or (global-locale locale) locale)))) (if (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) (if --letf-bound--25569 (fset (quote map-over-locales) --letf-save--25568) (fmakunbound (quote map-over-locales)))))) (if --letf-bound--25565 (fset (quote frob-locale) --letf-save--25564) (fmakunbound (quote frob-locale)))))) (if --letf-bound--25561 (fset (quote frob-face-inst-list) --letf-save--25560) (fmakunbound (quote frob-face-inst-list)))))) (if --letf-bound--25557 (fset (quote global-locale) --letf-save--25556) (fmakunbound (quote global-locale)))))) byte-compile-form((let* ((--letf-bound--25557 (fboundp (quote global-locale))) (--letf-save--25556 (and --letf-bound--25557 (symbol-function (quote global-locale))))) (unwind-protect (progn (fset (quote global-locale) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block global-locale (and (memq locale (quote (all nil global))) (quote global)))))) (let* ((--letf-bound--25561 (fboundp (quote frob-face-inst-list))) (--letf-save--25560 (and --letf-bound--25561 (symbol-function (quote frob-face-inst-list))))) (unwind-protect (progn (fset (quote frob-face-inst-list) (function (lambda (locale inst-list prop devtype-spec) "\nCommon Lisp lambda list:\n (lambda LOCALE INST-LIST PROP DEVTYPE-SPEC)\n\n" (block frob-face-inst-list (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results :test (function equal))))))) (let* ((--letf-bound--25565 (fboundp (quote frob-locale))) (--letf-save--25564 (and --letf-bound--25565 (symbol-function (quote frob-locale))))) (unwind-protect (progn (fset (quote frob-locale) (function (lambda (sp locale inst-list thunk) "\nCommon Lisp lambda list:\n (lambda SP LOCALE INST-LIST THUNK)\n\n" (block frob-locale (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil)))) (let* ((--letf-bound--25569 (fboundp (quote map-over-locales))) (--letf-save--25568 (and --letf-bound--25569 (symbol-function (quote map-over-locales))))) (unwind-protect (progn (fset (quote map-over-locales) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block map-over-locales (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (if do-later-stages (progn (if (global-locale locale) (setq locale (quote global))) (let (do-something) (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G25570 (cons win-prop tty-props)) (prop nil) (propspec nil) (devtype-spec nil)) (while (consp G25570) (setq prop (car G25570)) (setq propspec (get face prop)) (setq devtype-spec (if (eq prop win-prop) (quote window-system) (quote tty))) (if propspec (progn (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t)))))) (setq G25570 (cdr G25570))) nil))) (if do-something (map-over-locales (or (global-locale locale) locale)))) (if (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) (if --letf-bound--25569 (fset (quote map-over-locales) --letf-save--25568) (fmakunbound (quote map-over-locales)))))) (if --letf-bound--25565 (fset (quote frob-locale) --letf-save--25564) (fmakunbound (quote frob-locale)))))) (if --letf-bound--25561 (fset (quote frob-face-inst-list) --letf-save--25560) (fmakunbound (quote frob-face-inst-list)))))) (if --letf-bound--25557 (fset (quote global-locale) --letf-save--25556) (fmakunbound (quote global-locale))))) nil) byte-compile-body(((fset (quote nil-instantiator-ok) (function (lambda (inst devtype-spec) "\nCommon Lisp lambda list:\n (lambda INST DEVTYPE-SPEC)\n\n" (block nil-instantiator-ok (or inst (eq devtype-spec (quote tty))))))) (let* ((--letf-bound--25557 (fboundp (quote global-locale))) (--letf-save--25556 (and --letf-bound--25557 (symbol-function (quote global-locale))))) (unwind-protect (progn (fset (quote global-locale) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block global-locale (and (memq locale (quote (all nil global))) (quote global)))))) (let* ((--letf-bound--25561 (fboundp (quote frob-face-inst-list))) (--letf-save--25560 (and --letf-bound--25561 (symbol-function (quote frob-face-inst-list))))) (unwind-protect (progn (fset (quote frob-face-inst-list) (function (lambda (locale inst-list prop devtype-spec) "\nCommon Lisp lambda list:\n (lambda LOCALE INST-LIST PROP DEVTYPE-SPEC)\n\n" (block frob-face-inst-list (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results :test (function equal))))))) (let* ((--letf-bound--25565 (fboundp (quote frob-locale))) (--letf-save--25564 (and --letf-bound--25565 (symbol-function (quote frob-locale))))) (unwind-protect (progn (fset (quote frob-locale) (function (lambda (sp locale inst-list thunk) "\nCommon Lisp lambda list:\n (lambda SP LOCALE INST-LIST THUNK)\n\n" (block frob-locale (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil)))) (let* ((--letf-bound--25569 (fboundp (quote map-over-locales))) (--letf-save--25568 (and --letf-bound--25569 (symbol-function (quote map-over-locales))))) (unwind-protect (progn (fset (quote map-over-locales) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block map-over-locales (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (if do-later-stages (progn (if (global-locale locale) (setq locale (quote global))) (let (do-something) (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G25570 (cons win-prop tty-props)) (prop nil) (propspec nil) (devtype-spec nil)) (while (consp G25570) (setq prop (car G25570)) (setq propspec (get face prop)) (setq devtype-spec (if (eq prop win-prop) (quote window-system) (quote tty))) (if propspec (progn (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t)))))) (setq G25570 (cdr G25570))) nil))) (if do-something (map-over-locales (or (global-locale locale) locale)))) (if (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) (if --letf-bound--25569 (fset (quote map-over-locales) --letf-save--25568) (fmakunbound (quote map-over-locales)))))) (if --letf-bound--25565 (fset (quote frob-locale) --letf-save--25564) (fmakunbound (quote frob-locale)))))) (if --letf-bound--25561 (fset (quote frob-face-inst-list) --letf-save--25560) (fmakunbound (quote frob-face-inst-list)))))) (if --letf-bound--25557 (fset (quote global-locale) --letf-save--25556) (fmakunbound (quote global-locale)))))) nil) byte-compile-progn((progn (fset (quote nil-instantiator-ok) (function (lambda (inst devtype-spec) "\nCommon Lisp lambda list:\n (lambda INST DEVTYPE-SPEC)\n\n" (block nil-instantiator-ok (or inst (eq devtype-spec (quote tty))))))) (let* ((--letf-bound--25557 (fboundp (quote global-locale))) (--letf-save--25556 (and --letf-bound--25557 (symbol-function (quote global-locale))))) (unwind-protect (progn (fset (quote global-locale) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block global-locale (and (memq locale (quote (all nil global))) (quote global)))))) (let* ((--letf-bound--25561 (fboundp (quote frob-face-inst-list))) (--letf-save--25560 (and --letf-bound--25561 (symbol-function (quote frob-face-inst-list))))) (unwind-protect (progn (fset (quote frob-face-inst-list) (function (lambda (locale inst-list prop devtype-spec) "\nCommon Lisp lambda list:\n (lambda LOCALE INST-LIST PROP DEVTYPE-SPEC)\n\n" (block frob-face-inst-list (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results :test (function equal))))))) (let* ((--letf-bound--25565 (fboundp (quote frob-locale))) (--letf-save--25564 (and --letf-bound--25565 (symbol-function (quote frob-locale))))) (unwind-protect (progn (fset (quote frob-locale) (function (lambda (sp locale inst-list thunk) "\nCommon Lisp lambda list:\n (lambda SP LOCALE INST-LIST THUNK)\n\n" (block frob-locale (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil)))) (let* ((--letf-bound--25569 (fboundp (quote map-over-locales))) (--letf-save--25568 (and --letf-bound--25569 (symbol-function (quote map-over-locales))))) (unwind-protect (progn (fset (quote map-over-locales) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block map-over-locales (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (if do-later-stages (progn (if (global-locale locale) (setq locale (quote global))) (let (do-something) (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G25570 (cons win-prop tty-props)) (prop nil) (propspec nil) (devtype-spec nil)) (while (consp G25570) (setq prop (car G25570)) (setq propspec (get face prop)) (setq devtype-spec (if (eq prop win-prop) (quote window-system) (quote tty))) (if propspec (progn (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t)))))) (setq G25570 (cdr G25570))) nil))) (if do-something (map-over-locales (or (global-locale locale) locale)))) (if (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) (if --letf-bound--25569 (fset (quote map-over-locales) --letf-save--25568) (fmakunbound (quote map-over-locales)))))) (if --letf-bound--25565 (fset (quote frob-locale) --letf-save--25564) (fmakunbound (quote frob-locale)))))) (if --letf-bound--25561 (fset (quote frob-face-inst-list) --letf-save--25560) (fmakunbound (quote frob-face-inst-list)))))) (if --letf-bound--25557 (fset (quote global-locale) --letf-save--25556) (fmakunbound (quote global-locale))))))) byte-compile-form((progn (fset (quote nil-instantiator-ok) (function (lambda (inst devtype-spec) "\nCommon Lisp lambda list:\n (lambda INST DEVTYPE-SPEC)\n\n" (block nil-instantiator-ok (or inst (eq devtype-spec (quote tty))))))) (let* ((--letf-bound--25557 (fboundp (quote global-locale))) (--letf-save--25556 (and --letf-bound--25557 (symbol-function (quote global-locale))))) (unwind-protect (progn (fset (quote global-locale) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block global-locale (and (memq locale (quote (all nil global))) (quote global)))))) (let* ((--letf-bound--25561 (fboundp (quote frob-face-inst-list))) (--letf-save--25560 (and --letf-bound--25561 (symbol-function (quote frob-face-inst-list))))) (unwind-protect (progn (fset (quote frob-face-inst-list) (function (lambda (locale inst-list prop devtype-spec) "\nCommon Lisp lambda list:\n (lambda LOCALE INST-LIST PROP DEVTYPE-SPEC)\n\n" (block frob-face-inst-list (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results :test (function equal))))))) (let* ((--letf-bound--25565 (fboundp (quote frob-locale))) (--letf-save--25564 (and --letf-bound--25565 (symbol-function (quote frob-locale))))) (unwind-protect (progn (fset (quote frob-locale) (function (lambda (sp locale inst-list thunk) "\nCommon Lisp lambda list:\n (lambda SP LOCALE INST-LIST THUNK)\n\n" (block frob-locale (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil)))) (let* ((--letf-bound--25569 (fboundp (quote map-over-locales))) (--letf-save--25568 (and --letf-bound--25569 (symbol-function (quote map-over-locales))))) (unwind-protect (progn (fset (quote map-over-locales) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block map-over-locales (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (if do-later-stages (progn (if (global-locale locale) (setq locale (quote global))) (let (do-something) (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G25570 (cons win-prop tty-props)) (prop nil) (propspec nil) (devtype-spec nil)) (while (consp G25570) (setq prop (car G25570)) (setq propspec (get face prop)) (setq devtype-spec (if (eq prop win-prop) (quote window-system) (quote tty))) (if propspec (progn (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t)))))) (setq G25570 (cdr G25570))) nil))) (if do-something (map-over-locales (or (global-locale locale) locale)))) (if (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) (if --letf-bound--25569 (fset (quote map-over-locales) --letf-save--25568) (fmakunbound (quote map-over-locales)))))) (if --letf-bound--25565 (fset (quote frob-locale) --letf-save--25564) (fmakunbound (quote frob-locale)))))) (if --letf-bound--25561 (fset (quote frob-face-inst-list) --letf-save--25560) (fmakunbound (quote frob-face-inst-list)))))) (if --letf-bound--25557 (fset (quote global-locale) --letf-save--25556) (fmakunbound (quote global-locale)))))) nil) byte-compile-unwind-protect((unwind-protect (progn (fset (quote nil-instantiator-ok) (function (lambda (inst devtype-spec) "\nCommon Lisp lambda list:\n (lambda INST DEVTYPE-SPEC)\n\n" (block nil-instantiator-ok (or inst (eq devtype-spec (quote tty))))))) (let* ((--letf-bound--25557 (fboundp (quote global-locale))) (--letf-save--25556 (and --letf-bound--25557 (symbol-function (quote global-locale))))) (unwind-protect (progn (fset (quote global-locale) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block global-locale (and (memq locale (quote (all nil global))) (quote global)))))) (let* ((--letf-bound--25561 (fboundp (quote frob-face-inst-list))) (--letf-save--25560 (and --letf-bound--25561 (symbol-function (quote frob-face-inst-list))))) (unwind-protect (progn (fset (quote frob-face-inst-list) (function (lambda (locale inst-list prop devtype-spec) "\nCommon Lisp lambda list:\n (lambda LOCALE INST-LIST PROP DEVTYPE-SPEC)\n\n" (block frob-face-inst-list (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results:test (function equal))))))) (let* ((--letf-bound--25565 (fboundp (quote frob-locale))) (--letf-save--25564 (and --letf-bound--25565 (symbol-function (quote frob-locale))))) (unwind-protect (progn (fset (quote frob-locale) (function (lambda (sp locale inst-list thunk) "\nCommon Lisp lambda list:\n (lambda SP LOCALE INST-LIST THUNK)\n\n" (block frob-locale (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil)))) (let* ((--letf-bound--25569 (fboundp (quote map-over-locales))) (--letf-save--25568 (and --letf-bound--25569 (symbol-function (quote map-over-locales))))) (unwind-protect (progn (fset (quote map-over-locales) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block map-over-locales (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (if do-later-stages (progn (if (global-locale locale) (setq locale (quote global))) (let (do-something) (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G25570 (cons win-prop tty-props)) (prop nil) (propspec nil) (devtype-spec nil)) (while (consp G25570) (setq prop (car G25570)) (setq propspec (get face prop)) (setq devtype-spec (if (eq prop win-prop) (quote window-system) (quote tty))) (if propspec (progn (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t)))))) (setq G25570 (cdr G25570))) nil))) (if do-something (map-over-locales (or (global-locale locale) locale)))) (if (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) (if --letf-bound--25569 (fset (quote map-over-locales) --letf-save--25568) (fmakunbound (quote map-over-locales)))))) (if --letf-bound--25565 (fset (quote frob-locale) --letf-save--25564) (fmakunbound (quote frob-locale)))))) (if --letf-bound--25561 (fset (quote frob-face-inst-list) --letf-save--25560) (fmakunbound (quote frob-face-inst-list)))))) (if --letf-bound--25557 (fset (quote global-locale) --letf-save--25556) (fmakunbound (quote global-locale)))))) (if --letf-bound--25553 (fset (quote nil-instantiator-ok) --letf-save--25552) (fmakunbound (quote nil-instantiator-ok))))) byte-compile-form((unwind-protect (progn (fset (quote nil-instantiator-ok) (function (lambda (inst devtype-spec) "\nCommon Lisp lambda list:\n (lambda INST DEVTYPE-SPEC)\n\n" (block nil-instantiator-ok (or inst (eq devtype-spec (quote tty))))))) (let* ((--letf-bound--25557 (fboundp (quote global-locale))) (--letf-save--25556 (and --letf-bound--25557 (symbol-function (quote global-locale))))) (unwind-protect (progn (fset (quote global-locale) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block global-locale (and (memq locale (quote (all nil global))) (quote global)))))) (let* ((--letf-bound--25561 (fboundp (quote frob-face-inst-list))) (--letf-save--25560 (and --letf-bound--25561 (symbol-function (quote frob-face-inst-list))))) (unwind-protect (progn (fset (quote frob-face-inst-list) (function (lambda (locale inst-list prop devtype-spec) "\nCommon Lisp lambda list:\n (lambda LOCALE INST-LIST PROP DEVTYPE-SPEC)\n\n" (block frob-face-inst-list (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results :test (function equal))))))) (let* ((--letf-bound--25565 (fboundp (quote frob-locale))) (--letf-save--25564 (and --letf-bound--25565 (symbol-function (quote frob-locale))))) (unwind-protect (progn (fset (quote frob-locale) (function (lambda (sp locale inst-list thunk) "\nCommon Lisp lambda list:\n (lambda SP LOCALE INST-LIST THUNK)\n\n" (block frob-locale (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil)))) (let* ((--letf-bound--25569 (fboundp (quote map-over-locales))) (--letf-save--25568 (and --letf-bound--25569 (symbol-function (quote map-over-locales))))) (unwind-protect (progn (fset (quote map-over-locales) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block map-over-locales (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (if do-later-stages (progn (if (global-locale locale) (setq locale (quote global))) (let (do-something) (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G25570 (cons win-prop tty-props)) (prop nil) (propspec nil) (devtype-spec nil)) (while (consp G25570) (setq prop (car G25570)) (setq propspec (get face prop)) (setq devtype-spec (if (eq prop win-prop) (quote window-system) (quote tty))) (if propspec (progn (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t)))))) (setq G25570 (cdr G25570))) nil))) (if do-something (map-over-locales (or (global-locale locale) locale)))) (if (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) (if --letf-bound--25569 (fset (quote map-over-locales) --letf-save--25568) (fmakunbound (quote map-over-locales)))))) (if --letf-bound--25565 (fset (quote frob-locale) --letf-save--25564) (fmakunbound (quote frob-locale)))))) (if --letf-bound--25561 (fset (quote frob-face-inst-list) --letf-save--25560) (fmakunbound (quote frob-face-inst-list)))))) (if --letf-bound--25557 (fset (quote global-locale) --letf-save--25556) (fmakunbound (quote global-locale)))))) (if --letf-bound--25553 (fset (quote nil-instantiator-ok) --letf-save--25552) (fmakunbound (quote nil-instantiator-ok)))) nil) byte-compile-body(((unwind-protect (progn (fset (quote nil-instantiator-ok) (function (lambda (inst devtype-spec) "\nCommon Lisp lambda list:\n (lambda INST DEVTYPE-SPEC)\n\n" (block nil-instantiator-ok (or inst (eq devtype-spec (quote tty))))))) (let* ((--letf-bound--25557 (fboundp (quote global-locale))) (--letf-save--25556 (and --letf-bound--25557 (symbol-function (quote global-locale))))) (unwind-protect (progn (fset (quote global-locale) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block global-locale (and (memq locale (quote (all nil global))) (quote global)))))) (let* ((--letf-bound--25561 (fboundp (quote frob-face-inst-list))) (--letf-save--25560 (and --letf-bound--25561 (symbol-function (quote frob-face-inst-list))))) (unwind-protect (progn (fset (quote frob-face-inst-list) (function (lambda (locale inst-list prop devtype-spec) "\nCommon Lisp lambda list:\n (lambda LOCALE INST-LIST PROP DEVTYPE-SPEC)\n\n" (block frob-face-inst-list (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results :test (function equal))))))) (let* ((--letf-bound--25565 (fboundp (quote frob-locale))) (--letf-save--25564 (and --letf-bound--25565 (symbol-function (quote frob-locale))))) (unwind-protect (progn (fset (quote frob-locale) (function (lambda (sp locale inst-list thunk) "\nCommon Lisp lambda list:\n (lambda SP LOCALE INST-LIST THUNK)\n\n" (block frob-locale (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil)))) (let* ((--letf-bound--25569 (fboundp (quote map-over-locales))) (--letf-save--25568 (and --letf-bound--25569 (symbol-function (quote map-over-locales))))) (unwind-protect (progn (fset (quote map-over-locales) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block map-over-locales (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (if do-later-stages (progn (if (global-locale locale) (setq locale (quote global))) (let (do-something) (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G25570 (cons win-prop tty-props)) (prop nil) (propspec nil) (devtype-spec nil)) (while (consp G25570) (setq prop (car G25570)) (setq propspec (get face prop)) (setq devtype-spec (if (eq prop win-prop) (quote window-system) (quote tty))) (if propspec (progn (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t)))))) (setq G25570 (cdr G25570))) nil))) (if do-something (map-over-locales (or (global-locale locale) locale)))) (if (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) (if --letf-bound--25569 (fset (quote map-over-locales) --letf-save--25568) (fmakunbound (quote map-over-locales)))))) (if --letf-bound--25565 (fset (quote frob-locale) --letf-save--25564) (fmakunbound (quote frob-locale)))))) (if --letf-bound--25561 (fset (quote frob-face-inst-list) --letf-save--25560) (fmakunbound (quote frob-face-inst-list)))))) (if --letf-bound--25557 (fset (quote global-locale) --letf-save--25556) (fmakunbound (quote global-locale)))))) (if --letf-bound--25553 (fset (quote nil-instantiator-ok) --letf-save--25552) (fmakunbound (quote nil-instantiator-ok))))) nil) byte-compile-let*((let* ((--letf-bound--25553 (fboundp (quote nil-instantiator-ok))) (--letf-save--25552 (and --letf-bound--25553 (symbol-function (quote nil-instantiator-ok))))) (unwind-protect (progn (fset (quote nil-instantiator-ok) (function (lambda (inst devtype-spec) "\nCommon Lisp lambda list:\n (lambda INST DEVTYPE-SPEC)\n\n" (block nil-instantiator-ok (or inst (eq devtype-spec (quote tty))))))) (let* ((--letf-bound--25557 (fboundp (quote global-locale))) (--letf-save--25556 (and --letf-bound--25557 (symbol-function (quote global-locale))))) (unwind-protect (progn (fset (quote global-locale) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block global-locale (and (memq locale (quote (all nil global))) (quote global)))))) (let* ((--letf-bound--25561 (fboundp (quote frob-face-inst-list))) (--letf-save--25560 (and --letf-bound--25561 (symbol-function (quote frob-face-inst-list))))) (unwind-protect (progn (fset (quote frob-face-inst-list) (function (lambda (locale inst-list prop devtype-spec) "\nCommon Lisp lambda list:\n (lambda LOCALE INST-LIST PROP DEVTYPE-SPEC)\n\n" (block frob-face-inst-list (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results :test (function equal))))))) (let* ((--letf-bound--25565 (fboundp (quote frob-locale))) (--letf-save--25564 (and --letf-bound--25565 (symbol-function (quote frob-locale))))) (unwind-protect (progn (fset (quote frob-locale) (function (lambda (sp locale inst-list thunk) "\nCommon Lisp lambda list:\n (lambda SP LOCALE INST-LIST THUNK)\n\n" (block frob-locale (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil)))) (let* ((--letf-bound--25569 (fboundp (quote map-over-locales))) (--letf-save--25568 (and --letf-bound--25569 (symbol-function (quote map-over-locales))))) (unwind-protect (progn (fset (quote map-over-locales) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block map-over-locales (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (if do-later-stages (progn (if (global-locale locale) (setq locale (quote global))) (let (do-something) (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G25570 (cons win-prop tty-props)) (prop nil) (propspec nil) (devtype-spec nil)) (while (consp G25570) (setq prop (car G25570)) (setq propspec (get face prop)) (setq devtype-spec (if (eq prop win-prop) (quote window-system) (quote tty))) (if propspec (progn (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t)))))) (setq G25570 (cdr G25570))) nil))) (if do-something (map-over-locales (or (global-locale locale) locale)))) (if (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) (if --letf-bound--25569 (fset (quote map-over-locales) --letf-save--25568) (fmakunbound (quote map-over-locales)))))) (if --letf-bound--25565 (fset (quote frob-locale) --letf-save--25564) (fmakunbound (quote frob-locale)))))) (if --letf-bound--25561 (fset (quote frob-face-inst-list) --letf-save--25560) (fmakunbound (quote frob-face-inst-list)))))) (if --letf-bound--25557 (fset (quote global-locale) --letf-save--25556) (fmakunbound (quote global-locale)))))) (if --letf-bound--25553 (fset (quote nil-instantiator-ok) --letf-save--25552) (fmakunbound (quote nil-instantiator-ok)))))) byte-compile-form((let* ((--letf-bound--25553 (fboundp (quote nil-instantiator-ok))) (--letf-save--25552 (and --letf-bound--25553 (symbol-function (quote nil-instantiator-ok))))) (unwind-protect (progn (fset (quote nil-instantiator-ok) (function (lambda (inst devtype-spec) "\nCommon Lisp lambda list:\n (lambda INST DEVTYPE-SPEC)\n\n" (block nil-instantiator-ok (or inst (eq devtype-spec (quote tty))))))) (let* ((--letf-bound--25557 (fboundp (quote global-locale))) (--letf-save--25556 (and --letf-bound--25557 (symbol-function (quote global-locale))))) (unwind-protect (progn (fset (quote global-locale) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block global-locale (and (memq locale (quote (all nil global))) (quote global)))))) (let* ((--letf-bound--25561 (fboundp (quote frob-face-inst-list))) (--letf-save--25560 (and --letf-bound--25561 (symbol-function (quote frob-face-inst-list))))) (unwind-protect (progn (fset (quote frob-face-inst-list) (function (lambda (locale inst-list prop devtype-spec) "\nCommon Lisp lambda list:\n (lambda LOCALE INST-LIST PROP DEVTYPE-SPEC)\n\n" (block frob-face-inst-list (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results :test (function equal))))))) (let* ((--letf-bound--25565 (fboundp (quote frob-locale))) (--letf-save--25564 (and --letf-bound--25565 (symbol-function (quote frob-locale))))) (unwind-protect (progn (fset (quote frob-locale) (function (lambda (sp locale inst-list thunk) "\nCommon Lisp lambda list:\n (lambda SP LOCALE INST-LIST THUNK)\n\n" (block frob-locale (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil)))) (let* ((--letf-bound--25569 (fboundp (quote map-over-locales))) (--letf-save--25568 (and --letf-bound--25569 (symbol-function (quote map-over-locales))))) (unwind-protect (progn (fset (quote map-over-locales) (function (lambda (locale) "\nCommon Lisp lambda list:\n (lambda LOCALE)\n\n" (block map-over-locales (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (if do-later-stages (progn (if (global-locale locale) (setq locale (quote global))) (let (do-something) (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G25570 (cons win-prop tty-props)) (prop nil) (propspec nil) (devtype-spec nil)) (while (consp G25570) (setq prop (car G25570)) (setq propspec (get face prop)) (setq devtype-spec (if (eq prop win-prop) (quote window-system) (quote tty))) (if propspec (progn (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t)))))) (setq G25570 (cdr G25570))) nil))) (if do-something (map-over-locales (or (global-locale locale) locale)))) (if (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) (if --letf-bound--25569 (fset (quote map-over-locales) --letf-save--25568) (fmakunbound (quote map-over-locales)))))) (if --letf-bound--25565 (fset (quote frob-locale) --letf-save--25564) (fmakunbound (quote frob-locale)))))) (if --letf-bound--25561 (fset (quote frob-face-inst-list) --letf-save--25560) (fmakunbound (quote frob-face-inst-list)))))) (if --letf-bound--25557 (fset (quote global-locale) --letf-save--25556) (fmakunbound (quote global-locale)))))) (if --letf-bound--25553 (fset (quote nil-instantiator-ok) --letf-save--25552) (fmakunbound (quote nil-instantiator-ok))))) nil) byte-compile-top-level((progn (flet ((nil-instantiator-ok (inst devtype-spec) (or inst (eq devtype-spec (quote tty)))) (global-locale (locale) (and (memq locale (quote (all nil global))) (quote global))) (frob-face-inst-list (locale inst-list prop devtype-spec) (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results :test (function equal)))) (frob-locale (sp locale inst-list thunk) (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil) (map-over-locales (locale) (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (when do-later-stages (if (global-locale locale) (setq locale (quote global))) (let (do-something) (loop for prop in (cons win-prop tty-props) for propspec = (get face prop) for devtype-spec = (if (eq prop win-prop) (quote window-system) (quote tty)) if propspec do (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t))))) (when do-something (map-over-locales (or (global-locale locale) locale)))) (when (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) nil lambda) byte-compile-lambda((lambda (face locale tag-set exact-p unfrobbed-face frobbed-face win-prop tty-props frob-mapping standard-face-mapping) (flet ((nil-instantiator-ok (inst devtype-spec) (or inst (eq devtype-spec (quote tty)))) (global-locale (locale) (and (memq locale (quote (all nil global))) (quote global))) (frob-face-inst-list (locale inst-list prop devtype-spec) (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results :test (function equal)))) (frob-locale (sp locale inst-list thunk) (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil) (map-over-locales (locale) (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (when do-later-stages (if (global-locale locale) (setq locale (quote global))) (let (do-something) (loop for prop in (cons win-prop tty-props) for propspec = (get face prop) for devtype-spec = (if (eq prop win-prop) (quote window-system) (quote tty)) if propspec do (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t))))) (when do-something (map-over-locales (or (global-locale locale) locale)))) (when (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set))))))) byte-compile-file-form-defmumble((defun Face-frob-property (face locale tag-set exact-p unfrobbed-face frobbed-face win-prop tty-props frob-mapping standard-face-mapping) (flet ((nil-instantiator-ok (inst devtype-spec) (or inst (eq devtype-spec (quote tty)))) (global-locale (locale) (and (memq locale (quote (all nil global))) (quote global))) (frob-face-inst-list (locale inst-list prop devtype-spec) (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results :test (function equal)))) (frob-locale (sp locale inst-list thunk) (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil) (map-over-locales (locale) (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (when do-later-stages (if (global-locale locale) (setq locale (quote global))) (let (do-something) (loop for prop in (cons win-prop tty-props) for propspec = (get face prop) for devtype-spec = (if (eq prop win-prop) (quote window-system) (quote tty)) if propspec do (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t))))) (when do-something (map-over-locales (or (global-locale locale) locale)))) (when (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set)))))) nil) byte-compile-file-form-defun((defun Face-frob-property (face locale tag-set exact-p unfrobbed-face frobbed-face win-prop tty-props frob-mapping standard-face-mapping) (flet ((nil-instantiator-ok (inst devtype-spec) (or inst (eq devtype-spec (quote tty)))) (global-locale (locale) (and (memq locale (quote (all nil global))) (quote global))) (frob-face-inst-list (locale inst-list prop devtype-spec) (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results:test (function equal)))) (frob-locale (sp locale inst-list thunk) (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil) (map-over-locales (locale) (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (when do-later-stages (if (global-locale locale) (setq locale (quote global))) (let (do-something) (loop for prop in (cons win-prop tty-props) for propspec = (get face prop) for devtype-spec = (if (eq prop win-prop) (quote window-system) (quote tty)) if propspec do (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t))))) (when do-something (map-over-locales (or (global-locale locale) locale)))) (when (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set))))))) byte-compile-file-form((defun Face-frob-property (face locale tag-set exact-p unfrobbed-face frobbed-face win-prop tty-props frob-mapping standard-face-mapping) (flet ((nil-instantiator-ok (inst devtype-spec) (or inst (eq devtype-spec (quote tty)))) (global-locale (locale) (and (memq locale (quote (all nil global))) (quote global))) (frob-face-inst-list (locale inst-list prop devtype-spec) (let* ((ffpdev Face-frob-property-device-considered-current) (results (loop for (tag-set . x) in inst-list for devtype = (derive-device-type-from-locale-and-tag-set locale tag-set devtype-spec ffpdev) if devtype if (let* ((mapper (if (functionp frob-mapping) frob-mapping (plist-get frob-mapping devtype))) (result (cond ((vectorp x) (let ((change-to (cdr (assoc x standard-face-mapping)))) (cond ((or change-to (null (length x))) (list (cons tag-set (cond ((eq change-to t) x) (change-to) (t x))))) (t (let* ((subprop (if (> (length x) 1) (elt x 1) prop)) (subinsts (frob-face-inst-list locale (cdar (specifier-spec-list (face-property (elt x 0) subprop))) subprop devtype-spec))) (add-tag-to-inst-list subinsts tag-set)))))) (t (let ((value (if (eq devtype-spec (quote tty)) (funcall mapper x) (funcall mapper x (derive-domain-from-locale locale devtype-spec ffpdev))))) (and (nil-instantiator-ok value devtype-spec) (list (cons tag-set value)))))))) (if (and (eq (quote tty) devtype-spec) (not (or (eq (quote tty) tag-set) (memq (quote tty) tag-set)))) (nconc (add-tag-to-inst-list result (quote tty)) (list (cons tag-set x))) result)) nconc it))) (delete-duplicates results :test (function equal)))) (frob-locale (sp locale inst-list thunk) (let ((newinst (frob-face-inst-list locale inst-list (car thunk) (cdr thunk)))) (remove-specifier sp locale tag-set exact-p) (add-spec-list-to-specifier sp (list (cons locale newinst)))) nil) (map-over-locales (locale) (map-specifier (get face win-prop) (function frob-locale) locale (cons win-prop (quote window-system)) tag-set exact-p) (loop for prop in tty-props do (map-specifier (get face prop) (function frob-locale) locale (cons prop (quote tty)) tag-set exact-p)))) (let* ((ffpdev Face-frob-property-device-considered-current) (do-later-stages (or (global-locale locale) (valid-specifier-domain-p locale) (bufferp locale))) (domain (and do-later-stages (derive-domain-from-locale locale (quote window-system) ffpdev))) (check-differences (and unfrobbed-face frobbed-face domain (not (memq (face-name face) (quote (default bold italic bold-italic)))))) (orig-instance (and check-differences (face-property-instance face win-prop domain)))) (setq face (get-face face)) (map-over-locales locale) (when do-later-stages (if (global-locale locale) (setq locale (quote global))) (let (do-something) (loop for prop in (cons win-prop tty-props) for propspec = (get face prop) for devtype-spec = (if (eq prop win-prop) (quote window-system) (quote tty)) if propspec do (or (specifier-spec-list propspec locale) (let ((doit (derive-specifier-specs-from-locale propspec locale devtype-spec ffpdev (and (not tag-set) (not exact-p))))) (if (and (not doit) (eq locale (quote global))) (error "No fallback for specifier property %s in face %s???" prop face)) (when doit (add-spec-list-to-specifier propspec (list (cons locale (add-tag-to-inst-list doit (append (if (listp tag-set) tag-set (list tag-set)) (if (eq devtype-spec (quote tty)) (quote (tty)))))))) (setq do-something t))))) (when do-something (map-over-locales (or (global-locale locale) locale)))) (when (and check-differences (let ((new-instance (face-property-instance face win-prop domain))) (and (equal orig-instance new-instance) (equal orig-instance (face-property-instance unfrobbed-face win-prop domain))))) (set-face-property face win-prop (vector frobbed-face) (or (global-locale locale) locale) tag-set))))))) call-with-condition-handler(#<compiled-function (error-info) "...(4)" [error-info byte-compile-report-error] 2> #<compiled-function nil "...(43)" [byte-compile-unresolved-functions byte-compile-inbuffer 1 " \n" nil looking-at ";" byte-compile-file-form read byte-compile-flush-pending byte-compile-warn-about-unresolved-functions] 3>) # bind (byte-compile-warnings-beginning byte-compile-point-max-prev byte-compile-log-buffer byte-compile-macro-environment byte-compile-function-environment byte-compile-autoload-environment byte-compile-unresolved-functions byte-compile-bound-variables byte-compile-free-references byte-compile-free-assignments byte-compile-verbose byte-optimize byte-compile-emacs19-compatibility byte-compile-dynamic byte-compile-dynamic-docstrings byte-compile-warnings byte-compile-file-domain byte-compile-outbuffer float-output-format case-fold-search print-length print-level byte-compile-constants byte-compile-variables byte-compile-tag-number byte-compile-depth byte-compile-maxdepth byte-compile-output eval filename byte-compile-inbuffer) # (condition-case ... . ((error (byte-code " ﾂﾃ! 妾ﾂ! 妾ﾂﾄ! 妾ﾅﾆ! ｫ奨ﾆﾇ\" 妾ｪ廠ﾂ＠ﾈN ｮ召＠!妾ﾉﾊ A\"妾ﾂﾋ! 妾ﾇ奨" [file err princ ">>Error occurred processing " ": " fboundp display-error nil error-message mapcar #<compiled-function (x) "...(8)" [x princ " " prin1] 2> "\n"] 3)))) # bind (error file-to-process) # bind (error) (cond ((null command-line-args-left) (unless noninteractive (run-hooks (quote term-setup-hook)) (setq term-setup-hook nil) (when (string= (buffer-name) "*scratch*") (unless (or inhibit-startup-message (input-pending-p)) (let (tmout) (unwind-protect (catch (quote tmout) (setq tmout (add-timeout startup-message-timeout (lambda (ignore) (condition-case nil (throw (quote tmout) t) (error nil))) nil)) (display-splash-screen) (or nil (goto-char (point-min))) (sit-for 0) (setq unread-command-event (next-command-event))) (when tmout (disable-timeout tmout))))) (with-current-buffer (get-buffer "*scratch*") (erase-buffer) (when (stringp initial-scratch-message) (insert initial-scratch-message)) (set-buffer-modified-p nil))))) (t (let ((dir command-line-default-directory) (file-count 0) (line nil) (end-of-options nil) file-p arg tem) (while command-line-args-left (setq arg (pop command-line-args-left)) (cond (end-of-options (setq file-p t)) ((setq tem (when (eq (aref arg 0) ?-) (or (! assoc arg command-switch-alist) (assoc (substring arg 1) command-switch-alist)))) (funcall (cdr tem) arg)) ((string-match "\\`\\+[0-9]+\\'" arg) (setq line (string-to-int arg))) ((or (string= arg "-") (string= arg "--")) (setq end-of-options t)) (t (setq file-p t))) (when file-p (setq file-p nil) (incf file-count) (setq arg (expand-file-name arg dir)) (cond ((= file-count 1) (find-file arg)) (noninteractive (find-file arg)) (t (find-file-other-window arg))) (when line (goto-line line) (setq line nil))))))) (let ((command-line-args-left (cdr command-line-args))) (let ((debugger (quote early-error-handler)) (debug-on-error t)) (setq command-line-args-left (command-line-early command-line-args-left)) (when (eq system-type (quote windows-nt)) (declare-fboundp (init-mswindows-at-startup))) (when (featurep (quote toolbar)) (init-toolbar-location)) (when (featurep (quote mule)) (declare-fboundp (init-mule-at-startup))) (if (featurep (quote toolbar)) (if (featurep (quote infodock)) (require (quote id-x-toolbar)) (init-toolbar))) (when (and initial-window-system (not noninteractive)) (funcall (intern (concat "init-" (symbol-name initial-window-system) "-win")))) (frame-initialize)) (startup-initialize-custom-faces) (if (featurep (quote menubar)) (init-menubar-at-startup)) (load-init-file) (with-current-buffer (get-buffer "*scratch*") (erase-buffer) (set-buffer-modified-p nil) (when (eq major-mode (quote fundamental-mode)) (funcall initial-major-mode)) (font-lock-set-defaults)) (when ! (and (eq (quote tty) (console-type)) (not (noninteractive))) (load-terminal-library)) (command-line-1) (setq inhibit-warning-display nil) (when (noninteractive) (kill-emacs t))) (if (noninteractive) (command-line) (condition-case data (command-line) (t (setq error-data data)))) # bind (error-data) (let (error-data) (if (noninteractive) (command-line) (condition-case data (command-line) (t (setq error-data data)))) (setq default-directory (abbreviate-file-name default-directory)) (if auto-save-list-file-prefix (setq auto-save-list-file-name (expand-file-name (format "%s%d-%s" auto-save-list-file-prefix (emacs-pid) (system-name))))) (run-hooks (quote emacs-startup-hook)) (and term-setup-hook (run-hooks (quote term-setup-hook))) (setq term-setup-hook nil) (frame-notice-user-settings) (when window-setup-hook (run-hooks (quote window-setup-hook))) (setq window-setup-hook nil) (if error-data (signal-error (car error-data) (cdr error-data)))) (if command-line-processed (message "Back to top level.") (setq command-line-processed t) (when (getenv "XEMACSDEBUG") (eval (read (getenv "XEMACSDEBUG")))) (let ((value (user-home-directory))) (if (and value (< (length value) (length default-directory)) (equal (file-attributes default-directory) (file-attributes value))) (setq default-directory (file-name-as-directory value)))) (setq default-directory (abbreviate-file-name default-directory)) (initialize-xemacs-paths) (startup-set-invocation-environment) (startup-setup-paths (cond (inhibit-all-packages t) (inhibit-early-packages (quote (early))) (t nil)) nil) (startup-setup-paths-warning) (startup-load-autoloads) (let (error-data) (if (noninteractive) (command-line) (condition-case data (command-line) (t (setq error-data data)))) (setq default-directory (abbreviate-file-name default-directory)) (if auto-save-list-file-prefix (setq auto-save-list-file-name (expand-file-name (format "%s%d-%s" auto-save-list-file-prefix (ema! cs-pid) (system-name))))) (run-hooks (quote emacs-startup-hook)) (and term-setup-hook (run-hooks (quote term-setup-hook))) (setq term-setup-hook nil) (frame-notice-user-settings) (when window-setup-hook (run-hooks (quote window-setup-hook))) (setq window-setup-hook nil) (if error-data (signal-error (car error-data) (cdr error-data)))) (if load-user-init-file-p (maybe-migrate-user-init-file))) # (condition-case ... . error) > Contents of c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\nt\xemacs-21.5-clean-make-check-temacs.err > keeping lines matching > "^--\[\[\|\]\]$\|^$cd\|n?make$\s-\|errors?\|warnings?\|pure.*$space\|size$\|hides\b\|strange\|shadowings\|^Compil$ing\s-+in\|ation$\|^Using\|not\s-+found\|^While\s-+compiling.*$ \s-+.+$*\|^Note:\|Installing\|[Ff]ile(s) copied\|\s-+tests\s-+\|^[A-Z] [^ ]+$\|^Wrong number of arguments:\|^ \*\* " > and then deleting lines matching > "confl.*with.*auto-inlining\|^Formatting:" -- Adrian Aichner mailto:adrian＠xemacs.org http://www.xemacs.org/

1 participants
0 comments

Configure question -- how do you disable error checking in XEmacs-21.5? 19 years

Paul Keusemann

I just updated my source tree to the latest XEmacs-21.5, and am trying to configure without error checking. I have tried the following without success: configure --without-error-checking configure --disable-error-checking configure --with-error-checking=none configure --with-error-checking="" Unsurprisingly, the last attempt resulted in config completing with error-checking enabled. The first three attempts resulted in the following error message: configure: Usage error: Invalid type list supplied. Valid types for the --with-error-checking option are: extents types text gc malloc byte_code glyphs display structures. A prefix of "no" (eg, "notype" for "type") turns a type off. Types not explicitly specified or negated take their defaults. The list of defaults is "extents,types,text,gc,malloc,byte_code,glyphs,display,structures". Prefixing `all' or `none' to the list sets all defaults to on and off respectively. `yes' as the sole argument is equivalent to omitting the argument. Use `configure --help' to show usage. Am I missing something? As a secondary issue, configure always exits with a status of zero even when it fails, like it does above. -- Paul Keusemann pkeusem(a)visi.com 4266 Joppa Court (952) 894-7805 Savage, MN 55378

2 participants
2 comments

21.5.13 crashing too while using c++, completions and font-lock 19 years

Ulrich Müller

Hi folks. As reported earlier I had trouble with the SUSE 10.0 xemacs. A few days ago I downloaded the following: * xemacs-21.5.23.tar.gz * xemacs-sumo.tar.bz2 (latest version) The build (--with-xim=xlib --with-xfs --with-mule --with-debug) was done on the same machine running the same OS (SUSE 10.0). The .xemacs/custom.el is containing (load "completion") (load "font-lock") and .xemacs/init.el is empty Procedure: * open a file that triggers c++ mode (foo.cc for example) and contains a '#include' statement * goto the '#include' * goto the closing '>' and remove it SIGSEGV is the result for me. I can see the same behaviour having build it on a iBook G4 running Ubuntu 5.10 (There was a problem with /usr/X11R6/include/X11/bitmaps. I copied it from the SUSE machine. This made xemacs only running with '-nw' but the problems stays) Later on I've patched it to 21.5.24. The result was the same. The only thing I want to know is if anybody can reproduce this behaviour! Or if it's my fault. Best wishes Ulrich Müller --------------------------------- stack trace: #0 0xffffe410 in __kernel_vsyscall () #1 0xb79c7886 in kill () from /lib/tls/libc.so.6 #2 0x080d6980 in fatal_error_signal (sig=6) at emacs.c:3796 #3 <signal handler called> #4 0xffffe410 in __kernel_vsyscall () #5 0xb79c7541 in raise () from /lib/tls/libc.so.6 #6 0xb79c8dbb in abort () from /lib/tls/libc.so.6 #7 0x080d7cd7 in really_abort () at emacs.c:4659 #8 0x080d6a5f in assert_failed (file=0x82cc180 "marker.c", line=345, expr=0x82bbc88 "RECORD_TYPEP (obj, lrecord_type_marker)") at emacs.c:3982 #9 0x08100207 in error_check_marker (obj=137581732, file=0x82cc180 "marker.c", line=345) at lisp.h:2919 #10 0x081a6422 in byte_marker_position (marker=137581732) at marker.c:345 #11 0x0822568c in signal_syntax_table_extent_changed (extent=0x8b293a8) at syntax.c:412 #12 0x0810e080 in signal_single_extent_changed (extent=0x8b293a8, property=137581732, unused_old_start=72, unused_old_end=72) at extents.c:1925 #13 0x0810e1a0 in signal_extent_changed (extent=0x8b293a8, property=137581732, old_start=72, old_end=72, descendants_too=0) at extents.c:1966 #14 0x0810e694 in extent_detach (extent=0x8b293a8) at extents.c:2126 #15 0x08113d48 in process_extents_for_deletion_mapper (extent=0x8b293a8, arg=0xbf854d5c) at extents.c:5032 #16 0x0810f1a9 in map_extents (from=72, to=73, fn=0x8113ce0 <process_extents_for_deletion_mapper>, arg=0xbf854d5c, obj=145993536, after=0x0, flags=4097) at extents.c:2577 #17 0x08113da7 in process_extents_for_deletion (object=145993536, from=72, to=73, destroy_them=0) at extents.c:5053 #18 0x0818d24d in buffer_delete_range (buf=0x8b3af40, from=72, to=73, flags=0) at insdel.c:1483 #19 0x080aff71 in Fdelete_char (count=-1, killp=137581732) at cmds.c:283 #20 0x080b0037 in Fdelete_backward_char (count=3, killp=137581732) at cmds.c:319 #21 0x080dfee0 in Ffuncall (nargs=3, args=0xbf854f64) at eval.c:3890 #22 0x080a0860 in execute_optimized_program ( program=0x8c15fb8 "\n\034\212\f��'o�$`Sf��\024i\033�\210\viZ\023�\v\"\210�!\210)�\210\fS\211\024��n\t\"\210\b�\vl?�\a\212�\n\")\207", stack_depth=4, constants_data=0x83cff58) at bytecode.c:862 #23 0x080dfab6 in funcall_compiled_function (fun=138858552, nargs=1, args=0xbf855298) at eval.c:3495 #24 0x080e01ec in Ffuncall (nargs=2, args=0xbf855294) at eval.c:3929 #25 0x080a0860 in execute_optimized_program ( program=0x8b15ec8 "\t�\b\n�\005��\a\b�n!!\207�\207", stack_depth=3, constants_data=0x8a01478) at bytecode.c:862 #26 0x080dfab6 in funcall_compiled_function (fun=141697552, nargs=1, args=0xbf8555b4) at eval.c:3495 #27 0x080e01ec in Ffuncall (nargs=2, args=0xbf8555b0) at eval.c:3929 #28 0x080a7da1 in Fcall_interactively (function=141697156, record_flag=137581732, keys=137581732) at callint.c:994 #29 0x080ddc2f in Fcommand_execute (cmd=141697156, record_flag=137581732, keys=137581732) at eval.c:3116 #30 0x080f6c95 in execute_command_event (command_builder=0x898b658, event=144790436) at event-stream.c:4286 #31 0x080f767e in Fdispatch_event (event=144790436) at event-stream.c:4590 #32 0x080af687 in Fcommand_loop_1 () at cmdloop.c:600 #33 0x080af44c in command_loop_1 (unused_dummy=137581732) at cmdloop.c:505 #34 0x080dbfc5 in condition_case_1 (handlers=137580700, bfun=0x80af41c <command_loop_1>, barg=137581732, hfun=0x80af053 <cmd_error>, harg=137581732) at eval.c:1924 #35 0x080af173 in command_loop_3 () at cmdloop.c:262 #36 0x080af196 in command_loop_2 (unused_dummy=137581732) at cmdloop.c:275 #37 0x080dba7e in internal_catch (tag=137329348, func=0x80af18b <command_loop_2>, arg=137581732, threw=0x0, thrown_tag=0x0, backtrace_before_throw=0x0) at eval.c:1530 #38 0x080af27d in initial_command_loop (load_me=137581732) at cmdloop.c:313 #39 0x080d587c in xemacs_21_5_b24_i686_pc_linux (argc=1, argv=0xbf855cb4, unused_envp=0x0, restart=0) at emacs.c:2663 #40 0x080d61eb in main (argc=1, argv=0xbf855cb4, unused_envp=0xbf855cbc) at emacs.c:3107

1 participants
0 comments

Désinscription de la liste : master 19 years

Le Courrielleur

Désinscription de la liste: master L'adresse de courriel xemacs-beta(a)xemacs.org a été retirée. Cliquez sur le lien suivant pour vous réinscrire : http://go.courrielleur.com/opt-in.php?lid=3423&uid=2298&email=xemacs-beta... Cette liste est gérée par Le Courrielleur http://www.courrielleur.com

1 participants
0 comments

XEmacs Packages have been pre-released (2005-12-20-07) 19 years

Norbert Koch

-----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 Hey there everyone. I have just added the following packages to the 'Pre-Releases' directory: New Packages in Pre-Release: =========================== fortran-modes-1.05-pkg.tar.gz upstream version: none Previously Announced Packages Still in Pre-Release: ================================================== gnus-1.88-pkg.tar.gz upstream version: 5.10.7 python-modes-1.07-pkg.tar.gz upstream version: none Detailed Changes: ================ - ------- ChangeLog Entries from xemacs-packages/fortran-modes/ChangeLog ------- 2005-12-20 Norbert Koch <viteno(a)xemacs.org> * Makefile (VERSION): XEmacs package 1.05 released. 2005-12-20 Sergio Ballestrero <s.ballestrero(a)firenze.linux.it> * fortran.el: Sync with Emacs 21.3.1. Installing These: ================ Manually: - -------- 1) Download the packages that you want to install from: /ftp.xemacs.org:/pub/xemacs/beta/experimental/packages/ 2) Unpack them to: [1] /usr/local/lib/xemacs/xemacs-packages/ 3) Re-start XEmacs. Using XEmacs Package Tools (XEmacs 21.[245].x): - ---------------------------------------------- 1) Tools -> Packages -> Add Download Site -> Pre-Releases 2) Tools -> Packages -> List and Install 3) Select the packages you wish to install (there are brief instructions at the bottom of the packages buffer). 4) Packages -> Install/Remove Selected 5) Re-start XEmacs. Using XEmacs Package Tools (XEmacs 21.1.14): - ------------------------------------------- 1) Options -> Manage Packages -> Add Download Site -> Pre-Releases 2) Options -> Manage Packages -> List and Install 3 - 5) As per XEmacs 21.[245].x. norbert - XEmacs Package Release Manager. Footnotes: [1] Note: Mule packages should be installed into: /usr/local/lib/xemacs/mule-packages/ -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.1 (GNU/Linux) iD8DBQFDp6l4gu3ywdHdhM0RAvgOAKDTgl5xNI4ncl6Oh4TKRv6u+zGUtgCgltJP LvjfnurmG07hdilXWnVA0qU= =uBHL -----END PGP SIGNATURE-----

1 participants
0 comments

XEmacs Packages have been pre-released (2005-12-19-15) 19 years

Norbert Koch

-----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 Hey there everyone. I have just added the following packages to the 'Pre-Releases' directory: New Packages in Pre-Release: =========================== gnus-1.88-pkg.tar.gz upstream version: 5.10.7 Previously Announced Packages Still in Pre-Release: ================================================== python-modes-1.07-pkg.tar.gz upstream version: none Detailed Changes: ================ - ------- ChangeLog Entries from xemacs-packages/gnus/ChangeLog ------- 2005-12-19 Norbert Koch <viteno(a)xemacs.org> * Makefile (VERSION): XEmacs package 1.88 released. 2005-12-19 Steve Youngs <steve(a)sxemacs.org> * Sync with upstream stable branch. Please see the ChangeLog.upstream files for details. Installing These: ================ Manually: - -------- 1) Download the packages that you want to install from: /ftp.xemacs.org:/pub/xemacs/beta/experimental/packages/ 2) Unpack them to: [1] /usr/local/lib/xemacs/xemacs-packages/ 3) Re-start XEmacs. Using XEmacs Package Tools (XEmacs 21.[245].x): - ---------------------------------------------- 1) Tools -> Packages -> Add Download Site -> Pre-Releases 2) Tools -> Packages -> List and Install 3) Select the packages you wish to install (there are brief instructions at the bottom of the packages buffer). 4) Packages -> Install/Remove Selected 5) Re-start XEmacs. Using XEmacs Package Tools (XEmacs 21.1.14): - ------------------------------------------- 1) Options -> Manage Packages -> Add Download Site -> Pre-Releases 2) Options -> Manage Packages -> List and Install 3 - 5) As per XEmacs 21.[245].x. norbert - XEmacs Package Release Manager. Footnotes: [1] Note: Mule packages should be installed into: /usr/local/lib/xemacs/mule-packages/ -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.1 (GNU/Linux) iD8DBQFDpsO2gu3ywdHdhM0RArTjAKCOjXI3kFNXJ+Fi8ECeZiyzSa5tWACfSA6G M/KFweXe6wzoCB8mEx6C1WA= =pNlO -----END PGP SIGNATURE-----

2 participants
2 comments

the crw hack 19 years

Ben Wing

I've been using the following crw script for writes; is this still necessary? #!/bin/sh # With cvs.xemacs.org, it seems we need a special `crw' program to # do any writing operation to the repository. The problem seems to be # that this version of CVS (at least in older versions? Maybe or maybe # not always?) had some bugs that made various operations fail. So we # create a dual-access system where read-only operations are done # throuth a different CVS server for the same respository, using the #:pserver: method rather than the :ext:. The :pserver: method was # OK for read-only stuff, but not good for writing (perhaps because # it little or no security). Other systems will just use using the #:ext: system or something and it seems to work for everything. if [ -e CVS -a -e CVS/Root ] && cat CVS/Root | grep cvs.xemacs.org ; then exec env CVS_RSH=ssh cvs -w -z3 -d :ext:xemacs＠cvs.xemacs.org:/pack/xemacscvs ${1+"$＠"} else exec env CVS_RSH=ssh cvs -w -z3 ${1+"$＠"} fi

2 participants
1 comments

RE: [Bug: 21.5] Confusion over line endings 19 years

Cary Jamison

Adrian Aichner wrote: > >Hi Cary, watch out for use of crypt or crypt++. > >It attempts to support different EOL types, but has some side effects. > >One clue for its involvement would be that use see (Dos) >displayed in the modeline. I don't see (Dos), so I don't think that is relevant. But, I just found something really strange - I wanted to test with a later version, but without compiling it myself, so I installed the Cygwin 'experimental' release, which is Xemacs 21.5 (beta23) "daikon". The Cygwin version can be started three ways: X (DISPLAY env var set), Windows, -nw. The X and -nw modes work better, but still have problems from dired. The Windows mode doesn't work from c-xc-f, either. Are there other packages/default settings/etc. that are set in one mode and not the others? Here's what I'm currently seeing : Using c-xc-f : Windows : Open a text file - :T (can open any number of text files at this point, all get :T) Open a non-text file - no :T (this can be a zero-length file, a text file with single line with no return, a binary file, etc.) Open a text file - no :T (can't get back to a mode where :T gets set appropriately without restarting xemacs) X,-nw : Works as expected, text files get :T, non-text files don't >From dired : Windows,X,-nw : I can't ever load a file and get the :T Once a text file has been loaded incorrectly, c-xc-f doesn't work either for X/-nw. I have disabled my .xemacs so it is not a factor. Cary

1 participants
0 comments

← Newer
1
2
3
4
5
6
7
8
9
...
18
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

2002

2001

2000

1999

1998

XEmacs-Beta December 2005