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

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

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

revision 1.1 by rms, Sun Nov 25 02:41:14 2001 UTC revision 1.2 by fx, Sat Dec 15 17:59:27 2001 UTC
# Line 39  Line 39 
39  ;; used in quail/indian.el for typing Indian script in Emacs.  ;; used in quail/indian.el for typing Indian script in Emacs.
40    
41  (eval-and-compile  (eval-and-compile
 (require 'cl)  
42    
43  (defun range (from to)  (defun range (from to)
44    "Make the list of the integers of range FROM to TO."    "Make the list of the integers of range FROM to TO."
# Line 52  Line 51 
51      (regexp-opt      (regexp-opt
52       (sort       (sort
53        (let (dummy)        (let (dummy)
54          (maphash (function (lambda (key val) (setq dummy (cons key dummy)))) hashtbl)          (maphash (function (lambda (key val) (setq dummy (cons key dummy))))
55                     hashtbl)
56          dummy)          dummy)
57        (function (lambda (x y) (> (length x) (length y))))))))        (function (lambda (x y) (> (length x) (length y))))))))
58    
# Line 205  FUNCTION will be called 15 times." Line 205  FUNCTION will be called 15 times."
205         (lambda (x)         (lambda (x)
206           (apply           (apply
207            'mapthread            'mapthread
208            `(lambda (&rest y) (apply (quote ,function) ,x y))            (lambda (&rest y) (apply function x y))
209            seqrest))            seqrest))
210         seq1)         seq1)
211    (mapcar function seq1)))    (mapcar function seq1)))
# Line 221  FUNCTION will be called 15 times." Line 221  FUNCTION will be called 15 times."
221        (if (char-valid-p char) (setq char (char-to-string char)))        (if (char-valid-p char) (setq char (char-to-string char)))
222        (puthash char (car trans-char) encode-hash)        (puthash char (car trans-char) encode-hash)
223        (mapc        (mapc
224         '(lambda (trans)         (lambda (trans)
225            (puthash trans char decode-hash))           (puthash trans char decode-hash))
226         trans-char))))         trans-char))))
227    
228    (defun indian--map (f l1 l2)
229      (while l1
230        (funcall f (pop l1) (pop l2))))
231    
232  (defun indian--puthash-v (v trans-v hashtbls)  (defun indian--puthash-v (v trans-v hashtbls)
233    (mapcar*    (indian--map
234     '(lambda (v trans-v)     (lambda (v trans-v)
235        (indian--puthash-char (car v) trans-v hashtbls))       (indian--puthash-char (car v) trans-v hashtbls))
236     v trans-v))     v trans-v))
237    
238  (defun indian--puthash-c (c trans-c halant hashtbls)  (defun indian--puthash-c (c trans-c halant hashtbls)
239    (mapcar*    (indian--map
240     '(lambda (c trans-c)     (lambda (c trans-c)
241        (if (char-valid-p c) (setq c (char-to-string c)))       (if (char-valid-p c) (setq c (char-to-string c)))
242        (indian--puthash-char (concat c halant) trans-c hashtbls))       (indian--puthash-char (concat c halant) trans-c hashtbls))
243     c trans-c))     c trans-c))
244    
245  (defun indian--puthash-m (m trans-m hashtbls)  (defun indian--puthash-m (m trans-m hashtbls)
246    (mapcar*    (indian--map
247     '(lambda (m trans-m)     (lambda (m trans-m)
248        (indian--puthash-char m trans-m hashtbls))       (indian--puthash-char m trans-m hashtbls))
249     m trans-m))     m trans-m))
250    
251  (defun indian--puthash-cv (c trans-c v trans-v hashtbls)  (defun indian--puthash-cv (c trans-c v trans-v hashtbls)
252    (mapcar*    (indian--map
253     '(lambda (c trans-c)     (lambda (c trans-c)
254        (mapcar*       (indian--map
255         (lambda (v trans-v)        (lambda (v trans-v)
256           (when (and c trans-c  v trans-v)          (when (and c trans-c  v trans-v)
257             (if (char-valid-p c) (setq c (char-to-string c)))            (if (char-valid-p c) (setq c (char-to-string c)))
258             (setq v (if (char-valid-p (cadr v)) (char-to-string (cadr v)) ""))            (setq v (if (char-valid-p (cadr v)) (char-to-string (cadr v)) ""))
259             (if (stringp trans-c) (setq trans-c (list trans-c)))            (if (stringp trans-c) (setq trans-c (list trans-c)))
260             (if (stringp trans-v) (setq trans-v (list trans-v)))            (if (stringp trans-v) (setq trans-v (list trans-v)))
261             (indian--puthash-char            (indian--puthash-char
262              (concat c v)             (concat c v)
263              (apply 'append             (apply 'append
264                     (mapthread 'concat trans-c trans-v))                    (mapthread 'concat trans-c trans-v))
265              hashtbls)))             hashtbls)))
266         v trans-v))        v trans-v))
267     c trans-c))     c trans-c))
268    
269  (defun indian-make-hash (table trans-table)  (defun indian-make-hash (table trans-table)
# Line 306  FUNCTION will be called 15 times." Line 310  FUNCTION will be called 15 times."
310           (goto-char (point-min))           (goto-char (point-min))
311           (while (re-search-forward regexp nil t)           (while (re-search-forward regexp nil t)
312             (let ((matchstr (gethash (match-string 0)             (let ((matchstr (gethash (match-string 0)
313                                      (if ,encode-p (car ,hashtable) (cdr ,hashtable)))))                                      (if ,encode-p
314                                            (car ,hashtable)
315                                          (cdr ,hashtable)))))
316               (if matchstr (replace-match matchstr))))))))               (if matchstr (replace-match matchstr))))))))
317    
318  ;;;  ;;;
# Line 987  Returns new end position." Line 993  Returns new end position."
993            (let ((len (- (match-end 0) (match-beginning 0)))            (let ((len (- (match-end 0) (match-beginning 0)))
994                  subst)                  subst)
995              (if (= len 1)              (if (= len 1)
996                  (setq subst (aref indian-2-column-to-ucs-chartable (char-after (match-beginning 0))))                  (setq subst (aref indian-2-column-to-ucs-chartable
997                                      (char-after (match-beginning 0))))
998                (setq subst (assoc (match-string 0) alist)))                (setq subst (assoc (match-string 0) alist)))
999              (replace-match (if subst subst "?"))))              (replace-match (if subst subst "?"))))
1000          (indian-compose-region (point-min) (point-max))))))          (indian-compose-region (point-min) (point-max))))))
1001    
1002    ;;;###autoload
1003    (defun indian-glyph-char (index &optional script)
1004      "Return character of charset `indian-glyph' made from glyph index INDEX.
1005    The variable `indian-default-script' specifies the script of the glyph.
1006    Optional argument SCRIPT, if non-nil, overrides `indian-default-script'.
1007    See also the function `indian-char-glyph'."
1008      (or script
1009          (setq script indian-default-script))
1010      (let ((offset (get script 'indian-glyph-code-offset)))
1011        (or (integerp offset)
1012            (error "Invalid script name: %s" script))
1013        (or (and (>= index 0) (< index 256))
1014            (error "Invalid glyph index: %d" index))
1015        (setq index (+ offset index))
1016        (make-char 'indian-glyph (+ (/ index 96) 32) (+ (% index 96) 32))))
1017    
1018    (defvar indian-glyph-max-char
1019      (indian-glyph-char
1020       255 (aref indian-script-table (1- (length indian-script-table))))
1021      "The maximum valid code of characters in the charset `indian-glyph'.")
1022    
1023    ;;;###autoload
1024    (defun indian-char-glyph (char)
1025      "Return information about the glphy code for CHAR of `indian-glyph' charset.
1026    The value is (INDEX . SCRIPT), where INDEX is the glyph index
1027    in the font that Indian script name SCRIPT specifies.
1028    See also the function `indian-glyph-char'."
1029      (let ((split (split-char char))
1030            code)
1031        (or (eq (car split) 'indian-glyph)
1032            (error "Charset of `%c' is not indian-glyph" char))
1033        (or (<= char indian-glyph-max-char)
1034            (error "Invalid indian-glyph char: %d" char))
1035        (setq code (+ (* (- (nth 1 split) 32) 96) (nth 2 split) -32))
1036        (cons (% code 256) (aref indian-script-table (/ code 256)))))
1037            
1038  (provide 'ind-util)  (provide 'ind-util)
1039    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

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