← Back to branch summary

~ubuntu-branches/ubuntu/precise/uim/precise

« back to all changes in this revision

Viewing changes to scm/ct.scm

  • Committer: Package Import Robot
  • Author(s): Ilya Barygin
  • Date: 2011-12-18 16:35:38 UTC
  • mfrom: (1.1.13) (15.1.7 sid)
  • Revision ID: package-import@ubuntu.com-20111218163538-8ktir39z2mjpii8z
Tags: 1:1.7.1-3ubuntu1
https://launchpad.net/bugs/818199
* Merge from Debian testing (LP: #818199).
* Remaining changes:
  - debian/uim-qt.install: Fix plugin path for multiarch location.
* Dropped changes:
  - uim-applet-gnome removal (GNOME 3 applet is available)
  - 19_as-needed_compile_fix.dpatch (accepted into Debian package)
* translations.patch: add several files to POTFILE.in to prevent
  intltool-update failure.

Show diffs side-by-side

added added

removed removed

Lines of Context:
scm/ct.scm
 
1
;;;
 
2
;;; Copyright (c) 2010-2011 uim Project http://code.google.com/p/uim/
 
3
;;;
 
4
;;; All rights reserved.
 
5
;;;
 
6
;;; Redistribution and use in source and binary forms, with or without
 
7
;;; modification, are permitted provided that the following conditions
 
8
;;; are met:
 
9
;;; 1. Redistributions of source code must retain the above copyright
 
10
;;;    notice, this list of conditions and the following disclaimer.
 
11
;;; 2. Redistributions in binary form must reproduce the above copyright
 
12
;;;    notice, this list of conditions and the following disclaimer in the
 
13
;;;    documentation and/or other materials provided with the distribution.
 
14
;;; 3. Neither the name of authors nor the names of its contributors
 
15
;;;    may be used to endorse or promote products derived from this software
 
16
;;;    without specific prior written permission.
 
17
;;;
 
18
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND
 
19
;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 
20
;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 
21
;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE
 
22
;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 
23
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 
24
;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 
25
;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 
26
;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 
27
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 
28
;;; SUCH DAMAGE.
 
29
;;;;
 
30
 
 
31
;; ct.scm: provides rk-lib equivalent functions using composing table
 
32
;;
 
33
;; following functions are used by rk.scm if table is used as a rule
 
34
;;   ct-lib-expect-seq
 
35
;;   ct-lib-expect-key-for-seq?
 
36
;;   ct-lib-find-seq
 
37
;;   ct-lib-find-partial-seq
 
38
;;
 
39
;; NB: composing table needs to be sorted
 
40
 
 
41
(require-dynlib "look")
 
42
 
 
43
(define ct-lib-find-seq
 
44
  (lambda (seq table)
 
45
    (let ((looked (look-lib-look
 
46
                    #f
 
47
                    #f
 
48
                    1
 
49
                    (string-append (sys-pkgdatadir) "/tables/" table)
 
50
                    (apply string-append seq))))
 
51
      (if (and
 
52
            looked
 
53
            (not (null? looked))
 
54
            (= (string-contains (car looked) " " 0) 0))
 
55
        (list (list seq) (read-from-string (car looked)))
 
56
        #f))))
 
57
 
 
58
;; return a rule of partial match 
 
59
(define ct-lib-find-partial-seq
 
60
  (lambda (seq table)
 
61
    ;; search 2 entries matching (including partial match) with look
 
62
    (let ((looked (look-lib-look
 
63
                    #f
 
64
                    #f
 
65
                    2
 
66
                    (string-append (sys-pkgdatadir) "/tables/" table)
 
67
                    (apply string-append seq))))
 
68
      (if (and
 
69
            looked
 
70
            (not (null? looked)))
 
71
        (let ((first (car looked))
 
72
              (second (if (null? (cdr looked))
 
73
                        '()
 
74
                        (car (cdr looked)))))
 
75
          (cond
 
76
            ;; second one is partial
 
77
            ((and
 
78
                (not (null? second))
 
79
                (string=? (substring first 0 1) " "))
 
80
             (let ((partial
 
81
                     (reverse
 
82
                       (string-to-list (car (string-split second " ")))))
 
83
                   (cands
 
84
                     (apply string-append (cdr (string-split second " ")))))
 
85
               (list (list (append seq partial)) (read-from-string cands))))
 
86
            ;; first one is partial
 
87
            ((not (string=? (substring first 0 1) " "))
 
88
             (let ((partial
 
89
                     (reverse
 
90
                       (string-to-list (car (string-split first " ")))))
 
91
                   (cands
 
92
                     (apply string-append (cdr (string-split first " ")))))
 
93
               (list (list (append seq partial)) (read-from-string cands))))
 
94
            (else
 
95
              #f)))
 
96
        #f))))
 
97
 
 
98
(define ct-lib-expect-key-for-seq?
 
99
  (lambda (seq table str)
 
100
    (let* ((lst (ct-find-cands-incl-minimal-partial seq table))
 
101
           (residuals
 
102
             (filter-map (lambda (x) (if (string=? (cdr x) "")
 
103
                                       #f
 
104
                                       (substring (cdr x) 0 1))) lst)))
 
105
      (if (member str residuals)
 
106
        #t
 
107
        #f))))
 
108
 
 
109
(define ct-lib-expect-seq
 
110
  (lambda (seq table keystr)
 
111
    (let* ((lst (ct-find-cands-incl-minimal-partial seq table))
 
112
           (residuals
 
113
             (filter-map (lambda (x) (if (string=? (cdr x) "")
 
114
                                       #f
 
115
                                       (substring (cdr x) 0 1))) lst)))
 
116
    residuals)))
 
117
 
 
118
(define ct-find-cands-incl-minimal-partial
 
119
  (lambda (seq table)
 
120
    (let ((looked (look-lib-look
 
121
                    #f
 
122
                    #f
 
123
                    5000 ;; is it sufficient enough?
 
124
                    (string-append (sys-pkgdatadir) "/tables/" table)
 
125
                    (apply string-append seq))))
 
126
      (if (and
 
127
            looked
 
128
            (not (null? looked)))
 
129
        (let* ((min-partial-pos
 
130
                 (lambda (lst)
 
131
                   (let ((maxlen (apply max (map string-length lst))))
 
132
                     (let loop ((n 1))
 
133
                       (if (= maxlen n)
 
134
                         0 ;; not found
 
135
                         (if (not
 
136
                               (null?
 
137
                                 (filter
 
138
                                   (lambda (x)
 
139
                                     (string=? (substring x n (+ n 1)) " "))
 
140
                                   lst)))
 
141
                           n
 
142
                           (loop (+ n 1))))))))
 
143
               (pos (min-partial-pos looked))
 
144
               (match
 
145
                 (filter
 
146
                   (lambda (x)
 
147
                     (or (string=? (substring x pos (+ pos 1)) " ")
 
148
                         (string=? (substring x 0 1) " ")))
 
149
                   looked))
 
150
               (str (map (lambda (x) (string-split x " ")) match))
 
151
               (residual (map (lambda (x) (car  x)) str))
 
152
               (cands
 
153
                 (map
 
154
                   (lambda (x)
 
155
                     (read-from-string (apply string-append (cdr x)))) str))
 
156
               (lst (map (lambda (x y) (cons x y)) cands residual)))
 
157
          lst)
 
158
        '()))))