Rudimentary support for vc-pull and vc-merge in Git and Mercurial.

[bpt/emacs.git] / lisp / composite.el

diff --git a/lisp/composite.el b/lisp/composite.el
index c37a37e..8783024 100644 (file)
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -1,13 +1,14 @@
 ;;; composite.el --- support character composition
 
 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
 ;;; composite.el --- support character composition
 
 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,

-;;   2008, 2009
+;;   2008, 2009, 2010, 2011

 ;;   National Institute of Advanced Industrial Science and Technology (AIST)
 ;;   Registration Number H14PRO021
 
 ;; Author: Kenichi HANDA <handa@etl.go.jp>
 ;; (according to ack.texi)
 ;; Keywords: mule, multilingual, character composition
 ;;   National Institute of Advanced Industrial Science and Technology (AIST)
 ;;   Registration Number H14PRO021
 
 ;; Author: Kenichi HANDA <handa@etl.go.jp>
 ;; (according to ack.texi)
 ;; Keywords: mule, multilingual, character composition

+;; Package: emacs

 
 ;; This file is part of GNU Emacs.
 
 
 ;; This file is part of GNU Emacs.
 


@@ -28,6 +29,8 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

+(eval-when-compile (require 'cl))
+

 (defconst reference-point-alist
   '((tl . 0) (tc . 1) (tr . 2)
     (Bl . 3) (Bc . 4) (Br . 5)
 (defconst reference-point-alist
   '((tl . 0) (tc . 1) (tr . 2)
     (Bl . 3) (Bc . 4) (Br . 5)


@@ -44,7 +47,7 @@
 A glyph reference point symbol is to be used to specify a composition
 rule in COMPONENTS argument to such functions as `compose-region'.
 
 A glyph reference point symbol is to be used to specify a composition
 rule in COMPONENTS argument to such functions as `compose-region'.
 

-Meanings of glyph reference point codes are as follows:
+The meaning of glyph reference point codes is as follows:

 
     0----1----2 <---- ascent   0:tl or top-left
     |         |                        1:tc or top-center
 
     0----1----2 <---- ascent   0:tl or top-left
     |         |                        1:tc or top-center


@@ -77,7 +80,7 @@ follows (the point `*' corresponds to both reference points):
     +----+-----+ <--- new descent
 
 A composition rule may have the form \(GLOBAL-REF-POINT
     +----+-----+ <--- new descent
 
 A composition rule may have the form \(GLOBAL-REF-POINT

-NEW-REF-POINT XOFF YOFF), where XOFF and YOFF specifies how much
+NEW-REF-POINT XOFF YOFF), where XOFF and YOFF specify 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.")
 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.")


@@ -185,8 +188,17 @@ RULE is a cons of global and new reference point symbols
 (defun compose-region (start end &optional components modification-func)
   "Compose characters in the current region.
 
 (defun compose-region (start end &optional components modification-func)
   "Compose characters in the current region.
 

-Characters are composed relatively, i.e. composed by overstricking or
-stacking depending on ascent, descent and other properties.
+Characters are composed relatively, i.e. composed by overstriking
+or stacking depending on ascent, descent and other metrics of
+glyphs.
+
+For instance, if the region has three characters \"XYZ\", X is
+regarded as BASE glyph, and Y is displayed:
+  (1) above BASE if Y's descent value is not positive
+  (2) below BASE if Y's ascent value is not positive
+  (3) on BASE (i.e. at the BASE position) otherwise
+and Z is displayed with the same rule while regarding the whole
+XY glyphs as BASE.

 
 When called from a program, expects these four arguments.
 
 
 When called from a program, expects these four arguments.
 


@@ -201,9 +213,9 @@ of the text in the region.
 
 If it is a string, the elements are alternate characters.  In
 this case, TAB element has a special meaning.  If the first
 
 If it is a string, the elements are alternate characters.  In
 this case, TAB element has a special meaning.  If the first

-characer is TAB, the glyphs are displayed with left padding space
+character is TAB, the glyphs are displayed with left padding space

 so that no pixel overlaps with the previous column.  If the last
 so that no pixel overlaps with the previous column.  If the last

-character is TAB, the glyphs are displayed with rigth padding
+character is TAB, the glyphs are displayed with right padding

 space so that no pixel overlaps with the following column.
 
 If it is a vector or list, it is a sequence of alternate characters and
 space so that no pixel overlaps with the following column.
 
 If it is a vector or list, it is a sequence of alternate characters and


@@ -213,7 +225,7 @@ elements with previously composed N glyphs.
 
 A composition rule is a cons of global and new glyph reference point
 symbols.  See the documentation of `reference-point-alist' for more
 
 A composition rule is a cons of global and new glyph reference point
 symbols.  See the documentation of `reference-point-alist' for more

-detail.
+details.

 
 Optional 4th argument MODIFICATION-FUNC is a function to call to
 adjust the composition when it gets invalid because of a change of
 
 Optional 4th argument MODIFICATION-FUNC is a function to call to
 adjust the composition when it gets invalid because of a change of


@@ -290,16 +302,16 @@ A composition rule is a cons of glyph reference points of the form
     (compose-string-internal str 0 (length str) components)))
 
 (defun find-composition (pos &optional limit string detail-p)
     (compose-string-internal str 0 (length str) components)))
 
 (defun find-composition (pos &optional limit string detail-p)

-  "Return information about a composition at or nearest to buffer position POS.
+  "Return information about a composition at or near buffer position POS.

 
 If the character at POS has `composition' property, the value is a list
 
 If the character at POS has `composition' property, the value is a list

-of FROM, TO, and VALID-P.
+\(FROM TO VALID-P).

 
 FROM and TO specify the range of text that has the same `composition'
 property, VALID-P is t if this composition is valid, and nil if not.
 
 If there's no composition at POS, and the optional 2nd argument LIMIT
 
 FROM and TO specify the range of text that has the same `composition'
 property, VALID-P is t if this composition is valid, and nil if not.
 
 If there's no composition at POS, and the optional 2nd argument LIMIT

-is non-nil, search for a composition toward LIMIT.
+is non-nil, search for a composition toward the position given by LIMIT.

 
 If no composition is found, return nil.
 
 
 If no composition is found, return nil.
 


@@ -307,8 +319,9 @@ Optional 3rd argument STRING, if non-nil, is a string to look for a
 composition in; nil means the current buffer.
 
 If a valid composition is found and the optional 4th argument DETAIL-P
 composition in; nil means the current buffer.
 
 If a valid composition is found and the optional 4th argument DETAIL-P

-is non-nil, the return value is a list of FROM, TO, COMPONENTS,
-RELATIVE-P, MOD-FUNC, and WIDTH.
+is non-nil, the return value is a list of the form
+
+   (FROM TO COMPONENTS RELATIVE-P MOD-FUNC WIDTH)

 
 COMPONENTS is a vector of integers, the meaning depends on RELATIVE-P.
 
 
 COMPONENTS is a vector of integers, the meaning depends on RELATIVE-P.
 


@@ -322,12 +335,12 @@ MOD-FUNC is a modification function of the composition.
 
 WIDTH is a number of columns the composition occupies on the screen.
 
 
 WIDTH is a number of columns the composition occupies on the screen.
 

-When Automatic Compostion mode is on, this function also finds a
+When Automatic Composition mode is on, this function also finds a

 chunk of text that is automatically composed.  If such a chunk is
 found closer to POS than the position that has `composition'
 chunk of text that is automatically composed.  If such a chunk is
 found closer to POS than the position that has `composition'

-property, the value is a list of FROM, TO, and a glyph gstring
-the specify how the chunk is composed.  See the function
-`composition-get-gstring' for the format of the glyph string."
+property, the value is a list of FROM, TO, and a glyph-string
+that specifies how the chunk is to be composed.  See the function
+`composition-get-gstring' for the format of the glyph-string."

   (let ((result (find-composition-internal pos limit string detail-p)))
     (if (and detail-p (> (length result) 3) (nth 2 result) (not (nth 3 result)))
        ;; This is a valid rule-base composition.
   (let ((result (find-composition-internal pos limit string detail-p)))
     (if (and detail-p (> (length result) 3) (nth 2 result) (not (nth 3 result)))
        ;; This is a valid rule-base composition.


@@ -400,27 +413,6 @@ after a sequence of character events."
 \f
 ;;; Automatic character composition.
 
 \f
 ;;; Automatic character 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)
-

 ;; These macros must match with C macros LGSTRING_XXX and LGLYPH_XXX in font.h
 (defsubst lgstring-header (gstring) (aref gstring 0))
 (defsubst lgstring-set-header (gstring header) (aset gstring 0 header))
 ;; These macros must match with C macros LGSTRING_XXX and LGLYPH_XXX in font.h
 (defsubst lgstring-header (gstring) (aref gstring 0))
 (defsubst lgstring-set-header (gstring header) (aset gstring 0 header))


@@ -522,12 +514,12 @@ after a sequence of character events."
 
 (defun compose-gstring-for-graphic (gstring)
   "Compose glyph-string GSTRING for graphic display.
 
 (defun compose-gstring-for-graphic (gstring)
   "Compose glyph-string GSTRING for graphic display.

-Non-spacing characters are composed with the preceding base
+Combining characters are composed with the preceding base

 character.  If the preceding character is not a base character,
 character.  If the preceding character is not a base character,

-each non-spacing character is composed as a spacing character by
+each combining character is composed as a spacing character by

 a padding space before and/or after the character.
 
 a padding space before and/or after the character.
 

-All non-spacing characters has this function in
+All non-spacing characters have this function in

 `composition-function-table' unless overwritten."
   (let* ((header (lgstring-header gstring))
         (nchars (lgstring-char-len gstring))
 `composition-function-table' unless overwritten."
   (let* ((header (lgstring-header gstring))
         (nchars (lgstring-char-len gstring))


@@ -646,46 +638,70 @@ All non-spacing characters has this function in
              (setq i (1+ i))))
          gstring))))))
 
              (setq i (1+ i))))
          gstring))))))
 

-(let ((elt '(["[[:alpha:]]\\c^+" 1 compose-gstring-for-graphic]
+(let ((elt `([,(purecopy "\\c.\\c^+") 1 compose-gstring-for-graphic]

             [nil 0 compose-gstring-for-graphic])))
   (map-char-table
    #'(lambda (key val)
             [nil 0 compose-gstring-for-graphic])))
   (map-char-table
    #'(lambda (key val)

-       (if (= val 0)
+       (if (memq val '(Mn Mc Me))

           (set-char-table-range composition-function-table key elt)))
           (set-char-table-range composition-function-table key elt)))

-   char-width-table))
+   unicode-category-table))

 
 (defun compose-gstring-for-terminal (gstring)
   "Compose glyph string GSTRING for terminal display.
 Non-spacing characters are composed with the preceding base
 character.  If the preceding character is not a base character,
 each non-spacing character is composed as a spacing character by
 
 (defun compose-gstring-for-terminal (gstring)
   "Compose glyph string GSTRING for terminal display.
 Non-spacing characters are composed with the preceding base
 character.  If the preceding character is not a base character,
 each non-spacing character is composed as a spacing character by

-a prepending a space before it."
+prepending a space before it."

   (let* ((header (lgstring-header gstring))
         (nchars (lgstring-char-len gstring))
         (nglyphs (lgstring-glyph-len gstring))
         (i 0)
   (let* ((header (lgstring-header gstring))
         (nchars (lgstring-char-len gstring))
         (nglyphs (lgstring-glyph-len gstring))
         (i 0)

+        (coding (lgstring-font gstring))

         glyph)
     (while (and (< i nglyphs)
                (setq glyph (lgstring-glyph gstring i)))
         glyph)
     (while (and (< i nglyphs)
                (setq glyph (lgstring-glyph gstring i)))

-      (if (= (lglyph-width glyph) 0)
+      (if (not (char-charset (lglyph-char glyph) coding))

          (progn
          (progn

-           ;; Compose by prepending a space.
-           (setq gstring (lgstring-insert-glyph gstring i (lglyph-copy glyph))
-                 nglyphs (lgstring-glyph-len gstring))
-           (lglyph-set-char (lgstring-glyph gstring i) 32)
-           (setq i (+ 2)))
-       (let ((from (lglyph-from glyph))
-             (to (lglyph-to glyph))
-             (j (1+ i)))
-         (while (and (< j nglyphs)
-                     (setq glyph (lgstring-glyph gstring j))
-                     (= (lglyph-width glyph) 0))
-           (setq to (lglyph-to glyph)
-                 j (1+ j)))
-         (while (< i j)
-           (setq glyph (lgstring-glyph gstring i))
-           (lglyph-set-from-to glyph from to)
-           (setq i (1+ i))))))
+           ;; As the terminal doesn't support this glyph, return a
+           ;; gstring in which each glyph is its own graphme-cluster
+           ;; of width 1..
+           (setq i 0)
+           (while (and (< i nglyphs)
+                       (setq glyph (lgstring-glyph gstring i)))
+             (if (< (lglyph-width glyph) 1)
+                 (lglyph-set-width glyph 1))
+             (lglyph-set-from-to glyph i i)
+             (setq i (1+ i))))
+       (if (= (lglyph-width glyph) 0)
+           (if (eq (get-char-code-property (lglyph-char glyph)
+                                           'general-category)
+                   'Cf)
+               (progn
+                 ;; Compose by replacing with a space.
+                 (lglyph-set-char glyph 32)
+                 (lglyph-set-width glyph 1)
+                 (setq i (1+ i)))
+             ;; Compose by prepending a space.
+             (setq gstring (lgstring-insert-glyph gstring i
+                                                  (lglyph-copy glyph))
+                   nglyphs (lgstring-glyph-len gstring))
+             (setq glyph (lgstring-glyph gstring i))
+             (lglyph-set-char glyph 32)
+             (lglyph-set-width glyph 1)
+             (setq i (+ 2)))
+         (let ((from (lglyph-from glyph))
+               (to (lglyph-to glyph))
+               (j (1+ i)))
+           (while (and (< j nglyphs)
+                       (setq glyph (lgstring-glyph gstring j))
+                       (char-charset (lglyph-char glyph) coding)
+                       (= (lglyph-width glyph) 0))
+             (setq to (lglyph-to glyph)
+                   j (1+ j)))
+           (while (< i j)
+             (setq glyph (lgstring-glyph gstring i))
+             (lglyph-set-from-to glyph from to)
+             (setq i (1+ i)))))))

     gstring))
 
 
     gstring))
 
 


@@ -695,9 +711,7 @@ FUNC is called with one argument GSTRING which is built for characters
 in the region FROM (inclusive) and TO (exclusive).
 
 If the character are composed on a graphic display, FONT-OBJECT
 in the region FROM (inclusive) and TO (exclusive).
 
 If the character are composed on a graphic display, FONT-OBJECT

-is a font to use.
-
-Otherwise, FONT-OBJECT is nil, and the fucntion
+is a font to use.  Otherwise, FONT-OBJECT is nil, and the function

 `compose-gstring-for-terminal' is used instead of FUNC.
 
 If STRING is non-nil, it is a string, and FROM and TO are indices
 `compose-gstring-for-terminal' is used instead of FUNC.
 
 If STRING is non-nil, it is a string, and FROM and TO are indices


@@ -709,11 +723,14 @@ This function is the default value of `auto-composition-function' (which see)."
   (let ((gstring (composition-get-gstring from to font-object string)))
     (if (lgstring-shaped-p gstring)
        gstring
   (let ((gstring (composition-get-gstring from to font-object string)))
     (if (lgstring-shaped-p gstring)
        gstring

-      (or font-object
+      (or (fontp font-object 'font-object)

          (setq func 'compose-gstring-for-terminal))
       (funcall func gstring))))
 
          (setq func 'compose-gstring-for-terminal))
       (funcall func gstring))))
 

+(put 'auto-composition-mode 'permanent-local t)
+

 (make-variable-buffer-local 'auto-composition-function)
 (make-variable-buffer-local 'auto-composition-function)

+(setq-default auto-composition-function 'auto-compose-chars)

 
 ;;;###autoload
 (define-minor-mode auto-composition-mode
 
 ;;;###autoload
 (define-minor-mode auto-composition-mode


@@ -727,141 +744,21 @@ by functions registered in `composition-function-table' (which see).
 
 You can use `global-auto-composition-mode' to turn on
 Auto Composition mode in all buffers (this is the default)."
 
 You can use `global-auto-composition-mode' to 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)))
+  ;; It's defined in C, this stops the d-m-m macro defining it again.
+  :variable auto-composition-mode)
+;; It's not defined with DEFVAR_PER_BUFFER though.
+(make-variable-buffer-local 'auto-composition-mode)

 
 ;;;###autoload
 
 ;;;###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 if and only if 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)))
-               (font-obj (and (display-multi-font-p)
-                              (font-at (point) (selected-window))))
-               (pos (point)))
-           (if (and (functionp func) font-obj)
-               (goto-char (funcall func (point) to font-obj 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.
-
-(defun decompose-composite-char (char &optional type with-composition-rule)
-  "Convert CHAR to string.
-
-If optional 2nd arg TYPE is non-nil, it is `string', `list', or
-`vector'.  In this case, CHAR is converted to string, list of CHAR, or
-vector of CHAR respectively.
-Optional 3rd arg WITH-COMPOSITION-RULE is ignored."
-  (cond ((or (null type) (eq type 'string)) (char-to-string char))
-       ((eq type 'list) (list char))
-       (t (vector char))))
+(define-minor-mode global-auto-composition-mode
+  "Toggle Auto-Composition mode in every possible buffer.
+With prefix arg, turn Global-Auto-Composition mode on if and only if arg
+is positive.
+See `auto-composition-mode' for more information on Auto-Composition mode."
+  :variable (default-value 'auto-composition-mode))

 
 

-(make-obsolete 'decompose-composite-char 'char-to-string "21.1")
+(defalias 'toggle-auto-composition 'auto-composition-mode)

 
 \f
 
 
 \f
 

-;; arch-tag: ee703d77-1723-45d4-a31f-e9f0f867aa33

 ;;; composite.el ends here
 ;;; composite.el ends here