/[emacs]/emacs/lisp/language/devan-util.el
ViewVC logotype

Diff of /emacs/lisp/language/devan-util.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.43 by miles, Mon Sep 1 15:45:29 2003 UTC revision 1.44 by handa, Wed Sep 17 06:41:36 2003 UTC
# Line 75  Line 75 
75      (devanagari-compose-region (point-min) (point-max))      (devanagari-compose-region (point-min) (point-max))
76      (buffer-string)))      (buffer-string)))
77    
78    ;;;###autoload
79  (defun devanagari-post-read-conversion (len)  (defun devanagari-post-read-conversion (len)
80    (save-excursion    (save-excursion
81      (save-restriction      (save-restriction
# Line 564  preferred rule from the sanskrit fonts." Line 565  preferred rule from the sanskrit fonts."
565  (defun devanagari-compose-syllable-region (from to)  (defun devanagari-compose-syllable-region (from to)
566    "Compose devanagari syllable in region FROM to TO."    "Compose devanagari syllable in region FROM to TO."
567    (let ((glyph-str nil) (cons-num 0) glyph-str-list    (let ((glyph-str nil) (cons-num 0) glyph-str-list
568          (last-halant nil) (preceding-r nil) (last-modifier nil)          (last-halant nil) (preceding-r nil) (last-modifier nil)
569          (last-char (char-before to)) match-str          (last-char (char-before to)) match-str
570          glyph-block split-pos)          glyph-block split-pos)
571      (save-excursion      (save-excursion
572        (save-restriction        (save-restriction
573            ;;; *** char-to-glyph conversion ***            ;;; *** char-to-glyph conversion ***
574          ;; Special rule 1. -- Last halant must be preserved.          ;; Special rule 1. -- Last halant must be preserved.
575          (if (eq last-char ?$,16-(B)          (if (eq last-char ?$,16-(B)
576              (progn              (progn
577                (setq last-halant t)                (setq last-halant t)
578                (narrow-to-region from (1- to)))                (narrow-to-region from (1- to)))
579            (narrow-to-region from to)            (narrow-to-region from to)
580            ;; note if the last char is modifier.            ;; note if the last char is modifier.
581            (if (or (eq last-char ?$,15A(B) (eq last-char ?$,15B(B))            (if (or (eq last-char ?$,15A(B) (eq last-char ?$,15B(B))
582                (setq last-modifier t)))                (setq last-modifier t)))
583          (goto-char (point-min))          (goto-char (point-min))
584          ;; Special rule 2. -- preceding "r halant" must be modifier.          ;; Special rule 2. -- preceding "r halant" must be modifier.
585          (when (looking-at "$,15p6-(B.")          (when (looking-at "$,15p6-(B.")
586            (setq preceding-r t)            (setq preceding-r t)
587            (goto-char (+ 2 (point))))            (goto-char (+ 2 (point))))
588          ;; translate the rest characters into glyphs          ;; translate the rest characters into glyphs
589          (while (re-search-forward dev-char-glyph-regexp nil t)          (while (re-search-forward dev-char-glyph-regexp nil t)
590            (setq match-str (match-string 0))            (setq match-str (match-string 0))
591            (setq glyph-str            (setq glyph-str
592                  (concat glyph-str                  (concat glyph-str
593                          (gethash match-str dev-char-glyph-hash)))                          (gethash match-str dev-char-glyph-hash)))
594            ;; count the number of consonant-glyhs.            ;; count the number of consonant-glyhs.
595            (if (string-match devanagari-consonant match-str)            (if (string-match devanagari-consonant match-str)
596                (setq cons-num (1+ cons-num))))                (setq cons-num (1+ cons-num))))
597          ;; preceding-r must be attached before the anuswar if exists.          ;; preceding-r must be attached before the anuswar if exists.
598          (if preceding-r          (if preceding-r
599              (if last-modifier              (if last-modifier
600                  (setq glyph-str (concat (substring glyph-str 0 -1)                  (setq glyph-str (concat (substring glyph-str 0 -1)
601                                          "$,4"'(B" (substring glyph-str -1)))                                          "$,4"'(B" (substring glyph-str -1)))
602                (setq glyph-str (concat glyph-str "$,4"'(B"))))                (setq glyph-str (concat glyph-str "$,4"'(B"))))
603          (if last-halant (setq glyph-str (concat glyph-str "$,4""(B")))          (if last-halant (setq glyph-str (concat glyph-str "$,4""(B")))
604            ;;; *** glyph-to-glyph conversion ***            ;;; *** glyph-to-glyph conversion ***
605          (when (string-match dev-glyph-glyph-regexp glyph-str)          (when (string-match dev-glyph-glyph-regexp glyph-str)
606            (setq glyph-str            (setq glyph-str
607                  (replace-match (gethash (match-string 0 glyph-str)                  (replace-match (gethash (match-string 0 glyph-str)
608                                          dev-glyph-glyph-hash)                                          dev-glyph-glyph-hash)
609                                 nil t glyph-str))                                 nil t glyph-str))
610            (if (and (> cons-num 1)            (if (and (> cons-num 1)
611                     (string-match dev-glyph-glyph-2-regexp glyph-str))                     (string-match dev-glyph-glyph-2-regexp glyph-str))
612                (setq glyph-str                (setq glyph-str
613                      (replace-match (gethash (match-string 0 glyph-str)                      (replace-match (gethash (match-string 0 glyph-str)
614                                              dev-glyph-glyph-2-hash)                                              dev-glyph-glyph-2-hash)
615                                     nil t glyph-str))))                                     nil t glyph-str))))
616            ;;; *** glyph reordering ***            ;;; *** glyph reordering ***
617          (while (setq split-pos (string-match "$,4""(B\\|.$" glyph-str))          (while (setq split-pos (string-match "$,4""(B\\|.$" glyph-str))
618            (setq glyph-block (substring glyph-str 0 (1+ split-pos)))            (setq glyph-block (substring glyph-str 0 (1+ split-pos)))
619            (setq glyph-str (substring glyph-str (1+ split-pos)))            (setq glyph-str (substring glyph-str (1+ split-pos)))
620            (setq            (setq
621             glyph-block             glyph-block
622             (if (string-match dev-glyph-right-modifier-regexp glyph-block)             (if (string-match dev-glyph-right-modifier-regexp glyph-block)
623                 (sort (string-to-list glyph-block)                 (sort (string-to-list glyph-block)
624                       (function (lambda (x y)                       (function (lambda (x y)
625                          (< (get-char-code-property x 'composition-order)                          (< (get-char-code-property x 'composition-order)
626                             (get-char-code-property y 'composition-order)))))                             (get-char-code-property y 'composition-order)))))
627               (sort (string-to-list glyph-block)               (sort (string-to-list glyph-block)
628                     (function (lambda (x y)                     (function (lambda (x y)
629                        (let ((xo (get-char-code-property x 'composition-order))                        (let ((xo (get-char-code-property x 'composition-order))
630                              (yo (get-char-code-property y 'composition-order)))                              (yo (get-char-code-property y 'composition-order)))
631                          (if (= xo 2) nil (if (= yo 2) t (< xo yo)))))))))                          (if (= xo 2) nil (if (= yo 2) t (< xo yo)))))))))
632            (setq glyph-str-list (nconc glyph-str-list glyph-block)))            (setq glyph-str-list (nconc glyph-str-list glyph-block)))
633            ;; concatenate and attach reference-points.            ;; concatenate and attach reference-points.
634          (setq glyph-str          (setq glyph-str
635                (cdr                (cdr
636                 (apply                 (apply
637                  'nconc                  'nconc
638                  (mapcar                  (mapcar
639                   (function (lambda (x)                   (function (lambda (x)
640                     (list                     (list
641                      (or (get-char-code-property x 'reference-point)                      (or (get-char-code-property x 'reference-point)
642                      '(5 . 3) ;; default reference point.                      '(5 . 3) ;; default reference point.
643                       )                       )
644                      x)))                      x)))
645                   glyph-str-list))))))                   glyph-str-list))))))
646        (compose-region from to glyph-str)))        (compose-region from to glyph-str)))
647    
648  (provide 'devan-util)  (provide 'devan-util)

Legend:
Removed from v.1.43  
changed lines
  Added in v.1.44

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26