lisp/ChangeLog addition: 2007-08-06 Aidan Kehoe <kehoea(a)parhasard.net&gt; * mule/mule-coding.el (make-8-bit-coding-system): Eliminate byte compiler warnings for the generated coding systems. * mule/mule-msw-init-late.el (l): * mule/mule-x-init.el (x-use-halfwidth-roman-font): Add a couple of declare-fboundp calls for functions we know will be bound on a Windows build, to silence the byte compiler. 2007-08-06 Aidan Kehoe <kehoea(a)parhasard.net&gt; * diagnose.el (show-memory-usage): * diagnose.el (show-object-memory-usage-stats): * diagnose.el (show-mc-alloc-memory-usage): * diagnose.el (show-gc-stats): Only call sort-numeric-fields when it's bound. It will be, for anyone who has any business calling these functions; it's in xemacs-base. * font.el: Tell the byte compiler about a few more functions that are available and called on an XFT build, and unavailable and not called elsewhere. * gtk-font-menu.el (gtk-reset-device-font-menus): Improve the logic here; don't check for Mule, check whether #'charset-registries is bound with an if-fboundp call. * gtk-iso8859-1.el (x-iso8859-1): character-set-property is no longer used, on any platform. * gtk.el (gtk-import-function-internal): Tell the byte compiler about some functions that are available on the GTK build and not elsewhere. * help.el (help-symbol-function-context-menu): * help.el (help-symbol-variable-context-menu): * help.el (help-symbol-function-and-variable-context-menu): * help.el (help-find-source-or-scroll-up): * help.el (help-mouse-find-source-or-track): Only offer find-function, find-variable if they're available as functions. * iso8859-1.el: This file sets the case table for Latin 1, not the syntax table. * msw-font-menu.el: * msw-font-menu.el (mswindows-parse-font-style): Tell the byte compiler about a few functions that are available and called on msw builds, and not elsewhere. * occur.el (occur-engine): Use Ben's (if-fboundp ...) macro when calling (or otherwise) #'jit-lock-mode. * paragraphs.el (forward-paragraph): multiple-lines is set but not used; comment it out for the sake of the byte-compiler. * paragraphs.el (forward-sentence): Only call #'constrain-to-field if it's bound; give a more relevant error message if it isn't. * subr.el (check-argument-range): Call signal-error with the correct signature. * x-font-menu.el (charset-registries): Make the byte compiler aware of a pile of functions that are available on, and only called on, certain builds. XEmacs Trunk source patch: Diff command: cvs -q diff -Nu Files affected: lisp/mule/mule-x-init.el =================================================================== RCS lisp/mule/mule-msw-init-late.el =================================================================== RCS lisp/mule/mule-coding.el =================================================================== RCS lisp/mule/mule-cmds.el =================================================================== RCS lisp/x-font-menu.el =================================================================== RCS lisp/subr.el =================================================================== RCS lisp/paragraphs.el =================================================================== RCS lisp/occur.el =================================================================== RCS lisp/msw-font-menu.el =================================================================== RCS lisp/iso8859-1.el =================================================================== RCS lisp/help.el =================================================================== RCS lisp/gtk.el =================================================================== RCS lisp/gtk-iso8859-1.el =================================================================== RCS lisp/gtk-font-menu.el =================================================================== RCS lisp/font.el =================================================================== RCS lisp/diagnose.el =================================================================== RCS Index: lisp/diagnose.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/diagnose.el,v retrieving revision 1.11 diff -u -u -r1.11 diagnose.el --- lisp/diagnose.el 2007/03/30 14:38:42 1.11 +++ lisp/diagnose.el 2007/08/06 20:18:40 ＠＠ -125,14 +125,15 ＠＠ (window-list fr t)) (frame-list)) #'window-memory-usage)) - (sort-numeric-fields -1 - (save-excursion - (goto-char begin) - (forward-line 3) - (point)) - (save-excursion - (forward-line -2) - (point))) + (when-fboundp #'sort-numeric-fields + (sort-numeric-fields -1 + (save-excursion + (goto-char begin) + (forward-line 3) + (point)) + (save-excursion + (forward-line -2) + (point)))) (princ "\n") (let ((total 0) (fmt "%-30s%10s\n")) ＠＠ -155,14 +156,15 ＠＠ (princ "\n") (princ (format fmt "total" total)) (incf grandtotal total)) - (sort-numeric-fields -1 - (save-excursion - (goto-char begin) - (forward-line 2) - (point)) - (save-excursion - (forward-line -2) - (point))) + (when-fboundp #'sort-numeric-fields + (sort-numeric-fields -1 + (save-excursion + (goto-char begin) + (forward-line 2) + (point)) + (save-excursion + (forward-line -2) + (point)))) (princ (format "\n\ngrand total: %s\n" grandtotal))) grandtotal)))) ＠＠ -223,14 +225,15 ＠＠ (princ (format fmt "total" total-count total-use-overhead)) (incf grandtotal total-use-overhead) - (sort-numeric-fields -1 - (save-excursion - (goto-char begin) - (forward-line 2) - (point)) - (save-excursion - (forward-line -2) - (point)))))) + (when-fboundp #'sort-numeric-fields + (sort-numeric-fields -1 + (save-excursion + (goto-char begin) + (forward-line 2) + (point)) + (save-excursion + (forward-line -2) + (point))))))) (with-output-to-temp-buffer buffer (save-excursion (set-buffer buffer) ＠＠ -245,189 +248,195 ＠＠ "Show statistics about memory usage of the new allocator." (interactive) (garbage-collect) - (let* ((stats (mc-alloc-memory-usage)) - (page-size (first stats)) - (heap-sects (second stats)) - (used-plhs (third stats)) - (free-plhs (fourth stats)) - (globals (fifth stats)) - (mc-malloced-bytes (sixth stats))) - (with-output-to-temp-buffer "*mc-alloc memory usage*" - (flet ((print-used-plhs (text plhs) - (let ((sum-n-pages 0) - (sum-used-n-cells 0) - (sum-used-space 0) - (sum-used-total 0) (sum-total-n-cells 0) - (sum-total-space 0) - (sum-total-total 0) - (fmt "%7s%7s|%7s%9s%9s%4s|%7s%9s%9s%4s|%4s\n")) - (princ (format "%-14s|%-29s|%-29s|\n" - text - " currently in use" - " total available")) - (princ (format fmt "cell-sz" "#pages" - "#cells" "space" "total" "% " - "#cells" "space" "total" "% " "% ")) - (princ (make-string 79 ?-)) - (princ "\n") - (while plhs - (let* ((elem (car plhs)) - (cell-size (first elem)) - (n-pages (second elem)) - (used-n-cells (third elem)) - (used-space (fourth elem)) - (used-total (if (zerop cell-size) - (sixth elem) - (* cell-size used-n-cells))) - (used-eff (floor (if (not (zerop used-total)) - (* (/ (* used-space 1.0) - (* used-total 1.0)) - 100.0) - 0))) - (total-n-cells (fifth elem)) - (total-space (if (zerop cell-size) - used-space - (* cell-size total-n-cells))) - (total-total (sixth elem)) - (total-eff (floor (if (not (zerop total-total)) - (* (/ (* total-space 1.0) - (* total-total 1.0)) - 100.0) - 0))) - (eff (floor (if (not (zerop total-total)) - (* (/ (* used-space 1.0) - (* total-total 1.0)) - 100.0) - 0)))) - (princ (format fmt - cell-size n-pages used-n-cells used-space - used-total used-eff total-n-cells - total-space total-total total-eff eff)) - (incf sum-n-pages n-pages) - (incf sum-used-n-cells used-n-cells) - (incf sum-used-space used-space) - (incf sum-used-total used-total) - (incf sum-total-n-cells total-n-cells) - (incf sum-total-space total-space) - (incf sum-total-total total-total)) - (setq plhs (cdr plhs))) - (let ((avg-used-eff (floor (if (not (zerop sum-used-total)) - (* (/ (* sum-used-space 1.0) - (* sum-used-total 1.0)) - 100.0) - 0))) - (avg-total-eff (floor (if (not (zerop sum-total-total)) - (* (/ (* sum-total-space 1.0) - (* sum-total-total 1.0)) - 100.0) - 0))) - (avg-eff (floor (if (not (zerop sum-total-total)) - (* (/ (* sum-used-space 1.0) - (* sum-total-total 1.0)) - 100.0) - 0)))) - (princ (format fmt "sum " sum-n-pages sum-used-n-cells - sum-used-space sum-used-total avg-used-eff - sum-total-n-cells sum-total-space - sum-total-total avg-total-eff avg-eff)) - (princ "\n")))) + (if-fboundp #'mc-alloc-memory-usage + (let* ((stats (mc-alloc-memory-usage)) + (page-size (first stats)) + (heap-sects (second stats)) + (used-plhs (third stats)) + (free-plhs (fourth stats)) + (globals (fifth stats)) + (mc-malloced-bytes (sixth stats))) + (with-output-to-temp-buffer "*mc-alloc memory usage*" + (flet ((print-used-plhs (text plhs) + (let ((sum-n-pages 0) + (sum-used-n-cells 0) + (sum-used-space 0) + (sum-used-total 0) + (sum-total-n-cells 0) + (sum-total-space 0) + (sum-total-total 0) + (fmt "%7s%7s|%7s%9s%9s%4s|%7s%9s%9s%4s|%4s\n")) + (princ (format "%-14s|%-29s|%-29s|\n" + text + " currently in use" + " total available")) + (princ (format fmt "cell-sz" "#pages" + "#cells" "space" "total" "% " + "#cells" "space" "total" "% " "% ")) + (princ (make-string 79 ?-)) + (princ "\n") + (while plhs + (let* ((elem (car plhs)) + (cell-size (first elem)) + (n-pages (second elem)) + (used-n-cells (third elem)) + (used-space (fourth elem)) + (used-total (if (zerop cell-size) + (sixth elem) + (* cell-size used-n-cells))) + (used-eff (floor (if (not (zerop used-total)) + (* (/ (* used-space 1.0) + (* used-total 1.0)) + 100.0) + 0))) + (total-n-cells (fifth elem)) + (total-space (if (zerop cell-size) + used-space + (* cell-size total-n-cells))) + (total-total (sixth elem)) + (total-eff (floor (if (not (zerop total-total)) + (* (/ (* total-space 1.0) + (* total-total 1.0)) + 100.0) + 0))) + (eff (floor (if (not (zerop total-total)) + (* (/ (* used-space 1.0) + (* total-total 1.0)) + 100.0) + 0)))) + (princ (format fmt + cell-size n-pages used-n-cells used-space + used-total used-eff total-n-cells + total-space total-total total-eff eff)) + (incf sum-n-pages n-pages) + (incf sum-used-n-cells used-n-cells) + (incf sum-used-space used-space) + (incf sum-used-total used-total) + (incf sum-total-n-cells total-n-cells) + (incf sum-total-space total-space) + (incf sum-total-total total-total)) + (setq plhs (cdr plhs))) + (let ((avg-used-eff (floor (if (not (zerop sum-used-total)) + (* (/ (* sum-used-space 1.0) + (* sum-used-total 1.0)) + 100.0) + 0))) + (avg-total-eff (floor (if (not (zerop sum-total-total)) + (* (/ (* sum-total-space 1.0) + (* sum-total-total 1.0)) + 100.0) + 0))) + (avg-eff (floor (if (not (zerop sum-total-total)) + (* (/ (* sum-used-space 1.0) + (* sum-total-total 1.0)) + 100.0) + 0)))) + (princ (format fmt "sum " sum-n-pages sum-used-n-cells + sum-used-space sum-used-total avg-used-eff + sum-total-n-cells sum-total-space + sum-total-total avg-total-eff avg-eff)) + (princ "\n")))) - (print-free-plhs (text plhs) - (let ((sum-n-pages 0) - (sum-n-sects 0) - (sum-space 0) - (sum-total 0) - (fmt "%6s%10s |%7s%10s\n")) - (princ (format "%s\n" text)) - (princ (format fmt "#pages" "space" "#sects" "total")) - (princ (make-string 35 ?-)) - (princ "\n") - (while plhs - (let* ((elem (car plhs)) - (n-pages (first elem)) - (n-sects (second elem)) - (space (* n-pages page-size)) - (total (* n-sects space))) - (princ (format fmt n-pages space n-sects total)) - (incf sum-n-pages n-pages) - (incf sum-n-sects n-sects) - (incf sum-space space) - (incf sum-total total)) - (setq plhs (cdr plhs))) - (princ (make-string 35 ?=)) - (princ "\n") - (princ (format fmt sum-n-pages sum-space - sum-n-sects sum-total)) - (princ "\n")))) + (print-free-plhs (text plhs) + (let ((sum-n-pages 0) + (sum-n-sects 0) + (sum-space 0) + (sum-total 0) + (fmt "%6s%10s |%7s%10s\n")) + (princ (format "%s\n" text)) + (princ (format fmt "#pages" "space" "#sects" "total")) + (princ (make-string 35 ?-)) + (princ "\n") + (while plhs + (let* ((elem (car plhs)) + (n-pages (first elem)) + (n-sects (second elem)) + (space (* n-pages page-size)) + (total (* n-sects space))) + (princ (format fmt n-pages space n-sects total)) + (incf sum-n-pages n-pages) + (incf sum-n-sects n-sects) + (incf sum-space space) + (incf sum-total total)) + (setq plhs (cdr plhs))) + (princ (make-string 35 ?=)) + (princ "\n") + (princ (format fmt sum-n-pages sum-space + sum-n-sects sum-total)) + (princ "\n")))) - (princ (format "%-12s%10s\n\n" "PAGE_SIZE" page-size)) + (princ (format "%-12s%10s\n\n" "PAGE_SIZE" page-size)) - (print-used-plhs "USED HEAP" used-plhs) - (princ "\n\n") + (print-used-plhs "USED HEAP" used-plhs) + (princ "\n\n") - (print-free-plhs "FREE HEAP" free-plhs) - (princ "\n\n") + (print-free-plhs "FREE HEAP" free-plhs) + (princ "\n\n") - (let ((fmt "%-30s%10s\n")) - (princ (format fmt "heap sections" "")) - (princ (make-string 40 ?-)) - (princ "\n") - (princ (format fmt "number of heap sects" - (first heap-sects))) - (princ (format fmt "used size" (second heap-sects))) - (princ (make-string 40 ?-)) - (princ "\n") - (princ (format fmt "real size" (third heap-sects))) - (princ (format fmt "global allocator structs" globals)) - (princ (make-string 40 ?-)) - (princ "\n") - (princ (format fmt "real size + structs" - (+ (third heap-sects) globals))) - (princ "\n") - (princ (make-string 40 ?=)) - (princ "\n") - (princ (format fmt "grand total" mc-malloced-bytes))) + (let ((fmt "%-30s%10s\n")) + (princ (format fmt "heap sections" "")) + (princ (make-string 40 ?-)) + (princ "\n") + (princ (format fmt "number of heap sects" + (first heap-sects))) + (princ (format fmt "used size" (second heap-sects))) + (princ (make-string 40 ?-)) + (princ "\n") + (princ (format fmt "real size" (third heap-sects))) + (princ (format fmt "global allocator structs" globals)) + (princ (make-string 40 ?-)) + (princ "\n") + (princ (format fmt "real size + structs" + (+ (third heap-sects) globals))) + (princ "\n") + (princ (make-string 40 ?=)) + (princ "\n") + (princ (format fmt "grand total" mc-malloced-bytes))) - (+ mc-malloced-bytes))))) + (+ mc-malloced-bytes)))) + (message "mc-alloc not used in this XEmacs.")))  (defun show-gc-stats () "Show statistics about garbage collection cycles." (interactive) - (let ((buffer "*garbage collection statistics*") - (plist (gc-stats)) - (fmt "%-9s %16s %12s %12s %12s %12s\n")) - (flet ((plist-get-stat (category field) - (let ((stat (plist-get plist (intern (concat category field))))) - (if stat - (format "%.0f" stat) - "-"))) - (show-stats (category) - (princ (format fmt category - (plist-get-stat category "-total") - (plist-get-stat category "-in-last-gc") - (plist-get-stat category "-in-this-gc") - (plist-get-stat category "-in-last-cycle") - (plist-get-stat category "-in-this-cycle"))))) - (with-output-to-temp-buffer buffer - (save-excursion - (set-buffer buffer) - (princ (format "%s %g\n" "Current phase" (plist-get plist 'phase))) - (princ (make-string 78 ?-)) - (princ "\n") - (princ (format fmt "stat" "total" "last-gc" "this-gc" - "last-cycle" "this-cylce")) - (princ (make-string 78 ?-)) - (princ "\n") - (show-stats "n-gc") - (show-stats "n-cycles") - (show-stats "enqueued") - (show-stats "dequeued") - (show-stats "repushed") - (show-stats "enqueued2") - (show-stats "dequeued2") - (show-stats "finalized") - (show-stats "freed") - (plist-get plist 'n-gc-total)))))) + (if-fboundp #'gc-stats + (let ((buffer "*garbage collection statistics*") + (plist (gc-stats)) + (fmt "%-9s %16s %12s %12s %12s %12s\n")) + (flet ((plist-get-stat (category field) + (let ((stat (plist-get plist + (intern (concat category field))))) + (if stat + (format "%.0f" stat) + "-"))) + (show-stats (category) + (princ (format fmt category + (plist-get-stat category "-total") + (plist-get-stat category "-in-last-gc") + (plist-get-stat category "-in-this-gc") + (plist-get-stat category "-in-last-cycle") + (plist-get-stat category "-in-this-cycle"))))) + (with-output-to-temp-buffer buffer + (save-excursion + (set-buffer buffer) + (princ (format "%s %g\n" "Current phase" + (plist-get plist 'phase))) + (princ (make-string 78 ?-)) + (princ "\n") + (princ (format fmt "stat" "total" "last-gc" "this-gc" + "last-cycle" "this-cylce")) + (princ (make-string 78 ?-)) + (princ "\n") + (show-stats "n-gc") + (show-stats "n-cycles") + (show-stats "enqueued") + (show-stats "dequeued") + (show-stats "repushed") + (show-stats "enqueued2") + (show-stats "dequeued2") + (show-stats "finalized") + (show-stats "freed") + (plist-get plist 'n-gc-total))))) + (error 'void-function "gc-stats not available."))) Index: lisp/font.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/font.el,v retrieving revision 1.21 diff -u -u -r1.21 font.el --- lisp/font.el 2007/08/06 07:00:27 1.21 +++ lisp/font.el 2007/08/06 20:18:41 ＠＠ -49,7 +49,11 ＠＠ mswindows-font-regexp mswindows-canonicalize-font-name mswindows-parse-font-style mswindows-construct-font-style ;; #### perhaps we should rewrite font-warn to avoid the warning - font-warn)) + ;; Eh, now I look at the code, we definitely should. + font-warn + fc-pattern-get-family fc-pattern-get-size fc-pattern-get-weight + fc-font-weight-translate-from-constant make-fc-pattern + fc-pattern-add-family fc-pattern-add-size)) (globally-declare-boundp '(global-face-data Index: lisp/gtk-font-menu.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/gtk-font-menu.el,v retrieving revision 1.6 diff -u -u -r1.6 gtk-font-menu.el --- lisp/gtk-font-menu.el 2005/01/28 02:58:40 1.6 +++ lisp/gtk-font-menu.el 2007/08/06 20:18:41 ＠＠ -92,10 +92,9 ＠＠ ;; #### - this should implement a `menus-only' option, which would ;; recalculate the menus from the cache w/o having to do font-list again. (unless gtk-font-regexp-ascii - (setq gtk-font-regexp-ascii (if (featurep 'mule) - (declare-fboundp - (charset-registry 'ascii)) - "iso8859-1"))) + (setq gtk-font-regexp-ascii (if-fboundp #'charset-registries + (aref (charset-registries 'ascii) 0) + "iso8859-1"))) (setq gtk-font-menu-registry-encoding (if (featurep 'mule) "*-*" "iso8859-1")) (let ((case-fold-search t) Index: lisp/gtk-iso8859-1.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/gtk-iso8859-1.el,v retrieving revision 1.2 diff -u -u -r1.2 gtk-iso8859-1.el --- lisp/gtk-iso8859-1.el 2001/04/12 18:21:24 1.2 +++ lisp/gtk-iso8859-1.el 2007/08/06 20:18:41 ＠＠ -1,5 +1,4 ＠＠ ;; We can just cheat and use the same code that X does. -(setq character-set-property 'x-iso8859/1) ; see x-iso8859-1.el (require 'x-iso8859-1) (provide 'gtk-iso8859-1) Index: lisp/gtk.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/gtk.el,v retrieving revision 1.3 diff -u -u -r1.3 gtk.el --- lisp/gtk.el 2001/05/04 22:42:05 1.3 +++ lisp/gtk.el 2007/08/06 20:18:41 ＠＠ -1,5 +1,8 ＠＠ (globally-declare-fboundp - '(gtk-import-function-internal gtk-call-function gtk-type-name)) + '(gtk-import-function-internal + gtk-call-function + gtk-type-name + gtk-import-function)) (globally-declare-boundp '(gtk-enumeration-info)) Index: lisp/help.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/help.el,v retrieving revision 1.48 diff -u -u -r1.48 help.el --- lisp/help.el 2006/04/29 16:15:26 1.48 +++ lisp/help.el 2007/08/06 20:18:42 ＠＠ -1293,13 +1293,15 ＠＠ (defvar help-symbol-function-context-menu '(["View %_Documentation" (help-symbol-run-function 'describe-function)] - ["Find %_Function Source" (help-symbol-run-function 'find-function)] + ["Find %_Function Source" (help-symbol-run-function 'find-function) + (fboundp #'find-function)] ["Find %_Tag" (help-symbol-run-function 'find-tag)] )) (defvar help-symbol-variable-context-menu '(["View %_Documentation" (help-symbol-run-function 'describe-variable)] - ["Find %_Variable Source" (help-symbol-run-function 'find-variable)] + ["Find %_Variable Source" (help-symbol-run-function 'find-variable) + (fboundp #'find-variable)] ["Find %_Tag" (help-symbol-run-function 'find-tag)] )) ＠＠ -1308,8 +1310,10 ＠＠ 'describe-function)] ["View Variable D%_ocumentation" (help-symbol-run-function 'describe-variable)] - ["Find %_Function Source" (help-symbol-run-function 'find-function)] - ["Find %_Variable Source" (help-symbol-run-function 'find-variable)] + ["Find %_Function Source" (help-symbol-run-function 'find-function) + (fboundp #'find-function)] + ["Find %_Variable Source" (help-symbol-run-function 'find-variable) + (fboundp #'find-variable)] ["Find %_Tag" (help-symbol-run-function 'find-tag)] )) ＠＠ -1809,12 +1813,14 ＠＠ "Follow any cross reference to source code; if none, scroll up. " (interactive "d") (let ((e (extent-at pos nil 'find-function-symbol))) - (if e - (find-function (extent-property e 'find-function-symbol)) + (if (and-fboundp #'find-function e) + (with-fboundp #'find-function + (find-function (extent-property e 'find-function-symbol))) (setq e (extent-at pos nil 'find-variable-symbol)) - (if e - (find-variable (extent-property e 'find-variable-symbol)) - (view-scroll-lines-up 1))))) + (if (and-fboundp #'find-variable e) + (with-fboundp #'find-variable + (find-variable (extent-property e 'find-variable-symbol))) + (scroll-up 1))))) (defun help-mouse-find-source-or-track (event) "Follow any cross reference to source code under the mouse; ＠＠ -1822,11 +1828,13 ＠＠ (interactive "e") (mouse-set-point event) (let ((e (extent-at (point) nil 'find-function-symbol))) - (if e - (find-function (extent-property e 'find-function-symbol)) + (if (and-fboundp #'find-function e) + (with-fboundp #'find-function + (find-function (extent-property e 'find-function-symbol))) (setq e (extent-at (point) nil 'find-variable-symbol)) - (if e - (find-variable (extent-property e 'find-variable-symbol)) + (if (and-fboundp #'find-variable e) + (with-fboundp #'find-variable + (find-variable (extent-property e 'find-variable-symbol))) (mouse-track event))))) ;;; help.el ends here Index: lisp/iso8859-1.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/iso8859-1.el,v retrieving revision 1.4 diff -u -u -r1.4 iso8859-1.el --- lisp/iso8859-1.el 2006/08/04 20:01:06 1.4 +++ lisp/iso8859-1.el 2007/08/06 20:18:42 ＠＠ -1,4 +1,4 ＠＠ -;;; iso8859-1.el --- Set syntax table for Latin 1 +;;; iso8859-1.el --- Set case table for Latin 1 ;; Copyright (C) 1992, 1997, 2006 Free Software Foundation, Inc. Index: lisp/msw-font-menu.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/msw-font-menu.el,v retrieving revision 1.8 diff -u -u -r1.8 msw-font-menu.el --- lisp/msw-font-menu.el 2005/01/28 02:58:40 1.8 +++ lisp/msw-font-menu.el 2007/08/06 20:18:42 ＠＠ -48,6 +48,10 ＠＠ (require 'font-menu) (globally-declare-boundp 'mswindows-font-regexp) +(globally-declare-fboundp + '(mswindows-parse-font-style + mswindows-construct-font-style)) + (defvar mswindows-font-menu-junk-families (mapconcat #'identity Index: lisp/occur.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/occur.el,v retrieving revision 1.4 diff -u -u -r1.4 occur.el --- lisp/occur.el 2006/03/25 11:20:51 1.4 +++ lisp/occur.el 2007/08/06 20:18:42 ＠＠ -467,9 +467,9 ＠＠ (setq marker (make-marker)) (set-marker marker matchbeg) (if (and keep-props - (if (boundp 'jit-lock-mode) jit-lock-mode) + (if-boundp 'jit-lock-mode jit-lock-mode) (text-property-not-all begpt endpt 'fontified t)) - (if (fboundp 'jit-lock-fontify-now) + (if-fboundp #'jit-lock-fontify-now (jit-lock-fontify-now begpt endpt))) (setq curstring (buffer-substring begpt endpt)) ;; Depropertize the string, and maybe Index: lisp/paragraphs.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/paragraphs.el,v retrieving revision 1.11 diff -u -u -r1.11 paragraphs.el --- lisp/paragraphs.el 2005/02/10 03:16:59 1.11 +++ lisp/paragraphs.el 2007/08/06 20:18:43 ＠＠ -240,13 +240,13 ＠＠ ;; Search back for line that starts or separates paragraphs. (if (if fill-prefix-regexp ;; There is a fill prefix; it overrides parstart. - (let (multiple-lines) + (let nil ; (multiple-lines) (while (and (progn (beginning-of-line) (not (bobp))) (progn (move-to-left-margin) (not (looking-at parsep))) (looking-at fill-prefix-regexp)) - (unless (= (point) start) - (setq multiple-lines t)) + ; (unless (= (point) start) + ; (setq multiple-lines t)) (forward-line -1)) (move-to-left-margin) ;; This deleted code caused a long hanging-indent line ＠＠ -319,7 +319,11 ＠＠ (forward-char 1)) (if (< (point) (point-max)) (goto-char start)))) - (constrain-to-field nil opoint t) + (if-fboundp #'constrain-to-field + (constrain-to-field nil opoint t) + (error + 'void-function + "constrain-to-field not available; is xemacs-base installed?")) ;; Return the number of steps that could not be done. arg)) ＠＠ -434,7 +438,11 ＠＠ (skip-chars-backward " \t\n") (goto-char par-end))) (setq arg (1- arg))) - (constrain-to-field nil opoint t))) + (if-fboundp #'constrain-to-field + (constrain-to-field nil opoint t) + (error + 'void-function + "constrain-to-field not available; is xemacs-base installed?")))) (defun backward-sentence (&optional arg) "Move backward to start of sentence. With arg, do it arg times. Index: lisp/subr.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/subr.el,v retrieving revision 1.40 diff -u -u -r1.40 subr.el --- lisp/subr.el 2007/02/22 16:53:21 1.40 +++ lisp/subr.el 2007/08/06 20:18:44 ＠＠ -1326,7 +1326,7 ＠＠ (let ((newsym (gensym))) `(let ((,newsym ,argument)) (if (not (argument-in-range-p ,newsym ,min ,max)) - (signal-error 'args-out-of-range ,newsym ,min ,max)))))) + (signal-error 'args-out-of-range (list ,newsym ,min ,max))))))) (defun signal-error (error-symbol data) "Signal a non-continuable error. Args are ERROR-SYMBOL, and associated DATA. Index: lisp/x-font-menu.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-font-menu.el,v retrieving revision 1.19 diff -u -u -r1.19 x-font-menu.el --- lisp/x-font-menu.el 2007/04/22 09:24:12 1.19 +++ lisp/x-font-menu.el 2007/08/06 20:18:44 ＠＠ -42,8 +42,28 ＠＠ x-font-regexp-foundry-and-family x-font-regexp-spacing)) -(globally-declare-fboundp - '(charset-registries)) +(globally-declare-boundp + '(charset-registries + fc-find-available-font-families + fc-find-available-weights-for-family + fc-font-match + fc-font-slant-translate-from-string + fc-font-slant-translate-to-string + fc-font-weight-translate-from-string + fc-font-weight-translate-to-string + fc-name-parse + fc-name-unparse + fc-pattern-add-family + fc-pattern-add-size + fc-pattern-add-slant + fc-pattern-add-weight + fc-pattern-get-family + fc-pattern-get-size + fc-pattern-get-slant + fc-pattern-get-successp + fc-pattern-get-weight + make-fc-pattern + xlfd-font-name-p)) (defvar x-font-menu-registry-encoding nil "Registry and encoding to use with font menu fonts.") Index: lisp/mule/mule-cmds.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/mule-cmds.el,v retrieving revision 1.33 diff -u -u -r1.33 mule-cmds.el --- lisp/mule/mule-cmds.el 2007/07/23 14:20:10 1.33 +++ lisp/mule/mule-cmds.el 2007/08/06 20:18:44 ＠＠ -1112,7 +1112,7 ＠＠ LOCALE is a C library locale string, as returned by `current-locale'. Uses the `locale' property of the language environment." (block langenv - (multiple-value-bind (language region charset modifiers) + (multiple-value-bind (language ignored-arg charset ignored-arg) (parse-posix-locale-string locale) (let ((case-fold-search t) (desired-coding-system Index: lisp/mule/mule-coding.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/mule-coding.el,v retrieving revision 1.23 diff -u -u -r1.23 mule-coding.el --- lisp/mule/mule-coding.el 2007/08/01 13:53:41 1.23 +++ lisp/mule/mule-coding.el 2007/08/06 20:18:45 ＠＠ -630,7 +630,7 ＠＠ (or (plist-get props 'encode-failure-octet) (char-to-int ?~))) (aliases (plist-get props 'aliases)) encode-program decode-program - decode-table encode-table res) + decode-table encode-table) ;; Some sanity checking. (check-argument-range encode-failure-octet 0 #xFF) ＠＠ -652,24 +652,27 ＠＠ ;; And return the generated code. `(let ((encode-table-sym (gentemp (format "%s-encode-table" ',name))) - result) + ;; The case-fold-search bind shouldn't be necessary. If I take + ;; it, out, though, I get: + ;; + ;; (invalid-read-syntax "Multiply defined symbol label" 1) + ;; + ;; when the file is byte compiled. + (case-fold-search t)) (define-translation-hash-table encode-table-sym ,encode-table) - (setq result - (make-coding-system - ',name 'ccl ,description - (plist-put (plist-put ',props 'decode - ,(apply #'vector decode-program)) - 'encode - (apply #'vector - (nsublis - (list (cons - 'encode-table-sym - (symbol-value 'encode-table-sym))) - ',encode-program))))) + (make-coding-system + ',name 'ccl ,description + (plist-put (plist-put ',props 'decode + ,(apply #'vector decode-program)) + 'encode + (apply #'vector + (nsublis + (list (cons + 'encode-table-sym + (symbol-value 'encode-table-sym))) + ',encode-program)))) (coding-system-put ',name 'category 'iso-8-1) ,(macroexpand `(loop for alias in ',aliases do (define-coding-system-alias alias ',name))) - 'result)))) - - \ No newline at end of file + (find-coding-system ',name))))) Index: lisp/mule/mule-msw-init-late.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/mule-msw-init-late.el,v retrieving revision 1.2 diff -u -u -r1.2 mule-msw-init-late.el --- lisp/mule/mule-msw-init-late.el 2002/06/20 21:18:11 1.2 +++ lisp/mule/mule-msw-init-late.el 2007/08/06 20:18:45 ＠＠ -54,7 +54,7 ＠＠ (while l (let ((charset (car (car l))) (registry (cdr (car l)))) - (mswindows-set-charset-registry charset registry) + (declare-fboundp (mswindows-set-charset-registry charset registry)) (setq l (cdr l))))) (let ((l '((ascii . 1252) ＠＠ -81,5 +81,5 ＠＠ (while l (let ((charset (car (car l))) (code-page (cdr (car l)))) - (mswindows-set-charset-code-page charset code-page) + (declare-fboundp (mswindows-set-charset-code-page charset code-page)) (setq l (cdr l))))) Index: lisp/mule/mule-x-init.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/mule-x-init.el,v retrieving revision 1.7 diff -u -u -r1.7 mule-x-init.el --- lisp/mule/mule-x-init.el 2002/06/20 21:18:11 1.7 +++ lisp/mule/mule-x-init.el 2007/08/06 20:18:45 ＠＠ -50,13 +50,14 ＠＠ (and width1 width2 (eq (+ width1 width1) width2))))) (when (eq 'x (device-type)) - (condition-case nil - (unless (twice-as-wide 'ascii fullwidth-charset) - (set-charset-registry 'ascii roman-registry) - (unless (twice-as-wide 'ascii fullwidth-charset) - ;; Restore if roman-registry didn't help - (set-charset-registry 'ascii "iso8859-1"))) - (error (set-charset-registry 'ascii "iso8859-1")))))) + (let ((original-registries (charset-registries 'ascii))) + (condition-case nil + (unless (twice-as-wide 'ascii fullwidth-charset) + (set-charset-registries 'ascii (vector roman-registry)) + (unless (twice-as-wide 'ascii fullwidth-charset) + ;; Restore if roman-registry didn't help + (set-charset-registries 'ascii original-registries))) + (error (set-charset-registries 'ascii original-registries))))))) ;;;; -- On the quay of the little Black Sea port, where the rescued pair came once more into contact with civilization, Dobrinton was bitten by a dog which was assumed to be mad, though it may only have been indiscriminating. (Saki) _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches