Mercurial > hg > xemacs-beta
changeset 4103:b4f4e0cc90f1
[xemacs-hg @ 2007-08-07 23:08:47 by aidan]
Eliminate byte compiler warnings, give nicer errors in the absence of packages.
| author | aidan |
|---|---|
| date | Tue, 07 Aug 2007 23:09:22 +0000 |
| parents | 9856d458deda |
| children | 23d7fde3d773 |
| files | lisp/ChangeLog lisp/diagnose.el lisp/font.el lisp/gtk-font-menu.el lisp/gtk-iso8859-1.el lisp/gtk.el lisp/help.el lisp/iso8859-1.el lisp/msw-font-menu.el lisp/mule/mule-cmds.el lisp/mule/mule-coding.el lisp/mule/mule-msw-init-late.el lisp/mule/mule-x-init.el lisp/occur.el lisp/paragraphs.el lisp/subr.el lisp/x-font-menu.el |
| diffstat | 17 files changed, 380 insertions(+), 256 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Tue Aug 07 21:51:12 2007 +0000 +++ b/lisp/ChangeLog Tue Aug 07 23:09:22 2007 +0000 @@ -1,3 +1,69 @@ +2007-08-06 Aidan Kehoe <kehoea@parhasard.net> + + * 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@parhasard.net> + + * 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. + 2007-08-06 Aidan Kehoe <kehoea@parhasard.net> * font.el (x-font-create-object):
--- a/lisp/diagnose.el Tue Aug 07 21:51:12 2007 +0000 +++ b/lisp/diagnose.el Tue Aug 07 23:09:22 2007 +0000 @@ -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.")))
--- a/lisp/font.el Tue Aug 07 21:51:12 2007 +0000 +++ b/lisp/font.el Tue Aug 07 23:09:22 2007 +0000 @@ -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
--- a/lisp/gtk-font-menu.el Tue Aug 07 21:51:12 2007 +0000 +++ b/lisp/gtk-font-menu.el Tue Aug 07 23:09:22 2007 +0000 @@ -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)
--- a/lisp/gtk-iso8859-1.el Tue Aug 07 21:51:12 2007 +0000 +++ b/lisp/gtk-iso8859-1.el Tue Aug 07 23:09:22 2007 +0000 @@ -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)
--- a/lisp/gtk.el Tue Aug 07 21:51:12 2007 +0000 +++ b/lisp/gtk.el Tue Aug 07 23:09:22 2007 +0000 @@ -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))
--- a/lisp/help.el Tue Aug 07 21:51:12 2007 +0000 +++ b/lisp/help.el Tue Aug 07 23:09:22 2007 +0000 @@ -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
--- a/lisp/iso8859-1.el Tue Aug 07 21:51:12 2007 +0000 +++ b/lisp/iso8859-1.el Tue Aug 07 23:09:22 2007 +0000 @@ -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.
--- a/lisp/msw-font-menu.el Tue Aug 07 21:51:12 2007 +0000 +++ b/lisp/msw-font-menu.el Tue Aug 07 23:09:22 2007 +0000 @@ -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
--- a/lisp/mule/mule-cmds.el Tue Aug 07 21:51:12 2007 +0000 +++ b/lisp/mule/mule-cmds.el Tue Aug 07 23:09:22 2007 +0000 @@ -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
--- a/lisp/mule/mule-coding.el Tue Aug 07 21:51:12 2007 +0000 +++ b/lisp/mule/mule-coding.el Tue Aug 07 23:09:22 2007 +0000 @@ -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)))))
--- a/lisp/mule/mule-msw-init-late.el Tue Aug 07 21:51:12 2007 +0000 +++ b/lisp/mule/mule-msw-init-late.el Tue Aug 07 23:09:22 2007 +0000 @@ -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)))))
--- a/lisp/mule/mule-x-init.el Tue Aug 07 21:51:12 2007 +0000 +++ b/lisp/mule/mule-x-init.el Tue Aug 07 23:09:22 2007 +0000 @@ -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))))))) ;;;;
--- a/lisp/occur.el Tue Aug 07 21:51:12 2007 +0000 +++ b/lisp/occur.el Tue Aug 07 23:09:22 2007 +0000 @@ -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
--- a/lisp/paragraphs.el Tue Aug 07 21:51:12 2007 +0000 +++ b/lisp/paragraphs.el Tue Aug 07 23:09:22 2007 +0000 @@ -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.
--- a/lisp/subr.el Tue Aug 07 21:51:12 2007 +0000 +++ b/lisp/subr.el Tue Aug 07 23:09:22 2007 +0000 @@ -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.
--- a/lisp/x-font-menu.el Tue Aug 07 21:51:12 2007 +0000 +++ b/lisp/x-font-menu.el Tue Aug 07 23:09:22 2007 +0000 @@ -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.")