diff options
Diffstat (limited to 'lisp/composite.el')
| -rw-r--r-- | lisp/composite.el | 216 |
1 files changed, 180 insertions, 36 deletions
diff --git a/lisp/composite.el b/lisp/composite.el index 4f9faf2ccfa..8bb3028f778 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,7 +73,12 @@ follows (the point `*' corresponds to both reference points): | | 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.") ;;;###autoload @@ -90,17 +93,29 @@ 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. @@ -108,13 +123,20 @@ RULE 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 @@ -158,7 +180,6 @@ RULE is a cons of global and new reference point symbols (setq i (+ i 2)))) components) -;;;###autoload (defun compose-region (start end &optional components modification-func) "Compose characters in the current region. @@ -170,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. @@ -199,7 +219,6 @@ text in the composition." (compose-region-internal start end components modification-func) (restore-buffer-modified-p modified-p))) -;;;###autoload (defun decompose-region (start end) "Decompose text in the current region. @@ -211,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 @@ -236,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. @@ -266,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. @@ -306,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. @@ -327,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))) @@ -347,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 @@ -368,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. @@ -386,7 +531,6 @@ 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") |