;;; composite.el --- support character composition
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
-;; 2008
+;; 2008, 2009, 2010
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Author: Kenichi HANDA <handa@etl.go.jp>
+;; (according to ack.texi)
;; Keywords: mule, multilingual, character composition
;; This file is part of GNU Emacs.
(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.
+Characters are composed relatively, i.e. composed by overstriking
+or stacking depending on ascent, descent and other metrics of
+glyphs.
+
+For instance, if the region has three characters \"XYZ\", X is
+regarded as BASE glyph, and Y is displayed:
+ (1) above BASE if Y's descent value is not positive
+ (2) below BASE if Y's ascent value is not positive
+ (3) on BASE (i.e. at the BASE position) otherwise
+and Z is displayed with the same rule while regarding the whole
+XY glyphs as BASE.
When called from a program, expects these four arguments.
(defsubst lglyph-set-from-to (glyph from to)
(progn (aset glyph 0 from) (aset glyph 1 to)))
(defsubst lglyph-set-char (glyph char) (aset glyph 2 char))
+(defsubst lglyph-set-code (glyph code) (aset glyph 3 code))
(defsubst lglyph-set-width (glyph width) (aset glyph 4 width))
(defsubst lglyph-set-adjustment (glyph &optional xoff yoff wadjust)
(aset glyph 9 (vector (or xoff 0) (or yoff 0) (or wadjust 0))))
(setq i (1+ i))))
gstring))))))
-(let ((elt '(["[[:alpha:]]\\c^+" 1 compose-gstring-for-graphic]
+(let ((elt `([,(purecopy "\\c.\\c^+") 1 compose-gstring-for-graphic]
[nil 0 compose-gstring-for-graphic])))
(map-char-table
#'(lambda (key val)
(nchars (lgstring-char-len gstring))
(nglyphs (lgstring-glyph-len gstring))
(i 0)
+ (coding (lgstring-font gstring))
glyph)
(while (and (< i nglyphs)
(setq glyph (lgstring-glyph gstring i)))
- (if (= (lglyph-width glyph) 0)
+ (if (not (char-charset (lglyph-char glyph) coding))
(progn
- ;; Compose by prepending a space.
- (setq gstring (lgstring-insert-glyph gstring i (lglyph-copy glyph))
- nglyphs (lgstring-glyph-len gstring))
- (lglyph-set-char (lgstring-glyph gstring i) 32)
- (setq i (+ 2)))
- (let ((from (lglyph-from glyph))
- (to (lglyph-to glyph))
- (j (1+ i)))
- (while (and (< j nglyphs)
- (setq glyph (lgstring-glyph gstring j))
- (= (lglyph-width glyph) 0))
- (setq to (lglyph-to glyph)
- j (1+ j)))
- (while (< i j)
- (setq glyph (lgstring-glyph gstring i))
- (lglyph-set-from-to glyph from to)
- (setq i (1+ i))))))
+ ;; As the terminal doesn't support this glyph, return a
+ ;; gstring in which each glyph is its own graphme-cluster
+ ;; of width 1..
+ (setq i 0)
+ (while (and (< i nglyphs)
+ (setq glyph (lgstring-glyph gstring i)))
+ (if (< (lglyph-width glyph) 1)
+ (lglyph-set-width glyph 1))
+ (lglyph-set-from-to glyph i i)
+ (setq i (1+ i))))
+ (if (= (lglyph-width glyph) 0)
+ (if (eq (get-char-code-property (lglyph-char glyph)
+ 'general-category)
+ 'Cf)
+ (progn
+ ;; Compose by replacing with a space.
+ (lglyph-set-char glyph 32)
+ (lglyph-set-width glyph 1)
+ (setq i (1+ i)))
+ ;; Compose by prepending a space.
+ (setq gstring (lgstring-insert-glyph gstring i
+ (lglyph-copy glyph))
+ nglyphs (lgstring-glyph-len gstring))
+ (setq glyph (lgstring-glyph gstring i))
+ (lglyph-set-char glyph 32)
+ (lglyph-set-width glyph 1)
+ (setq i (+ 2)))
+ (let ((from (lglyph-from glyph))
+ (to (lglyph-to glyph))
+ (j (1+ i)))
+ (while (and (< j nglyphs)
+ (setq glyph (lgstring-glyph gstring j))
+ (char-charset (lglyph-char glyph) coding)
+ (= (lglyph-width glyph) 0))
+ (setq to (lglyph-to glyph)
+ j (1+ j)))
+ (while (< i j)
+ (setq glyph (lgstring-glyph gstring i))
+ (lglyph-set-from-to glyph from to)
+ (setq i (1+ i)))))))
gstring))
in the region FROM (inclusive) and TO (exclusive).
If the character are composed on a graphic display, FONT-OBJECT
-is a font to use.
-
-Otherwise, FONT-OBJECT is nil, and the fucntion
+is a font to use. Otherwise, FONT-OBJECT is nil, and the function
`compose-gstring-for-terminal' is used instead of FUNC.
If STRING is non-nil, it is a string, and FROM and TO are indices
(let ((gstring (composition-get-gstring from to font-object string)))
(if (lgstring-shaped-p gstring)
gstring
- (or font-object
+ (or (fontp font-object 'font-object)
(setq func 'compose-gstring-for-terminal))
(funcall func gstring))))
+(make-variable-buffer-local 'auto-composition-mode)
+(put 'auto-composition-mode 'permanent-local t)
+
(make-variable-buffer-local 'auto-composition-function)
+(setq-default auto-composition-function 'auto-compose-chars)
;;;###autoload
-(define-minor-mode auto-composition-mode
+(defun auto-composition-mode (&optional arg)
"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
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 auto-composition-mode nil))
- (cond (auto-composition-mode
- (add-hook 'after-change-functions 'auto-composition-after-change nil t)
- (setq auto-composition-function 'auto-compose-chars))
- (t
- (remove-hook 'after-change-functions 'auto-composition-after-change t)
- (setq auto-composition-function nil)))
- (save-buffer-state nil
- (save-restriction
- (widen)
- (remove-text-properties (point-min) (point-max) '(auto-composed nil))
- (decompose-region (point-min) (point-max)))))
-
-(defun auto-composition-after-change (start end old-len)
- (save-buffer-state nil
- (if (< start (point-min))
- (setq start (point-min)))
- (if (> end (point-max))
- (setq end (point-max)))
- (when (and auto-composition-mode (not memory-full))
- (let (func1 func2)
- (when (and (> start (point-min))
- (setq func2 (aref composition-function-table
- (char-after (1- start))))
- (or (= start (point-max))
- (not (setq func1 (aref composition-function-table
- (char-after start))))
- (eq func1 func2)))
- (setq start (1- start)
- func1 func2)
- (while (eq func1 func2)
- (if (> start (point-min))
- (setq start (1- start)
- func2 (aref composition-function-table
- (char-after start)))
- (setq func2 nil))))
- (when (and (< end (point-max))
- (setq func2 (aref composition-function-table
- (char-after end)))
- (or (= end (point-min))
- (not (setq func1 (aref composition-function-table
- (char-after (1- end)))))
- (eq func1 func2)))
- (setq end (1+ end)
- func1 func2)
- (while (eq func1 func2)
- (if (< end (point-max))
- (setq func2 (aref composition-function-table
- (char-after end))
- end (1+ end))
- (setq func2 nil))))
- (if (< start end)
- (remove-text-properties start end '(auto-composed nil)))))))
-
-(defun turn-on-auto-composition-if-enabled ()
- (if enable-multibyte-characters
- (auto-composition-mode 1)))
+ (interactive "P")
+ (setq auto-composition-mode
+ (if arg
+ (or (not (integerp arg)) (> arg 0))
+ (not auto-composition-mode))))
;;;###autoload
-(define-global-minor-mode global-auto-composition-mode
- auto-composition-mode turn-on-auto-composition-if-enabled
- :extra-args (dummy)
- :initialize 'custom-initialize-safe-default
- :init-value (not noninteractive)
- :group 'auto-composition
- :version "23.1")
-
-(defun toggle-auto-composition (&optional arg)
- "Change whether automatic character composition is enabled in this buffer.
-With arg, enable it if and only if arg is positive."
+(defun global-auto-composition-mode (&optional arg)
+ "Toggle Auto-Composition mode in every possible buffer.
+With prefix arg, turn Global-Auto-Composition mode on if and only if arg
+is positive.
+See `auto-composition-mode' for more information on Auto-Composition mode."
(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)
- (remove-text-properties (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)))
- (font-obj (and (display-multi-font-p)
- (font-at (point) (selected-window))))
- (pos (point)))
- (if (and (functionp func) font-obj)
- (goto-char (funcall func (point) to font-obj nil)))
- (if (<= (point) pos)
- (forward-char 1)))))
- (put-text-property from to 'auto-composed t)
- (set-buffer-modified-p modified-p))))
+ (setq-default auto-composition-mode
+ (if arg
+ (or (not (integerp arg)) (> arg 0))
+ (not (default-value 'auto-composition-mode)))))
+(defalias 'toggle-auto-composition 'auto-composition-mode)
\f
;; The following codes are only for backward compatibility with Emacs