;;; composite.el --- support character composition
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;; 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
nref (car nref))
(or (and (>= xoff -100) (<= xoff 100)
(>= yoff -100) (<= yoff 100))
- (error "Invalid compostion rule: %s" rule))
+ (error "Invalid composition rule: %s" rule))
(setq xoff (+ xoff 128) yoff (+ yoff 128)))
;; (GREF . NREF)
(setq xoff 0 yoff 0))
(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
-a character after POS. If non-nil value is found, the format of the
-value should be an alist of PATTERNs vs FUNCs, where PATTERNs are
-regular expressions and FUNCs are functions. If the text after POS
-matches one of PATTERNs, call the corresponding FUNC with three
-arguments POS, TO, and PATTERN, where TO is the end position of text
-matching PATTERN, and return what FUNC returns. Otherwise, return
-nil.
+It looks up the char-table `composition-function-table' (which
+see) by a character at POS, and compose characters after POS
+according to the contents of `composition-function-table'.
-FUNC is responsible for composing the text properly. The return value
-is:
- nil -- if no characters were composed.
- CHARS (integer) -- if CHARS characters were composed.
-
-Optional 2nd arg LIMIT, if non-nil, limits the matching of text.
+Optional 2nd arg LIMIT, if non-nil, limits characters to compose.
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)))
+ (font-obj (and (display-multi-font-p)
+ (and (not (stringp object))
+ (font-at pos (selected-window)))))
pattern func result)
+ (or limit
+ (setq limit (if (stringp object) (length object) (point-max))))
(when tail
(save-match-data
(save-excursion
- (while (and tail (not func))
- (setq pattern (car (car tail))
- func (cdr (car tail)))
+ (while tail
+ (if (functionp (car tail))
+ (setq pattern nil func (car tail))
+ (setq pattern (car (car tail))
+ func (cdr (car tail))))
(goto-char pos)
- (if (if limit
- (and (re-search-forward pattern limit t)
- (= (match-beginning 0) pos))
- (looking-at pattern))
- (setq result (funcall func pos (match-end 0) pattern nil))
- (setq func nil tail (cdr tail)))))))
- result))
+ (if pattern
+ (if (and (if (stringp object)
+ (eq (string-match pattern object) 0)
+ (looking-at pattern))
+ (<= (match-end 0) limit))
+ (setq result
+ (funcall func pos (match-end 0) font-obj object)))
+ (setq result (funcall func pos limit font-obj object)))
+ (if result (setq tail nil))))))
+ result))
(defun compose-last-chars (args)
"Compose last characters.
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.
+An element, if non-nil, is FUNC or an alist of PATTERNs vs FUNCs,
+where PATTERNs are regular expressions and FUNCs are functions.
+If the element is FUNC, FUNC itself determines the region to
+compose.
+
+Each function is called with 4 arguments, FROM, TO, FONT-OBJECT,
+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.
+If STRING is nil, FROM and TO are positions specifying the region
+matching with PATTERN in the current buffer, and the function has
+to compose character in that region (possibly with characters
+preceding FROM). FONT-OBJECT may be nil if not
+available (e.g. for the case of terminal). The return value of
+the function is the end position where characters are composed,
+or nil if no composition is made.
-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.
+Otherwise, STRING is a string, and FROM and TO are indices into
+the string. In this case, the function has to compose a
+character in the string. The others are the same as above.
-See also the command `toggle-auto-composition'.")
+See also the documentation of `auto-composition-mode'.")
;; Copied from font-lock.el.
(eval-when-compile
(put 'save-buffer-state 'lisp-indent-function 1)
-;; This function is called when a composition created by
-;; terminal-composition-function is partially modified.
-(defun terminal-composition-modification (from to)
- (terminal-composition-function from))
-
-(defun terminal-composition-function (pos &optional string)
+(defun terminal-composition-function (from to font-object string)
"General composition function used on terminal.
Non-spacing characters are composed with the preceding spacing
character. All non-spacing characters has this function in
`terminal-composition-function-table'."
- (let ((from (1- pos))
- ch)
+ (let ((pos (1+ from)))
(if string
- (length string)
- (setq pos (1+ pos))
- (while (and (< pos (point-max))
+ (progn
+ (while (and (< pos to)
+ (= (aref char-width-table (aref string pos)) 0))
+ (setq pos (1+ pos)))
+ (if (> from 0)
+ (compose-string string (1- from) pos)
+ (compose-string string from pos
+ (concat " " (buffer-substring from pos)))))
+ (while (and (< pos to)
(= (aref char-width-table (char-after pos)) 0))
(setq pos (1+ pos)))
- (if (and (>= from (point-min))
- (= (aref (symbol-name (get-char-code-property
- (char-after from)
- 'general-category)) 0) ?L))
- (compose-region from pos (buffer-substring from pos))
- (compose-region (1+ from) pos
- (concat " " (buffer-substring (1+ from) pos))
- 'terminal-composition-modification))
- pos)))
+ (if (> from (point-min))
+ (compose-region (1- from) pos (buffer-substring from pos))
+ (compose-region from pos
+ (concat " " (buffer-substring from pos)))))
+ pos))
(defvar terminal-composition-function-table
(let ((table (make-char-table nil)))
This is like `composition-function-table' but used when Emacs is running
on a terminal.")
-(defvar auto-compose-current-font nil
- "The current font-object used for characters being composed automatically.")
-
-(defun auto-compose-chars (pos string font-object)
- "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.
-FONT-OBJECT is a font selected for the character at POS.
+(defun auto-compose-chars (from to window string)
+ "Compose characters in the region between FROM and TO.
+WINDOW is a window displaying the current buffer.
+If STRING is non-nil, it is a string, and FROM and TO are indices
+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)))
- (auto-compose-current-font font-object)
- (table (if (display-graphic-p)
- composition-function-table
- terminal-composition-function-table))
- 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 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 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))))))
+ (save-restriction
+ (save-match-data
+ (let ((table (if (display-graphic-p)
+ composition-function-table
+ terminal-composition-function-table))
+ (start from))
+ (setq to (or (text-property-any (1+ from) to 'auto-composed t
+ string)
+ to))
+ (if string
+ (while (< from to)
+ (let* ((ch (aref string from))
+ (elt (aref table ch))
+ font-obj newpos)
+ (when elt
+ (if window
+ (setq font-obj (font-at from window string)))
+ (if (functionp elt)
+ (setq newpos (funcall elt from to font-obj string))
+ (while (and elt
+ (or (not (eq (string-match (caar elt) string
+ from)
+ from))
+ (not (setq newpos
+ (funcall (cdar elt) from
+ (match-end 0)
+ font-obj string)))))
+ (setq elt (cdr elt)))))
+ (if (and newpos (> newpos from))
+ (setq from newpos)
+ (setq from (1+ from)))))
+ (narrow-to-region from to)
+ (while (< from to)
+ (let* ((ch (char-after from))
+ (elt (aref table ch))
+ func pattern font-obj newpos)
+ (when elt
+ (if window
+ (setq font-obj (font-at from window)))
+ (if (functionp elt)
+ (setq newpos (funcall elt from to font-obj nil))
+ (goto-char from)
+ (while (and elt
+ (or (not (looking-at (caar elt)))
+ (not (setq newpos
+ (funcall (cdar elt) from
+ (match-end 0)
+ font-obj nil)))))
+ (setq elt (cdr elt)))))
+ (if (and newpos (> newpos from))
+ (setq from newpos)
+ (setq from (1+ from))))))
+ (put-text-property start to 'auto-composed t string)))))))
(make-variable-buffer-local 'auto-composition-function)
;;;###autoload
(define-minor-mode auto-composition-mode
- "Toggle Auto Compostion mode.
-With arg, turn Auto Compostion mode off if and only if arg is a non-positive
-number; if arg is nil, toggle Auto Compostion mode; anything else turns Auto
-Compostion on.
+ "Toggle Auto Composition mode.
+With ARG, turn Auto Composition mode off if and only if ARG is a non-positive
+number; if ARG is nil, toggle Auto Composition mode; anything else turns Auto
+Composition on.
When Auto Composition is enabled, text characters are automatically composed
by functions registered in `composition-function-table' (which see).
-You can use Global Auto Composition mode to automagically turn on
+You can use `global-auto-composition-mode' to turn on
Auto Composition mode in all buffers (this is the default)."
nil nil nil
(if noninteractive
(setq stop (next-single-property-change (point)
'auto-composed nil to)))
(let ((func (aref composition-function-table (following-char)))
+ (font-obj (and (display-multi-font-p)
+ (font-at (point) (selected-window))))
(pos (point)))
(if (functionp func)
- (goto-char (funcall func (point) nil)))
+ (goto-char (funcall func (point) to font-obj nil)))
(if (<= (point) pos)
(forward-char 1)))))
(put-text-property from to 'auto-composed t)