X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/463f5630a5e7cbe7f042bc1175d1fa1c4e98860f..40fb2103c2986cbb91add4afed635886c4f87ae5:/lisp/composite.el

diff --git a/lisp/composite.el b/lisp/composite.el
index 1f279cd6a1..8bb3028f77 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -26,7 +26,6 @@
 
 ;;; Code:
 
-;;;###autoload
 (defconst reference-point-alist
   '((tl . 0) (tc . 1) (tr . 2)
     (Bl . 3) (Bc . 4) (Br . 5)
@@ -41,8 +40,7 @@
     (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:
 
@@ -75,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.
@@ -104,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
@@ -154,7 +180,6 @@ follows (the point `*' corresponds to both reference points):
       (setq i (+ i 2))))
   components)
 
-;;;###autoload
 (defun compose-region (start end &optional components modification-func)
   "Compose characters in the current region.
 
@@ -166,9 +191,8 @@ 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.  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.
@@ -193,9 +217,8 @@ 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)))
 
-;;;###autoload
 (defun decompose-region (start end)
   "Decompose text in the current region.
 
@@ -207,15 +230,14 @@ positions (integers or markers) specifying the 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
@@ -232,13 +254,11 @@ text in the composition."
   (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.
@@ -262,7 +282,6 @@ A composition rule is a cons of glyph reference points of the form
       (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.
 
@@ -302,7 +321,6 @@ WIDTH is a number of columns the composition occupies on the screen."
     result))
 
 
-;;;###autoload
 (defun compose-chars-after (pos &optional limit object)
   "Compose characters in current buffer after position POS.
 
@@ -323,7 +341,7 @@ is:
 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)))
@@ -343,7 +361,6 @@ This function is the default value of `compose-chars-after-function'."
 	      (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
@@ -364,13 +381,145 @@ after a sequence character events."
 	    (compose-region (- (point) chars) (point) (nth 2 args))
 	  (compose-chars-after (- (point) chars) (point))))))
 
-;;;###autoload(global-set-key [compose-last-chars] 'compose-last-chars)
+(global-set-key [compose-last-chars] 'compose-last-chars)
+
+
+;;; Automatic character composition.
+
+(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))))
 
 
 ;;; The following codes are only for backward compatibility with Emacs
 ;;; 20.4 and earlier.
 
-;;;###autoload
 (defun decompose-composite-char (char &optional type with-composition-rule)
   "Convert CHAR to string.
 
@@ -382,8 +531,9 @@ Optional 3rd arg WITH-COMPOSITION-RULE is ignored."
 	((eq type 'list) (list char))
 	(t (vector char))))
 
-;;;###autoload
 (make-obsolete 'decompose-composite-char 'char-to-string "21.1")
 
 
+
+;;; arch-tag: ee703d77-1723-45d4-a31f-e9f0f867aa33
 ;;; composite.el ends here