Fast lock mode issue
18 years
Nelson Ferreira
For a long time I have been having a problem with closing some
buffers. In order to be able to close them I had to manually turn off
font-lock mode.
One such buffer has been the Info buffer.
Here is the back trace:
Debugger entered--Lisp error: (wrong-type-argument stringp nil)
expand-file-name(nil)
fast-lock-cache-name("~/.sxemacs/flc")
fast-lock-save-cache()
fast-lock-save-cache-before-kill-buffer()
kill-buffer("*info*")
call-interactively(kill-buffer)
I was able to fix it with this small patch:
$ cvs diff -ub fast-lock.el
Index: fast-lock.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/edit-utils/fast-lock.el,v
retrieving revision 1.4
diff -u -u -b -r1.4 fast-lock.el
--- fast-lock.el 2006/03/07 07:10:32 1.4
+++ fast-lock.el 2006/11/13 01:06:08
＠＠ -526,7 +526,8 ＠＠
See `fast-lock-cache-directory'."
(if (string-equal directory ".")
(concat buffer-file-name ".flc")
- (let* ((bufile (expand-file-name buffer-file-truename))
+ (let* ((bufile (expand-file-name (or buffer-file-truename
+ buffer-file-name)))
(chars-alist
(cond
((eq system-type 'emx)
--
Nelson Ferreira
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
patch for Info-find-emacs-command-nodes
18 years
Jeff Miller
The regex in Info-find-command-nodes shouldn't be tied to the end of
line.
Most lines in Command Index look like:
* calendar: Calendar/Diary. (line 6)
The regex only works for lines that are split across two lines, like
* calendar-backward-day: Calendar Unit Motion.
(line 34)
Here is a test-case:
(let ((where
(Info-find-emacs-command-nodes 'calendar)))
(Info-find-node (car (car where)) (car (cdr (car where)))))
21.4 requires a similar patch.
2006-10-14 Jeff Miller <jmiller(a)xemacs.org>
* info.el (Info-find-emacs-command-nodes): fix regex for find
command node.
--- lisp/info.el.orig 2006-10-13 20:03:38.000000000 -0400
+++ lisp/info.el 2006-10-14 17:03:17.000000000 -0400
＠＠ -3117,7 +3117,7 ＠＠
\(FILENAME NODENAME BUFFERPOS\)."
(let ((where '())
(cmd-desc (concat "^\\* " (regexp-quote (symbol-name command))
- ":\\s *\\(.*\\)\\.$")))
+ ":\\s *\\(.*\\)\\.")))
(save-excursion
(Info-find-node "XEmacs" "Command Index")
;; Take the index node off the Info history.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
[AC21.5 R21.4] Avoid a crash in Cygwin when clicking File -> Print under Win32
18 years
Aidan Kehoe
Ar an t-ochtú lá is fiche de mí na Samhain, scríobh Dr. Volker Zell:
> Aidan, can we install this patch for 21.4 and 21.5 ? It seems to do the
> right thing.
It’s Vin’s call as to whether it goes into 21.4, but I see no reason for it
not to.
APPROVE COMMIT 21.5, RECOMMEND 21.4.
NOTE: This patch has been committed.
src/ChangeLog addition:
2006-11-29 Aidan Kehoe <kehoea(a)parhasard.net>
* sound.c (init_native_sound):
Only X11 and GTK devices can possibly not be on the console of the
associated machine. Fixes a crash when init_native_sound is called
on a msprinter device.
XEmacs Trunk source patch:
Diff command: cvs -q diff -Nu
Files affected: src/sound.c
===================================================================
RCS
Index: src/sound.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/sound.c,v
retrieving revision 1.27
diff -u -u -r1.27 sound.c
--- src/sound.c 2006/07/11 23:40:17 1.27
+++ src/sound.c 2006/11/29 19:06:06
＠＠ -590,7 +590,7 ＠＠
static void
init_native_sound (struct device *d)
{
- if (DEVICE_TTY_P (d) || DEVICE_STREAM_P (d) || DEVICE_MSWINDOWS_P(d))
+ if (!(DEVICE_X_P(d) || DEVICE_GTK_P(dev)))
DEVICE_ON_CONSOLE_P (d) = 1;
#ifdef HAVE_X_WINDOWS
else
--
Santa Maradona, priez pour moi!
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
Latest Cygwin Xpm-noX package breaks configure (with patch to configure.ac)
18 years
Rick Rankin
A recent update to the Cygwin Xpm package has caused a problem with XEmacs configure when configuring for a non-X Cygwin build. The Cygwin folks renamed the library from libXpm.a to libXpm-noX.a. With the attached patch to configure.ac, configure can find the correct library.
I tested the patch on Cygwin with no-X, X-only, and combined builds, as well as on Linux (Fedora Core 6). Everything worked except the X-only Cygwin build, which failed to link because of undefined externals from src/intl-auto-encap-win32.c. I'm not sure if this file should even be used in an X-only build. It's also not clear how common an X-only build on Cygwin is, or if this issue is even worth fixing. An X-only build is an option, however, which is why I tested it.
--Rick
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
Fix file-name handling for `insert-file-contents'
18 years
Michael Sperber
This was happening too late (in `insert-file-contents-internal'),
because `insert-file-contents' would do stuff before calling
`insert-file-contents-internal'.
This would cause unpleasant interactions (with Dired, for example),
causing the coding-system problems with Dired.
2006-11-30 Mike Sperber <mike(a)xemacs.org>
* fileio.c (Finsert_file_contents_internal): Don't call the
file-name handler for `insert-file-contents' from here, which is
too late. Instead, do it from Lisp.SSper
2006-11-30 Mike Sperber <mike(a)xemacs.org>
* code-files.el (insert-file-contents): Call the file-name handler
from Lisp, not from `insert-file-contents-internal', which is too late.
--
Cheers =8-} Mike
Friede, Völkerverständigung und überhaupt blabla
Index: src/fileio.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/fileio.c,v
retrieving revision 1.107
diff -u -r1.107 fileio.c
--- src/fileio.c 1 Nov 2006 20:25:50 -0000 1.107
+++ src/fileio.c 30 Nov 2006 10:43:10 -0000
＠＠ -2844,16 +2844,6 ＠＠
filename = Fexpand_file_name (filename, Qnil);
- /* If the file name has special constructs in it,
- call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
- if (!NILP (handler))
- {
- val = call6 (handler, Qinsert_file_contents, filename,
- visit, start, end, replace);
- goto handled;
- }
-
if (!NILP (used_codesys))
CHECK_SYMBOL (used_codesys);
Index: lisp/code-files.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/code-files.el,v
retrieving revision 1.19
diff -u -r1.19 code-files.el
--- lisp/code-files.el 7 Oct 2003 21:52:15 -0000 1.19
+++ lisp/code-files.el 30 Nov 2006 10:43:13 -0000
＠＠ -382,86 +382,90 ＠＠
See also `insert-file-contents-access-hook',
`insert-file-contents-pre-hook', `insert-file-contents-error-hook',
and `insert-file-contents-post-hook'."
- (let (return-val coding-system used-codesys)
- ;; OK, first load the file.
- (condition-case err
- (progn
- (run-hook-with-args 'insert-file-contents-access-hook
- filename visit)
- ;; determine the coding system to use, as described above.
- (setq coding-system
- (or
- ;; #1.
- coding-system-for-read
- ;; #2.
- (run-hook-with-args-until-success
- 'insert-file-contents-pre-hook
- filename visit)
- ;; #3.
- (find-file-coding-system-for-read-from-filename filename)
- ;; #4.
- buffer-file-coding-system-for-read
- ;; #5.
- 'raw-text))
- (if (consp coding-system)
- (setq return-val coding-system)
- (if (null (find-coding-system coding-system))
- (progn
- (lwarn 'coding-system 'notice
- "Invalid coding-system (%s), using 'undecided"
- coding-system)
- (setq coding-system 'undecided)))
- (setq return-val
- (insert-file-contents-internal filename visit start end
- replace coding-system
- ;; store here!
- 'used-codesys))
- ))
- (file-error
- (run-hook-with-args 'insert-file-contents-error-hook
- filename visit err)
- (signal (car err) (cdr err))))
- (setq coding-system used-codesys)
- ;; call any `post-read-conversion' for the coding system that
- ;; was used ...
- (let ((func
- (coding-system-property coding-system 'post-read-conversion))
- (endmark (make-marker)))
- (set-marker endmark (+ (point) (nth 1 return-val)))
- (if func
- (unwind-protect
- (save-excursion
- (let (buffer-read-only)
- (if (>= (function-max-args func) 2)
- ;; #### fuckme! Someone at FSF changed the calling
- ;; convention of post-read-conversion. We try to
- ;; support the old way. #### Should we kill this?
- (funcall func (point) (marker-position endmark))
- (funcall func (- (marker-position endmark) (point))))))
- (if visit
- (progn
- (set-buffer-auto-saved)
- (set-buffer-modified-p nil)))))
- (setcar (cdr return-val) (- (marker-position endmark) (point))))
- ;; now finally set the buffer's `buffer-file-coding-system' ...
- (if (run-hook-with-args-until-success 'insert-file-contents-post-hook
- filename visit return-val)
- nil
- (if (local-variable-p 'buffer-file-coding-system (current-buffer))
- ;; if buffer-file-coding-system is already local, just
- ;; set its eol type to what was found, if it wasn't
- ;; set already.
- (set-buffer-file-coding-system
- (subsidiary-coding-system buffer-file-coding-system
- (coding-system-eol-type coding-system)) t)
- ;; otherwise actually set buffer-file-coding-system.
- (set-buffer-file-coding-system coding-system t)))
- ;; ... and `buffer-file-coding-system-when-loaded'. the machinations
- ;; of set-buffer-file-coding-system cause the actual coding system
- ;; object to be stored, so do that here, too.
- (setq buffer-file-coding-system-when-loaded
- (get-coding-system coding-system))
- return-val))
+ (let* ((expanded (substitute-in-file-name filename))
+ (handler (find-file-name-handler expanded 'insert-file-contents)))
+ (if handler
+ (funcall handler 'insert-file-contents filename visit start end replace)
+ (let (return-val coding-system used-codesys)
+ ;; OK, first load the file.
+ (condition-case err
+ (progn
+ (run-hook-with-args 'insert-file-contents-access-hook
+ filename visit)
+ ;; determine the coding system to use, as described above.
+ (setq coding-system
+ (or
+ ;; #1.
+ coding-system-for-read
+ ;; #2.
+ (run-hook-with-args-until-success
+ 'insert-file-contents-pre-hook
+ filename visit)
+ ;; #3.
+ (find-file-coding-system-for-read-from-filename filename)
+ ;; #4.
+ buffer-file-coding-system-for-read
+ ;; #5.
+ 'raw-text))
+ (if (consp coding-system)
+ (setq return-val coding-system)
+ (if (null (find-coding-system coding-system))
+ (progn
+ (lwarn 'coding-system 'notice
+ "Invalid coding-system (%s), using 'undecided"
+ coding-system)
+ (setq coding-system 'undecided)))
+ (setq return-val
+ (insert-file-contents-internal filename visit start end
+ replace coding-system
+ ;; store here!
+ 'used-codesys))
+ ))
+ (file-error
+ (run-hook-with-args 'insert-file-contents-error-hook
+ filename visit err)
+ (signal (car err) (cdr err))))
+ (setq coding-system used-codesys)
+ ;; call any `post-read-conversion' for the coding system that
+ ;; was used ...
+ (let ((func
+ (coding-system-property coding-system 'post-read-conversion))
+ (endmark (make-marker)))
+ (set-marker endmark (+ (point) (nth 1 return-val)))
+ (if func
+ (unwind-protect
+ (save-excursion
+ (let (buffer-read-only)
+ (if (>= (function-max-args func) 2)
+ ;; #### fuckme! Someone at FSF changed the calling
+ ;; convention of post-read-conversion. We try to
+ ;; support the old way. #### Should we kill this?
+ (funcall func (point) (marker-position endmark))
+ (funcall func (- (marker-position endmark) (point))))))
+ (if visit
+ (progn
+ (set-buffer-auto-saved)
+ (set-buffer-modified-p nil)))))
+ (setcar (cdr return-val) (- (marker-position endmark) (point))))
+ ;; now finally set the buffer's `buffer-file-coding-system' ...
+ (if (run-hook-with-args-until-success 'insert-file-contents-post-hook
+ filename visit return-val)
+ nil
+ (if (local-variable-p 'buffer-file-coding-system (current-buffer))
+ ;; if buffer-file-coding-system is already local, just
+ ;; set its eol type to what was found, if it wasn't
+ ;; set already.
+ (set-buffer-file-coding-system
+ (subsidiary-coding-system buffer-file-coding-system
+ (coding-system-eol-type coding-system)) t)
+ ;; otherwise actually set buffer-file-coding-system.
+ (set-buffer-file-coding-system coding-system t)))
+ ;; ... and `buffer-file-coding-system-when-loaded'. the machinations
+ ;; of set-buffer-file-coding-system cause the actual coding system
+ ;; object to be stored, so do that here, too.
+ (setq buffer-file-coding-system-when-loaded
+ (get-coding-system coding-system))
+ return-val))))
(defvar write-region-pre-hook nil
"A special hook to decide the coding system used for writing out a file.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
[PATCH] Revert workaround missing d_ino field from 'struct dirent' for Cygwin patch
18 years
Dr. Volker Zell
2006-11-29 Dr. Volker Zell <Dr.Volker.Zell(a)oracle.com>
* sysdir.h: Revert workaround missing d_ino field from 'struct dirent'
for Cygwin as it's back in again.
diff -urN origsrc/xemacs-21.4.19/src/sysdir.h src/xemacs-21.4.19/src/sysdir.h
--- origsrc/xemacs-21.4.19/src/sysdir.h 2006-01-24 03:54:45.000000000 +0100
+++ src/xemacs-21.4.19/src/sysdir.h 2006-11-29 21:25:12.079908800 +0100
＠＠ -59,11 +59,7 ＠＠
Since applying strlen to the name always works, we'll just do that. */
#define NAMLEN(p) strlen (p->d_name)
-#ifdef __CYGWIN__
-# define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != '\0')
-#else
# define DIRENTRY_NONEMPTY(p) ((p)->d_ino)
-#endif
/* encapsulation: directory calls */
An equivalent patch should also be applied to 21.5.
Ciao
Volker
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
[PATCH] Re: [Failure] The Package Smoketest
18 years
Aidan Kehoe
Ar an triochadú lá de mí na Samhain, scríobh Stephen J. Turnbull:
> Looks like it's probably related to your work, Aidan. Please fix.
Won’t get to committing it until this evening or tomorrow, but for
reference, here’s a fix.
--- fsf-compat-unicode.el~ 2006-11-30 10:26:10.453125000 +0100
+++ fsf-compat-unicode.el 2006-11-30 10:28:36.515625000 +0100
＠＠ -34,14 +34,44 ＠＠
(encode-char (decode-char 'ucs #x31C) 'ucs))))
(error "Unicode support needed for this file not available!"))
-(define-ccl-program fsf-compat-ccl-encode-to-ucs-2
- `(1
- ((r1 = (r1 << 8))
- (r1 = (r1 | r2))
- (mule-to-unicode r0 r1)
- (r1 = (r0 >> 8))
- (r2 = (r0 & 255))))
- "CCL program to transform Mule characters to UCS-2.")
+
+(if (eval-when-compile
+ (and (> emacs-major-version 20)
+ (> emacs-minor-version 4)
+ (featurep 'mule)))
+
+ ;; If we're being compiled by 21.5, use the actual define-ccl-program
+ ;; macro, but evaluated at runtime.
+ ;;
+ ;; Having this as
+ ;;
+ ;; (eval-when-compile (and (featurep 'mule) (macroexpand
+ ;; '(define-ccl-program ...))
+ ;;
+ ;; in order to have the macro evaluated at compile time, results
+ ;; in the statement being empty in the compiled file, which as I
+ ;; understand it is a bug.
+
+ (eval
+ '(define-ccl-program fsf-compat-ccl-encode-to-ucs-2
+ `(1
+ ((r1 = (r1 << 8))
+ (r1 = (r1 | r2))
+ (mule-to-unicode r0 r1)
+ (r1 = (r0 >> 8))
+ (r2 = (r0 & 255))))
+ "CCL program to transform Mule characters to UCS-2."))
+
+ ;; Pre-expand the macro for 21.4. 21.4 will error on loading this file, but
+ ;; it may compile it. define-ccl-program should not be a macro, but that's
+ ;; by the way.
+ (let ((prog [1 10 131127 8 98872 65823 147513 8 82009 255 22]))
+ (defconst fsf-compat-ccl-encode-to-ucs-2 prog
+ "CCL program to transform Mule characters to UCS-2.")
+ (put (quote fsf-compat-ccl-encode-to-ucs-2)
+ (quote ccl-program-idx)
+ (register-ccl-program (quote fsf-compat-ccl-encode-to-ucs-2) prog))
+ nil))
(defun fsf-compat-init-mule-unicode-charsets ()
"Make some Mule character sets that the FSF uses available in XEmacs.
--
Santa Maradona, priez pour moi!
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
Fix revert again
18 years
Michael Sperber
Aidan's recent fix (of 2006-10-27) worked, except for the "binary"
coding system, if that was determined implicitly. The reason is the
handling of buffer-local variables. (First against the wall when the
revolution comes.)
Aidan, could you have a look at this before I commit?
Index: lisp/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v
retrieving revision 1.771
diff -u -r1.771 ChangeLog
2006-11-28 Mike Sperber <mike(a)xemacs.org>
* files.el (revert-buffer-internal): Determine the coding system
while still in the original buffer, rather than the new one.
--
Cheers =8-} Mike
Friede, Völkerverständigung und überhaupt blabla
Index: lisp/files.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/files.el,v
retrieving revision 1.76
diff -u -r1.76 files.el
--- lisp/files.el 27 Oct 2006 19:07:33 -0000 1.76
+++ lisp/files.el 28 Nov 2006 16:29:25 -0000
＠＠ -3512,7 +3512,10 ＠＠
Return nil if identical, and the new buffer if different."
(let* ((newbuf (get-buffer-create " *revert*"))
- bmin bmax)
+ bmin bmax
+ ;; #### b-f-c-s is _not necessarily_ the coding system that
+ ;; was used to read in the file. See its docstring.
+ (coding-system buffer-file-coding-system))
(save-excursion
(set-buffer newbuf)
(with-obsolete-variable '(before-change-function after-change-function)
＠＠ -3522,9 +3525,8 ＠＠
after-change-functions
before-change-function
before-change-functions
- ;; #### b-f-c-s is _not necessarily_ the coding system that
- ;; was used to read in the file. See its docstring.
- (coding-system-for-read buffer-file-coding-system))
+ (coding-system-for-read coding-system)
+ )
(if revert-buffer-insert-file-contents-function
(funcall revert-buffer-insert-file-contents-function
file-name nil)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
[COMMIT] Add a define-setf, a couple of make-obsoletes, and update docstrings
18 years
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
lisp/ChangeLog addition:
2006-11-29 Aidan Kehoe <kehoea(a)parhasard.net>
* mule/mule-charset.el:
* mule/mule-charset.el (charset-registry):
* mule/mule-charset.el (set-charset-registry):
* mule/mule-charset.el (charset-registries): New.
Make set-charset-registry, charset-registry obsolete; define a
setf for charset-registries.
XEmacs Trunk source patch:
Diff command: cvs -q diff -Nu
Files affected: lisp/mule/mule-charset.el
===================================================================
RCS
Index: lisp/mule/mule-charset.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/mule-charset.el,v
retrieving revision 1.20
diff -u -u -r1.20 mule-charset.el
--- lisp/mule/mule-charset.el 2006/11/15 21:39:59 1.20
+++ lisp/mule/mule-charset.el 2006/11/29 22:31:28
＠＠ -82,14 +82,14 ＠＠
;; Not in GNU Emacs/Mule
(defun charset-registry (charset)
- "Return the registry of CHARSET.
-This is a regular expression matching the registry field of fonts
-that can display the characters in CHARSET."
+ "Obsolete; use charset-registries instead. "
(lwarn 'xintl 'warning
"charset-registry is obsolete--use charset-registries instead. ")
(when (charset-property charset 'registries)
(elt (charset-property charset 'registries) 0)))
+(make-obsolete 'charset-registry 'charset-registries)
+
(defun charset-registries (charset)
"Return the registries of CHARSET."
(charset-property charset 'registries))
＠＠ -106,6 +106,8 ＠＠
charset
(apply 'vector registry (append (charset-registries charset) nil))))
+(make-obsolete 'set-charset-registry 'set-charset-registries)
+
(defun charset-ccl-program (charset)
"Return the CCL program of CHARSET.
See `make-charset'."
＠＠ -124,6 +126,7 ＠＠
(defsetf charset-registry set-charset-registry)
(defsetf charset-ccl-program set-charset-ccl-program)
+(defsetf charset-registries set-charset-registries)
;;; FSF compatibility functions
(defun charset-after (&optional pos)
--
Santa Maradona, priez pour moi!
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
[PATCH] Make the FSF's Unicode subset charsets available in XEmacs
18 years
Aidan Kehoe
Comments? Objections?
xemacs-packages/fsf-compat/ChangeLog addition:
2006-11-11 Aidan Kehoe <kehoea(a)parhasard.net>
* mule-unicode-charsets.el:
Provide support for some FSF-specific Unicode-coverage Mule
charsets.
XEmacs Packages source patch:
Diff command: cvs -q diff -Nu
Files affected: xemacs-packages/fsf-compat/mule-unicode-charsets.el
===================================================================
RCS
Index: xemacs-packages/fsf-compat/mule-unicode-charsets.el
===================================================================
RCS file: mule-unicode-charsets.el
diff -N mule-unicode-charsets.el
--- /dev/null Sat Nov 11 19:14:42 2006
+++ mule-unicode-charsets.el Sat Nov 11 19:14:19 2006
＠＠ -0,0 +1,95 ＠＠
+;;; mule-unicode-charsets.el --- Provide the FSF's Mule Unicode subsets in
+;;; XEmacs.
+
+;; Copyright (C) 2006 by Free Software Foundation, Inc.
+
+;; Author: Aidan Kehoe <kehoea(a)parhasard.net>
+;; Keywords: Unicode, Mule
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;;; Code:
+
+(define-ccl-program fsf-compat-ccl-encode-to-ucs-2
+ `(1
+ ((r1 = (r1 << 8))
+ (r1 = (r1 | r2))
+ (mule-to-unicode r0 r1)
+ (r1 = (r0 >> 8))
+ (r2 = (r0 & 255))))
+ "CCL program to transform Mule characters to UCS-2.")
+
+(defun fsf-compat-init-mule-unicode-charsets ()
+ "Make some Mule character sets that the FSF uses available in XEmacs.
+
+These character sets cover some Unicode code space explicitly; we use a
+different solution to the same problem, so you should only need these
+character sets if you're editing FSF source. "
+ (let (charset-symbol)
+ (loop
+ for (first-ucs last-ucs final) in '((#x0100 #x24FF ?1)
+ (#x2500 #x33ff ?2)
+ (#xE000 #xFFFF ?3))
+ do
+ (setq charset-symbol
+ (intern (format "mule-unicode-%04x-%04x"
+ first-ucs last-ucs)))
+ (make-charset charset-symbol
+ (format
+ "Unicode subset (U+%04X..U+%04X) for FSF compatibility."
+ first-ucs last-ucs)
+ (list 'dimension 2
+ 'registries ["iso10646-1"]
+ 'chars 96
+ 'columns 1
+ 'direction 'l2r
+ 'final final
+ 'graphic 0
+ 'short-name (format "Unicode subset %c" final)
+ 'long-name (format "Unicode subset (U+%04X..U+%04X)"
+ first-ucs last-ucs)
+ 'ccl-program 'fsf-compat-ccl-encode-to-ucs-2))
+ ;; The names of the character sets lie, at least as of GNU Emacs
+ ;; 22.0.50.3. The difference appears to be that they keep assigning
+ ;; code points until the end of the 96x96 space of the character sets.
+ (loop for ku from 32 to 127 do
+ (loop for ten from 32 to 127 do
+ (set-unicode-conversion (make-char charset-symbol ku ten) first-ucs)
+ (incf first-ucs))))))
+
+;; The following code creates a form, which, when evaluated in GNU Emacs,
+;; checks our compatibility with their three character sets.
+
+; (progn
+; (insert "(require 'cl)\n\n(assert\n (and\n")
+; (loop
+; for charset-symbol in '(mule-unicode-2500-33ff
+; mule-unicode-e000-ffff
+; mule-unicode-0100-24ff)
+; do
+; (loop for ku from 32 to 127 do
+; (loop for ten from 32 to 127 do
+; (insert (format
+; " (eq (encode-char (make-char '%s %d %d) 'ucs) #x%04X)\n"
+; charset-symbol ku ten
+; (encode-char (make-char charset-symbol ku ten) 'ucs))))))
+; (insert " ) nil \"We're incompatible with the FSF!\")"))
--
Santa Maradona, priez pour moi!
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches