positions (integers or markers) specifying the region."
(interactive "r")
(let ((modified-p (buffer-modified-p))
- (buffer-read-only nil))
+ (inhibit-read-only t))
(remove-text-properties start end '(composition nil))
- (set-buffer-modified-p modified-p)))
+ (restore-buffer-modified-p modified-p)))
-;;;###autoload
(defun compose-string (string &optional start end components modification-func)
"Compose characters in string STRING.
(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)
+
+\f
+;;; 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)
+
+;; This function is called when a composition created by
+;; terminal-composition-function is partially modified.
+(defun terminal-composition-modification (from to)
+ (terminal-composition-function from))
+
+(defun terminal-composition-function (pos &optional string)
+ "General composition function used on terminal.
+Non-spacing characters are composed with the preceding spacing
+character. All non-spacing characters has this function in
+`terminal-composition-function-table'."
+ (let ((from (1- pos))
+ ch)
+ (if string
+ (length string)
+ (setq pos (1+ pos))
+ (while (and (< pos (point-max))
+ (= (aref char-width-table (char-after pos)) 0))
+ (setq pos (1+ pos)))
+ (if (and (>= from (point-min))
+ (= (aref (symbol-name (get-char-code-property
+ (char-after from)
+ 'general-category)) 0) ?L))
+ (compose-region from pos (buffer-substring from pos))
+ (compose-region (1+ from) pos
+ (concat " " (buffer-substring (1+ from) pos))
+ 'terminal-composition-modification))
+ pos)))
+
+(defvar terminal-composition-function-table
+ (let ((table (make-char-table nil)))
+ (map-char-table
+ #'(lambda (key val)
+ (if (= val 0) (set-char-table-range table key
+ 'terminal-composition-function)))
+ char-width-table)
+ table)
+ "Char table of functions for automatic character composition on terminal.
+This is like `composition-function-table' but used when Emacs is running
+on a terminal.")
+
+(defvar auto-compose-current-font nil
+ "The current font-object used for characters being composed automatically.")
+
+(defun auto-compose-chars (pos string font-object)
+ "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.
+FONT-OBJECT is a font selected for the character at POS.
+
+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)))
+ (auto-compose-current-font font-object)
+ (table (if (display-graphic-p)
+ composition-function-table
+ terminal-composition-function-table))
+ 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 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 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))))))
+
+(make-variable-buffer-local 'auto-composition-function)
+
+;;;###autoload
+(define-minor-mode auto-composition-mode
+ "Toggle Auto Compostion mode.
+With arg, turn Auto Compostion mode off if and only if arg is a non-positive
+number; if arg is nil, toggle Auto Compostion mode; anything else turns Auto
+Compostion on.
+
+When Auto Composition is enabled, text characters are automatically composed
+by functions registered in `composition-function-table' (which see).
+
+You can use Global Auto Composition mode to automagically 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)))
+
+;;;###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 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)
+ (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)))
+ (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.
+ ;; 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.