-;;; composite.el --- Support character composition.
+;;; composite.el --- support character composition
;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
-;;;###autoload
(defconst reference-point-alist
'((tl . 0) (tc . 1) (tr . 2)
(Bl . 3) (Bc . 4) (Br . 5)
(mid-left . 3) (mid-center . 10) (mid-right . 5))
"Alist of symbols vs integer codes of glyph reference points.
A glyph reference point symbol is to be used to specify a composition
-rule in COMPONENTS argument to such functions as `compose-region' and
-`make-composition'.
+rule in COMPONENTS argument to such functions as `compose-region'.
Meanings of glyph reference point codes are as follows:
be added.
For instance, if GLOBAL-REF-POINT is `br' (bottom-right) and
-NEW-REF-POINT is `tl' (top-left), the overall glyph is updated as
+NEW-REF-POINT is `tc' (top-center), the overall glyph is updated as
follows (the point `*' corresponds to both reference points):
+-------+--+ <--- new ascent
| | new |
| |glyph|
+----+-----+ <--- new descent
-")
-;; Encode composition rule RULE into an integer value. RULE is a cons
-;; of global and new reference point symbols.
-;; This must be compatible with C macro COMPOSITION_ENCODE_RULE
-;; defined in composite.h.
+A composition rule may have the form \(GLOBAL-REF-POINT
+NEW-REF-POINT XOFF YOFF), where XOFF and YOFF specifies how much
+to shift NEW-REF-POINT from GLOBAL-REF-POINT. In this case, XOFF
+and YOFF are integers in the range -100..100 representing the
+shifting percentage against the font size.")
+
+;;;###autoload
(defun encode-composition-rule (rule)
+ "Encode composition rule RULE into an integer value.
+RULE is a cons of global and new reference point symbols
+\(see reference-point-alist)."
+
+ ;; This must be compatible with C macro COMPOSITION_ENCODE_RULE
+ ;; defined in composite.h.
+
(if (and (integerp rule) (< rule 144))
;; Already encoded.
rule
- (or (consp rule)
- (error "Invalid composition rule: %S" rule))
- (let ((gref (car rule))
- (nref (cdr rule)))
- (or (integerp gref)
- (setq gref (cdr (assq gref reference-point-alist))))
- (or (integerp nref)
- (setq nref (cdr (assq nref reference-point-alist))))
- (or (and (>= gref 0) (< gref 12) (>= nref 0) (< nref 12))
- (error "Invalid composition rule: %S" rule))
- (+ (* gref 12) nref))))
+ (if (consp rule)
+ (let ((gref (car rule))
+ (nref (cdr rule))
+ xoff yoff)
+ (if (consp nref) ; (GREF NREF XOFF YOFF)
+ (progn
+ (setq xoff (nth 1 nref)
+ yoff (nth 2 nref)
+ nref (car nref))
+ (or (and (>= xoff -100) (<= xoff 100)
+ (>= yoff -100) (<= yoff 100))
+ (error "Invalid compostion rule: %s" rule))
+ (setq xoff (+ xoff 128) yoff (+ yoff 128)))
+ ;; (GREF . NREF)
+ (setq xoff 0 yoff 0))
+ (or (integerp gref)
+ (setq gref (cdr (assq gref reference-point-alist))))
+ (or (integerp nref)
+ (setq nref (cdr (assq nref reference-point-alist))))
+ (or (and (>= gref 0) (< gref 12) (>= nref 0) (< nref 12))
+ (error "Invalid composition rule: %S" rule))
+ (logior (lsh xoff 16) (lsh yoff 8) (+ (* gref 12) nref)))
+ (error "Invalid composition rule: %S" rule))))
;; Decode encoded composition rule RULE-CODE. The value is a cons of
;; global and new reference point symbols.
;; defined in composite.h.
(defun decode-composition-rule (rule-code)
- (or (and (natnump rule-code) (< rule-code 144))
+ (or (and (natnump rule-code) (< rule-code #x1000000))
(error "Invalid encoded composition rule: %S" rule-code))
- (let ((gref (car (rassq (/ rule-code 12) reference-point-alist)))
- (nref (car (rassq (% rule-code 12) reference-point-alist))))
+ (let ((xoff (lsh rule-code -16))
+ (yoff (logand (lsh rule-code -8) #xFF))
+ gref nref)
+ (setq rule-code (logand rule-code #xFF)
+ gref (car (rassq (/ rule-code 12) reference-point-alist))
+ nref (car (rassq (% rule-code 12) reference-point-alist)))
(or (and gref (symbolp gref) nref (symbolp nref))
(error "Invalid composition rule code: %S" rule-code))
- (cons gref nref)))
+ (if (and (= xoff 0) (= yoff 0))
+ (cons gref nref)
+ (setq xoff (- xoff 128) yoff (- yoff 128))
+ (list gref xoff yoff nref))))
;; Encode composition rules in composition components COMPONENTS. The
;; value is a copy of COMPONENTS, where composition rules (cons of
(setq i (+ i 2))))
components)
-;;;###autoload
(defun compose-region (start end &optional components modification-func)
"Compose characters in the current region.
+Characters are composed relatively, i.e. composed by overstricking or
+stacking depending on ascent, descent and other properties.
+
When called from a program, expects these four arguments.
First two arguments START and END are positions (integers or markers)
specifying the region.
-Optional 3rd argument COMPONENTS, if non-nil, is a character or a
-sequence (vector, list, or string) of integers.
+Optional 3rd argument COMPONENTS, if non-nil, is a character, a string
+or a vector or list of integers and rules.
If it is a character, it is an alternate character to display instead
of the text in the region.
(if (or (vectorp components) (listp components))
(setq components (encode-composition-components components)))
(compose-region-internal start end components modification-func)
- (set-buffer-modified-p modified-p)))
+ (restore-buffer-modified-p modified-p)))
-;;;###autoload
(defun decompose-region (start end)
"Decompose text in the current region.
(remove-text-properties start end '(composition nil))
(set-buffer-modified-p modified-p)))
-;;;###autoload
(defun compose-string (string &optional start end components modification-func)
"Compose characters in string STRING.
-The return value is STRING where `composition' property is put on all
+The return value is STRING with the `composition' property put on all
the characters in it.
Optional 2nd and 3rd arguments START and END specify the range of
-STRING to be composed. They defaults to the beginning and the end of
+STRING to be composed. They default to the beginning and the end of
STRING respectively.
Optional 4th argument COMPONENTS, if non-nil, is a character or a
(compose-string-internal string start end components modification-func)
string)
-;;;###autoload
(defun decompose-string (string)
"Return STRING where `composition' property is removed."
(remove-text-properties 0 (length string) '(composition nil) string)
string)
-;;;###autoload
(defun compose-chars (&rest args)
"Return a string from arguments in which all characters are composed.
For relative composition, arguments are characters.
(setq str (concat args)))
(compose-string-internal str 0 (length str) components)))
-;;;###autoload
(defun find-composition (pos &optional limit string detail-p)
"Return information about a composition at or nearest to buffer position POS.
result))
\f
-;; A char-table of functions to call for compositions.
-;;;###autoload
-(put 'composition-function-table 'char-table-extra-slots 0)
-
-;;;###autoload
-(defvar composition-function-table
- (make-char-table 'composition-function-table)
- "Char table of patterns and functions to make a composition.
-
-Each element is nil or an alist of PATTERNs vs FUNCs, where PATTERNs
-are regular expressions and FUNCs are functions. FUNC is responsible
-for composing text matching the corresponding PATTERN. FUNC is called
-with three arguments FROM, TO, and PATTERN. See the function
-`compose-chars-after' for more detail.
-
-This table is looked up by the first character of a composition when
-the composition gets invalid after a change in a buffer.")
-
-;;;###autoload
-(defun compose-chars-after (pos &optional limit)
+(defun compose-chars-after (pos &optional limit object)
"Compose characters in current buffer after position POS.
It looks up the char-table `composition-function-table' (which see) by
Optional 2nd arg LIMIT, if non-nil, limits the matching of text.
+Optional 3rd arg OBJECT, if non-nil, is a string that contains the
+text to compose. In that case, POS and LIMIT index into the string.
+
This function is the default value of `compose-chars-after-function'."
(let ((tail (aref composition-function-table (char-after pos)))
pattern func result)
(when tail
(save-match-data
(save-excursion
- (while (and tail (not func))
+ (while (and tail (not func))
(setq pattern (car (car tail))
func (cdr (car tail)))
(goto-char pos)
(setq func nil tail (cdr tail)))))))
result))
-;;;###autoload
(defun compose-last-chars (args)
"Compose last characters.
-The argument is a parameterized event of the form (compose-last-chars N),
-where N is the number of characters before point to compose.
+The argument is a parameterized event of the form
+ \(compose-last-chars N COMPONENTS),
+where N is the number of characters before point to compose,
+COMPONENTS, if non-nil, is the same as the argument to `compose-region'
+\(which see). If it is nil, `compose-chars-after' is called,
+and that function find a proper rule to compose the target characters.
This function is intended to be used from input methods.
The global keymap binds special event `compose-last-chars' to this
-function. Input method may generate an event (compose-last-chars N)
+function. Input method may generate an event (compose-last-chars N COMPONENTS)
after a sequence character events."
(interactive "e")
(let ((chars (nth 1 args)))
(if (and (numberp chars)
(>= (- (point) (point-min)) chars))
- (compose-chars-after (- (point) chars) (point)))))
+ (if (nth 2 args)
+ (compose-region (- (point) chars) (point) (nth 2 args))
+ (compose-chars-after (- (point) chars) (point))))))
+
+(global-set-key [compose-last-chars] 'compose-last-chars)
+
+\f
+;;; Automatic character composition.
-;;;###autoload(global-set-key [compose-last-chars] 'compose-last-chars)
+(defvar composition-function-table
+ (make-char-table nil)
+ "Char table of functions for automatic character composition.
+For each character that has to be composed automatically with
+preceding and/or following characters, this char table contains
+a function to call to compose that character.
+
+Each function is called with two arguments, POS and STRING.
+
+If STRING is nil, POS is a position in the current buffer, and the
+function has to compose a character at POS with surrounding characters
+in the current buffer.
+
+Otherwise, STRING is a string, and POS is an index into the string. In
+this case, the function has to compose a character at POS with
+surrounding characters in the string.
+
+See also the command `toggle-auto-composition'.")
+
+;; Copied from font-lock.el.
+(eval-when-compile
+ ;; Borrowed from lazy-lock.el.
+ ;; We use this to preserve or protect things when modifying text properties.
+ (defmacro save-buffer-state (varlist &rest body)
+ "Bind variables according to VARLIST and eval BODY restoring buffer state."
+ `(let* ,(append varlist
+ '((modified (buffer-modified-p)) (buffer-undo-list t)
+ (inhibit-read-only t) (inhibit-point-motion-hooks t)
+ (inhibit-modification-hooks t)
+ deactivate-mark buffer-file-name buffer-file-truename))
+ ,@body
+ (unless modified
+ (restore-buffer-modified-p nil))))
+ ;; Fixme: This makes bootstrapping fail with this error.
+ ;; Symbol's function definition is void: eval-defun
+ ;;(def-edebug-spec save-buffer-state let)
+ )
+
+(put 'save-buffer-state 'lisp-indent-function 1)
+
+(defun auto-compose-chars (pos string)
+ "Compose characters after the buffer position POS.
+If STRING is non-nil, it is a string, and POS is an index into the string.
+In that case, compose characters in the string.
+
+This function is the default value of `auto-composition-function' (which see)."
+ (save-buffer-state nil
+ (save-excursion
+ (save-match-data
+ (condition-case nil
+ (let ((start pos)
+ (limit (if string (length string) (point-max)))
+ ch func newpos)
+ (setq limit
+ (or (text-property-any pos limit 'auto-composed t string)
+ limit)
+ pos
+ (catch 'tag
+ (if string
+ (while (< pos limit)
+ (setq ch (aref string pos))
+ (if (= ch ?\n)
+ (throw 'tag (1+ pos)))
+ (setq func (aref composition-function-table ch))
+ (if (and (functionp func)
+ (setq newpos (funcall func pos string))
+ (> newpos pos))
+ (setq pos newpos)
+ (setq pos (1+ pos))))
+ (while (< pos limit)
+ (setq ch (char-after pos))
+ (if (= ch ?\n)
+ (throw 'tag (1+ pos)))
+ (setq func (aref composition-function-table ch))
+ (if (and (functionp func)
+ (setq newpos (funcall func pos string))
+ (> newpos pos))
+ (setq pos newpos)
+ (setq pos (1+ pos)))))
+ limit))
+ (put-text-property start pos 'auto-composed t string))
+ (error nil))))))
+
+(setq auto-composition-function 'auto-compose-chars)
+
+(defun toggle-auto-composition (&optional arg)
+ "Change whether automatic character composition is enabled in this buffer.
+With arg, enable it iff arg is positive."
+ (interactive "P")
+ (let ((enable (if (null arg) (not auto-composition-function)
+ (> (prefix-numeric-value arg) 0))))
+ (if enable
+ (kill-local-variable 'auto-composition-function)
+ (make-local-variable 'auto-composition-function)
+ (setq auto-composition-function nil)
+ (save-buffer-state nil
+ (save-restriction
+ (widen)
+ (decompose-region (point-min) (point-max)))))
+
+ (save-buffer-state nil
+ (save-restriction
+ (widen)
+ (put-text-property (point-min) (point-max) 'auto-composed nil)))))
+
+(defun auto-compose-region (from to)
+ "Force automatic character composition on the region FROM and TO."
+ (save-excursion
+ (if (get-text-property from 'auto-composed)
+ (setq from (next-single-property-change from 'auto-composed nil to)))
+ (goto-char from)
+ (let ((modified-p (buffer-modified-p))
+ (inhibit-read-only '(composition auto-composed))
+ (stop (next-single-property-change (point) 'auto-composed nil to)))
+ (while (< (point) to)
+ (if (= (point) stop)
+ (progn
+ (goto-char (next-single-property-change (point)
+ 'auto-composed nil to))
+ (setq stop (next-single-property-change (point)
+ 'auto-composed nil to)))
+ (let ((func (aref composition-function-table (following-char)))
+ (pos (point)))
+ (if (functionp func)
+ (goto-char (funcall func (point) nil)))
+ (if (<= (point) pos)
+ (forward-char 1)))))
+ (put-text-property from to 'auto-composed t)
+ (set-buffer-modified-p modified-p))))
\f
;;; The following codes are only for backward compatibility with Emacs
-;;; 20.4 and the earlier.
+;;; 20.4 and earlier.
-;;;###autoload
(defun decompose-composite-char (char &optional type with-composition-rule)
"Convert CHAR to string.
-This is only for backward compatibility with Emacs 20.4 and the earlier.
If optional 2nd arg TYPE is non-nil, it is `string', `list', or
-`vector'. In this case, CHAR is converted string, list of CHAR, or
-vector of CHAR respectively."
+`vector'. In this case, CHAR is converted to string, list of CHAR, or
+vector of CHAR respectively.
+Optional 3rd arg WITH-COMPOSITION-RULE is ignored."
(cond ((or (null type) (eq type 'string)) (char-to-string char))
((eq type 'list) (list char))
(t (vector char))))
(make-obsolete 'decompose-composite-char 'char-to-string "21.1")
\f
+
+;;; arch-tag: ee703d77-1723-45d4-a31f-e9f0f867aa33
;;; composite.el ends here