(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:
| | new |
| |glyph|
+----+-----+ <--- new descent
-")
+
+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.")
;; Encode composition rule RULE into an integer value. RULE is a cons
;; of global and new reference point symbols.
(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
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. In this case,
-characters are composed not relatively but according to COMPONENTS.
+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)))
(defun decompose-region (start end)
"Decompose text in the current region.
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 to the string.
+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)))
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 to the string. In
+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.
;; Copied from font-lock.el.
(eval-when-compile
- ;;
- ;; We don't do this at the top-level as we only use non-autoloaded macros.
- (require 'cl)
- ;;
;; Borrowed from lazy-lock.el.
;; We use this to preserve or protect things when modifying text properties.
(defmacro save-buffer-state (varlist &rest body)
,@body
(unless modified
(restore-buffer-modified-p nil))))
- (put 'save-buffer-state 'lisp-indent-function 1)
- ;; Fixme: This makes bootstrapping fails by this error.
+ ;; Fixme: This makes bootstrapping fail with this error.
;; Symbol's function definition is void: eval-defun
;;(def-edebug-spec save-buffer-state let)
)
-(defvar auto-composition-chunk-size 500
- "*Automatic composition chunks of this many characters, or smaller.")
+(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 to the string.
+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-restriction
- (save-match-data
- (let* ((start pos)
- (end (if string (length string) (point-max)))
- (limit (next-single-property-change pos 'auto-composed string
- end))
- (lines 0)
- ch func newpos)
- (if (> (- limit start) auto-composition-chunk-size)
- (setq limit (+ start auto-composition-chunk-size)))
- (while (and (< pos end)
- (setq ch (if string (aref string pos)
- (char-after pos)))
- (or (< pos limit)
- (/= ch ?\n)))
- (setq func (aref composition-function-table ch))
- (if (fboundp func)
- (setq newpos (funcall func pos string)
- pos (if (and (integerp newpos) (> newpos pos))
- newpos
- (1+ pos)))
- (setq pos (1+ pos))))
- (if (< pos limit)
- (setq pos (1+ pos)))
- (put-text-property start pos 'auto-composed t string)))))))
+ (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)
(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 earlier.
(make-obsolete 'decompose-composite-char 'char-to-string "21.1")
\f
+
+;;; arch-tag: ee703d77-1723-45d4-a31f-e9f0f867aa33
;;; composite.el ends here
HCoop / bpt / emacs.git / blobdiff