10:07 p.m.
lisp/ChangeLog addition:
2007-08-06 Aidan Kehoe <kehoea(a)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(a)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.
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