[PATCH] Update man page for init file, one nroff format error
17 years, 3 months
Shyamal Prasad
Shyamal Prasad
etc/ChangeLog addition:
2004-12-03 Shyamal Prasad <shyamal(a)member.fsf.org>
* xemacs.1: Now describe $HOME/.xemacs/init.el as the
preferred init file. Fixed excessive space insertion
in the description of the '-vanilla' option
XEmacs source patch:
Diff command: cvs -q diff -u
Files affected: etc/xemacs.1
Index: etc/xemacs.1
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/etc/xemacs.1,v
retrieving revision 1.13
diff -u -r1.13 xemacs.1
--- etc/xemacs.1 2001/04/12 18:20:52 1.13
+++ etc/xemacs.1 2004/12/04 01:33:45
＠＠ -147,12 +147,7 ＠＠
.TP
.B \-vanilla
Load no extra files at startup. Equivalent to the combination of
-.B \-q
-,
-.B \-no-site-file
-, and
-.B \-no-early-packages
-\.
+.BR \-q ", " \-no-site-file ", and " \-no-early-packages .
.TP
.BI \-u " user, " \-user " user"
Load
＠＠ -628,7 +623,8 ＠＠
META-left Make a rectangular selection.
.SH FILES
Lisp code is read at startup from the user's init file,
-\fB$HOME/.emacs\fP.
+\fB$HOME/.xemacs/init.el\fP. If this file does not exist then
+\fB$HOME/.emacs\fP will be read if it is present.
/usr/local/info - files for the Info documentation browser
(a subsystem of
- 2 participants
- 1 comments
[PATCH] Synch up format-time-string % specifiers with Emacs 21.3.1
17 years, 3 months
Shyamal Prasad
Shyamal Prasad
This patch adds % specifiers to format-time-string that are missing in
XEmacs but supported by Emacs 21.3.1
src/ChangeLog addition:
2004-12-08 Shyamal Prasad <shyamal(a)member.fsf.org>
* editfns.c:
* editfns.c (Fformat_time_string):
Added documentation for %z, %g, %G and %V specifiers. This synchs
up the set of % specifiers for format-time-string with Emacs
21.3.1. Make copy of static buffer returned by localtime().
* strftime.c:
* strftime.c (strftime):
Implemented %z, %g, %G and %V in a style similar to existing
implementation of other specifiers.
XEmacs source patch:
Diff command: cvs -q diff -u
Files affected: src/strftime.c src/editfns.c
Index: src/editfns.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/editfns.c,v
retrieving revision 1.51
diff -u -r1.51 editfns.c
--- src/editfns.c 2004/12/06 03:52:03 1.51
+++ src/editfns.c 2004/12/09 02:40:17
＠＠ -1015,6 +1015,8 ＠＠
%d is replaced by the day of month, zero-padded.
%D is a synonym for "%m/%d/%y".
%e is replaced by the day of month, blank-padded.
+%G is replaced by the year containing the ISO 8601 week
+%g is replaced by the year of the ISO 8601 week within the century (00-99)
%h is a synonym for "%b".
%H is replaced by the hour (00-23).
%I is replaced by the hour (00-12).
＠＠ -1033,12 +1035,14 ＠＠
%t is a synonym for "\\t".
%T is a synonym for "%H:%M:%S".
%U is replaced by the week of the year (00-53), first day of week is Sunday.
+%V is replaced by the ISO 8601 week number
%w is replaced by the day of week (0-6), Sunday is day 0.
%W is replaced by the week of the year (00-53), first day of week is Monday.
%x is a locale-specific synonym, which defaults to "%D" in the C locale.
%X is a locale-specific synonym, which defaults to "%T" in the C locale.
%y is replaced by the year without century (00-99).
%Y is replaced by the year with century.
+%z is replaced by the time zone as a numeric offset (e.g +0530, -0800 etc.)
%Z is replaced by the time zone abbreviation.
The number of options reflects the `strftime' function.
＠＠ -1063,13 +1067,15 ＠＠
{
Extbyte *buf = alloca_extbytes (size);
Extbyte *formext;
+ /* make a copy of the static buffer returned by localtime() */
+ struct tm tm = * localtime(&value);
+
*buf = 1;
/* !!#### this use of external here is not totally safe, and
potentially data lossy. */
LISP_STRING_TO_EXTERNAL (format_string, formext, Qnative);
- if (emacs_strftime (buf, size, formext,
- localtime (&value))
+ if (emacs_strftime (buf, size, formext, &tm)
|| !*buf)
return build_ext_string (buf, Qnative);
/* If buffer was too small, make it bigger. */
Index: src/strftime.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/strftime.c,v
retrieving revision 1.6
diff -u -r1.6 strftime.c
--- src/strftime.c 2002/03/29 04:48:37 1.6
+++ src/strftime.c 2004/12/09 02:40:18
＠＠ -58,6 +58,7 ＠＠
%S second (00..61)
%T time, 24-hour (hh:mm:ss)
%X locale's time representation (%H:%M:%S)
+ %z time zone offset (e.g. +0530, -0800 etc)
%Z time zone (EDT), or nothing if no time zone is determinable
Date fields:
＠＠ -70,10 +71,13 ＠＠
%d day of month (01..31)
%e day of month ( 1..31)
%D date (mm/dd/yy)
+ %G year corresponding to the ISO 8601 week
+ %g Year of the ISO 8601 week within century (00 - 99)
%h same as %b
%j day of year (001..366)
%m month (01..12)
%U week number of year with Sunday as first day of week (00..53)
+ %V ISO 8601 week number (first week is the earliest one with Thu)
%w day of week (0..6)
%W week number of year with Monday as first day of week (00..53)
%x locale's date representation (mm/dd/yy)
＠＠ -235,6 +239,30 ＠＠
return dl <= 0 ? 0 : dl / 7 + (dl % 7 != 0);
}
+#ifndef __isleap
+/* Nonzero if YEAR is a leap year (every 4 years,
+ except every 100th isn't, and every 400th is). */
+# define __isleap(year) \
+ ((year) % 4 == 0 && ((year) % 100 != 0 || (year) % 400 == 0))
+#endif
+
+/* The number of days from the first day of the first ISO week of this
+ year to the year day YDAY with week day WDAY. ISO weeks start on
+ Monday; the first ISO week has the year's first Thursday. YDAY may
+ be as small as YDAY_MINIMUM. */
+#define ISO_WEEK_START_WDAY 1 /* Monday */
+#define ISO_WEEK1_WDAY 4 /* Thursday */
+#define YDAY_MINIMUM (-366)
+static int
+iso_week_days (int yday, int wday)
+{
+ /* Add enough to the first operand of % to make it nonnegative. */
+ int big_enough_multiple_of_7 = (-YDAY_MINIMUM / 7 + 2) * 7;
+ return (yday
+ - (yday - wday + ISO_WEEK1_WDAY + big_enough_multiple_of_7) % 7
+ + ISO_WEEK1_WDAY - ISO_WEEK_START_WDAY);
+}
+
#if !defined(HAVE_TM_ZONE) && !defined(HAVE_TZNAME)
char *zone_name (const struct tm *tp);
char *
＠＠ -362,10 +390,125 ＠＠
length +=
strftime (&string[length], max - length, "%H:%M:%S", tm);
break;
+
+ case 'V':
+ case 'g':
+ case 'G':
+ {
+ int year = tm->tm_year + 1900;
+ int days = iso_week_days (tm->tm_yday, tm->tm_wday);
+
+ if (days < 0)
+ {
+ /* This ISO week belongs to the previous year. */
+ year--;
+ days =
+ iso_week_days (tm->tm_yday + (365 + __isleap (year)),
+ tm->tm_wday);
+ }
+ else
+ {
+ int d =
+ iso_week_days (tm->tm_yday - (365 + __isleap (year)),
+ tm->tm_wday);
+ if (0 <= d)
+ {
+ /* This ISO week belongs to the next year. */
+ year++;
+ days = d;
+ }
+ }
+
+ switch (*format)
+ {
+ /*
+ #### FIXME
+ We really can't assume 1000 <= year <= 9999
+ once time_t gets beyond 32 bits, but it's true
+ of the rest of the code here so get with the
+ program
+ */
+ case 'g':
+ length +=
+ add_num2 (&string[length], year % 100,
+ max - length, pad);
+ break;
+
+ case 'G':
+ add_char (year / 1000 + '0');
+ length += add_num3 (&string[length], year % 1000,
+ max - length, zero);
+ break;
+
+ default:
+ length +=
+ add_num2 (&string[length], days / 7 + 1,
+ max - length, pad);
+ break;
+ }
+ }
+ break;
case 'X':
length +=
strftime (&string[length], max - length, "%H:%M:%S", tm);
break;
+ case 'z':
+ {
+ /*
+ #### FIXME: could use tm->tm_gmtoff if present. Since
+ the other code in xemacs does not do so we follow the
+ leaders (and don't add a autoconf macro to detect
+ its presence).
+ */
+ long int offset;
+ long int minutes;
+ struct tm lt, *ut;
+ time_t utc;
+
+ lt = *tm;
+ utc = mktime(<);
+ ut = gmtime(&utc);
+ /* assume that tm is valid so the others will be too! */
+ assert( utc != (time_t) -1 && ut != NULL );
+
+ /* tm diff code below is based on mktime.c, glibc 2.3.2 */
+ {
+ int lt4, ut4, lt100, ut100, lt400, ut400;
+ int intervening_leap_days, years, days;
+
+ lt4 = (lt.tm_year >> 2) + (1900 >> 2) -
+ ! (lt.tm_year & 3);
+ ut4 = (ut->tm_year >> 2) + (1900 >> 2) -
+ ! (ut->tm_year & 3);
+ lt100 = lt4 / 25 - (lt4 % 25 < 0);
+ ut100 = ut4 / 25 - (ut4 % 25 < 0);
+ lt400 = lt100 >> 2;
+ ut400 = ut100 >> 2;
+ intervening_leap_days =
+ (lt4 - ut4) - (lt100 - ut100) + (lt400 - ut400);
+ years = lt.tm_year - ut->tm_year;
+ days = (365 * years + intervening_leap_days
+ + (lt.tm_yday - ut->tm_yday));
+ offset = (60 * (60 * (24 * days + (lt.tm_hour - ut->tm_hour))
+ + (lt.tm_min - ut->tm_min))
+ + (lt.tm_sec - ut->tm_sec));
+ }
+
+ minutes = offset / ( offset < 0 ? -60 : 60 );
+
+ add_char ((offset < 0 ? '-' : '+'));
+
+ if ( minutes / 600 != 0 )
+ add_char (minutes / 600 + '0');
+ else if ( pad != none )
+ add_char ((pad == zero ? '0' : ' '));
+
+ length +=
+ add_num3 (&string[length],
+ ((minutes / 60 ) % 10) * 100 + (minutes % 60),
+ max - length, pad);
+ break;
+ }
case 'Z':
#ifdef HAVE_TM_ZONE
length += add_str (&string[length], tm->tm_zone, max - length);
- 2 participants
- 1 comments
[PATCH] Eliminate a crash when profiling.
17 years, 4 months
Aidan Kehoe
Aidan Kehoe
This follows discussion with Adrian, and I’ll commit it later today.
src/ChangeLog addition:
2006-11-26 Aidan Kehoe <kehoea(a)parhasard.net>
* eval.c (Fcommand_execute):
* eval.c (Feval):
* eval.c (Ffuncall):
Use the PROFILE_DECLARE macro instead of declaring `struct
backtrace backtrace' by hand.
* profile.h:
* profile.h (PROFILE_EXIT_FUNCTION):
* profile.h (PROFILE_ENTER_FUNCTION):
Check do_backtrace before passing the backtrace structure to
profile_record_about_to_call, profile_record_just_called.
XEmacs Trunk source patch:
Diff command: cvs -q diff -Nu
Files affected: src/profile.h
===================================================================
RCS src/eval.c
===================================================================
RCS
Index: src/eval.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/eval.c,v
retrieving revision 1.93
diff -u -u -r1.93 eval.c
--- src/eval.c 2006/08/29 14:10:54 1.93
+++ src/eval.c 2006/11/26 10:05:42
＠＠ -3078,7 +3078,7 ＠＠
/* This function can GC */
Lisp_Object prefixarg;
Lisp_Object final = cmd;
- struct backtrace backtrace;
+ PROFILE_DECLARE();
struct console *con = XCONSOLE (Vselected_console);
prefixarg = con->prefix_arg;
＠＠ -3511,7 +3511,7 ＠＠
/* This function can GC */
Lisp_Object fun, val, original_fun, original_args;
int nargs;
- struct backtrace backtrace;
+ PROFILE_DECLARE();
#ifdef ERROR_CHECK_TRAPPING_PROBLEMS
check_proper_critical_section_lisp_protection ();
＠＠ -3806,7 +3806,7 ＠＠
/* This function can GC */
Lisp_Object fun;
Lisp_Object val;
- struct backtrace backtrace;
+ PROFILE_DECLARE();
int fun_nargs = nargs - 1;
Lisp_Object *fun_args = args + 1;
Index: src/profile.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/profile.h,v
retrieving revision 1.4
diff -u -u -r1.4 profile.h
--- src/profile.h 2006/03/14 19:31:43 1.4
+++ src/profile.h 2006/11/26 10:05:42
＠＠ -47,11 +47,18 ＠＠
This ensures correct behavior (e.g. we never modify the profiling info
when profiling is not active) because we seed and reap all functions
currently on the stack when starting and stopping. See
- `start-profiling'. */
+ `start-profiling'.
+
+ We check do_backtrace to make sure that the backtrace structure is
+ initialised. If it isn't, we can enter a function with profiling turned
+ off, and exit it with it turned on, with the consequence that an
+ unitialised backtrace structure is passed to
+ profile_record_just_called. Since do_backtrace is function-local (apart
+ from in the garbage collector) this avoids that. */
#define PROFILE_ENTER_FUNCTION() \
do \
{ \
- if (profiling_active) \
+ if (profiling_active && do_backtrace) \
profile_record_about_to_call (&backtrace); \
} \
while (0)
＠＠ -59,7 +66,7 ＠＠
#define PROFILE_EXIT_FUNCTION() \
do \
{ \
- if (profiling_active) \
+ if (profiling_active && do_backtrace) \
profile_record_just_called (&backtrace); \
} \
while (0)
--
Santa Maradona, priez pour moi!
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 1 comments
[C] [R21.4] xemacs-21.5-clean: Sync font-lock-add-keywords and font-lock-remove-keywords from GNU Emacs
17 years, 4 months
Adrian Aichner
Adrian Aichner
Hi Vin, here is the patch again.
I was able to find it quickly by use of
M-x gnus-article-refer-article
on the message-id I quoted in my followup mail.
Let me know if this works for you.
Best regards!
Adrian
COMMIT
RECOMMEND 21.4
Many unbundled lisp libraries don't work out-of-the-box due to these
missing functions.
I've had these locally added to my 21.4 build for years.
It's time we close this compatibility gap.
oddmuse.el works out of the box for me with this patch.
Adrian
xemacs-21.5-clean ChangeLog patch:
Diff command: cvs -q diff -U 0
Files affected: lisp/ChangeLog
Index: lisp/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v
retrieving revision 1.766
diff -u -U0 -r1.766 ChangeLog
--- lisp/ChangeLog 1 Nov 2006 21:35:35 -0000 1.766
+++ lisp/ChangeLog 1 Nov 2006 23:13:52 -0000
＠＠ -0,0 +1,10 ＠＠
+2006-11-02 Adrian Aichner <adrian(a)xemacs.org>
+
+ * font-lock.el: Sync font-lock-add-keywords and
+ font-lock-remove-keywords from GNU Emacs.
+ * font-lock.el (font-lock-keywords-alist): New.
+ * font-lock.el (font-lock-removed-keywords-alist): New.
+ * font-lock.el (font-lock-add-keywords): New.
+ * font-lock.el (font-lock-update-removed-keyword-alist): New.
+ * font-lock.el (font-lock-remove-keywords): New.
+
xemacs-21.5-clean source patch:
Diff command: cvs -f -z3 -q diff -u -w -N
Files affected: lisp/font-lock.el
Index: lisp/font-lock.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/font-lock.el,v
retrieving revision 1.30
diff -u -w -r1.30 font-lock.el
--- lisp/font-lock.el 4 Feb 2006 01:56:06 -0000 1.30
+++ lisp/font-lock.el 1 Nov 2006 23:10:11 -0000
＠＠ -449,6 +449,32 ＠＠
Be very careful composing regexps for this list; the wrong pattern can
dramatically slow things down!
")
+
+(defvar font-lock-keywords-alist nil
+ "Alist of additional `font-lock-keywords' elements for major modes.
+
+Each element has the form (MODE KEYWORDS . HOW).
+`font-lock-set-defaults' adds the elements in the list KEYWORDS to
+`font-lock-keywords' when Font Lock is turned on in major mode MODE.
+
+If HOW is nil, KEYWORDS are added at the beginning of
+`font-lock-keywords'. If it is `set', they are used to replace the
+value of `font-lock-keywords'. If HOW is any other non-nil value,
+they are added at the end.
+
+This is normally set via `font-lock-add-keywords' and
+`font-lock-remove-keywords'.")
+
+(defvar font-lock-removed-keywords-alist nil
+ "Alist of `font-lock-keywords' elements to be removed for major modes.
+
+Each element has the form (MODE . KEYWORDS). `font-lock-set-defaults'
+removes the elements in the list KEYWORDS from `font-lock-keywords'
+when Font Lock is turned on in major mode MODE.
+
+This is normally set via `font-lock-add-keywords' and
+`font-lock-remove-keywords'.")
+
;;;###autoload
(make-variable-buffer-local 'font-lock-keywords)
＠＠ -868,6 +894,188 ＠＠
(setq font-lock-maximum-decoration t)
(font-lock-recompute-variables)))
+(defun font-lock-add-keywords (mode keywords &optional how)
+ "Add highlighting KEYWORDS for MODE.
+
+MODE should be a symbol, the major mode command name, such as `c-mode'
+or nil. If nil, highlighting keywords are added for the current buffer.
+KEYWORDS should be a list; see the variable `font-lock-keywords'.
+By default they are added at the beginning of the current highlighting list.
+If optional argument HOW is `set', they are used to replace the current
+highlighting list. If HOW is any other non-nil value, they are added at the
+end of the current highlighting list.
+
+For example:
+
+ (font-lock-add-keywords 'c-mode
+ '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 font-lock-warning-face prepend)
+ (\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" . font-lock-keyword-face)))
+
+adds two fontification patterns for C mode, to fontify `FIXME:' words, even in
+comments, and to fontify `and', `or' and `not' words as keywords.
+
+The above procedure will only add the keywords for C mode, not
+for modes derived from C mode. To add them for derived modes too,
+pass nil for MODE and add the call to c-mode-hook.
+
+For example:
+
+ (add-hook 'c-mode-hook
+ (lambda ()
+ (font-lock-add-keywords nil
+ '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 font-lock-warning-face prepend)
+ (\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" .
+ font-lock-keyword-face)))))
+
+The above procedure may fail to add keywords to derived modes if
+some involved major mode does not follow the standard conventions.
+File a bug report if this happens, so the major mode can be corrected.
+
+Note that some modes have specialized support for additional patterns, e.g.,
+see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types',
+`objc-font-lock-extra-types' and `java-font-lock-extra-types'."
+ (cond (mode
+ ;; If MODE is non-nil, add the KEYWORDS and HOW spec to
+ ;; `font-lock-keywords-alist' so `font-lock-set-defaults' uses them.
+ (let ((spec (cons keywords how)) cell)
+ (if (setq cell (assq mode font-lock-keywords-alist))
+ (if (eq how 'set)
+ (setcdr cell (list spec))
+ (setcdr cell (append (cdr cell) (list spec))))
+ (push (list mode spec) font-lock-keywords-alist)))
+ ;; Make sure that `font-lock-removed-keywords-alist' does not
+ ;; contain the new keywords.
+ (font-lock-update-removed-keyword-alist mode keywords how))
+ (t
+ ;; Otherwise set or add the keywords now.
+ ;; This is a no-op if it has been done already in this buffer
+ ;; for the correct major mode.
+ (font-lock-set-defaults)
+ (let ((was-compiled (eq (car font-lock-keywords) t)))
+ ;; Bring back the user-level (uncompiled) keywords.
+ (if was-compiled
+ (setq font-lock-keywords (cadr font-lock-keywords)))
+ ;; Now modify or replace them.
+ (if (eq how 'set)
+ (setq font-lock-keywords keywords)
+ (font-lock-remove-keywords nil keywords) ;to avoid duplicates
+ (let ((old (if (eq (car-safe font-lock-keywords) t)
+ (cdr font-lock-keywords)
+ font-lock-keywords)))
+ (setq font-lock-keywords (if how
+ (append old keywords)
+ (append keywords old)))))
+ ;; If the keywords were compiled before, compile them again.
+ (if was-compiled
+ (setq font-lock-keywords
+ (font-lock-compile-keywords font-lock-keywords)))))))
+
+(defun font-lock-update-removed-keyword-alist (mode keywords how)
+ "Update `font-lock-removed-keywords-alist' when adding new KEYWORDS to MODE."
+ ;; When font-lock is enabled first all keywords in the list
+ ;; `font-lock-keywords-alist' are added, then all keywords in the
+ ;; list `font-lock-removed-keywords-alist' are removed. If a
+ ;; keyword was once added, removed, and then added again it must be
+ ;; removed from the removed-keywords list. Otherwise the second add
+ ;; will not take effect.
+ (let ((cell (assq mode font-lock-removed-keywords-alist)))
+ (if cell
+ (if (eq how 'set)
+ ;; A new set of keywords is defined. Forget all about
+ ;; our old keywords that should be removed.
+ (setq font-lock-removed-keywords-alist
+ (delq cell font-lock-removed-keywords-alist))
+ ;; Delete all previously removed keywords.
+ (dolist (kword keywords)
+ (setcdr cell (delete kword (cdr cell))))
+ ;; Delete the mode cell if empty.
+ (if (null (cdr cell))
+ (setq font-lock-removed-keywords-alist
+ (delq cell font-lock-removed-keywords-alist)))))))
+
+;; Written by Anders Lindgren <andersl(a)andersl.com>.
+;;
+;; Case study:
+;; (I) The keywords are removed from a major mode.
+;; In this case the keyword could be local (i.e. added earlier by
+;; `font-lock-add-keywords'), global, or both.
+;;
+;; (a) In the local case we remove the keywords from the variable
+;; `font-lock-keywords-alist'.
+;;
+;; (b) The actual global keywords are not known at this time.
+;; All keywords are added to `font-lock-removed-keywords-alist',
+;; when font-lock is enabled those keywords are removed.
+;;
+;; Note that added keywords are taken out of the list of removed
+;; keywords. This ensure correct operation when the same keyword
+;; is added and removed several times.
+;;
+;; (II) The keywords are removed from the current buffer.
+(defun font-lock-remove-keywords (mode keywords)
+ "Remove highlighting KEYWORDS for MODE.
+
+MODE should be a symbol, the major mode command name, such as `c-mode'
+or nil. If nil, highlighting keywords are removed for the current buffer.
+
+To make the removal apply to modes derived from MODE as well,
+pass nil for MODE and add the call to MODE-hook. This may fail
+for some derived modes if some involved major mode does not
+follow the standard conventions. File a bug report if this
+happens, so the major mode can be corrected."
+ (cond (mode
+ ;; Remove one keyword at the time.
+ (dolist (keyword keywords)
+ (let ((top-cell (assq mode font-lock-keywords-alist)))
+ ;; If MODE is non-nil, remove the KEYWORD from
+ ;; `font-lock-keywords-alist'.
+ (when top-cell
+ (dolist (keyword-list-how-pair (cdr top-cell))
+ ;; `keywords-list-how-pair' is a cons with a list of
+ ;; keywords in the car top-cell and the original how
+ ;; argument in the cdr top-cell.
+ (setcar keyword-list-how-pair
+ (delete keyword (car keyword-list-how-pair))))
+ ;; Remove keyword list/how pair when the keyword list
+ ;; is empty and how doesn't specify `set'. (If it
+ ;; should be deleted then previously deleted keywords
+ ;; would appear again.)
+ (let ((cell top-cell))
+ (while (cdr cell)
+ (if (and (null (car (car (cdr cell))))
+ (not (eq (cdr (car (cdr cell))) 'set)))
+ (setcdr cell (cdr (cdr cell)))
+ (setq cell (cdr cell)))))
+ ;; Final cleanup, remove major mode cell if last keyword
+ ;; was deleted.
+ (if (null (cdr top-cell))
+ (setq font-lock-keywords-alist
+ (delq top-cell font-lock-keywords-alist))))
+ ;; Remember the keyword in case it is not local.
+ (let ((cell (assq mode font-lock-removed-keywords-alist)))
+ (if cell
+ (unless (member keyword (cdr cell))
+ (nconc cell (list keyword)))
+ (push (cons mode (list keyword))
+ font-lock-removed-keywords-alist))))))
+ (t
+ ;; Otherwise remove it immediately.
+ (font-lock-set-defaults)
+ (let ((was-compiled (eq (car font-lock-keywords) t)))
+ ;; Bring back the user-level (uncompiled) keywords.
+ (if was-compiled
+ (setq font-lock-keywords (cadr font-lock-keywords)))
+
+ ;; Edit them.
+ (setq font-lock-keywords (copy-sequence font-lock-keywords))
+ (dolist (keyword keywords)
+ (setq font-lock-keywords
+ (delete keyword font-lock-keywords)))
+
+ ;; If the keywords were compiled before, compile them again.
+ (if was-compiled
+ (setq font-lock-keywords
+ (font-lock-compile-keywords font-lock-keywords)))))))
;;;;;;;;;;;;;;;;;;;;;; actual code ;;;;;;;;;;;;;;;;;;;;;;
--
Adrian Aichner
mailto:adrian＠xemacs.org
http://www.xemacs.org/
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 2 participants
- 2 comments
[21.5] Fix crash in PNG initialiation [was: can't move cursor ...]
17 years, 4 months
Stephen J. Turnbull
Stephen J. Turnbull
21.5
Vin, this presumably affects 21.4 too. If you don't recall any
related reports (probably only comes up if PNG lib that gets found at
runtime differs from build-time link lib), I'll take my time....
Stephen J. Turnbull writes:
> Does `configure --with-cppflags="-newflag $CPPFLAGS" ...' work in your
> application? I think that having the `--with-whateverflags' options
> override the corresponding environment variables is easier to
> explain. It's certainly easier to code!
[[ This is in my queue but I am working on other stuff. ]]
> Ron Isaacson writes:
> > #2 is definitely not our problem. :-) I think you need to ensure that
> > png_err_stct.setjmp_buffer is set to a valid address BEFORE passing
> > png_error_func as a parameter to anything. Otherwise, any runtime
> > error from png_create_read_struct will get you into the same boat.
OK, yes, this is really ugly. (But then, when isn't a setjmp/longjmp
ugly?) I think the attached patch should fix the problem, but I don't
yet have a test case and I've never patched code involving setjmp/
longjmp before so a second opinion would be welcome (and a third...).
(I think the relevant test case for the original bug can be easily
constructed by substituting "You're going down, sucker!" for
PNG_LIBPNG_VER_STRING, but I haven't done that yet.)
The first hunk is a little suspicious; for some reason
png_destroy_read_struct() wants access to the pointer variable
containing png_ptr, not just the pointer itself. The only reason I
can think why it would want that is to NULL it, and I've done that, so
passing &tmp to png_destroy_read_struct() should be OK, I think.
The other changes are to first NULL out any unwind pointers to
structures that are being destroyed in case the libpng code longjmps,
then call libpng's finalizer; to move the setjmp call much earlier;
and to stuff the unwind structure with the the necessary data as soon
as we get it.
I guess I have to assume that none of the libpng functions will
implicitly call a finalizer....
I'll run with it a while before committing, but would really
appreciate comments.
2007-02-17 Stephen J. Turnbull <stephen(a)xemacs.org>
* glyphs-eimage.c (png_instantiate_unwind): Avoid recursion.
(png_instantiate): Initialize setjmp_buffer early, and avoid
recursive entry to error handler.
diff --git a/src/glyphs-eimage.c b/src/glyphs-eimage.c
index 49364ca..5184e2c 100644
--- a/src/glyphs-eimage.c
+++ b/src/glyphs-eimage.c
＠＠ -849,7 +849,13 ＠＠ png_instantiate_unwind (Lisp_Object unwind_obj)
free_opaque_ptr (unwind_obj);
if (data->png_ptr)
- png_destroy_read_struct (&(data->png_ptr), &(data->info_ptr), (png_infopp)NULL);
+ {
+ /* ensure we can't get here again */
+ png_structp tmp = data->png_ptr;
+ data->png_ptr = NULL;
+ png_destroy_read_struct (&tmp, &(data->info_ptr), (png_infopp)NULL);
+ }
+
if (data->instream)
retry_fclose (data->instream);
＠＠ -874,24 +880,36 ＠＠ png_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
png_structp png_ptr;
png_infop info_ptr;
+ xzero (unwind);
+ record_unwind_protect (png_instantiate_unwind, make_opaque_ptr (&unwind));
+
+ if (setjmp (png_err_stct.setjmp_buffer))
+ {
+ /* Something blew up:
+ just display the error (cleanup happens in the unwind) */
+ signal_image_error_2 ("Error decoding PNG",
+ build_string(png_err_stct.err_str),
+ instantiator);
+ }
+
/* Initialize all PNG structures */
- png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, (void*)&png_err_stct,
+ png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING,
+ (void *) &png_err_stct,
png_error_func, png_warning_func);
if (!png_ptr)
signal_image_error ("Error obtaining memory for png_read", instantiator);
+ unwind.png_ptr = png_ptr;
+
info_ptr = png_create_info_struct (png_ptr);
if (!info_ptr)
{
+ unwind.png_ptr = NULL; /* avoid re-calling png_destroy_read_struct
+ when unwinding */
png_destroy_read_struct (&png_ptr, (png_infopp)NULL, (png_infopp)NULL);
signal_image_error ("Error obtaining memory for png_read", instantiator);
}
-
- xzero (unwind);
- unwind.png_ptr = png_ptr;
unwind.info_ptr = info_ptr;
- record_unwind_protect (png_instantiate_unwind, make_opaque_ptr (&unwind));
-
/* This code is a mixture of stuff from Ben's GIF/JPEG stuff from
this file, example.c from the libpng 0.81 distribution, and the
pngtopnm sources. -WMP-
＠＠ -900,16 +918,6 ＠＠ png_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
and is no longer usable for previous versions. jh
*/
- /* Set the jmp_buf return context for png_error ... if this returns !0, then
- we ran into a problem somewhere, and need to clean up after ourselves. */
- if (setjmp (png_err_stct.setjmp_buffer))
- {
- /* Something blew up: just display the error (cleanup happens in the unwind) */
- signal_image_error_2 ("Error decoding PNG",
- build_string(png_err_stct.err_str),
- instantiator);
- }
-
/* Initialize the IO layer and read in header information */
{
Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 2 participants
- 2 comments
[PATCH] fix buffer overrun in pdump_load()
17 years, 4 months
Nix
Nix
The initial problem was easy to describe: starting XEmacs with absolute
paths was broken (at least it is if you use a separate .dmp file, which
I'm constrained to right now because I'm using the new GC.)
loki 1686 /usr/packages/xemacs/i686-loki% which xemacs
/usr/bin/xemacs
loki 1687 /usr/packages/xemacs/i686-loki% xemacs -vanilla -batch -eval '(message "foo")'
foo
loki 1685 /usr/packages/xemacs/i686-loki% /usr/bin/xemacs -vanilla -batch -eval '(message "foo")'
temacs can only be run in -batch mode.
strace and valgrind (and a bit of gdb) pinpoint the cause:
loki 1688 /usr/packages/xemacs/i686-loki% strace -e open /usr/bin/xemacs -vanilla -batch -eval '(message "foo")'
[...]
open("/lib/libpthread.so.0", O_RDONLY) = 3
open("", O_RDONLY|O_LARGEFILE) = -1 ENOENT (No such file or directory)
open("", O_RDONLY|O_LARGEFILE) = -1 ENOENT (No such file or directory)
open("", O_RDONLY|O_LARGEFILE) = -1 ENOENT (No such file or directory)
open("/etc/fonts/fonts.conf", O_RDONLY|O_LARGEFILE) = 3
[...]
==29209== Syscall param open(filename) points to unaddressable byte(s)
==29209== at 0x4D873272: open64 (in /lib/libc-2.4.so)
==29209== Address 0xBEBA0070 is not stack'd, malloc'd or (recently) free'd
If you're unlucky, that "" turns into an -EFAULT, and if you're *really*
unlucky, you get a segfault.
This is happening because in src/dumper.c:pdump_load(), exe_path is
being sized as (if XEmacs is invoked with an absolute path) one byte
longer than the length of the directory component of the name, or (if
XEmacs is invoked with a relative path) ten bytes longer than the larger
of the name and PATH variable...
... and then pdump_load() calls pdump_file_try(), which proceeds to
sprintf() things on the end of it, like "-21.5-b27-453712b7.dmp". Oops,
there's no room for that. Instant buffer overrun, and because that
structure is alloca()ed a lot of the time, instant stack overrun as
well, which if you're unlucky blows away a pile of variables,
invalidates `exe_path', et seq ad nauseam.
(Probably nobody's noticed this because most of the time XEmacs is
invoked without an absolute path, and most people have a PATH that is
much longer than five characters. I don't know what the ten bytes of
slop are for: it's not even long enough for `-21.4.16.dmp'...)
I've `fixed' this by moving from incorrect dynamic allocation to
arguably inefficient-but-who-cares static allocation: it's way too much
work to realloc() this string, and it's also way too much work to
determine the maximum possible length of that string (plus it's brittle;
the next time someone changes the filename construction method,
*boom*). This necessitated a tiny fix to text.h before PATH_MAX_EXTERNAL
could be used on non-Windows systems at all...
You may want to fix the fix if using PATH_MAX_{INTERNAL,EXTERNAL} is
really as bad as all that.
(This patch is against CVS HEAD.)
2006-10-26 Nix <nix(a)esperi.org.uk>
* dumper.c (pdump_load): Statically allocate a large enough
exe_path for all conceivable uses. Fixes a buffer overrun.
* text.h (MAX_XETCHAR_SIZE): Define, for PATH_MAX_EXTERNAL.
Index: 21.5/src/dumper.c
===================================================================
--- 21.5.orig/src/dumper.c 2006-10-26 00:29:53.000000000 +0100
+++ 21.5/src/dumper.c 2006-10-26 00:30:21.000000000 +0100
＠＠ -2658,7 +2658,7 ＠＠
wext_strcpy (exe_path, wexe);
}
#else /* !WIN32_NATIVE */
- Wexttext *exe_path;
+ Wexttext exe_path[PATH_MAX_EXTERNAL];
Wexttext *w;
const Wexttext *dir, *p;
＠＠ -2692,8 +2692,7 ＠＠
if (p != dir)
{
/* invocation-name includes a directory component -- presumably it
- is relative to cwd, not $PATH */
- exe_path = alloca_array (Wexttext, 1 + wext_strlen (dir));
+ is relative to cwd, not $PATH. */
wext_strcpy (exe_path, dir);
}
else
＠＠ -2701,9 +2700,6 ＠＠
const Wexttext *path = wext_getenv ("PATH"); /* not egetenv --
not yet init. */
const Wexttext *name = p;
- exe_path = alloca_array (Wexttext,
- 10 + max (wext_strlen (name),
- wext_strlen (path)));
for (;;)
{
p = path;
Index: 21.5/src/text.h
===================================================================
--- 21.5.orig/src/text.h 2006-10-26 00:29:53.000000000 +0100
+++ 21.5/src/text.h 2006-10-26 00:30:21.000000000 +0100
＠＠ -2988,6 +2988,7 ＠＠
/* Extra indirection needed in case of manifest constant as arg */
#define WEXTSTRING_1(arg) L##arg
#define WEXTSTRING(arg) WEXTSTRING_1(arg)
+#define MAX_XETCHAR_SIZE sizeof (WCHAR)
#define wext_strlen wcslen
#define wext_strcmp wcscmp
#define wext_strncmp wcsncmp
＠＠ -3013,6 +3014,7 ＠＠
#else
#define WEXTTEXT_ZTERM_SIZE sizeof (char)
#define WEXTSTRING(arg) arg
+#define MAX_XETCHAR_SIZE sizeof (char)
#define wext_strlen strlen
#define wext_strcmp strcmp
#define wext_strncmp strncmp
--
`When we are born we have plenty of Hydrogen but as we age our
Hydrogen pool becomes depleted.'
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 3 participants
- 3 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
[PATCH (pkgs)] Small AUCTeX tweak
17 years, 7 months
Jerry James
Jerry James
PATCH packages
As David Kastrup said on xemacs-beta, using rawfile IS the right thing
to do here. I suggest this patch as a stopgap measure until we can
figure out how to import the latest version of AUCTeX.
This incidentally fixes the building of HISTORY.
xemacs-packages/auctex/ChangeLog addition:
2006-08-03 Jerry James <james(a)xemacs.org>
* Makefile (EXTRA_SOURCES): Add HISTORY.
* Makefile (RUN_MAKEINFO_INDIVIDUAL): Build plain text files with
-D rawfile.
* Makefile (HISTORY): Builds correctly with the previous fix.
packages source patch:
Diff command: cvs -q diff -uN
Files affected: xemacs-packages/auctex/Makefile
Index: xemacs-packages/auctex/Makefile
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/auctex/Makefile,v
retrieving revision 1.59
diff -d -u -r1.59 Makefile
--- xemacs-packages/auctex/Makefile 2005/02/12 17:10:02 1.59
+++ xemacs-packages/auctex/Makefile 2006/08/03 20:20:04
＠＠ -35,7 +35,7 ＠＠
context-en.elc context-nl.elc tex-fold.elc \
-EXTRA_SOURCES = CHANGES PROBLEMS README FAQ RELEASE TODO \
+EXTRA_SOURCES = CHANGES PROBLEMS README FAQ RELEASE TODO HISTORY \
ChangeLog.auctex tex-site.el \
ETC_ELCS = etc/units.elc etc/nicefrac.elc etc/alltt.elc \
＠＠ -102,7 +102,7 ＠＠
&& texindex auc-tex.vr && texindex auc-tex.cp \
&& $(TEX) "\nonstopmode\input auc-tex.texi"
-RUN_MAKEINFO_INDIVIDUAL = $(MAKEINFO) -I texi/ --no-validate --force --no-headers -o $＠ $<
+RUN_MAKEINFO_INDIVIDUAL = $(MAKEINFO) -D rawfile -I texi/ --no-validate --force --no-headers -o $＠ $<
INSTALLATION: texi/install.texi
-$(RUN_MAKEINFO_INDIVIDUAL)
＠＠ -113,6 +113,5 ＠＠
CHANGES: texi/changes.texi
-$(RUN_MAKEINFO_INDIVIDUAL)
-# does not build.
HISTORY: texi/history.texi
-$(RUN_MAKEINFO_INDIVIDUAL)
--
Jerry James, Assistant Professor james(a)xemacs.org
Computer Science Department http://www.cs.usu.edu/~jerry/
Utah State University
- 2 participants
- 2 comments
[AC21.5R21.4] etags and implicit tags
17 years, 7 months
Stephen J. Turnbull
Stephen J. Turnbull
APPROVE COMMIT 21.5 RECOMMEND 21.4
(sorry for the XEmacs process gobbledygook)
Steve Youngs writes:
> * Francesco Potorti` <pot(a)gnu.org> writes:
>
> > The first one is that etags should be compiled with
> > -DEMACS_NAME="\"Xemacs"\"
> > -DVERSION="\"${version}\""
> Steve T, you won't need to add `-DVERSION' in the XEmacs Makefile,
> like SXEmacs, it's already defined in config.h.
Thanks for the hint; EMACS_NAME is defined there, too. It looks like
all we actually need is -DHAVE_CONFIG_H, but I haven't tested that yet.
> Also, both XEmacs and SXEmacs define `EMACS_VERSION' which might be
> better to use in etags.c. There's an advantage for SXEmacs, (not sure
> about XEmacs), in that it will print the exact patchset revision of
> the SXEmacs that this etags goes with...
I'm going to go ahead and tentatively put both suggestions into XEmacs,
as I think that's useful precision, and there's a warning I want
suppressed so we will be a tiny bit divergent anyway. If Francesco
decides not to adopt the idea, we will probably resync (ie, get rid of
the extra info) at the next update to etags.
This patch has been tested both with "make etags" in XEmacs and
standalone with the -D flags removed from the compile command that
make etags uses. In the latter case, gcc throws a few warnings about
implicit definitions of built-in functions. (Apple's GCC 4.01)
Index: lib-src/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lib-src/ChangeLog,v
retrieving revision 1.216
diff -u -r1.216 ChangeLog
--- lib-src/ChangeLog 24 Mar 2007 11:46:43 -0000 1.216
+++ lib-src/ChangeLog 24 Mar 2007 12:21:24 -0000
＠＠ -0,0 +1,7 ＠＠
+2007-03-24 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * etags.c (print_version): More precise version info. Suggested
+ by Steve Youngs.
+ (print_help): Use #ifdef; PRINT_UNDOCUMENTED_OPTIONS_HELP may be
+ undefined.
+
Index: lib-src/etags.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lib-src/etags.c,v
retrieving revision 1.37
diff -u -r1.37 etags.c
--- lib-src/etags.c 24 Mar 2007 11:46:43 -0000 1.37
+++ lib-src/etags.c 24 Mar 2007 12:21:26 -0000
＠＠ -834,13 +834,23 ＠＠
#ifndef EMACS_NAME
# define EMACS_NAME "standalone"
#endif
-#ifndef VERSION
-# define VERSION "version"
+#ifdef EMACS_VERSION
+# ifdef XEMACS_EXTRA_NAME
+# define E_VERSION EMACS_VERSION " " XEMACS_EXTRA_NAME
+# else
+# define E_VERSION EMACS_VERSION
+# endif
+#elif defined(VERSION)
+# define E_VERSION VERSION
+#else
+# define E_VERSION "version"
#endif
+
static void
print_version ()
{
- printf ("%s (%s %s)\n", (CTAGS) ? "ctags" : "etags", EMACS_NAME, VERSION);
+ printf ("%s (%s %s)\n", (CTAGS) ? "ctags" : "etags", EMACS_NAME, E_VERSION);
+ puts (pot_etags_version);
puts ("Copyright (C) 2006 Free Software Foundation, Inc. and Ken Arnold");
puts ("This program is distributed under the same terms as Emacs");
＠＠ -978,7 +988,7 ＠＠
Print on the standard output an index of items intended for\n\
human consumption, similar to the output of vgrind. The index\n\
is sorted, and gives the page number of each item.");
-# if PRINT_UNDOCUMENTED_OPTIONS_HELP
+# ifdef PRINT_UNDOCUMENTED_OPTIONS_HELP
puts ("-w, --no-duplicates\n\
Do not create duplicate tag entries, for compatibility with\n\
traditional ctags.");
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 2 participants
- 2 comments
[PATCH] Make the X11 font menu work again.
17 years, 8 months
Aidan Kehoe
Aidan Kehoe
lisp/ChangeLog addition:
2007-01-02 Aidan Kehoe <kehoea(a)parhasard.net>
* cus-face.el (custom-set-face-update-spec):
Fix some formatting.
* faces.el (reset-face):
reset-face resets other faces to behave like the default face--it
shouldn't do anything if it's handed the default face.
* font-menu.el:
* font-menu.el (font-menu-set-font):
If the font was initialised from X resources (the tag-set
contains 'x-resource) pretend to Custom that it has
responsibility for those settings.
* x-faces.el:
Add a couple of fontconfig functions to the
globally-declare-fboundp, to eliminate a couple of byte-compile
warnings.
* x-faces.el ('x-resource)): New specifier tag, used to mark when
a face's font or other attributes have been initialised from X
resources.
* x-faces.el (x-init-face-from-resources):
Use the new specifier tag; also, instead of using a fragile
explicit list of what would incidentally be specified for the X11
Unicode fonts in faces.c, pay attention to the new specifier tag
created in that file for the specific purpose of grouping those
instantiators together.
src/ChangeLog addition:
2007-01-02 Aidan Kehoe <kehoea(a)parhasard.net>
* faces.c:
* faces.c (syms_of_faces):
* faces.c (complex_vars_of_faces):
New symbol and corresponding specifier tag,
x-coverage-instantiator, used to group those fonts used for their
extensive coverage for obscure characters in x-faces.el.
* specifier.c (setup_device_initial_specifier_tags):
Fix a bug where the mswindows specifier tag was matching X11
devices, because the format of the DEVICE_USER_SPECIFIED_TAGS list
wasn't being respected correctly.
XEmacs Trunk source patch:
Diff command: cvs -q diff -Nu
Files affected: src/specifier.c
===================================================================
RCS src/faces.c
===================================================================
RCS lisp/x-faces.el
===================================================================
RCS lisp/font-menu.el
===================================================================
RCS lisp/faces.el
===================================================================
RCS lisp/cus-face.el
===================================================================
RCS
Index: lisp/cus-face.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/cus-face.el,v
retrieving revision 1.12
diff -u -u -r1.12 cus-face.el
--- lisp/cus-face.el 2005/10/25 11:28:24 1.12
+++ lisp/cus-face.el 2007/01/01 23:36:44
＠＠ -282,7 +282,7 ＠＠
;;;###autoload
(defun custom-set-face-update-spec (face display plist)
"Customize the FACE for display types matching DISPLAY, merging
- in the new items from PLIST."
+in the new items from PLIST."
(let ((spec (face-spec-update-all-matching (custom-face-get-spec face)
display plist)))
(put face 'customized-face spec)
Index: lisp/faces.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/faces.el,v
retrieving revision 1.39
diff -u -u -r1.39 faces.el
--- lisp/faces.el 2006/11/05 22:31:32 1.39
+++ lisp/faces.el 2007/01/01 23:36:45
＠＠ -398,10 +398,10 ＠＠
The arguments LOCALE, TAG-SET and EXACT-P are the same as for
`remove-specifier'."
- (mapc (lambda (x)
- (remove-specifier (face-property face x) locale tag-set exact-p))
- built-in-face-specifiers)
- nil)
+ ;; Don't reset the default face.
+ (unless (eq 'default face)
+ (dolist (x built-in-face-specifiers nil)
+ (remove-specifier (face-property face x) locale tag-set exact-p))))
(defun set-face-parent (face parent &optional locale tag-set how-to-add)
"Set the parent of FACE to PARENT, for all properties.
Index: lisp/font-menu.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/font-menu.el,v
retrieving revision 1.9
diff -u -u -r1.9 font-menu.el
--- lisp/font-menu.el 2005/11/26 11:45:54 1.9
+++ lisp/font-menu.el 2007/01/01 23:36:46
＠＠ -365,13 +365,32 ＠＠
(/ (or size from-size)
(specifier-instance font-menu-size-scaling
(selected-device))))
- "pt"))))
+ "pt")))
+ new-spec-list)
+ ;; If the font was initialised from X resources (the tag-set
+ ;; contains 'x-resource) pretend to Custom that it has
+ ;; responsibility for those settings.
+ (map-specifier (face-font 'default)
+ (lambda (spec locale inst-list arg)
+ (loop
+ for (tag-set . inst)
+ in inst-list
+ do (setq tag-set (delq 'x-resource tag-set)
+ tag-set (delq 'custom tag-set)
+ tag-set (cons 'custom tag-set))
+ (push (cons tag-set inst) new-spec-list)
+ ;; Need to return nil, else map-specifier stops
+ finally return nil))
+ nil nil '(x-resource))
+ (remove-specifier (face-font 'default) nil '(x-resource))
+ (when new-spec-list
+ (add-spec-list-to-specifier (face-font 'default)
+ (list (cons 'global new-spec-list))))
(custom-set-face-update-spec 'default
(list (list 'type (device-type)))
(list :family (or family from-family)
:size fsize))))
(message "Font %s" (face-font-name 'default))))
-
;; #### This should be called `font-menu-maybe-change-face'
;; I wonder if a better API wouldn't (face attribute from to)
Index: lisp/x-faces.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-faces.el,v
retrieving revision 1.27
diff -u -u -r1.27 x-faces.el
--- lisp/x-faces.el 2006/12/17 11:25:59 1.27
+++ lisp/x-faces.el 2007/01/01 23:36:49
＠＠ -74,11 +74,11 ＠＠
fc-font-name-slant-oblique fc-font-name-slant-italic
fc-font-name-slant-roman))
(globally-declare-fboundp
- '(fc-pattern-del-size fc-pattern-get-size fc-pattern-add-size
- fc-pattern-del-style fc-pattern-duplicate fc-copy-pattern-partial
- fc-pattern-add-weight fc-pattern-del-weight fc-try-font
- fc-pattern-del-slant fc-pattern-add-slant fc-name-unparse
- fc-pattern-get-pixelsize)))
+ '(fc-font-match fc-pattern-del-size fc-pattern-get-size
+ fc-pattern-add-size fc-pattern-del-style fc-pattern-duplicate
+ fc-copy-pattern-partial fc-pattern-add-weight fc-pattern-del-weight
+ fc-try-font fc-pattern-del-slant fc-pattern-add-slant fc-name-parse
+ fc-name-unparse fc-pattern-get-pixelsize)))
(defconst x-font-regexp nil)
(defconst x-font-regexp-head nil)
＠＠ -653,6 +653,9 ＠＠
;;; state where signalling an error or entering the debugger would likely
;;; result in a crash.
+;; When we initialise a face from an X resource, note that we did so.
+(define-specifier-tag 'x-resource)
+
(defun x-init-face-from-resources (face &optional locale set-anyway)
;;
＠＠ -681,6 +684,7 ＠＠
;; specs.
(x-tag-set '(x default))
(tty-tag-set '(tty default))
+ (our-tag-set '(x x-resource))
(device-class nil)
(face-sym (face-name face))
(name (symbol-name face-sym))
＠＠ -738,7 +742,8 ＠＠
(if device-class
(setq tag-set (cons device-class tag-set)
x-tag-set (cons device-class x-tag-set)
- tty-tag-set (cons device-class tty-tag-set)))
+ tty-tag-set (cons device-class tty-tag-set)
+ our-tag-set (cons device-class our-tag-set)))
;;
;; If this is the default face, then any unspecified properties should
＠＠ -782,28 +787,22 ＠＠
;; globally. This means we should override global
;; defaults for all X device classes.
(remove-specifier (face-font face) locale x-tag-set nil))
- (set-face-font face fn locale 'x append)
- ;
- ; (debug-print "the face is %s, locale %s, specifier %s"
- ; face locale (face-font face))
- ;
+ (set-face-font face fn locale our-tag-set append)
+
;; And retain some of the fallbacks in the generated default face,
;; since we don't want to try andale-mono's ISO-10646-1 encoding for
- ;; Amharic or Thai. This is fragile; it depends on the code in
- ;; faces.c.
- (unless (featurep 'xft-fonts)
- (dolist (assocked '((x encode-as-utf-8 initial)
- (x two-dimensional initial)
- (x one-dimensional final)
- (x two-dimensional final)))
- (when (and (specifierp (face-font face))
- (consp (specifier-fallback (face-font face)))
- (setq assocked
- (assoc assocked
- (specifier-fallback
- (face-font face)))))
- (set-face-font face (cdr assocked) locale
- (nreverse (car assocked)) append)))))
+ ;; Amharic or Thai.
+ (when (and (specifierp (face-font face))
+ (consp (specifier-fallback (face-font face))))
+ (loop
+ for (tag-set . instantiator)
+ in (specifier-fallback (face-font face))
+ if (memq 'x-coverage-instantiator tag-set)
+ do (add-spec-list-to-specifier
+ (face-font face)
+ (list (cons (or locale 'global)
+ (list (cons tag-set instantiator))))
+ append))))
;; Kludge-o-rooni. Set the foreground and background resources for
;; X devices only -- otherwise things tend to get all messed up
＠＠ -814,14 +813,14 ＠＠
locale
x-tag-set)
(remove-specifier (face-foreground face) locale x-tag-set nil))
- (set-face-foreground face fg locale 'x append))
+ (set-face-foreground face fg locale our-tag-set append))
(when bg
(if device-class
(remove-specifier-specs-matching-tag-set-cdrs (face-background face)
locale
x-tag-set)
(remove-specifier (face-background face) locale x-tag-set nil))
- (set-face-background face bg locale 'x append))
+ (set-face-background face bg locale our-tag-set append))
(when bgp
(if device-class
(remove-specifier-specs-matching-tag-set-cdrs (face-background-pixmap
＠＠ -829,7 +828,7 ＠＠
locale
x-tag-set)
(remove-specifier (face-background-pixmap face) locale x-tag-set nil))
- (set-face-background-pixmap face bgp locale nil append))
+ (set-face-background-pixmap face bgp locale our-tag-set append))
(when ulp
(if device-class
(remove-specifier-specs-matching-tag-set-cdrs (face-property
＠＠ -838,7 +837,7 ＠＠
tty-tag-set)
(remove-specifier (face-property face 'underline) locale
tty-tag-set nil))
- (set-face-underline-p face ulp locale nil append))
+ (set-face-underline-p face ulp locale our-tag-set append))
(when stp
(if device-class
(remove-specifier-specs-matching-tag-set-cdrs (face-property
＠＠ -847,7 +846,7 ＠＠
tty-tag-set)
(remove-specifier (face-property face 'strikethru)
locale tty-tag-set nil))
- (set-face-strikethru-p face stp locale nil append))
+ (set-face-strikethru-p face stp locale our-tag-set append))
(when hp
(if device-class
(remove-specifier-specs-matching-tag-set-cdrs (face-property
＠＠ -856,7 +855,7 ＠＠
tty-tag-set)
(remove-specifier (face-property face 'highlight)
locale tty-tag-set nil))
- (set-face-highlight-p face hp locale nil append))
+ (set-face-highlight-p face hp locale our-tag-set append))
(when dp
(if device-class
(remove-specifier-specs-matching-tag-set-cdrs (face-property
＠＠ -864,7 +863,7 ＠＠
locale
tty-tag-set)
(remove-specifier (face-property face 'dim) locale tty-tag-set nil))
- (set-face-dim-p face dp locale nil append))
+ (set-face-dim-p face dp locale our-tag-set append))
(when bp
(if device-class
(remove-specifier-specs-matching-tag-set-cdrs (face-property
＠＠ -873,7 +872,7 ＠＠
tty-tag-set)
(remove-specifier (face-property face 'blinking) locale
tty-tag-set nil))
- (set-face-blinking-p face bp locale nil append))
+ (set-face-blinking-p face bp locale our-tag-set append))
(when rp
(if device-class
(remove-specifier-specs-matching-tag-set-cdrs (face-property
＠＠ -882,7 +881,7 ＠＠
tty-tag-set)
(remove-specifier (face-property face 'reverse) locale
tty-tag-set nil))
- (set-face-reverse-p face rp locale nil append))
+ (set-face-reverse-p face rp locale our-tag-set append))
))
;; GNU Emacs compatibility. (move to obsolete.el?)
Index: src/faces.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/faces.c,v
retrieving revision 1.53
diff -u -u -r1.53 faces.c
--- src/faces.c 2006/12/17 11:26:09 1.53
+++ src/faces.c 2007/01/01 23:36:52
＠＠ -2011,7 +2011,7 ＠＠
#ifdef MULE
-Lisp_Object Qone_dimensional, Qtwo_dimensional;
+Lisp_Object Qone_dimensional, Qtwo_dimensional, Qx_coverage_instantiator;
DEFUN ("specifier-tag-one-dimensional-p",
Fspecifier_tag_one_dimensional_p,
＠＠ -2108,6 +2108,8 ＠＠
#ifdef MULE
DEFSYMBOL (Qone_dimensional);
DEFSYMBOL (Qtwo_dimensional);
+ DEFSYMBOL (Qx_coverage_instantiator);
+
/* I would much prefer these were in Lisp. */
DEFSUBR (Fspecifier_tag_one_dimensional_p);
DEFSUBR (Fspecifier_tag_two_dimensional_p);
＠＠ -2307,6 +2309,13 ＠＠
define_specifier_tag (Qencode_as_utf_8, Qnil,
intern("specifier-tag-encode-as-utf-8-p"));
+
+ /* This tag is used to group those instantiators made available in the
+ fallback for the sake of coverage of obscure characters, notably
+ Markus Kuhn's misc-fixed fonts. They will be copied from the fallback
+ when the default face is determined from X resources at startup. */
+ define_specifier_tag (Qx_coverage_instantiator, Qnil, Qnil);
+
#endif /* MULE */
#ifdef USE_XFT
＠＠ -2333,7 +2342,7 ＠＠
inst_list =
Fcons
(Fcons
- (list3(device_symbol, Qtwo_dimensional, Qfinal),
+ (list4(device_symbol, Qtwo_dimensional, Qfinal, Qx_coverage_instantiator),
build_string
("-misc-fixed-medium-r-normal--15-140-75-75-c-90-iso10646-1")),
inst_list);
＠＠ -2345,7 +2354,7 ＠＠
inst_list =
Fcons
(Fcons
- (list3(device_symbol, Qone_dimensional, Qfinal),
+ (list4(device_symbol, Qone_dimensional, Qfinal, Qx_coverage_instantiator),
build_string
("-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso10646-1")),
inst_list);
＠＠ -2365,7 +2374,7 ＠＠
inst_list =
Fcons
(Fcons
- (list3(device_symbol, Qencode_as_utf_8, Qinitial),
+ (list4(device_symbol, Qencode_as_utf_8, Qinitial, Qx_coverage_instantiator),
build_string
("-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso10646-1")),
inst_list);
Index: src/specifier.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/specifier.c,v
retrieving revision 1.51
diff -u -u -r1.51 specifier.c
--- src/specifier.c 2006/12/11 12:22:52 1.51
+++ src/specifier.c 2007/01/01 23:36:57
＠＠ -1310,18 +1310,17 ＠＠
assert(3 == list_len);
device_predicate = XCADR(XCAR (rest));
- charset_predicate = XCADDR(XCAR (rest));
if (NILP (device_predicate))
{
- XCDR (XCAR (rest2)) = list2(Qt, charset_predicate);
+ XCDR (XCAR (rest2)) = Qt;
}
else
{
device_predicate = !NILP (call_critical_lisp_code
(d, device_predicate, device))
? Qt : Qnil;
- XCDR (XCAR (rest2)) = list2(device_predicate, charset_predicate);
+ XCDR (XCAR (rest2)) = device_predicate;
}
}
}
--
When I was in the scouts, the leader told me to pitch a tent. I couldn't
find any pitch, so I used creosote.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 2 comments