[PATCH] Add mule-lisp-directory to the load-path when compiling packages
17 years, 4 months
Aidan Kehoe
Aidan Kehoe
ChangeLog addition:
2007-08-14 Aidan Kehoe <kehoea(a)parhasard.net>
* package-compile.el (depth):
Add mule-lisp-directory to the load-path when it is non-nil. Fixes
problems with CCL not being picked up on a 21.5 non-Mule build.
xemacs-packages/apel/ChangeLog addition:
2007-08-14 Aidan Kehoe <kehoea(a)parhasard.net>
* pccl-20.el:
* pccl-20.el (broken):
* pccl-20.el (ccl-execute-eof-block-on-encoding-null):
* pccl-20.el (ccl-execute-eof-block-on-encoding-some):
* pccl-20.el (ccl-execute-eof-block-on-decoding-null):
* pccl-20.el (ccl-execute-eof-block-on-decoding-some):
Move all these tests to unconditionally returning t. We only
support XEmacs 21.4 and XEmacs 21.5, where both of these things
are true, and checking for CCL support at compile time is
inappropriate when compile time can be a non-Mule XEmacs and
runtime can be a Mule XEmacs.
* pccl.el:
Note that the logic of this package is rotten in our context.
XEmacs Packages source patch:
Diff command: cvs -q diff -Nu
Files affected: xemacs-packages/apel/pccl.el
===================================================================
RCS xemacs-packages/apel/pccl-20.el
===================================================================
RCS package-compile.el
===================================================================
RCS
Index: package-compile.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/package-compile.el,v
retrieving revision 1.71
diff -u -u -r1.71 package-compile.el
--- package-compile.el 2007/05/24 20:22:30 1.71
+++ package-compile.el 2007/08/14 21:03:09
＠＠ -72,8 +72,12 ＠＠
((boundp 'paths-core-load-path-depth) ; XEmacs > 21.2.41
paths-core-load-path-depth)
(t (error "Somebody has been messing with paths-find-*!")))))
- (setq load-path (paths-find-recursive-load-path (list lisp-directory)
- depth)))
+ (setq load-path (paths-find-recursive-load-path
+ (cons lisp-directory
+ ;; Only pay attention to mule-lisp-directory if
+ ;; it's non-nil.
+ (and mule-lisp-directory (list mule-lisp-directory)))
+ depth)))
(load (expand-file-name "auto-autoloads" (car load-path)))
Index: xemacs-packages/apel/pccl-20.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/apel/pccl-20.el,v
retrieving revision 1.3
diff -u -u -r1.3 pccl-20.el
--- xemacs-packages/apel/pccl-20.el 2005/12/06 10:47:18 1.3
+++ xemacs-packages/apel/pccl-20.el 2007/08/14 21:03:09
＠＠ -25,127 +25,30 ＠＠
;;; Code:
-(eval-when-compile (require 'ccl))
(require 'broken)
+;; We only support 21.4 and 21.5 in the packages; all these tests return
+;; true.
+
(broken-facility ccl-accept-symbol-as-program
"Emacs does not accept symbol as CCL program."
- (progn
- (define-ccl-program test-ccl-identity
- '(1 ((read r0) (loop (write-read-repeat r0)))))
- (condition-case nil
- (progn
- (funcall
- (if (fboundp 'ccl-vector-execute-on-string)
- 'ccl-vector-execute-on-string
- 'ccl-execute-on-string)
- 'test-ccl-identity
- (make-vector 9 nil)
- "")
- t)
- (error nil)))
t)
-(eval-and-compile
-
- (static-if (featurep 'xemacs)
- (defadvice make-coding-system (before ccl-compat (name type &rest ad-subr-args) activate)
- (when (and (integerp type)
- (eq type 4)
- (characterp (ad-get-arg 2))
- (stringp (ad-get-arg 3))
- (consp (ad-get-arg 4))
- (symbolp (car (ad-get-arg 4)))
- (symbolp (cdr (ad-get-arg 4))))
- (setq type 'ccl)
- (setq ad-subr-args
- (list
- (ad-get-arg 3)
- (append
- (list
- 'mnemonic (char-to-string (ad-get-arg 2))
- 'decode (symbol-value (car (ad-get-arg 4)))
- 'encode (symbol-value (cdr (ad-get-arg 4))))
- (ad-get-arg 5)))))))
-
- (if (featurep 'xemacs)
- (defun make-ccl-coding-system (name mnemonic docstring decoder encoder)
- "\
-Define a new CODING-SYSTEM by CCL programs DECODER and ENCODER.
-
-CODING-SYSTEM, DECODER and ENCODER must be symbol."
- (make-coding-system
- name 'ccl docstring
- (list 'mnemonic (char-to-string mnemonic)
- 'decode (symbol-value decoder)
- 'encode (symbol-value encoder))))
- (defun make-ccl-coding-system
- (coding-system mnemonic docstring decoder encoder)
- "\
-Define a new CODING-SYSTEM by CCL programs DECODER and ENCODER.
-
-CODING-SYSTEM, DECODER and ENCODER must be symbol."
- (when-broken ccl-accept-symbol-as-program
- (setq decoder (symbol-value decoder))
- (setq encoder (symbol-value encoder)))
- (make-coding-system coding-system 4 mnemonic docstring
- (cons decoder encoder)))
- )
-
- (when-broken ccl-accept-symbol-as-program
-
- (when (subrp (symbol-function 'ccl-execute))
- (fset 'ccl-vector-program-execute
- (symbol-function 'ccl-execute))
- (defun ccl-execute (ccl-prog reg)
- "\
-Execute CCL-PROG with registers initialized by REGISTERS.
-If CCL-PROG is symbol, it is dereferenced."
- (ccl-vector-program-execute
- (if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog)
- reg)))
-
- (when (subrp (symbol-function 'ccl-execute-on-string))
- (fset 'ccl-vector-program-execute-on-string
- (symbol-function 'ccl-execute-on-string))
- (defun ccl-execute-on-string (ccl-prog status string &optional contin)
- "\
-Execute CCL-PROG with initial STATUS on STRING.
-If CCL-PROG is symbol, it is dereferenced."
- (ccl-vector-program-execute-on-string
- (if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog)
- status string contin)))
- )
- )
-
-(eval-when-compile
- (define-ccl-program test-ccl-eof-block
- '(1
- ((read r0)
- (write r0)
- (read r0))
- (write "[EOF]")))
-
- (make-ccl-coding-system
- 'test-ccl-eof-block-cs ?T "CCL_EOF_BLOCK tester"
- 'test-ccl-eof-block 'test-ccl-eof-block)
- )
-
(broken-facility ccl-execute-eof-block-on-encoding-null
"Emacs forgets executing CCL_EOF_BLOCK with encoding on empty input. (Fixed on Emacs 20.4)"
- (equal (encode-coding-string "" 'test-ccl-eof-block-cs) "[EOF]"))
+ t)
(broken-facility ccl-execute-eof-block-on-encoding-some
"Emacs forgets executing CCL_EOF_BLOCK with encoding on non-empty input. (Fixed on Emacs 20.3)"
- (equal (encode-coding-string "a" 'test-ccl-eof-block-cs) "a[EOF]"))
+ t)
(broken-facility ccl-execute-eof-block-on-decoding-null
"Emacs forgets executing CCL_EOF_BLOCK with decoding on empty input. (Fixed on Emacs 20.4)"
- (equal (decode-coding-string "" 'test-ccl-eof-block-cs) "[EOF]"))
+ t)
(broken-facility ccl-execute-eof-block-on-decoding-some
"Emacs forgets executing CCL_EOF_BLOCK with decoding on non-empty input. (Fixed on Emacs 20.4)"
- (equal (decode-coding-string "a" 'test-ccl-eof-block-cs) "a[EOF]"))
+ t)
(broken-facility ccl-execute-eof-block-on-encoding
"Emacs may forget executing CCL_EOF_BLOCK with encoding."
Index: xemacs-packages/apel/pccl.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/apel/pccl.el,v
retrieving revision 1.5
diff -u -u -r1.5 pccl.el
--- xemacs-packages/apel/pccl.el 2005/12/06 10:47:18 1.5
+++ xemacs-packages/apel/pccl.el 2007/08/14 21:03:09
＠＠ -22,6 +22,12 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; ##### Much of the logic here is flawed in the context of XEmacs
+;;; packages. All the static-if and broken-facility stuff is evaluated at
+;;; compile time, which is inappropriate if the file is to be compiled on a
+;;; non-Mule XEmacs and to run on a Mule XEmacs. Aidan Kehoe, Di Aug 14
+;;; 21:31:39 CEST 2007
+
;;; Code:
(require 'broken)
--
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
- 1 participants
- 0 comments
[PATCH] Fix numeric overflow leading to failure to GC
17 years, 4 months
Nix
Nix
This is the fix for the dreaded memory leak, which isn't a memory leak
at all (which kind of explains why it was so hard to find when I was
looking for leaks).
A clue to the problem is that you can make the leak go away by setting
`gc-cons-percentage' to zero.
I instrumented recompute_need_to_garbage_collect() in gc.c to report the
total memory usage at GC and the percentage used whenever the
percentage-based counting should kick in. It kicked in when I'd
expected: with the default setting for gc-cons-percentage of 40 and a
gc-cons-threshold of 40000000, when the total memory consumed
approximated 70Mb. It soon became obvious that something was very wrong:
total gc usage: 56471356; GC percentage used: -5
[...]
total gc usage: 56471356; GC percentage used: -1
total gc usage: 56471356; GC percentage used: 0
total gc usage: 56471356; GC percentage used: 1
[...]
(consing-since-gc was rising all along, at about 75000000 at this
point, but I wasn't printing it out in this debugging dump.)
The problem is numeric overflow in the percentage-comparison code:
(!total_gc_usage_set ||
(100 * consing_since_gc) / total_gc_usage >=
gc_cons_percentage)
Obviously if consing-since-gc is bigger than about 20Mb (since this is a
*signed* integer) we're pretty much dead; each time around, we allow the
heap to bloat more and more, and GC less and less often: heap
fragmentation just makes things worse, because memory's vanishingly
rarely going to get given back to the OS as long as GCs get less and
less frequent like this.
(This also explains why this leak takes some time to kick in: XEmacs has
to load enough to be governed by gc-cons-percentage rather than
gc-cons-threshold in the first place, particularly if you've got it set
as high as I have. It turns up less often when not using X because not
loading the X stuff means that the total_gc_usage takes longer to reach
that threshold.)
2006-12-29 Nix <nix(a)esperi.org.uk>
* gc.c (recompute_need_to_garbage_collect): Avoid numeric
overflow in percentage calculation.
Index: 21.5/src/gc.c
===================================================================
--- 21.5.orig/src/gc.c 2006-12-29 18:21:43.000000000 +0000
+++ 21.5/src/gc.c 2006-12-29 22:11:22.000000000 +0000
＠＠ -314,12 +314,12 ＠＠
(consing_since_gc > gc_cons_threshold
&&
#if 0 /* #### implement this better */
- (100 * consing_since_gc) / total_data_usage () >=
- gc_cons_percentage
+ ((double)consing_since_gc) / total_data_usage()) >=
+ ((double)gc_cons_percentage / 100)
#else
(!total_gc_usage_set ||
- (100 * consing_since_gc) / total_gc_usage >=
- gc_cons_percentage)
+ ((double)consing_since_gc / total_gc_usage) >=
+ ((double)gc_cons_percentage / 100))
#endif
);
recompute_funcall_allocation_flag ();
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 2 participants
- 2 comments
Re: [Bug: 21.4.17] XEmacs eats customizations in .emacs file
17 years, 4 months
Michael Sperber
Michael Sperber
Ralf Angeli <angeli(a)iwi.uni-sb.de> writes:
> When starting XEmacs without a .xemacs directory, but with a .emacs
> file being present, it asks if the .emacs file should be migrated to
> .xemacs/init.el. If you answer "no" to this question, it will change
> and delete a lot of customizations in the .emacs file.
I know things take a long time out here, but here's finally a fix for
this. Migration will now create a backup file of your .emacs if
possible. (Leaving the old .emacs in place doesn't really
work---migration either wants to replace it or know that it's been
moved.) Will apply Saturday if nobody objects.
2007-08-09 Mike Sperber <mike(a)xemacs.org>
* startup.el (migrate-user-init-file): Create backup of
`user-init-file' before migrating.
* startup.el (maybe-migrate-user-init-file): Print
information about backup file.
(maybe-create-compatibility-dot-emacs): Follow above change.
--
Cheers =8-} Mike
Friede, Völkerverständigung und überhaupt blabla
Index: lisp/startup.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/startup.el,v
retrieving revision 1.59
diff -u -r1.59 startup.el
--- lisp/startup.el 2 Aug 2007 06:37:53 -0000 1.59
+++ lisp/startup.el 9 Aug 2007 12:54:05 -0000
＠＠ -880,43 +880,56 ＠＠
(yes-or-no-p-minibuf (concat "Migrate init file to "
user-init-directory
"? "))))
- (progn
- (migrate-user-init-file)
- (maybe-create-compatibility-dot-emacs))
- (customize-save-variable 'load-home-init-file t))))
-(defun maybe-create-compatibility-dot-emacs ()
- "Ask user if she wants to create a .emacs compatibility file."
- (if (with-output-to-temp-buffer (help-buffer-name nil)
- (progn
- (princ "The initialization code has now been migrated to the ")
- (princ user-init-directory)
- (princ "directory.
+ (let ((backup (migrate-user-init-file)))
+ (with-output-to-temp-buffer (help-buffer-name nil)
+ (progn
+ (princ "The initialization code has now been migrated to the ")
+ (princ user-init-directory)
+ (princ "directory.
For backwards compatibility with, for example, older versions of XEmacs,
XEmacs can create a special old-style .emacs file in your home
directory which will load the relocated initialization code.")
- (show-temp-buffer-in-current-frame standard-output)
- (yes-or-no-p-minibuf "Create compatibility .emacs? ")))
+ (if backup
+ (progn
+ (princ "\nMoreover, a backup of your old .emacs file was created as\n")
+ (princ backup)
+ (princ ".\n")))
+ (show-temp-buffer-in-current-frame standard-output)
+ (maybe-create-compatibility-dot-emacs))))
+ (customize-save-variable 'load-home-init-file t))))
+
+(defun maybe-create-compatibility-dot-emacs ()
+ "Ask user if she wants to create a .emacs compatibility file."
+ (if (yes-or-no-p-minibuf "Create compatibility .emacs? ")
(create-compatibility-dot-emacs)))
(defun migrate-user-init-file ()
- "Migrate the init file from the home directory."
+ "Migrate the init file from the home directory.
+Return the name of backup file, if one was created."
(interactive)
(if (not (file-exists-p user-init-directory))
(progn
(message "Creating %s directory..." user-init-directory)
(make-directory user-init-directory)))
(message "Migrating custom file...")
- (customize-set-value 'load-home-init-file nil)
- (custom-migrate-custom-file (make-custom-file-name user-init-file
- 'force-new))
- (message "Moving init file...")
- (let ((new-user-init-file (expand-file-name user-init-file-base
- user-init-directory)))
- (rename-file user-init-file new-user-init-file)
- (setq user-init-file new-user-init-file))
- (message "Migration done."))
+ (let* ((backup (concat user-init-file ".backup"))
+ (backup-p
+ (and (not (file-exists-p backup))
+ (progn
+ (copy-file user-init-file backup)
+ t))))
+ (customize-set-value 'load-home-init-file nil)
+ (custom-migrate-custom-file (make-custom-file-name user-init-file
+ 'force-new))
+ (message "Moving init file...")
+ (let ((new-user-init-file (expand-file-name user-init-file-base
+ user-init-directory)))
+ (rename-file user-init-file new-user-init-file)
+ (setq user-init-file new-user-init-file))
+ (message "Migration done.")
+ (and backup-p backup)))
(defun create-compatibility-dot-emacs ()
"Create .emacs compatibility file for migrated setup."
_______________________________________________
XEmacs-Beta mailing list
XEmacs-Beta(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-beta
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 1 comments
Re: [Q] Merge a bug fix from Sebastian Freundt's SXEmacs work
17 years, 4 months
Aidan Kehoe
Aidan Kehoe
Ar an t-ochtú lá de mí Lúnasa, scríobh Vin Shelton:
> Yes, I see. I think you should augment the ChangeLog with your
> explanation.
Okay, I did that.
What’s the protocol for submitting ChangeLog changes to -patches? Is there
one?
> (I was led astray by the reference to Sebastian Freundt's mail, thinking
> that was a link to an email archive which would describe the problem in
> more detail.)
>
> Thanks!
> Vin
>
> On 8/8/07, Aidan Kehoe <kehoea(a)parhasard.net> wrote:
> >
> > Ar an t-ochtú lá de mí Lúnasa, scríobh Vin Shelton:
> >
> > > QUERY
> > >
> > > What bug does this fix?
> >
> > M-: (this-is-not-a-function nil t) RET
> >
> > would signal
> >
> > Invalid function: #<INTERNAL OBJECT (XEmacs bug?) (symbol-value-forward type 13) 0x5e3740>
> >
> > instead of
> >
> > Symbol's function definition is void: this-is-not-a-function
> >
> > > Is this patch needed for 21.4?
> >
> > No; the bug it fixes only happens in 21.5.
> >
> > > On 8/8/07, Aidan Kehoe <kehoea(a)parhasard.net> wrote:
> > > >
> > > > APPROVE COMMIT
> > > >
> > > > NOTE: This patch has been committed.
> > > >
> > > > src/ChangeLog addition:
> > > >
> > > > 2007-08-08 Aidan Kehoe <kehoea(a)parhasard.net>
> > > >
> > > > * eval.c (Feval): fix, stick with original error messages instead
> > > > of referring to the indirected function.
> > > > From Sebastian Freundt's mail
> > > > nhtfy9sitjf.fsf(a)muck.math.tu-berlin.de .
> > > >
> > > >
> > > > XEmacs Trunk source patch:
> > > > Diff command: cvs -q diff -u
> > > > Files affected: src/eval.c
> > > > ===================================================================
> > > > RCS
> > > >
> > > > Index: src/eval.c
> > > > ===================================================================
> > > > RCS file: /pack/xemacscvs/XEmacs/xemacs/src/eval.c,v
> > > > retrieving revision 1.97
> > > > diff -u -r1.97 eval.c
> > > > --- src/eval.c 2007/06/22 00:21:17 1.97
> > > > +++ src/eval.c 2007/08/08 14:40:53
> > > > ＠＠ -3799,7 +3799,12 ＠＠
> > > > goto invalid_function;
> > > > }
> > > > }
> > > > - else /* ! (SUBRP (fun) || COMPILED_FUNCTIONP (fun) || CONSP (fun)) */
> > > > + else if (UNBOUNDP (fun))
> > > > + {
> > > > + val = signal_void_function_error (original_fun);
> > > > + }
> > > > + else /* ! (SUBRP (fun) || COMPILED_FUNCTIONP (fun) || CONSP (fun)
> > > > + UNBOUNDP (fun)) */
> > > > {
> > > > invalid_function:
> > > > val = signal_invalid_function_error (fun);
> > > >
> > > > --
> > > > 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
> > > >
> > >
> > >
> > > --
> > > The Journey by Mary Oliver
> > > http://www.poemhunter.com/p/m/poem.asp?poet=6771&poem=30506
> >
> > --
> > 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
> >
>
>
> --
> The Journey by Mary Oliver
> http://www.poemhunter.com/p/m/poem.asp?poet=6771&poem=30506
--
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
- 1 participants
- 0 comments
Give roots precedence over base directories in path searching
17 years, 4 months
Michael Sperber
Michael Sperber
"Stephen J. Turnbull" <stephen(a)xemacs.org> writes:
> `paths-find-module-directory' uses `paths-find-architecture-directory'.
> Unfortunately, `paths-find-architecture-directory' does a breadth-
> first search across roots, looking for architecture-specific
> directories first, so it will definitely find
> "/usr/local/xemacs/xemacs-21.5-b27/powerpc-apple-darwin8.8.0/modules"
> before it finds "~/Software/XEmacs/git-staging/+build/modules" even
> though I'm running in-place.
The attached patch fixes this. Will commit Thursday if nobody objects.
2007-08-07 Mike Sperber <mike(a)xemacs.org>
* setup-paths.el (paths-find-doc-directory):
(paths-find-exec-directory):
(paths-find-lisp-directory):
(paths-find-mule-lisp-directory):
(paths-construct-info-path):
(paths-find-data-directory):
* packages.el (packages-find-installation-package-directories):
* find-paths.el (paths-for-each-emacs-directory):
(paths-find-emacs-directories):
(paths-find-emacs-directory):
(paths-for-each-site-directory):
(paths-find-site-directory):
(paths-find-site-directories):
(paths-for-each-version-directory):
(paths-find-version-directories):
(paths-find-version-directory): Generalize to multiple bases.
(paths-find-architecture-directory): Use above to give roots
precedence over bases. This means, for example, that a directory
in an in-place root will always get precedence over an installed
root.
--
Cheers =8-} Mike
Friede, Völkerverständigung und überhaupt blabla
Index: lisp/setup-paths.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/setup-paths.el,v
retrieving revision 1.24
diff -u -r1.24 setup-paths.el
--- lisp/setup-paths.el 2 Aug 2007 06:33:59 -0000 1.24
+++ lisp/setup-paths.el 7 Aug 2007 15:20:39 -0000
＠＠ -158,21 +158,21 ＠＠
(defun paths-find-site-lisp-directory (roots)
"Find the site Lisp directory of the XEmacs hierarchy.
ROOTS is a list of installation roots."
- (paths-find-site-directory roots "site-lisp"
+ (paths-find-site-directory roots (list "site-lisp")
nil nil
configure-site-directory))
(defun paths-find-site-module-directory (roots)
"Find the site modules directory of the XEmacs hierarchy.
ROOTS is a list of installation roots."
- (paths-find-site-directory roots "site-modules"
+ (paths-find-site-directory roots (list "site-modules")
t nil
configure-site-module-directory))
(defun paths-find-lisp-directory (roots)
"Find the main Lisp directory of the XEmacs hierarchy.
ROOTS is a list of installation roots."
- (paths-find-version-directory roots "lisp"
+ (paths-find-version-directory roots (list "lisp")
nil nil
configure-lisp-directory))
＠＠ -186,14 +186,14 ＠＠
(paths-construct-path (list lisp-directory "mule")))))
(if (paths-file-readable-directory-p guess)
guess
- (paths-find-version-directory roots "mule-lisp"
+ (paths-find-version-directory roots (list "mule-lisp")
nil nil
configure-mule-lisp-directory)))))
(defun paths-find-module-directory (roots)
"Find the main modules directory of the XEmacs hierarchy.
ROOTS is a list of installation roots."
- (paths-find-architecture-directory roots "modules"
+ (paths-find-architecture-directory roots (list "modules")
nil configure-module-directory))
(defun paths-construct-load-path
＠＠ -264,7 +264,7 ＠＠
(paths-uniq-append
(append
(let ((info-directory
- (paths-find-version-directory roots "info"
+ (paths-find-version-directory roots (list "info")
nil nil
configure-info-directory)))
(and info-directory
＠＠ -282,12 +282,12 ＠＠
(defun paths-find-doc-directory (roots)
"Find the documentation directory.
ROOTS is the list of installation roots."
- (paths-find-architecture-directory roots "lib-src" nil configure-doc-directory))
+ (paths-find-architecture-directory roots (list "lib-src") nil configure-doc-directory))
(defun paths-find-exec-directory (roots)
"Find the binary directory.
ROOTS is the list of installation roots."
- (paths-find-architecture-directory roots "lib-src"
+ (paths-find-architecture-directory roots (list "lib-src")
nil configure-exec-directory))
(defun paths-construct-exec-path (roots exec-directory
＠＠ -319,7 +319,7 ＠＠
(defun paths-find-data-directory (roots)
"Find the data directory.
ROOTS is the list of installation roots."
- (paths-find-version-directory roots "etc" nil "EMACSDATA" configure-data-directory))
+ (paths-find-version-directory roots (list "etc") nil "EMACSDATA" configure-data-directory))
(defun paths-construct-data-directory-list (data-directory
early-package-hierarchies
Index: lisp/find-paths.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/find-paths.el,v
retrieving revision 1.31
diff -u -r1.31 find-paths.el
--- lisp/find-paths.el 2 Aug 2007 06:33:58 -0000 1.31
+++ lisp/find-paths.el 7 Aug 2007 15:20:39 -0000
＠＠ -138,14 +138,14 ＠＠
(defun paths-for-each-emacs-directory (func
- roots suffix base
+ roots suffix bases
&optional envvar default keep-suffix)
"Iterate over directories in the XEmacs hierarchy.
FUNC is a function that called for each directory, with the directory
as the only argument.
ROOTS must be a list of installation roots.
SUFFIX is the subdirectory from there.
-BASE is the base to look for.
+BASEA is a list of possible bases to look for.
ENVVAR is the name of the environment variable that might also
specify the directory.
DEFAULT is the preferred value.
＠＠ -157,25 +157,29 ＠＠
(paths-file-readable-directory-p preferred-value))
(file-name-as-directory preferred-value)
(while roots
- (let* ((root (car roots))
- ;; installed
- (path (paths-construct-emacs-directory root suffix base)))
- (if (paths-file-readable-directory-p path)
- (funcall func path)
- ;; in-place
- (if (null keep-suffix)
- (let ((path (paths-construct-emacs-directory root "" base)))
- (if (paths-file-readable-directory-p path)
- (funcall func path))))))
+ (let ((root (car roots))
+ (bases bases))
+ (while bases
+ (let* ((base (car bases))
+ ;; installed
+ (path (paths-construct-emacs-directory root suffix base)))
+ (if (paths-file-readable-directory-p path)
+ (funcall func path)
+ ;; in-place
+ (if (null keep-suffix)
+ (let ((path (paths-construct-emacs-directory root "" base)))
+ (if (paths-file-readable-directory-p path)
+ (funcall func path))))))
+ (setq bases (cdr bases))))
(setq roots (cdr roots))))))
(defun paths-find-emacs-directories (roots
- suffix base
+ suffix bases
&optional envvar default keep-suffix)
"Find a list of directories in the XEmacs hierarchy.
ROOTS must be a list of installation roots.
SUFFIX is the subdirectory from there.
-BASE is the base to look for.
+BASES is a list of bases to look for.
ENVVAR is the name of the environment variable that might also
specify the directory.
DEFAULT is the preferred value.
＠＠ -185,16 +189,16 ＠＠
(paths-for-each-emacs-directory #'(lambda (dir)
(setq l (cons dir l)))
roots
- suffix base
+ suffix bases
envvar default keep-suffix)
(reverse l)))
-(defun paths-find-emacs-directory (roots suffix base
+(defun paths-find-emacs-directory (roots suffix bases
&optional envvar default keep-suffix)
"Find a directory in the XEmacs hierarchy.
ROOTS must be a list of installation roots.
SUFFIX is the subdirectory from there.
-BASE is the base to look for.
+BASES is a list of possible bases to look for.
ENVVAR is the name of the environment variable that might also
specify the directory.
DEFAULT is the preferred value.
＠＠ -204,15 +208,18 ＠＠
(paths-for-each-emacs-directory #'(lambda (dir)
(throw 'gotcha dir))
roots
- suffix base
+ suffix bases
envvar default keep-suffix)))
-(defun paths-for-each-site-directory (func roots base arch-dependent-p &optional envvar default)
+(defun paths-for-each-site-directory (func
+ roots bases
+ arch-dependent-p
+ &optional envvar default)
"Iterate over the site-specific directories in the XEmacs hierarchy.
FUNC is a function that called for each directory, with the directory
as the only argument.
ROOTS must be a list of installation roots.
-BASE is the base to look for.
+BASES is a list of possible bases to look for.
ARCH-DEPENDENT-P says whether the file is architecture-specific.
ENVVAR is the name of the environment variable that might also
specify the directory.
＠＠ -223,13 +230,13 ＠＠
(paths-construct-path (list
(if arch-dependent-p "lib" "share")
emacs-program-name)))
- base
+ bases
envvar default))
-(defun paths-find-site-directory (roots base arch-dependent-p &optional envvar default)
+(defun paths-find-site-directory (roots bases arch-dependent-p &optional envvar default)
"Find a site-specific directory in the XEmacs hierarchy.
ROOTS must be a list of installation roots.
-BASE is the base to look for.
+BASES is a list of possible bases to look for.
ARCH-DEPENDENT-P says whether the file is architecture-specific.
ENVVAR is the name of the environment variable that might also
specify the directory.
＠＠ -237,13 +244,13 ＠＠
(catch 'gotcha
(paths-for-each-site-directory #'(lambda (dir)
(throw 'gotcha dir))
- roots base arch-dependent-p
+ roots bases arch-dependent-p
envvar default)))
-(defun paths-find-site-directories (roots base arch-dependent-p &optional envvar default)
+(defun paths-find-site-directories (roots bases arch-dependent-p &optional envvar default)
"Find a list of site-specific directories in the XEmacs hierarchy.
ROOTS must be a list of installation roots.
-BASE is the base to look for.
+BASES is a list of bases to look for.
ARCH-DEPENDENT-P says whether the file is architecture-specific.
ENVVAR is the name of the environment variable that might also
specify the directory.
＠＠ -251,17 +258,17 ＠＠
(let ((l '()))
(paths-for-each-site-directory #'(lambda (dir)
(setq l (cons dir l)))
- roots base arch-dependent-p
+ roots bases arch-dependent-p
envvar default)
(reverse l)))
-(defun paths-for-each-version-directory (func roots base arch-dependent-p
+(defun paths-for-each-version-directory (func roots bases arch-dependent-p
&optional envvar default enforce-version)
"Iterate over version-specific directories in the XEmacs hierarchy.
FUNC is a function that called for each directory, with the directory
as the only argument.
ROOTS must be a list of installation roots.
-BASE is the base to look for.
+BASES is a list of possible bases to look for.
ARCH-DEPENDENT-P says whether the file is architecture-specific.
ENVVAR is the name of the environment variable that might also
specify the directory.
＠＠ -273,14 +280,14 ＠＠
(paths-construct-path
(list (if arch-dependent-p "lib" "share")
(construct-emacs-version-name))))
- base
+ bases
envvar default))
-(defun paths-find-version-directory (roots base arch-dependent-p
+(defun paths-find-version-directory (roots bases arch-dependent-p
&optional envvar default enforce-version)
"Find a version-specific directory in the XEmacs hierarchy.
ROOTS must be a list of installation roots.
-BASE is the base to look for.
+BASES is a list of possible bases to look for.
ARCH-DEPENDENT-P says whether the file is architecture-specific.
ENVVAR is the name of the environment variable that might also
specify the directory.
＠＠ -289,14 +296,14 ＠＠
(catch 'gotcha
(paths-for-each-version-directory #'(lambda (dir)
(throw 'gotcha dir))
- roots base arch-dependent-p
+ roots bases arch-dependent-p
envvar default)))
-(defun paths-find-version-directories (roots base arch-dependent-p
+(defun paths-find-version-directories (roots bases arch-dependent-p
&optional envvar default enforce-version)
"Find a list of version-specific directories in the XEmacs hierarchy.
ROOTS must be a list of installation roots.
-BASE is the base to look for.
+BASES is a list of possible bases to look for.
ARCH-DEPENDENT-P says whether the file is architecture-specific.
ENVVAR is the name of the environment variable that might also
specify the directory.
＠＠ -305,30 +312,29 ＠＠
(let ((l '()))
(paths-for-each-version-directory #'(lambda (dir)
(setq l (cons dir l)))
- roots base arch-dependent-p
+ roots bases arch-dependent-p
envvar default)
(reverse l)))
-(defun paths-find-architecture-directory (roots base &optional envvar default)
+(defun paths-find-architecture-directory (roots bases &optional envvar default)
"Find an architecture-specific directory in the XEmacs hierarchy.
ROOTS must be a list of installation roots.
-BASE is the base to look for.
+BASES is a list of possible bases to look for.
ENVVAR is the name of the environment variable that might also
specify the directory.
DEFAULT is the preferred value."
- (or
- ;; from more to less specific
- (paths-find-version-directory roots
- (paths-construct-path
- (list system-configuration base))
- t
- envvar default)
- (paths-find-version-directory roots
- base t
- envvar)
- (paths-find-version-directory roots
- system-configuration t
- envvar)))
+ (paths-find-version-directory roots
+ ;; from more to less specific
+ (append
+ (mapcar
+ #'(lambda (base)
+ (paths-construct-path
+ (list system-configuration base)))
+ bases)
+ bases
+ (list system-configuration))
+ t
+ envvar default))
(defun construct-emacs-version-name ()
"Construct a string from the raw XEmacs version number."
Index: lisp/packages.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/packages.el,v
retrieving revision 1.56
diff -u -r1.56 packages.el
--- lisp/packages.el 2 Aug 2007 06:33:58 -0000 1.56
+++ lisp/packages.el 7 Aug 2007 15:20:39 -0000
＠＠ -386,8 +386,8 ＠＠
(defun packages-find-installation-package-directories (roots)
"Find the package directories in the XEmacs installation.
ROOTS is a list of installation roots."
- (paths-uniq-append (paths-find-version-directories roots "" nil nil nil t)
- (paths-find-site-directories roots "" nil)))
+ (paths-uniq-append (paths-find-version-directories roots (list "") nil nil nil t)
+ (paths-find-site-directories roots (list "") nil)))
(defun packages-find-package-hierarchies (package-directories &optional envvar default)
"Find package hierarchies in a list of package directories.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 2 participants
- 2 comments
[COMMIT] Make the Mule-UCS CCL code a little saner.
17 years, 4 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
Ar an t-ochtú lá de mí Lúnasa, scríobh Aidan Kehoe:
> Ar an t-ochtú lá de mí Lúnasa, scríobh Mike FABIAN:
>
> > Aidan Kehoe <kehoea(a)parhasard.net> さんは書きました:
> >
> > > Ar an t-ochtú lá de mí Lúnasa, scríobh Mike FABIAN:
> > >
> > > > Mike FABIAN <mfabian(a)suse.de> さんは書きました:
> > > >
> > > > > As it fails in mule-ucs and mule-ucs isn't needed for XEmacs
> > > > > 21.5.x anyway, maybe I could just disable the build of mule-ucs.
> > > >
> > > > That is not so easy because mule-ucs seems to be required by
> > > > latin-unity.
> > >
> > > I know what’s broken here; I’ll check in a change this evening.
> >
> > A change to the packages or to XEmacs?
>
> To mule-ucs.
Okay, this is that change.
mule-packages/mule-ucs/lisp/ChangeLog addition:
2007-08-08 Aidan Kehoe <kehoea(a)parhasard.net>
* trans-util.el:
Require ccl at compile time for the sake of the macro expansion of
define-ccl-program.
* un-define.el:
Don't manipulate font-ccl-encode-alist; it's pointless in XEmacs
21.4 and XEmacs 21.5.
XEmacs Packages source patch:
Diff command: cvs -q diff -Nu
Files affected: mule-packages/mule-ucs/lisp/un-define.el
===================================================================
RCS mule-packages/mule-ucs/lisp/trans-util.el
===================================================================
RCS
Index: mule-packages/mule-ucs/lisp/trans-util.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/mule-packages/mule-ucs/lisp/trans-util.el,v
retrieving revision 1.1.1.1
diff -u -u -r1.1.1.1 trans-util.el
--- mule-packages/mule-ucs/lisp/trans-util.el 2001/12/12 11:35:56 1.1.1.1
+++ mule-packages/mule-ucs/lisp/trans-util.el 2007/08/08 20:43:28
＠＠ -24,6 +24,9 ＠＠
;;; String to number translation functions
+;; This file is not compilable on a non-Mule emacs.
+(eval-when-compile (require 'ccl))
+
(defun string-to-number-with-radix (string radix)
(let ((i 0)
(j (length string))
Index: mule-packages/mule-ucs/lisp/un-define.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/mule-packages/mule-ucs/lisp/un-define.el,v
retrieving revision 1.4
diff -u -u -r1.4 un-define.el
--- mule-packages/mule-ucs/lisp/un-define.el 2005/05/05 17:23:10 1.4
+++ mule-packages/mule-ucs/lisp/un-define.el 2007/08/08 20:43:28
＠＠ -854,12 +854,6 ＠＠
) ;; un-define package definition ends here
-
-;;; font encoder setup
-(add-to-list
- 'font-ccl-encoder-alist
- '("iso10646" . unicode-font-encoder))
-
; font encoder setup (for Meadow)
(if (featurep 'meadow)
(w32-regist-font-encoder
--
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
- 1 participants
- 0 comments
[AC21.5] Restore missing paren in sunpro.c, fix build
17 years, 4 months
Stephen J. Turnbull
Stephen J. Turnbull
APPROVE COMMIT 21.5
Not needed for 21.4. Tested with success by Paul Keusemann, so in we
go.
Stephen J. Turnbull writes:
> Paul Keusemann writes:
>
> > I sent in a patch for this in October 2005. I've attached a current
> > diff. Not sure the last time I updated from CVS.
>
> It's still valid. I prefer Rob's suggested patch though, because the
> conditionalized code is syntactically a unit.
>
> > > Does the feature actually work?
> >
> > I haven't actually used it in a while but I believe it still does.
>
> Well, there doesn't seem to be a way to configure it short of directly
> hacking src/config.h; config.h.in says it's undocumented and probably
> not used. (Martin, do you have idea about this stuff?)
>
> Could you try configuring
>
> --with-sparcworks --with-usage-tracking
>
> and tell me what
>
> grep "SUNPRO\|USAGE_TRACKING" src/config.h
>
> says? A test that the patch applies and builds would be greatly
> appreciated too.
>
> > > > Secondly linking temacs fails with:
>
> Any news on the link failure?
Index: src/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v
retrieving revision 1.1077
diff -u -r1.1077 ChangeLog
--- src/ChangeLog 26 Jul 2007 11:15:04 -0000 1.1077
+++ src/ChangeLog 4 Aug 2007 05:22:05 -0000
＠＠ -0,0 +1,6 ＠＠
+2007-08-04 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * sunpro.c (Fut_log_text): Fix mismatched parentheses, reorganize.
+ Thanks to Paul Keusemann (for a suggested patch) and Rob McMahon
+ for reporting the issue.
+
Index: src/sunpro.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/sunpro.c,v
retrieving revision 1.3
diff -u -r1.3 sunpro.c
--- src/sunpro.c 20 Sep 2004 19:20:00 -0000 1.3
+++ src/sunpro.c 4 Aug 2007 05:22:05 -0000
＠＠ -21,6 +21,12 ＠＠
/* Synched up with: Not in FSF. */
+/* Commentary:
+
+According to Paul Keusemann in <20070802140358.GA19566(a)visi.com>, this
+feature probably still works as of 2007-08-02. However, that doesn't seem
+reliable since there doesn't seem to be a way to configure it! */
+
#include <config.h>
#include "lisp.h"
＠＠ -51,6 +57,7 ＠＠
#else
(int UNUSED (nargs), Lisp_Object *UNUSED (args))
#endif
+ )
{
#ifdef USAGE_TRACKING
Lisp_Object xs;
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
Re: [Q] Merge a bug fix from Sebastian Freundt's SXEmacs work
17 years, 4 months
Aidan Kehoe
Aidan Kehoe
Ar an t-ochtú lá de mí Lúnasa, scríobh Vin Shelton:
> QUERY
>
> What bug does this fix?
M-: (this-is-not-a-function nil t) RET
would signal
Invalid function: #<INTERNAL OBJECT (XEmacs bug?) (symbol-value-forward type 13) 0x5e3740>
instead of
Symbol’s function definition is void: this-is-not-a-function
> Is this patch needed for 21.4?
No; the bug it fixes only happens in 21.5.
> On 8/8/07, Aidan Kehoe <kehoea(a)parhasard.net> wrote:
> >
> > APPROVE COMMIT
> >
> > NOTE: This patch has been committed.
> >
> > src/ChangeLog addition:
> >
> > 2007-08-08 Aidan Kehoe <kehoea(a)parhasard.net>
> >
> > * eval.c (Feval): fix, stick with original error messages instead
> > of referring to the indirected function.
> > From Sebastian Freundt's mail
> > nhtfy9sitjf.fsf(a)muck.math.tu-berlin.de .
> >
> >
> > XEmacs Trunk source patch:
> > Diff command: cvs -q diff -u
> > Files affected: src/eval.c
> > ===================================================================
> > RCS
> >
> > Index: src/eval.c
> > ===================================================================
> > RCS file: /pack/xemacscvs/XEmacs/xemacs/src/eval.c,v
> > retrieving revision 1.97
> > diff -u -r1.97 eval.c
> > --- src/eval.c 2007/06/22 00:21:17 1.97
> > +++ src/eval.c 2007/08/08 14:40:53
> > ＠＠ -3799,7 +3799,12 ＠＠
> > goto invalid_function;
> > }
> > }
> > - else /* ! (SUBRP (fun) || COMPILED_FUNCTIONP (fun) || CONSP (fun)) */
> > + else if (UNBOUNDP (fun))
> > + {
> > + val = signal_void_function_error (original_fun);
> > + }
> > + else /* ! (SUBRP (fun) || COMPILED_FUNCTIONP (fun) || CONSP (fun)
> > + UNBOUNDP (fun)) */
> > {
> > invalid_function:
> > val = signal_invalid_function_error (fun);
> >
> > --
> > 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
> >
>
>
> --
> The Journey by Mary Oliver
> http://www.poemhunter.com/p/m/poem.asp?poet=6771&poem=30506
--
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
- 1 participants
- 0 comments
[COMMIT] Merge a bug fix from Sebastian Freundt's SXEmacs work
17 years, 4 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
src/ChangeLog addition:
2007-08-08 Aidan Kehoe <kehoea(a)parhasard.net>
* eval.c (Feval): fix, stick with original error messages instead
of referring to the indirected function.
From Sebastian Freundt's mail
nhtfy9sitjf.fsf(a)muck.math.tu-berlin.de .
XEmacs Trunk source patch:
Diff command: cvs -q diff -u
Files affected: src/eval.c
===================================================================
RCS
Index: src/eval.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/eval.c,v
retrieving revision 1.97
diff -u -r1.97 eval.c
--- src/eval.c 2007/06/22 00:21:17 1.97
+++ src/eval.c 2007/08/08 14:40:53
＠＠ -3799,7 +3799,12 ＠＠
goto invalid_function;
}
}
- else /* ! (SUBRP (fun) || COMPILED_FUNCTIONP (fun) || CONSP (fun)) */
+ else if (UNBOUNDP (fun))
+ {
+ val = signal_void_function_error (original_fun);
+ }
+ else /* ! (SUBRP (fun) || COMPILED_FUNCTIONP (fun) || CONSP (fun)
+ UNBOUNDP (fun)) */
{
invalid_function:
val = signal_invalid_function_error (fun);
--
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
- 1 participants
- 0 comments
[PATCH] Eliminate byte compiler warnings, give nicer errors in the absence of packages
17 years, 4 months
Aidan Kehoe
Aidan Kehoe
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
- 1 participants
- 1 comments