))
(defun x-decompose-font-name (pattern)
- "Decompose PATTERN into XLFD's fields and return vector of the fields.
-The length of the vector is 14.
-
-If PATTERN doesn't conform to XLFD, try to get a full XLFD name from
-X server and use the information of the full name to decompose
-PATTERN. If no full XLFD name is gotten, return nil."
- (let (xlfd-fields fontname)
- (if (string-match xlfd-tight-regexp pattern)
- (let ((i 0))
- (setq xlfd-fields (make-vector 14 nil))
- (while (< i 14)
- (aset xlfd-fields i (match-string (1+ i) pattern))
- (setq i (1+ i)))
- xlfd-fields)
- (setq fontname (condition-case nil
- (x-resolve-font-name pattern)
- (error)))
- (if (and fontname
- (string-match xlfd-tight-regexp fontname))
- ;; We get a full XLFD name.
- (let ((len (length pattern))
- (i 0)
- l)
- ;; Setup xlfd-fields by the full XLFD name. Each element
- ;; should be a cons of matched index and matched string.
- (setq xlfd-fields (make-vector 14 nil))
- (while (< i 14)
- (aset xlfd-fields i
- (cons (match-beginning (1+ i))
- (match-string (1+ i) fontname)))
- (setq i (1+ i)))
-
- ;; Replace wild cards in PATTERN by regexp codes.
- (setq i 0)
- (while (< i len)
- (let ((ch (aref pattern i)))
- (if (= ch ??)
- (setq pattern (concat (substring pattern 0 i)
- "\\(.\\)"
- (substring pattern (1+ i)))
- len (+ len 4)
- i (+ i 4))
- (if (= ch ?*)
- (setq pattern (concat (substring pattern 0 i)
- "\\(.*\\)"
- (substring pattern (1+ i)))
- len (+ len 5)
- i (+ i 5))
- (setq i (1+ i))))))
-
- ;; Set each element of xlfd-fields to proper strings.
- (if (string-match pattern fontname)
- ;; The regular expression PATTERN matchs the full XLFD
- ;; name. Set elements that correspond to a wild card
- ;; in PATTERN to "*", set the other elements to the
- ;; exact strings in PATTERN.
- (let ((l (cdr (cdr (match-data)))))
- (setq i 0)
- (while (< i 14)
- (if (or (null l) (< (car (aref xlfd-fields i)) (car l)))
- (progn
- (aset xlfd-fields i (cdr (aref xlfd-fields i)))
- (setq i (1+ i)))
- (if (< (car (aref xlfd-fields i)) (car (cdr l)))
- (progn
- (aset xlfd-fields i "*")
- (setq i (1+ i)))
- (setq l (cdr (cdr l)))))))
- ;; Set each element of xlfd-fields to the exact string
- ;; in the corresonding fields in full XLFD name.
- (setq i 0)
- (while (< i 14)
- (aset xlfd-fields i (cdr (aref xlfd-fields i)))
- (setq i (1+ i))))
- xlfd-fields)))))
-
-;; Replace consecutive wild-cards (`*') in NAME to one.
-;; Ex. (x-reduce-font-name "-*-*-*-iso8859-1") => "-*-iso8859-1"
-(defsubst x-reduce-font-name (name)
- (while (string-match "-\\*-\\(\\*-\\)+" name)
- (setq name (replace-match "-*-" t t name)))
- name)
+ "Decompose PATTERN into XLFD fields and return a vector of the fields.
+The length of the vector is 12.
+The FOUNDRY and FAMILY fields are concatinated and stored in the first
+element of the vector.
+The REGISTRY and ENCODING fields are concatinated and stored in the last
+element of the vector.
+
+Return nil if PATTERN doesn't conform to XLFD."
+ (if (string-match xlfd-tight-regexp pattern)
+ (let ((xlfd-fields (make-vector 12 nil)))
+ (dotimes (i 12)
+ (aset xlfd-fields i (match-string (1+ i) pattern)))
+ (dotimes (i 12)
+ (if (string-match "^[*-]+$" (aref xlfd-fields i))
+ (aset xlfd-fields i nil)))
+ xlfd-fields)))
(defun x-compose-font-name (fields &optional reduce)
- "Compose X's fontname from FIELDS.
-FIELDS is a vector of XLFD fields, of length 14.
+ "Compose X fontname from FIELDS.
- FIELDS is a vector of XLFD fields, the length 12.
++FIELDS is a vector of XLFD fields, of length 12.
If a field is nil, wild-card letter `*' is embedded.
- Optional argument REDUCE is always ignored. It exists just for
- backward compatibility."
+ Optional argument REDUCE exists just for backward compatibility,
+ and is always ignored."
(concat "-" (mapconcat (lambda (x) (or x "*")) fields "-")))
+
(defun x-must-resolve-font-name (xlfd-fields)
"Like `x-resolve-font-name', but always return a font name.
XLFD-FIELDS is a vector of XLFD (X Logical Font Description) fields.
&optional style-variant noerror)
"Create a fontset from fontset specification string FONTSET-SPEC.
FONTSET-SPEC is a string of the format:
- FONTSET-NAME,SCRIPT-NAME0:FONT-NAME0,SCRIPT-NAME1:FONT-NAME1, ...
- FONTSET-NAME,CHARSET0:FONT0,CHARSET1:FONT1, ...
++ FONTSET-NAME,SCRIPT0:FONT0,SCRIPT1:FONT1, ...
Any number of SPACE, TAB, and NEWLINE can be put before and after commas.
-Optional 2nd arg exists just for backward compatibility, and is ignored.
+When a frame uses the fontset as the `font' parameter, the frame's
+default font name is derived from FONTSET-NAME by substituting
+\"iso8859-1\" for the tail part \"fontset-XXX\". But, if SCRIPT-NAMEn
+is \"ascii\", use the corresponding FONT-NAMEn as the default font
+name.
- Optional 2nd and 3rd arguments are ignored. They exist just for
- backward compatibility.
-If this function attempts to create already existing fontset, an error is
-signaled unless the optional 3rd argument NOERROR is non-nil.
++Optional 2nd and 3rd arguments exist just for backward compatibility,
++and are ignored.
-It returns a name of the created fontset."
- (if (not (string-match "^[^,]+" fontset-spec))
+It returns a name of the created fontset.
+
+For backward compatibility, SCRIPT-NAME may be a charset name, in
+which case, the corresponding script is decided by the variable
+`charset-script-alist' (which see)."
+ (or (string-match "^[^,]+" fontset-spec)
(error "Invalid fontset spec: %s" fontset-spec))
- (setq fontset-spec (downcase fontset-spec))
(let ((idx (match-end 0))
(name (match-string 0 fontset-spec))
- xlfd-fields charset fontlist ascii-font)
- (if (query-fontset name)
- (or noerror
- (error "Fontset \"%s\" already exists" name))
- (setq xlfd-fields (x-decompose-font-name name))
- (or xlfd-fields
- (error "Fontset \"%s\" not conforming to XLFD" name))
-
- ;; At first, extract pairs of charset and fontname from FONTSET-SPEC.
- (while (string-match "[, \t\n]*\\([^:]+\\):[ \t]*\\([^,]+\\)"
- fontset-spec idx)
- (setq idx (match-end 0))
- (setq charset (intern (match-string 1 fontset-spec)))
- (if (charsetp charset)
- (setq fontlist (cons (cons charset (match-string 2 fontset-spec))
- fontlist))))
- (setq ascii-font (cdr (assq 'ascii fontlist)))
-
- ;; Complement FONTLIST.
- (setq fontlist (x-complement-fontset-spec xlfd-fields fontlist))
-
- (new-fontset name fontlist)
-
- ;; Define the short name alias.
- (if (and (string-match "fontset-.*$" name)
- (not (assoc name fontset-alias-alist)))
- (let ((alias (match-string 0 name)))
- (or (rassoc alias fontset-alias-alist)
- (setq fontset-alias-alist
- (cons (cons name alias) fontset-alias-alist)))))
-
- ;; Define the ASCII font name alias.
- (or ascii-font
- (setq ascii-font (cdr (assq 'ascii fontlist))))
- (or (rassoc ascii-font fontset-alias-alist)
- (setq fontset-alias-alist
- (cons (cons name ascii-font)
- fontset-alias-alist))))
-
- name))
+ xlfd-fields target script fontlist)
+ (setq xlfd-fields (x-decompose-font-name name))
+ (or xlfd-fields
+ (error "Fontset name \"%s\" not conforming to XLFD" name))
+
+ ;; At first, extract pairs of charset and fontname from FONTSET-SPEC.
+ (while (string-match "[, \t\n]*\\([^:]+\\):[ \t]*\\([^,]+\\)"
+ fontset-spec idx)
+ (setq idx (match-end 0))
+ (setq target (intern (match-string 1 fontset-spec)))
+ (cond ((or (eq target 'ascii)
+ (memq target (char-table-extra-slot char-script-table 0)))
+ (push (list target (match-string 2 fontset-spec)) fontlist))
+ ((setq script (cdr (assq target charset-script-alist)))
+ (push (list script (match-string 2 fontset-spec)) fontlist))
+ ((charsetp target)
+ (push (list target (match-string 2 fontset-spec)) fontlist))))
+
+ ;; Complement FONTLIST.
+ (setq fontlist (x-complement-fontset-spec xlfd-fields fontlist))
+
+ ;; Create a fontset.
+ (new-fontset name (nreverse fontlist))))
(defun create-fontset-from-ascii-font (font &optional resolved-font
fontset-name)
#define BIT_UPPER 0x10
#define BIT_MULTIBYTE 0x20
-/* Set a range START..END to WORK_AREA.
- The range is passed through TRANSLATE, so START and END
- should be untranslated. */
-#define SET_RANGE_TABLE_WORK_AREA(work_area, start, end) \
+/* Set a range (RANGE_START, RANGE_END) to WORK_AREA. */
+#define SET_RANGE_TABLE_WORK_AREA(work_area, range_start, range_end) \
do { \
- int tem; \
- tem = set_image_of_range (&work_area, start, end, translate); \
- if (tem > 0) \
- FREE_STACK_RETURN (tem); \
+ EXTEND_RANGE_TABLE ((work_area), 2); \
+ (work_area).table[(work_area).used++] = (range_start); \
+ (work_area).table[(work_area).used++] = (range_end); \
} while (0)
- /* Free allocated memory for WORK_AREA. */
+ /* Free allocated memory for WORK_AREA. */
#define FREE_RANGE_TABLE_WORK_AREA(work_area) \
do { \
if ((work_area).table) \
d++;
range--;
}
-#ifdef emacs
- if (multibyte && range > lim)
+ }
+ else
+ {
+ if (multibyte)
+ while (range > lim)
{
- /* Check that we are at the beginning of a char. */
- int at_boundary;
- AT_CHAR_BOUNDARY_P (at_boundary, d, d_start);
- if (at_boundary)
+ int buf_charlen;
+
+ buf_ch = STRING_CHAR_AND_LENGTH (d, range - lim,
+ buf_charlen);
+ if (fastmap[CHAR_LEADING_CODE (buf_ch)])
break;
- else
- { /* We have matched an internal byte of a char
- rather than the leading byte, so it's a false
- positive: we should keep scanning. */
- d++; range--;
- }
+ range -= buf_charlen;
+ d += buf_charlen;
}
- else
-#endif
- break;
- } while (1);
-
+ else
+ while (range > lim && !fastmap[*d])
+ {
+ d++;
+ range--;
+ }
+ }
startpos += irange - range;
}
- else /* Searching backwards. */
+ else /* Searching backwards. */
{
int room = (startpos >= size1
? size2 + size1 - startpos
}
WEAK_ALIAS (__re_match_2, re_match_2)
+#ifdef emacs
+#define TRANSLATE_VIA_MULTIBYTE(c) \
+ do { \
+ if (multibyte) \
+ (c) = TRANSLATE (c); \
+ else \
+ { \
+ MAKE_CHAR_MULTIBYTE (c); \
+ (c) = TRANSLATE (c); \
+ MAKE_CHAR_UNIBYTE (c); \
+ } \
+ } while (0)
+
+#else
+#define TRANSLATE_VIA_MULTIBYTE(c) ((c) = TRANSLATE (c))
+#endif
+
+
/* This is a separate function so that we can force an alloca cleanup
- afterwards. */
+ afterwards. */
static int
re_match_2_internal (bufp, string1, size1, string2, size2, pos, regs, stop)
struct re_pattern_buffer *bufp;