]> code.delx.au - gnu-emacs/blobdiff - lisp/composite.el
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-25
[gnu-emacs] / lisp / composite.el
index 4f8f1cb4ce28b012c581218b11f8d598c41f987e..8bb3028f778e9936895bb48cd577873a27b8bbbf 100644 (file)
@@ -73,28 +73,49 @@ follows (the point `*' corresponds to both reference points):
     |    | 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.
@@ -102,13 +123,20 @@ follows (the point `*' corresponds to both reference points):
 ;; 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
@@ -189,7 +217,7 @@ text in the composition."
     (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.
@@ -407,34 +435,39 @@ This function is the default value of `auto-composition-function' (which see)."
   (save-buffer-state nil
     (save-excursion
       (save-match-data
-       (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))
-         (catch 'tag
-           (if string
-               (while (< pos limit)
-                 (setq ch (aref string pos))
-                 (if (= ch ?\n)
-                     (throw 'tag nil))
-                 (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 nil))
-               (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))))))
-         (put-text-property start pos 'auto-composed t string))))))
+       (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)
 
@@ -501,4 +534,6 @@ Optional 3rd arg WITH-COMPOSITION-RULE is ignored."
 (make-obsolete 'decompose-composite-char 'char-to-string "21.1")
 
 \f
+
+;;; arch-tag: ee703d77-1723-45d4-a31f-e9f0f867aa33
 ;;; composite.el ends here