[PATCH] Have set-buffer-file-coding-system mark the buffer as modified.
17 years, 7 months
Aidan Kehoe
Aidan Kehoe
lisp/ChangeLog addition:
2007-04-30 Aidan Kehoe <kehoea(a)parhasard.net>
* code-files.el (set-buffer-file-coding-system):
Make set-buffer-file-coding-system update the buffer's modified
flag. Also make it accept a new flag, NOMODIFY, taken from GNU, to
suppress this behaviour.
* code-files.el (insert-file-contents):
Use the NOMODIFY flag when calling set-buffer-file-coding-system.
XEmacs Trunk source patch:
Diff command: cvs -q diff -Nu
Files affected: lisp/code-files.el
===================================================================
RCS
Index: lisp/code-files.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/code-files.el,v
retrieving revision 1.20
diff -u -u -r1.20 code-files.el
--- lisp/code-files.el 2006/12/05 08:21:03 1.20
+++ lisp/code-files.el 2007/04/30 14:42:35
＠＠ -105,20 +105,36 ＠＠
`buffer-file-coding-system-for-read', but is overridden by
`coding-system-for-read'.")
-(defun set-buffer-file-coding-system (coding-system &optional force)
- "Set buffer-file-coding-system of the current buffer to CODING-SYSTEM.
-If optional argument FORCE (interactively, the prefix argument) is not
-given, attempt to match the EOL type of the new coding system to
-the current value of `buffer-file-coding-system'."
- (interactive "zFile coding system: \nP")
- (get-coding-system coding-system) ;; correctness check
- (if (not force)
- (setq coding-system
+(defun set-buffer-file-coding-system (coding-system &optional force nomodify)
+ "Set the file coding-system of the current buffer to CODING-SYSTEM.
+This means that when you save the buffer, it will be converted
+according to CODING-SYSTEM. For a list of possible values of CODING-SYSTEM,
+use \\[list-coding-systems].
+
+If CODING-SYSTEM leaves the text conversion unspecified, or if it
+leaves the end-of-line conversion unspecified, FORCE controls what to
+do. If FORCE is nil, get the unspecified aspect (or aspects) from the
+buffer's previous `buffer-file-coding-system' value (if it is
+specified there). Otherwise, leave it unspecified.
+
+This marks the buffer modified so that the succeeding \\[save-buffer]
+surely saves the buffer with CODING-SYSTEM. From a program, if you
+don't want to mark the buffer modified, specify t for NOMODIFY.
+If you know exactly what coding system you want to use,
+just set the variable `buffer-file-coding-system' directly."
+ (interactive "zCoding system for saving file (default nil): \nP")
+ (check-coding-system coding-system)
+ (if (and coding-system buffer-file-coding-system (null force))
+ (setq coding-system
(subsidiary-coding-system
coding-system
(coding-system-eol-type buffer-file-coding-system))))
- (setq buffer-file-coding-system coding-system)
- (redraw-modeline t))
+ (setq buffer-file-coding-system coding-system)
+ ;; XEmacs change; remove a call to ucs-set-table-for-input, which we don't
+ ;; have.
+ (unless nomodify
+ (set-buffer-modified-p t))
+ (force-mode-line-update))
(defun toggle-buffer-file-coding-system ()
"Set EOL type of buffer-file-coding-system of the current buffer to
＠＠ -456,10 +472,11 ＠＠
;; 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)
+ (subsidiary-coding-system
+ buffer-file-coding-system
+ (coding-system-eol-type coding-system)) t t)
;; otherwise actually set buffer-file-coding-system.
- (set-buffer-file-coding-system coding-system t)))
+ (set-buffer-file-coding-system coding-system t 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.
cvs server: cannot find modules/ldap/configure
--
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
[21.5] Implement FcConfig handling (95%)
17 years, 8 months
Stephen J. Turnbull
Stephen J. Turnbull
21.5
I'm going to run with this for a few days, and if I see no major
problems, I'll commit.
I got tired of being unable to see what was an XEmacs problem and what
was due to misconfiguration of fontconfig, so I implemented the config
querying operations in Lisp.
Mostly it's pretty straightforward, but there are a couple of places
I'd appreciate review/testing because they're a little tricky. First,
It turned out to be very easy to crash fontconfig and XEmacs along
with it, simply by doing `(fc-config-set-current (fc-config-create))'
and then trying to change the default face's font. The workaround is
somewhat expensive and unlovely (see Ffc_config_set_current).
Second, FcConfigGetCurrent() hands you a reference to a fontconfig
internal structure, and FcConfigSetCurrent() allows you to install a
Lisp-created instance into fontconfig internals. If you destroy it,
fontconfig (and XEmacs) crashes. I'm managing this by comparing the
FcConfig* to the current FcConfig, and not destroying in that case
(see finalize_fc_config). Also, I try to ensure that there's only one
reference to any given FcConfig by keeping a list of fc_config Lisp
objects, and having fc-config-get-current return an existing one from
Vfc_config_weak_list if possible. I'm a little fuzzy on weak lists,
so I'd like review on this.
Here are some test operations:
(fc-get-version)
=> 20402
(fc-config-get-current)
=> #<fc-config 0x2df37>
(fc-config-p (fc-config-get-current))
=> t
(fc-config-get-fonts (fc-config-get-current) 'fc-set-application)
=> nil
(length (fc-config-get-fonts (fc-config-get-current) 'fc-set-system))
=> 1037
(fc-config-get-rescan-interval (fc-config-get-current))
=> 30
(fc-config-get-rescan-interval (fc-config-create))
=> 30
(length (fc-config-get-fonts (fc-config-create) 'fc-set-system))
=> 0
(fc-config-get-config-files (fc-config-get-current))
=> ("/opt/local/etc/fonts/conf.d/90-synthetic.conf"
"/opt/local/etc/fonts/conf.d/80-delicious.conf"
"/opt/local/etc/fonts/conf.d/69-unifont.conf"
;; several directories omitted
"/opt/local/etc/fonts/fonts.conf")
(fc-config-get-config-files (fc-config-create))
=> nil
(fc-config-get-config-dirs (fc-config-get-current))
=> ("/Users/steve/.fonts" "/opt/local/share/fonts" "/usr/X11R6/lib/X11/fonts"
"/System/Library/Fonts" "/Network/Library/Fonts" "/Library/Fonts"
"/usr/share/fonts")
(fc-config-get-config-dirs (fc-config-create))
=> nil
(fc-config-set-current (fc-config-create))
=> nil
(fc-config-get-config-dirs (fc-config-get-current))
=> nil
(fc-config-get-config-files (fc-config-get-current))
=> nil
(setq config (fc-config-create))
=> #<fc-config 0x2e94a>
(fc-config-build-fonts config)
=> nil
(fc-config-get-fonts config 'fc-set-system)
=> nil
(fc-config-app-font-add-dir config "/Library/Fonts")
=> t
(length (fc-config-get-fonts config 'fc-set-system))
=> 0
(length (fc-config-get-fonts config 'fc-set-application))
=> 190
(set-face-font 'default "Andale Mono-12")
=> "Andale Mono-12"
src/ChangeLog addition:
2007-04-15 Stephen J. Turnbull <stephen(a)xemacs.org>
* font-mgr.c (DestroyFontsetP): New enum.
* font-mgr.c (fontset_to_list): Add destroyp argument of that type.
* font-mgr.c (Ffc_font_list): Add argument.
* font-mgr.c (Ffc_font_sort): Add argument.
* font-mgr.h (fc_config): Declare new Lisp object type.
* font-mgr.c (print_fc_config):
* font-mgr.c (finalize_fc_config):
* font-mgr.c (fc_config_p):
* font-mgr.c (Qfc_configp):
Implement it.
* font-mgr.c (syms_of_font_mgr):
* font-mgr.c (complex_vars_of_font_mgr):
* lrecord.h (lrecord_type_fc_config):
Initialize it.
* font-mgr.c (fc_config_create_using): New helper function.
* font-mgr.c (FCSTRLIST_TO_LISP_USING): New helper macro.
* font-mgr.c (Vfc_config_weak_list): Manage references to FcConfigs.
* font-mgr.c (Ffc_get_version):
* font-mgr.c (Ffc_config_create):
* font-mgr.c (Ffc_config_get_current):
* font-mgr.c (Ffc_config_set_current):
* font-mgr.c (Ffc_config_up_to_date):
* font-mgr.c (Ffc_config_build_fonts):
* font-mgr.c (Ffc_config_get_config_dirs):
* font-mgr.c (Ffc_config_get_font_dirs):
* font-mgr.c (Ffc_config_get_config_files):
* font-mgr.c (Ffc_config_get_cache):
* font-mgr.c (Ffc_config_get_rescan_interval):
* font-mgr.c (Ffc_config_set_rescan_interval):
* font-mgr.c (Ffc_config_app_font_add_file):
* font-mgr.c (Ffc_config_app_font_add_dir):
* font-mgr.c (Ffc_config_app_font_clear):
* font-mgr.c (Ffc_config_filename):
* font-mgr.c (Ffc_init_load_config):
* font-mgr.c (Ffc_init_load_config_and_fonts):
* font-mgr.c (Ffc_init):
* font-mgr.c (Ffc_init_reinitialize):
Implemented operations.
* font-mgr.c (Ffc_config_destroy):
* font-mgr.c (Ffc_config_get_blanks):
Stub operations.
21.5 source patch:
Diff command: cvs -q diff -u
Index: src/font-mgr.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/font-mgr.c,v
retrieving revision 1.5
diff -u -u -r1.5 font-mgr.c
--- src/font-mgr.c 14 Apr 2007 16:10:57 -0000 1.5
+++ src/font-mgr.c 14 Apr 2007 16:19:07 -0000
＠＠ -80,6 +80,10 ＠＠
/* Lisp_Object Vfc_version; */ /* #### Should have this, too! */
Fixnum debug_xft; /* Set to 1 enables lots of obnoxious messages.
Setting it to 2 or 3 enables even more. */
+#ifdef FONTCONFIG_EXPOSE_CONFIG
+Lisp_Object Qfc_configp;
+static Lisp_Object Vfc_config_weak_list;
+#endif
/****************************************************************
* FcPattern objects *
＠＠ -529,9 +533,10 ＠＠
return wrap_fcpattern(res_fcpat);
}
-/* NOTE NOTE NOTE This function destroys the FcFontSet passed to it. */
+enum DestroyFontsetP { DestroyNo = 0, DestroyYes = 1 };
+
static Lisp_Object
-fontset_to_list (FcFontSet *fontset)
+fontset_to_list (FcFontSet *fontset, enum DestroyFontsetP destroyp)
{
int idx;
Lisp_Object fontlist = Qnil;
＠＠ -548,7 +553,8 ＠＠
fcpat->fcpatPtr = FcPatternDuplicate (fontset->fonts[idx]);
fontlist = Fcons (wrap_fcpattern(fcpat), fontlist);
}
- FcFontSetDestroy (fontset);
+ if (destroyp)
+ FcFontSetDestroy (fontset);
return fontlist;
}
＠＠ -578,7 +584,7 ＠＠
fontset = FcFontList (NULL, XFCPATTERN_PTR (pattern), os);
FcObjectSetDestroy (os);
- return fontset_to_list (fontset);
+ return fontset_to_list (fontset, DestroyYes);
}
＠＠ -614,10 +620,459 ＠＠
FcConfigSubstitute (fcc, p, FcMatchPattern);
fontset = FcFontSort (fcc, p, !NILP(trim), NULL, &fcresult);
- return fontset_to_list (fontset);
+ return fontset_to_list (fontset, DestroyYes);
+ }
+}
+
+#ifdef FONTCONFIG_EXPOSE_CONFIG
+
+/* Configuration routines --- for debugging
+ Don't depend on these routines being available in the future!
+
+ 3.2.10 Initialization
+ ---------------------
+
+ An FcConfig object holds the internal representation of a configuration.
+ There is a default configuration which applications may use by passing
+ 0 to any function using the data within an FcConfig.
+*/
+
+static void
+finalize_fc_config (void *header, int UNUSED (for_disksave))
+{
+ struct fc_config *p = (struct fc_config *) header;
+ if (p->fccfgPtr && p->fccfgPtr != FcConfigGetCurrent())
+ {
+ /* If we get here, all of *our* references are garbage (see comment on
+ fc_config_create_using() for why), and the only reference that
+ fontconfig keeps is the current FcConfig. */
+ FcConfigDestroy (p->fccfgPtr);
+ }
+ p->fccfgPtr = 0;
+}
+
+static void
+print_fc_config (Lisp_Object obj, Lisp_Object printcharfun,
+ int UNUSED(escapeflag))
+{
+ struct fc_config *c = XFCCONFIG (obj);
+ if (print_readably)
+ printing_unreadable_object ("#<fc-config 0x%x>", c->header.uid);
+ write_fmt_string (printcharfun, "#<fc-config 0x%x>", c->header.uid);
+}
+
+static const struct memory_description fcconfig_description [] = {
+ /* #### nothing here, is this right?? */
+ { XD_END }
+};
+
+DEFINE_LRECORD_IMPLEMENTATION("fc-config", fc_config, 0,
+ 0, print_fc_config, finalize_fc_config, 0, 0,
+ fcconfig_description,
+ struct fc_config);
+
+/* We obviously need to be careful about garbage collecting the current
+ FcConfig. I infer from the documentation of FcConfigDestroy that that
+ is the only reference maintained by fontconfig.
+ So we keep track of our own references on a weak list, and only cons a
+ new object if we don't already have a reference to it there. */
+
+static Lisp_Object
+fc_config_create_using (FcConfig * (*create_function) ())
+{
+ FcConfig *fc = (*create_function) ();
+ Lisp_Object configs = XWEAK_LIST_LIST (Vfc_config_weak_list);
+
+ /* Linear search: fc_configs are not going to multiply like conses. */
+ {
+ LIST_LOOP_2 (cfg, configs)
+ if (fc == XFCCONFIG_PTR (cfg))
+ return cfg;
}
+
+ {
+ fc_config *fccfg =
+ ALLOC_LCRECORD_TYPE (struct fc_config, &lrecord_fc_config);
+ fccfg->fccfgPtr = fc;
+ configs = Fcons (wrap_fcconfig (fccfg), configs);
+ XWEAK_LIST_LIST (Vfc_config_weak_list) = configs;
+ return wrap_fcconfig (fccfg);
+ }
+}
+
+DEFUN("fc-config-p", Ffc_config_p, 1, 1, 0, /*
+Returns t if OBJECT is of type fc-config, nil otherwise.
+*/
+ (object))
+{
+ return FCCONFIGP (object) ? Qt : Qnil;
+}
+
+DEFUN("fc-config-create", Ffc_config_create, 0, 0, 0, /*
+ -- Function: FcConfig *FcConfigCreate (void)
+ Creates an empty configuration. */
+ ())
+{
+ return fc_config_create_using (&FcConfigCreate);
+}
+
+#if 0
+/* I'm sorry, but we just don't do this in Lisp, OK?
+ Don't even think about implementing this. */
+DEFUN("fc-config-destroy", Ffc_config_destroy, 1, 1, 0, /*
+ -- Function: void FcConfigDestroy (FcConfig *config)
+ Destroys a configuration and any data associated with it. Note
+ that calling this function with the return value from
+ FcConfigGetCurrent will place the library in an indeterminate
+ state. */
+ (config))
+{
+ signal_error (Qunimplemented, "No user-servicable parts!",
+ intern ("fc-config-destroy");
+}
+#endif
+
+DEFUN("fc-config-get-current", Ffc_config_get_current, 0, 0, 0, /*
+ -- Function: FcConfig *FcConfigGetCurrent (void)
+ Returns the current default configuration. */
+ ())
+{
+ return fc_config_create_using (&FcConfigGetCurrent);
}
+DEFUN("fc-config-up-to-date", Ffc_config_up_to_date, 1, 1, 0, /*
+ -- Function: FcBool FcConfigUptoDate (FcConfig *config)
+ Checks all of the files related to 'config' and returns whether the
+ in-memory version is in sync
+ /* Yes, we need to do this check -- sheesh, Keith! */ \
+ if (!thing_list) \
+ return Qnil; \
+ while ((thing = FcStrListNext (thing_list))) \
+ value = Fcons (build_fcapi_string (thing), value); \
+ FcStrListDone (thing_list); \
+ return value; \
+ } while (0)
+
+DEFUN("fc-config-get-config-dirs", Ffc_config_get_config_dirs, 1, 1, 0, /*
+ -- Function: FcStrList *FcConfigGetConfigDirs (FcConfig *config)
+ Returns the list of font directories specified in the
+ configuration files for 'config'. Does not include any
+ subdirectories. */
+ (config))
+{
+ FCSTRLIST_TO_LISP_USING (FcConfigGetConfigDirs);
+}
+
+DEFUN("fc-config-get-font-dirs", Ffc_config_get_font_dirs, 1, 1, 0, /*
+ -- Function: FcStrList *FcConfigGetFontDirs (FcConfig *config)
+ Returns the list of font directories in 'config'. This includes the
+ configured font directories along with any directories below those
+ in the filesystem. */
+ (config))
+{
+ FCSTRLIST_TO_LISP_USING (FcConfigGetFontDirs);
+}
+
+DEFUN("fc-config-get-config-files", Ffc_config_get_config_files, 1, 1, 0, /*
+ -- Function: FcStrList *FcConfigGetConfigFiles (FcConfig *config)
+ Returns the list of known configuration files used to generate
+ 'config'. Note that this will not include any configuration done
+ with FcConfigParse. */
+ (config))
+{
+ FCSTRLIST_TO_LISP_USING (FcConfigGetConfigFiles);
+}
+
+#undef FCSTRLIST_TO_LISP_USING
+
+DEFUN("fc-config-get-cache", Ffc_config_get_cache, 1, 1, 0, /*
+ -- Function: char *FcConfigGetCache (FcConfig *config)
+ Returns the name of the file used to store per-user font
+ information. */
+ (config))
+{
+ CHECK_FCCONFIG (config);
+ /* Surely FcConfigGetCache just casts an FcChar8* to char*. */
+ return build_fcapi_string ((FcChar8 *) FcConfigGetCache (XFCCONFIG_PTR (config)));
+}
+
+DEFUN("fc-config-get-fonts", Ffc_config_get_fonts, 2, 2, 0, /*
+ -- Function: FcFontSet *FcConfigGetFonts (FcConfig *config, FcSetName set)
+ Returns one of the two sets of fonts from the configuration as
+ specified by 'set'.
+ `FcSetName'
+ Specifies one of the two sets of fonts available in a
+ configuration; FcSetSystem for those fonts specified in the
+ configuration and FcSetApplication which holds fonts provided by
+ the application. */
+ (config, set))
+{
+ FcSetName name = FcSetSystem;
+ FcFontSet *fs = NULL;
+
+ CHECK_FCCONFIG (config);
+ CHECK_SYMBOL (set);
+
+ if (EQ (set, intern ("fc-set-system")))
+ name = FcSetSystem;
+ else if (EQ (set, intern ("fc-set-application")))
+ name = FcSetApplication;
+ else
+ wtaerror ("must be in (fc-set-system fc-set-application)", set);
+
+ fs = FcConfigGetFonts (XFCCONFIG_PTR (config), name);
+ return fs ? fontset_to_list (fs, DestroyNo) : Qnil;
+}
+
+DEFUN("fc-config-set-current", Ffc_config_set_current, 1, 1, 0, /*
+ -- Function: FcBool FcConfigSetCurrent (FcConfig *config)
+ Sets the current default configuration to 'config'. Implicitly
+ calls FcConfigBuildFonts if necessary, returning FcFalse if that
+ call fails.
+XEmacs: signals out-of-memory if FcConfigBuildFonts fails, or args-out-of-range
+if the resulting FcConfig has no fonts (which would crash XEmacs if installed).
+*/
+ (config))
+{
+ CHECK_FCCONFIG (config);
+ /* *sigh* "Success" DOES NOT mean you have any fonts available. It is
+ easy to crash fontconfig, and XEmacs with it. Without the following
+ check, this will do it:
+ (progn
+ (fc-config-set-current (fc-config-create))
+ (set-face-font 'default "serif-12"))
+ */
+
+ if (FcConfigBuildFonts (XFCCONFIG_PTR (config)) == FcFalse)
+ out_of_memory ("FcConfigBuildFonts failed", config);
+ /* #### We'd like to avoid this consing, and FcConfigGetFonts sometimes
+ returns NULL, but it doesn't always. This will do for now .... */
+ if (NILP (Ffc_config_get_fonts (config, intern ("fc-set-system")))
+ && NILP (Ffc_config_get_fonts (config, intern ("fc-set-application"))))
+ signal_error (intern ("args-out-of-range"), "no fonts found", config);
+ /* Should never happen, but I don't trust Keith anymore .... */
+ if (FcConfigSetCurrent (XFCCONFIG_PTR (config)) == FcFalse)
+ out_of_memory ("FcConfigBuildFonts failed in set", config);
+ return Qnil;
+}
+
+DEFUN("fc-config-get-blanks", Ffc_config_get_blanks, 1, 1, 0, /*
+ -- Function: FcBlanks *FcConfigGetBlanks (FcConfig *config)
+ Returns the FcBlanks object associated with the given
+ configuration, if no blanks were present in the configuration,
+ this function will return 0.
+XEmacs: should convert to a chartable.
+#### Unimplemented. */
+ (config))
+{
+ CHECK_FCCONFIG (config);
+ signal_error (Qunimplemented, "no method to convert FcBlanks object",
+ intern ("fc-config-get-blanks"));
+}
+
+/* The misspelling in the fontconfig function name accurately corresponds to
+ the version of fontconfig.h I had on 2007-04-13. -- sjt */
+DEFUN("fc-config-get-rescan-interval", Ffc_config_get_rescan_interval, 1, 1, 0, /*
+ -- Function: int FcConfigGetRescanInverval (FcConfig *config)
+ Returns the interval between automatic checks of the configuration
+ (in seconds) specified in 'config'. The configuration is checked
+ during a call to FcFontList when this interval has passed since
+ the last check. */
+ (config))
+{
+ CHECK_FCCONFIG (config);
+ return make_int (FcConfigGetRescanInverval (XFCCONFIG_PTR (config)));
+}
+
+/* The misspelling in the fontconfig function name accurately corresponds to
+ the version of fontconfig.h I had on 2007-04-13. -- sjt */
+DEFUN("fc-config-set-rescan-interval", Ffc_config_set_rescan_interval, 2, 2, 0, /*
+ -- Function: FcBool FcConfigSetRescanInverval (FcConfig *config, int
+ rescanInterval)
+ Sets the rescan interval; returns FcFalse if an error occurred.
+ XEmacs: signal such error, or return nil on success. */
+ (config, rescan_interval))
+{
+ CHECK_FCCONFIG (config);
+ CHECK_INT (rescan_interval);
+ if (FcConfigSetRescanInverval (XFCCONFIG_PTR (config),
+ XINT (rescan_interval)) == FcFalse)
+ signal_error (Qio_error, "FcConfigSetRescanInverval barfed",
+ intern ("fc-config-set-rescan-interval"));
+ return Qnil;
+}
+
+/* #### This might usefully be made interactive. */
+DEFUN("fc-config-app-font-add-file", Ffc_config_app_font_add_file, 2, 2, 0, /*
+ -- Function: FcBool FcConfigAppFontAddFile (FcConfig *config, const
+ char *file)
+ Adds an application-specific font to the configuration. */
+ (config, file))
+{
+ CHECK_FCCONFIG (config);
+ CHECK_STRING (file);
+ if (FcConfigAppFontAddFile
+ (XFCCONFIG_PTR (config),
+ /* #### FIXME! is this really Qnative? */
+ (FcChar8 *) NEW_LISP_STRING_TO_EXTERNAL ((file), Qnative)) == FcFalse)
+ return Qnil;
+ else
+ return Qt;
+}
+
+/* #### This might usefully be made interactive. */
+DEFUN("fc-config-app-font-add-dir", Ffc_config_app_font_add_dir, 2, 2, 0, /*
+ -- Function: FcBool FcConfigAppFontAddDir (FcConfig *config, const
+ char *dir)
+ Scans the specified directory for fonts, adding each one found to
+ the application-specific set of fonts. */
+ (config, dir))
+{
+ CHECK_FCCONFIG (config);
+ CHECK_STRING (dir);
+ if (FcConfigAppFontAddDir
+ (XFCCONFIG_PTR (config),
+ /* #### FIXME! is this really Qnative? */
+ (FcChar8 *) NEW_LISP_STRING_TO_EXTERNAL ((dir), Qnative)) == FcFalse)
+ return Qnil;
+ else
+ return Qt;
+}
+
+/* #### This might usefully be made interactive. */
+DEFUN("fc-config-app-font-clear", Ffc_config_app_font_clear, 1, 1, 0, /*
+ -- Function: void FcConfigAppFontClear (FcConfig *config)
+ Clears the set of application-specific fonts. */
+ (config))
+{
+ CHECK_FCCONFIG (config);
+ FcConfigAppFontClear (XFCCONFIG_PTR (config));
+ return Qnil;
+}
+
+/* These functions provide some control over how the default
+ configuration of the library is initialized. (This configuration is
+ normally implicitly initialized.) */
+
+DEFUN("fc-config-filename", Ffc_config_filename, 1, 1, 0, /*
+ -- Function: char *FcConfigFilename (const char *name)
+ Given the specified external entity name, return the associated
+ filename. This provides applications a way to convert various
+ configuration file references into filename form.
+
+ A null or empty 'name' indicates that the default configuration
+ file should be used; which file this references can be overridden
+ with the FC_CONFIG_FILE environment variable. Next, if the name
+ starts with '~', it refers to a file in the current users home
+ directory. Otherwise if the name doesn't start with '/', it
+ refers to a file in the default configuration directory; the
+ built-in default directory can be overridden with the
+ FC_CONFIG_DIR environment variable. */
+ (name))
+{
+ char *fcname = "";
+
+ if (!NILP (name))
+ {
+ CHECK_STRING (name);
+ /* #### FIXME! is this really Qnative? */
+ fcname = NEW_LISP_STRING_TO_EXTERNAL (name, Qnative);
+ }
+ return (build_fcapi_string (FcConfigFilename ((FcChar8 *) fcname)));
+}
+
+DEFUN("fc-init-load-config", Ffc_init_load_config, 0, 0, 0, /*
+ -- Function: FcConfig *FcInitLoadConfig (void)
+ Loads the default configuration file and returns the resulting
+ configuration. Does not load any font information. */
+ ())
+{
+ return fc_config_create_using (&FcInitLoadConfig);
+}
+
+DEFUN("fc-init-load-config-and-fonts", Ffc_init_load_config_and_fonts, 0, 0, 0, /*
+ -- Function: FcConfig *FcInitLoadConfigAndFonts (void)
+ Loads the default configuration file and builds information about
+ the available fonts. Returns the resulting configuration. */
+ ())
+{
+ return fc_config_create_using (&FcInitLoadConfigAndFonts);
+}
+
+DEFUN("fc-init", Ffc_init, 0, 0, 0, /*
+ -- Function: FcBool FcInit (void)
+ Loads the default configuration file and the fonts referenced
+ therein and sets the default configuration to that result.
+ Returns whether this process succeeded or not. If the default
+ configuration has already been loaded, this routine does nothing
+ and returns FcTrue. */
+ ())
+{
+ return (FcInit () == FcTrue) ? Qt : Qnil;
+}
+
+DEFUN("fc-get-version", Ffc_get_version, 0, 0, 0, /*
+ -- Function: int FcGetVersion (void)
+ Returns the version number of the library.
+ XEmacs: No, this should NOT return a pretty string.
+ (let ((i (fc-get-version)))
+ (format "%d.%d.%d" (/ i 10000) (mod (/ i 100) 100) (mod i 100)))
+ gives the usual x.y.z format. */
+ ())
+{
+ return make_int (FcGetVersion ());
+}
+
+DEFUN("fc-init-reinitialize", Ffc_init_reinitialize, 0, 0, 0, /*
+ -- Function: FcBool FcInitReinitialize (void)
+ Forces the default configuration file to be reloaded and resets
+ the default configuration. */
+ ())
+{
+ return (FcInitReinitialize () == FcTrue) ? Qt : Qnil;
+}
+
+DEFUN("fc-init-bring-up-to-date", Ffc_init_bring_up_to_date, 0, 0, 0, /*
+ -- Function: FcBool FcInitBringUptoDate (void)
+ Checks the rescan interval in the default configuration, checking
+ the configuration if the interval has passed and reloading the
+ configuration when any changes are detected. */
+ ())
+{
+ return (FcInitBringUptoDate () == FcTrue) ? Qt : Qnil;
+}
+
+#endif /* FONTCONFIG_EXPOSE_CONFIG */
+
DEFUN("xlfd-font-name-p", Fxlfd_font_name_p, 1, 1, 0, /*
Check whether the string FONTNAME is a XLFD font name. */
(fontname))
＠＠ -764,6 +1219,40 ＠＠
DEFSUBR(Ffc_font_sort);
DEFSUBR(Ffc_font_match);
DEFSUBR(Fxlfd_font_name_p);
+
+#ifdef FONTCONFIG_EXPOSE_CONFIG
+ INIT_LRECORD_IMPLEMENTATION(fc_config);
+
+ DEFSYMBOL_MULTIWORD_PREDICATE(Qfc_configp);
+
+ DEFSUBR(Ffc_config_p);
+ DEFSUBR(Ffc_config_create);
+#if 0
+ DEFSUBR(Ffc_config_destroy);
+#endif
+ DEFSUBR(Ffc_config_set_current);
+ DEFSUBR(Ffc_config_get_current);
+ DEFSUBR(Ffc_config_up_to_date);
+ DEFSUBR(Ffc_config_build_fonts);
+ DEFSUBR(Ffc_config_get_config_dirs);
+ DEFSUBR(Ffc_config_get_font_dirs);
+ DEFSUBR(Ffc_config_get_config_files);
+ DEFSUBR(Ffc_config_get_cache);
+ DEFSUBR(Ffc_config_get_fonts);
+ DEFSUBR(Ffc_config_get_blanks);
+ DEFSUBR(Ffc_config_get_rescan_interval);
+ DEFSUBR(Ffc_config_set_rescan_interval);
+ DEFSUBR(Ffc_config_app_font_add_file);
+ DEFSUBR(Ffc_config_app_font_add_dir);
+ DEFSUBR(Ffc_config_app_font_clear);
+ DEFSUBR(Ffc_config_filename);
+ DEFSUBR(Ffc_init_load_config);
+ DEFSUBR(Ffc_init_load_config_and_fonts);
+ DEFSUBR(Ffc_init);
+ DEFSUBR(Ffc_get_version);
+ DEFSUBR(Ffc_init_reinitialize);
+ DEFSUBR(Ffc_init_bring_up_to_date);
+#endif /* FONTCONFIG_EXPOSE_CONFIG */
}
void
＠＠ -791,6 +1280,11 ＠＠
void
complex_vars_of_font_mgr (void)
{
+#ifdef FONTCONFIG_EXPOSE_CONFIG
+ Vfc_config_weak_list = make_weak_list (WEAK_LIST_SIMPLE);
+ staticpro (&Vfc_config_weak_list);
+#endif
+
DEFVAR_LISP("xft-xlfd-font-regexp", &Vxlfd_font_name_regexp /*
The regular expression used to match XLFD font names. */
);
Index: src/font-mgr.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/font-mgr.h,v
retrieving revision 1.5
diff -u -u -r1.5 font-mgr.h
--- src/font-mgr.h 7 Nov 2006 15:58:24 -0000 1.5
+++ src/font-mgr.h 14 Apr 2007 16:19:07 -0000
＠＠ -68,6 +68,27 ＠＠
#define CONCHECK_FCPATTERN(x) CONCHECK_RECORD (x, fc_pattern)
#define XFCPATTERN_PTR(x) (XFCPATTERN(x)->fcpatPtr)
+#define FONTCONFIG_EXPOSE_CONFIG
+#ifdef FONTCONFIG_EXPOSE_CONFIG
+
+struct fc_config
+{
+ struct LCRECORD_HEADER header;
+ FcConfig *fccfgPtr;
+};
+
+typedef struct fc_config fc_config;
+
+DECLARE_LRECORD(fc_config, struct fc_config);
+#define XFCCONFIG(x) XRECORD (x, fc_config, struct fc_config)
+#define wrap_fcconfig(p) wrap_record (p, fc_config)
+#define FCCONFIGP(x) RECORDP (x, fc_config)
+#define CHECK_FCCONFIG(x) CHECK_RECORD (x, fc_config)
+#define CONCHECK_FCCONFIG(x) CONCHECK_RECORD (x, fc_config)
+#define XFCCONFIG_PTR(x) (XFCCONFIG(x)->fccfgPtr)
+
+#endif /* FONTCONFIG_EXPOSE_CONFIG */
+
#ifdef USE_XFT
/*
The format of a fontname (as returned by fontconfig) is not well-documented,
Index: src/lrecord.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lrecord.h,v
retrieving revision 1.47
diff -u -u -r1.47 lrecord.h
--- src/lrecord.h 27 Feb 2006 16:29:27 -0000 1.47
+++ src/lrecord.h 14 Apr 2007 16:19:08 -0000
＠＠ -211,6 +211,7 ＠＠
};
#endif /* not NEW_GC */
+/* DON'T FORGET to update .gdbinit.in if you change this list. */
enum lrecord_type
{
/* Symbol value magic types come first to make SYMBOL_VALUE_MAGIC_P fast.
＠＠ -279,6 +280,7 ＠＠
lrecord_type_image_instance,
lrecord_type_glyph,
lrecord_type_face,
+ lrecord_type_fc_config,
lrecord_type_fc_pattern,
lrecord_type_database,
lrecord_type_tooltalk_message,
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 4 participants
- 4 comments
[AC21.5] Typo fix in internals.texi
17 years, 8 months
Stephen J. Turnbull
Stephen J. Turnbull
APPROVE COMMIT 21.5
2007-04-30 Stephen J. Turnbull <stephen(a)xemacs.org>
* internals/internals.texi (Creating a New Console/Device/Frame Type):
Typo fix.
Index: man/internals/internals.texi
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/man/internals/internals.texi,v
retrieving revision 1.78
diff -u -u -r1.78 internals.texi
--- man/internals/internals.texi 1 Jan 2007 10:04:13 -0000 1.78
+++ man/internals/internals.texi 30 Apr 2007 13:48:14 -0000
＠＠ -17540,7 +17540,7 ＠＠
do with Lisp objects and little to do with redisplay, respectively.
Rather they implement abstractions used for rendering on each console
type, such as fonts and colors (＠file{objects}) and string and graphics
-drawing primitives (＠file{rendering}). These modules are conceptually
+drawing primitives (＠file{redisplay}). These modules are conceptually
part of the console implementations, not part of redisplay or Lisp.
Public methods of a console are implemented as C functions declared
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[AC] whitespace.el upgrade
17 years, 8 months
Didier Verna
Didier Verna
NOTE: This patch has been committed. The version below is
informational only (whitespace differences have been removed).
Dear reviewers,
this is my upgrade of whitespace.el.
xemacs-packages/text-modes/ChangeLog addition:
2007-04-30 Didier Verna <didier(a)xemacs.org>
* whitespace.el: Doc update.
* whitespace.el (whitespace-version): Increase to 2.3.
* whitespace.el (cl): Require it.
* whitespace.el (whitespace-checks-custom-type): New.
* whitespace.el (whitespace-modes): Use it.
* whitespace.el (whitespace-files): New user option.
* whitespace.el (whitespace-check-whitespace-mode): Handle it.
XEmacs Packages source patch:
Diff command: cvs -q diff -u -t -b -B -w
Files affected: xemacs-packages/text-modes/whitespace.el
Index: xemacs-packages/text-modes/whitespace.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/text-modes/whitespace.el,v
retrieving revision 1.3
diff -u -u -t -b -B -w -r1.3 whitespace.el
--- xemacs-packages/text-modes/whitespace.el 25 Mar 2005 17:09:08 -0000 1.3
+++ xemacs-packages/text-modes/whitespace.el 30 Apr 2007 15:47:08 -0000
＠＠ -1,11 +1,12 ＠＠
;;; whitespace.el --- warn about and clean bogus whitespaces in the file
-;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2007 Free Software Foundation, Inc.
;; Author: Rajesh Vaidheeswarran <rv(a)gnu.org>
+;; Maintainer: Didier Verna <didier(a)xemacs.org>
;; Keywords: convenience
-;; $Id: whitespace.el,v 1.2 2005/02/09 23:39:13 scop Exp $
+;; $Id: whitespace.el,v 1.3 2005/03/25 17:09:08 aidan Exp $
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
＠＠ -23,21 +24,26 ＠＠
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Synched up with: FSF 21.3.
+;;; Synched up with: not synched with FSF.
;;; Commentary:
-;; Whitespace.el URL: http://www.dsmit.com/lisp/
+;; #### NOTE: this version is outdated -- dvl
+;; Whitespace.el URL: http://www.dsmit.com/lisp/whitespace.el
-;; The whitespace library is intended to find and help fix five different types
-;; of whitespace problems that commonly exist in source code.
-;; 1. Leading space (empty lines at the top of a file).
-;; 2. Trailing space (empty lines at the end of a file).
-;; 3. Indentation space (8 or more spaces at beginning of line, that should be
-;; replaced with TABS).
-;; 4. Spaces followed by a TAB. (Almost always, we never want that).
-;; 5. Spaces or TABS at the end of a line.
+;; Description:
+;; ============
+
+;; The whitespace library is intended to find and help fix the following five
+;; different types of whitespace problems that commonly exist in source code.
+
+;; 1. Leading space: empty lines at the top of a file, that should be removed.
+;; 2. Trailing space: empty lines at the end of a file, that should be removed.
+;; 3. Indentation space: 8 or more spaces at beginning of line, that should be
+;; replaced with TABS.
+;; 4. Spaces followed by a TAB, that should be replaced by TABS.
+;; 5. Spaces or TABS at the end of a line, that should be removed.
;; Whitespace errors are reported in a buffer, and on the modeline.
＠＠ -53,10 +59,10 ＠＠
;; If any of the whitespace checks is turned off, the modeline will display a
;; !<y>.
-;; (since (3) is the most controversial one, here is the rationale: Most
+;; (since (3) is the most controversial one, here is the rationale: most
;; terminal drivers and printer drivers have TAB configured or even
-;; hardcoded to be 8 spaces. (Some of them allow configuration, but almost
-;; always they default to 8.)
+;; hardcoded to be 8 spaces. Some of them allow configuration, but almost
+;; always they default to 8.
;; Changing `tab-width' to other than 8 and editing will cause your code to
;; look different from within Emacs, and say, if you cat it or more it, or
＠＠ -74,24 +80,49 ＠＠
;; All the above have caused (and will cause) unwanted codeline integration and
;; merge problems.
-;; whitespace.el will complain if it detects whitespaces on opening a file, and
-;; warn you on closing a file also (in case you had inserted any
-;; whitespaces during the process of your editing).
-
-;; Exported functions:
-
-;; `whitespace-buffer' - To check the current buffer for whitespace problems.
-;; `whitespace-cleanup' - To cleanup all whitespaces in the current buffer.
-;; `whitespace-region' - To check between point and mark for whitespace
-;; problems.
-;; `whitespace-cleanup-region' - To cleanup all whitespaces between point
-;; and mark in the current buffer.
+
+;; Usage:
+;; ======
+
+;; Selecting which files / buffers to check:
+;; -----------------------------------------
+;; Whitespace decides whether to perform on a per-file, then per-mode basis.
+;; See the user options `whitespace-files' and `whitespace-modes' for more
+;; information.
+
+;; Checking files / buffers:
+;; -------------------------
+;; Use the functions `whitespace-buffer' or `whitespace-region' to perform
+;; checking. If the user option `whitespace-auto-cleanup' is set, checking for
+;; whitespace problems will also immediately trigger cleanup.
+
+;; Fixing whitespace problems:
+;; ---------------------------
+;; Use the functions `whitespace-cleanup' or `whitespace-cleanup-region' to
+;; cleanup whitespaces.
+
+;; Automatic whitespace checking / cleaning:
+;; -----------------------------------------
+;; To check (and possibly fix if `whitespace-auto-cleanup' is set) whitespace
+;; problems automatically on new buffers, you can turn
+;; `whitespace-global-mode' on.
+;;
+;; To check (and possibly fix if `whitespace-auto-cleanup' is set) whitespace
+;; problems automatically but only when saving buffers, you can add the
+;; function `whitespace-write-file-hook' to your `write-file-hooks'.
+
+;; There are others things that are customizable. The best thing to do in
+;; order to get an idea is to customize the whitespace group and see what's in
+;; it.
+
;;; Code:
+(require 'cl)
+
(eval-when-compile (require 'easy-mmode))
-(defvar whitespace-version "3.2" "Version of the whitespace library.")
+(defvar whitespace-version "3.3" "Version of the whitespace library.")
(defvar whitespace-all-buffer-files nil
"An associated list of buffers and files checked for whitespace cleanliness.
＠＠ -227,7 +258,6 ＠＠
:type 'boolean
:group 'whitespace)
-;; (defcustom whitespace-ateol-regexp "[ \t]$"
(defcustom whitespace-ateol-regexp "[ \t]+$"
"Regexp to match a TAB or a space at the EOL."
:type 'regexp
＠＠ -259,6 +289,49 ＠＠
:type 'boolean
:group 'whitespace)
+(defconst whitespace-checks-custom-type
+ '(repeat :inline t :tag "Checks"
+ (choice :inline t
+ (list :inline t :tag "Leading"
+:format "%{%t%}: %v"
+ (const :tag "" :value leading)
+ boolean)
+ (list :inline t :tag "Trailing"
+:format "%{%t%}: %v"
+ (const :tag "" :value trailing)
+ boolean)
+ (list :inline t :tag "Indent"
+:format "%{%t%}: %v"
+ (const :tag "" :value indent)
+ boolean)
+ (list :inline t :tag "Space Tab"
+:format "%{%t%}: %v"
+ (const :tag "" :value spacetab)
+ boolean)
+ (list :inline t :tag "At EOL"
+:format "%{%t%}: %v"
+ (const :tag "" :value ateol)
+ boolean)))
+ ;; Custom type for check options used both in `whitespace-files' and
+ ;; `whitespace-modes'.
+ )
+
+(defcustom whitespace-files nil
+ "Files in which we turn on whitespace checking.
+
+Each entry is either a regexp matching the file name,
+or looks like (REGEXP CHECK t|nil ...).
+CHECK is one of 'leading, 'trailing, 'indent, 'spacetab or 'ateol.
+Checks not specified will inherit from the default value.
+
+See also \`whitespace-check-whitespace-mode'."
+:type `(repeat
+ (choice (regexp :tag "File Name Matching")
+ (group :value ("")
+ (regexp :tag "File Name Matching")
+ ,whitespace-checks-custom-type)))
+:group 'whitespace)
+
(defcustom whitespace-modes '(ada-mode asm-mode autoconf-mode awk-mode
c-mode c++-mode cc-mode
change-log-mode cperl-mode
＠＠ -271,20 +344,23 ＠＠
pascal-mode perl-mode prolog-mode
python-mode scheme-mode sgml-mode
sh-mode shell-script-mode simula-mode
- tcl-mode tex-mode texinfo-mode
+ tcl-mode tex-mode
+ (texinfo-mode indent nil spacetab nil)
vrml-mode xml-mode)
"Major Modes in which we turn on whitespace checking.
-These are mostly programming and documentation modes. But you may add other
-modes that you want whitespaces checked in by adding something like the
-following to your `.emacs':
-
-\(setq whitespace-modes (cons 'my-mode (cons 'my-other-mode
- whitespace-modes))\)
-
-Or, alternately, you can use the Emacs `customize' command to set this."
-:type '(repeat symbol)
+Each entry is either a symbol corresponding to a major mode,
+or looks like (SYMBOL CHECK t|nil ...).
+CHECK is one of 'leading, 'trailing, 'indent, 'spacetab or 'ateol.
+Checks not specified will inherit from the default value.
+
+See also \`whitespace-check-whitespace-mode'."
+:type `(repeat
+ (choice (symbol :tag "Major Mode")
+ (group :value (fundamental)
+ (symbol :tag "Major Mode")
+ ,whitespace-checks-custom-type)))
:group 'whitespace)
(defcustom whitespace-rescan-timer-time 600
＠＠ -343,13 +419,37 ＠＠
(set-default 'whitespace-check-buffer-ateol
whitespace-check-ateol-whitespace)
-(defun whitespace-check-whitespace-mode (&optional arg)
- "Test and set the whitespace-mode in qualifying buffers."
- (if (null whitespace-mode)
- (setq whitespace-mode
- (if (or arg (member major-mode whitespace-modes))
- t
- nil))))
+(defun whitespace-check-whitespace-mode (&optional force)
+ "Test and set the whitespace-mode in \"qualifying\" buffers.
+A buffer qualifies if its file name matches something in
+\`whitespace-files', or if its major mode matches something in
+\`whitespace-modes'."
+ (when (null whitespace-mode)
+ (if force
+ (setq whitespace-mode t)
+ (let (behavior)
+ (setq behavior (or
+ (find-if
+ #'(lambda (item)
+ (string-match (if (stringp item) item (car item))
+ (buffer-file-name)))
+ whitespace-files)
+ (find-if
+ #'(lambda (item)
+ (eq (if (symbolp item) item (car item))
+ major-mode))
+ whitespace-modes)))
+ (when behavior
+ (setq whitespace-mode t)
+ (when (listp behavior)
+ (pop behavior)
+ (when behavior
+ (let (symbol)
+ (while (setq symbol (pop behavior))
+ (set (intern (concat "whitespace-check-buffer-"
+ (symbol-name symbol)))
+ (pop behavior)))))))))))
+
;;;###autoload
(defun whitespace-toggle-leading-check ()
--
Read the Jazz Blog !! http://jazzblog.didierverna.com
Didier Verna, didier(a)lrde.epita.fr, http://www.lrde.epita.fr/~didier
EPITA / LRDE, 14-16 rue Voltaire Tel.+33 (1) 44 08 01 85
94276 Le Kremlin-Bicêtre, France Fax.+33 (1) 53 14 59 22 didier(a)xemacs.org
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[PATCH] Support non-BMP UTF-16.
17 years, 8 months
Aidan Kehoe
Aidan Kehoe
src/ChangeLog addition:
2007-04-30 Aidan Kehoe <kehoea(a)parhasard.net>
* unicode.c:
* unicode.c (encode_unicode_char_1):
* unicode.c (unicode_convert):
Support non-BMP characters in UTF-16.
tests/ChangeLog addition:
2007-04-30 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/mule-tests.el (featurep):
Minimal tests of the non-BMP UTF-16 support.
XEmacs Trunk source patch:
Diff command: cvs -q diff -Nu
Files affected: tests/automated/mule-tests.el
===================================================================
RCS src/unicode.c
===================================================================
RCS
Index: src/unicode.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/unicode.c,v
retrieving revision 1.36
diff -u -u -r1.36 unicode.c
--- src/unicode.c 2006/12/29 18:09:51 1.36
+++ src/unicode.c 2007/04/30 13:51:00
＠＠ -200,6 +200,28 ＠＠
Lisp_Object Qutf_8_bom;
+/* See the Unicode FAQ, http://www.unicode.org/faq/utf_bom.html#35 for this
+ algorithm.
+
+ (They also give another, really verbose one, as part of their explanation
+ of the various planes of the encoding, but we won't use that.) */
+
+#define UTF_16_LEAD_OFFSET (0xD800 - (0x10000 >> 10))
+#define UTF_16_SURROGATE_OFFSET (0x10000 - (0xD800 << 10) - 0xDC00)
+
+#define utf_16_surrogates_to_code(lead, trail) \
+ (((lead) << 10) + (trail) + UTF_16_SURROGATE_OFFSET)
+
+#define CODE_TO_UTF_16_SURROGATES(codepoint, lead, trail) do { \
+ int __ctu16s_code = (codepoint); \
+ lead = UTF_16_LEAD_OFFSET + (__ctu16s_code >> 10); \
+ trail = 0xDC00 + (__ctu16s_code & 0x3FF); \
+} while (0)
+
+#define valid_utf_16_first_surrogate(ch) (((ch) & 0xFC00) == 0xD800)
+#define valid_utf_16_last_surrogate(ch) (((ch) & 0xFC00) == 0xDC00)
+#define valid_utf_16_surrogate(ch) (((ch) & 0xF800) == 0xD800)
+
#ifdef MULE
/* Using ints for to_unicode is OK (as long as they are >= 32 bits).
＠＠ -1742,13 +1764,39 ＠＠
case UNICODE_UTF_16:
if (little_endian)
{
- Dynarr_add (dst, (unsigned char) (code & 255));
- Dynarr_add (dst, (unsigned char) ((code >> 8) & 255));
+ if (code < 0x10000) {
+ Dynarr_add (dst, (unsigned char) (code & 255));
+ Dynarr_add (dst, (unsigned char) ((code >> 8) & 255));
+ } else {
+ /* Little endian; least significant byte first. */
+ int first, second;
+
+ CODE_TO_UTF_16_SURROGATES(code, first, second);
+
+ Dynarr_add (dst, (unsigned char) (first & 255));
+ Dynarr_add (dst, (unsigned char) ((first >> 8) & 255));
+
+ Dynarr_add (dst, (unsigned char) (second & 255));
+ Dynarr_add (dst, (unsigned char) ((second >> 8) & 255));
+ }
}
else
{
- Dynarr_add (dst, (unsigned char) ((code >> 8) & 255));
- Dynarr_add (dst, (unsigned char) (code & 255));
+ if (code < 0x10000) {
+ Dynarr_add (dst, (unsigned char) ((code >> 8) & 255));
+ Dynarr_add (dst, (unsigned char) (code & 255));
+ } else {
+ /* Big endian; most significant byte first. */
+ int first, second;
+
+ CODE_TO_UTF_16_SURROGATES(code, first, second);
+
+ Dynarr_add (dst, (unsigned char) ((first >> 8) & 255));
+ Dynarr_add (dst, (unsigned char) (first & 255));
+
+ Dynarr_add (dst, (unsigned char) ((second >> 8) & 255));
+ Dynarr_add (dst, (unsigned char) (second & 255));
+ }
}
break;
＠＠ -1919,17 +1967,40 ＠＠
break;
case UNICODE_UTF_16:
+
if (little_endian)
ch = (c << counter) | ch;
else
ch = (ch << 8) | c;
counter += 8;
+
+ if (counter == 16 && valid_utf_16_first_surrogate(ch))
+ break;
+
if (counter == 16)
{
int tempch = ch;
ch = 0;
counter = 0;
decode_unicode_char (tempch, dst, data, ignore_bom);
+ }
+ if (counter == 32)
+ {
+ int tempch;
+ /* #### Signalling an error may be a bit extreme. Should
+ we try and read it in anyway? */
+ if (!valid_utf_16_first_surrogate(ch >> 16)
+ || !valid_utf_16_last_surrogate(ch & 0xFFFF))
+ {
+ signal_error(Qtext_conversion_error,
+ "Invalid UTF-16 surrogate sequence",
+ Qunbound);
+ }
+ tempch = utf_16_surrogates_to_code((ch >> 16),
+ (ch & 0xffff));
+ ch = 0;
+ counter = 0;
+ decode_unicode_char(tempch, dst, data, ignore_bom);
}
break;
Index: tests/automated/mule-tests.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/tests/automated/mule-tests.el,v
retrieving revision 1.14
diff -u -u -r1.14 mule-tests.el
--- tests/automated/mule-tests.el 2007/04/29 13:20:00 1.14
+++ tests/automated/mule-tests.el 2007/04/30 13:51:00
＠＠ -339,9 +339,9 ＠＠
'utf-8
'iso-8859-2))
)
- ;; This is how you suppress output from `message', called by `write-region'
(Assert (not (equal name1 name2)))
(Assert (not (file-exists-p name1)))
+ ;; This is how you suppress output from `message', called by `write-region'
(Silence-Message
(write-region (point-min) (point-max) name1))
(Assert (file-exists-p name1))
＠＠ -399,6 +399,14 ＠＠
(Assert (equal (concat "\033%G" utf-8-char)
(encode-coding-string xemacs-character 'ctext))))))
+ (loop
+ for (code-point encoded)
+ in '((#x10000 "\xd8\x00\xdc\x00")
+ (#x10FFFD "\xdb\xff\xdf\xfd"))
+ do (Assert (equal (encode-coding-string
+ (decode-char 'ucs code-point) 'utf-16)
+ encoded)))
+
;;---------------------------------------------------------------
;; Regression test for a couple of CCL-related bugs.
;;---------------------------------------------------------------
--
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] Make the charsets-in-region algorithm irrelevant, mule-tests.el
17 years, 8 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
tests/ChangeLog addition:
2007-04-29 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/mule-tests.el (featurep):
Sort the results of charsets-in-region, charsets-in-string before
comparing them to the previously-determined list of character
sets. Eliminates a dependency on the algorithm
charsets-in-{region,string} uses.
XEmacs Trunk source patch:
Diff command: cvs -q diff -Nu
Files affected: tests/automated/mule-tests.el
===================================================================
RCS
cvs server: cannot find modules/ldap/configure
Index: tests/automated/mule-tests.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/tests/automated/mule-tests.el,v
retrieving revision 1.13
diff -u -u -r1.13 mule-tests.el
--- tests/automated/mule-tests.el 2006/11/25 22:06:34 1.13
+++ tests/automated/mule-tests.el 2007/04/29 13:10:50
＠＠ -446,22 +446,23 ＠＠
;;---------------------------------------------------------------
(with-temp-buffer
(insert-file-contents (locate-data-file "HELLO"))
- ;; #### rewrite robustly, both assume that the tested implementation
- ;; uses the same algorithm as was used by the version current at time
- ;; this test was written
- (Assert (equal (charsets-in-region (point-min) (point-max))
- '(korean-ksc5601 chinese-big5-1 chinese-gb2312
- japanese-jisx0212 katakana-jisx0201 japanese-jisx0208
- vietnamese-viscii-lower thai-xtis cyrillic-iso8859-5
- hebrew-iso8859-8 greek-iso8859-7 latin-iso8859-1
- latin-iso8859-2 arabic-2-column arabic-1-column
- ethiopic ascii)))
- (Assert (equal (charsets-in-string (buffer-substring (point-min)
+ (Assert (equal
+ ;; The sort is to make the algorithm of charsets-in-region
+ ;; irrelevant.
+ (sort (charsets-in-region (point-min) (point-max))
+ 'string<)
+ '(arabic-1-column arabic-2-column ascii chinese-big5-1
+ chinese-gb2312 cyrillic-iso8859-5 ethiopic greek-iso8859-7
+ hebrew-iso8859-8 japanese-jisx0208 japanese-jisx0212
+ katakana-jisx0201 korean-ksc5601 latin-iso8859-1
+ latin-iso8859-2 thai-xtis vietnamese-viscii-lower)))
+ (Assert (equal
+ (sort (charsets-in-string (buffer-substring (point-min)
(point-max)))
- '(korean-ksc5601 chinese-big5-1 chinese-gb2312
- japanese-jisx0212 katakana-jisx0201 japanese-jisx0208
- vietnamese-viscii-lower thai-xtis cyrillic-iso8859-5
- hebrew-iso8859-8 greek-iso8859-7 latin-iso8859-1
- latin-iso8859-2 arabic-2-column arabic-1-column
- ethiopic ascii))))
+ 'string<)
+ '(arabic-1-column arabic-2-column ascii chinese-big5-1
+ chinese-gb2312 cyrillic-iso8859-5 ethiopic greek-iso8859-7
+ hebrew-iso8859-8 japanese-jisx0208 japanese-jisx0212
+ katakana-jisx0201 korean-ksc5601 latin-iso8859-1
+ latin-iso8859-2 thai-xtis vietnamese-viscii-lower))))
)
--
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] Don't try to manipulate XFT fonts on a mswindows device, Cygwin
17 years, 8 months
Aidan Kehoe
Aidan Kehoe
Starting a Cygwin XEmacs built with XFT support without setting DISPLAY
aborts with a backtrace, as a result of Face-frob-property calling the X11
frobbing functions with a mswindows device and the XFT libraries objecting
to that, quite reasonably. With server-side font support, x-make-font-bold
and friends silently accept a mswindows-device, and that’s why this problem
wasn’t seen previously.
There are other functions that accept CURRENT-DEVICE and that don’t seem to
be quite sane in their treatment of it, but I’m not going to look into them
right now.
lisp/ChangeLog addition:
2007-04-22 Aidan Kehoe <kehoea(a)parhasard.net>
* specifier.el (device-type-matches-spec):
Add `msprinter' to the type of devices that are not window
systems.
* specifier.el (derive-device-type-from-tag-set):
Remove a superflous empty line.
* specifier.el (derive-device-type-from-locale-and-tag-set):
If CURRENT-DEVICE is provided, only ever return its type (if it
matches TAG-SET) or nil (if it doesn't).
XEmacs Trunk source patch:
Diff command: cvs -q diff -Nu
Files affected: lisp/specifier.el
===================================================================
RCS
Index: lisp/specifier.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/specifier.el,v
retrieving revision 1.15
diff -u -u -r1.15 specifier.el
--- lisp/specifier.el 2005/11/13 07:39:28 1.15
+++ lisp/specifier.el 2007/04/22 14:50:59
＠＠ -739,7 +739,7 ＠＠
;; OK), or `window-system' -- window system device types OK.
(cond ((not devtype-spec) devtype)
((eq devtype-spec 'window-system)
- (and (not (memq devtype '(tty stream))) devtype))
+ (and (not (memq devtype '(msprinter tty stream))) devtype))
(t (and (eq devtype devtype-spec) devtype))))
(defun add-tag-to-inst-list (inst-list tag-set)
＠＠ -815,7 +815,10 ＠＠
devtype-spec current-device)
"Given a tag set, try (heuristically) to get a device type from it.
-There are three stages that this function proceeds through, each one trying
+If CURRENT-DEVICE is supplied, then this function either returns its type,
+in the event that it matches TAG-SET, or nil.
+
+Otherwise, there are three stages that it proceeds through, each one trying
harder than the previous to get a value. TRY-STAGES controls how many
stages to try. If nil or 1, only stage 1 is done; if 2; stages 1 and 2 are
done; if 3, stages 1-3 are done; if t, all stages are done (currently 1-3).
＠＠ -847,39 +850,48 ＠＠
(if (eq try-stages t) (setq try-stages 3))
(check-argument-range try-stages 1 3)
(flet ((delete-wrong-type (x)
- (delete-if-not
- #'(lambda (y)
- (device-type-matches-spec y devtype-spec))
- x)))
- (let ((both (intersection (device-type-list)
- (canonicalize-tag-set tag-set))))
+ (delete-if-not
+ #'(lambda (y)
+ (device-type-matches-spec y devtype-spec))
+ x)))
+ (let ((both (intersection
+ (if current-device
+ (list (device-type current-device))
+ (device-type-list))
+ (canonicalize-tag-set tag-set))))
;; shouldn't be more than one (will fail), but whatever
(if both (first (delete-wrong-type both))
- (and (>= try-stages 2)
- ;; no device types mentioned. try the hard way,
- ;; i.e. check each existing device to see if it will
- ;; pass muster.
- (let ((okdevs
- (delete-wrong-type
- (delete-duplicates
- (mapcan
- #'(lambda (dev)
- (and (device-matches-specifier-tag-set-p
- dev tag-set)
- (list (device-type dev))))
- (device-list)))))
- (devtype (cond ((or (null devtype-spec)
- (eq devtype-spec 'window-system))
- (let ((dev (derive-domain-from-locale
- 'global devtype-spec
- current-device)))
- (and dev (device-type dev))))
- (t devtype-spec))))
- (cond ((= 1 (length okdevs)) (car okdevs))
- ((< try-stages 3) nil)
- ((null okdevs) devtype)
- ((memq devtype okdevs) devtype)
- (t (car okdevs)))))))))
+ (and (>= try-stages 2)
+ ;; no device types mentioned. try the hard way,
+ ;; i.e. check each existing device (or the
+ ;; supplied device) to see if it will pass muster.
+ ;;
+ ;; Further checking is not relevant if current-device was
+ ;; supplied.
+ (not current-device)
+ (let ((okdevs
+ (delete-wrong-type
+ (delete-duplicates
+ (mapcan
+ #'(lambda (dev)
+ (and (device-matches-specifier-tag-set-p
+ dev tag-set)
+ (list (device-type dev))))
+ (if current-device
+ (list current-device)
+ (device-list))))))
+ (devtype (cond ((or (null devtype-spec)
+ (eq devtype-spec 'window-system))
+ (let ((dev (derive-domain-from-locale
+ 'global devtype-spec
+ current-device)))
+ (and dev (device-type dev))))
+ (t devtype-spec))))
+ (cond ((= 1 (length okdevs)) (car okdevs))
+ ((< try-stages 3) nil)
+ ((null okdevs) devtype)
+ ((memq devtype okdevs) devtype)
+ (t (car okdevs)))))))))
;; Sheesh, the things you do to get "intuitive" behavior.
(defun derive-device-type-from-locale-and-tag-set (locale tag-set
＠＠ -895,7 +907,6 ＠＠
type from the tag set.
DEVTYPE-SPEC and CURRENT-DEVICE as in `derive-domain-from-locale'."
-
(cond ((valid-specifier-domain-p locale)
;; if locale is a domain, then it must match DEVTYPE-SPEC,
;; or we exit immediately with nil.
--
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
Re: [Q] Re: [21.5] Implement FcConfig handling (95%)
17 years, 8 months
Aidan Kehoe
Aidan Kehoe
Ar an ceathrú lá is fiche de mí Aibréan, scríobh Stephen J. Turnbull:
> Aidan Kehoe writes:
>
> > I now have a Mac, so I’ll get to implementing the
> > Qfile_name-is-always-UTF-8 semantics there soon,
>
> AFAIK this just involves adding another row to the table of platforms
> with special needs in Mule initialization. Don't *enforce* the
> semantics of "always", because there are exceptions.
You mean people mounting Fat 32 drives with unspecified file name coding
systems? Or are there others?
> > since the system normalises text as needed and we don’t have to
> > (though we should :-/ ).
>
> What do you mean, we "should" normalize? Normalization is an
> optimization. We should recognize all equivalent forms as equivalent,
To do that, we need to normalise. Recognising that "/tmp/aidan/äargh" and
"/tmp/aidan/äargh" are the same file can’t be done without it.
> but we can leave the actual normalization to those systems that do
> normalization AFAICS.
Yeah, Apple have done a pretty sane implementation there, thankfully.
> We should be *able* to normalize for the purpose of communicating with
> non-conforming systems, of course, but that is not trivial to
> implement portably.
--
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
Re: [Q] Re: [21.5] Implement FcConfig handling (95%)
17 years, 8 months
Aidan Kehoe
Aidan Kehoe
Ar an ceathrú lá is fiche de mí Aibréan, scríobh Stephen J. Turnbull:
> > > + CHECK_STRING (file);
> > > + if (FcConfigAppFontAddFile
> > > + (XFCCONFIG_PTR (config),
> > > + /* #### FIXME! is this really Qnative? */
> >
> > It appears to be--Google Code search is really useful for checking this,
> > http://www.google.com/codesearch .
>
> I'm not confident that we can't get hosed by LANG, etc.
Actually, Qfile_name would be better.
Well, we can get as hosed by LANG as the rest of the treatment of the file
system name encoding can. Which is to say, if that happens, we need to fix
the locale sniffing in mule-cmds.el.
I’m writing this on a Mac, so I intend pretty soon to implement behaviour
such that when (eq system-type 'darwin), Qfile_name is unconditionally
UTF-8. Happily, the file system does normalisation when passed
non-normalised names, at least when creating new files and opening existing
ones. Though we need to implement normalisation anyway.
--
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
Re: [Q] Re: [21.5] Implement FcConfig handling (95%)
17 years, 8 months
Aidan Kehoe
Aidan Kehoe
Ar an ceathrú lá is fiche de mí Aibréan, scríobh Stephen J. Turnbull:
> > + CHECK_STRING (file);
> > > + if (FcConfigAppFontAddFile
> > > + (XFCCONFIG_PTR (config),
> > > + /* #### FIXME! is this really Qnative? */
> >
> > It appears to be--Google Code search is really useful for checking this,
> > http://www.google.com/codesearch .
>
> I'm not confident that we can't get hosed by LANG, etc.
We can of course get hosed by LANG on most Unixes, but not more than the
rest of the file name handling. Anyway, I’ve changed my opinion--it should
be Qfile_name. Which is normally an alias to Qnative anyway, but using it
instead seems like a sensible idea.
I now have a Mac, so I’ll get to implementing the Qfile_name-is-always-UTF-8
semantics there soon, since the system normalises text as needed and we
don’t have to (though we should :-/ ).
--
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