[wadalabfont-kit] / lisp / tools / kinput.l  

Annotation of /lisp/tools/kinput.l

Parent Directory | Revision Log

Revision: 1.1.1.1 - (view) (download)

1 : ktanaka 1.1 ;;----------;;
2 :     ;; kinput.l ;;
3 :     ;;----------;;
4 :    
5 :     (defun read-string-from-kinput (win)
6 :    
7 :     (let* ((display (window-display win))
8 :     (kinput-win (selection-owner display "JAPANESE_CONVERSION")))
9 :     (cond ((null kinput-win)
10 :     (print 'kinput-is-dead)
11 :     (let ((prompt "kinput> "))
12 :     (string (read))))
13 :     (t
14 :     (let* ((string nil)
15 :     (japanese-conversion
16 :     (find-atom display "JAPANESE_CONVERSION"))
17 :     (compound-text
18 :     (find-atom display "COMPOUND_TEXT"))
19 :     (conversion-request
20 :     (find-atom display "CONVERSION_REQUEST"))
21 :     (conversion-notify
22 :     (find-atom display "CONVERSION_NOTIFY"))
23 :     (conversion-end-request
24 :     (find-atom display "CONVERSION_END_REQUEST")))
25 :    
26 :     (delete-property win :JAPANESE_CONVERSION)
27 :    
28 :     (send-event kinput-win
29 :     :client-message
30 :     nil
31 :     :window kinput-win
32 :     :format 32
33 :     :type :CONVERSION_REQUEST
34 :     :data
35 :     (list japanese-conversion
36 :     (window-id win)
37 :     compound-text
38 :     japanese-conversion
39 :     0))
40 :     (let ((end? nil))
41 :     (loop
42 :     (event-case (display)
43 :     (:client-message
44 :     (window type format data)
45 :     (print (list 'client-message window type format data))
46 :     (pr data)
47 :     (if (eq window win) (setq end? t))
48 :     t)
49 :     (otherwise
50 :     ()
51 :     t))
52 :     (if end? (exit))))
53 :    
54 :     (print 'kinput-acknowledge)
55 :    
56 :     (let ((end? nil))
57 :     (loop
58 :     (event-case (display)
59 :     (:property-notify
60 :     (window atom state time)
61 :     (print (list 'property-notify window atom state time))
62 :     (if (eq window win)
63 :     (setq string (first (get-property
64 :     win
65 :     ':JAPANESE_CONVERSION
66 :     :result-type 'string))))
67 :     (if string (setq end? t))
68 :     t)
69 :     (otherwise
70 :     ()
71 :     t))
72 :     (if end? (exit))))
73 :    
74 :     (send-event kinput-win
75 :     :client-message
76 :     nil
77 :     :window kinput-win
78 :     :format 32
79 :     :type :CONVERSION_END_REQUEST
80 :     :data
81 :     (list japanese-conversion
82 :     (window-id win)
83 :     0
84 :     0
85 :     0))
86 :    
87 :     (display-force-output display)
88 :    
89 :     (if (and (>= (string-length string) 1)
90 :     (= (sref string (1- (string-length string))) 10))
91 :     (setq string
92 :     (substring string 0 (1- (string-length string)))))
93 :    
94 :     (if (and (>= (string-length string) 4)
95 :     (string-equal (substring string 0 4) "$)B"))
96 :     (setq string (substring string 4)))
97 :    
98 :     string
99 :     )))))
100 :    
101 :    
102 :    

ktanaka

Powered by ViewCVS 1.0-dev

ViewCVS and CVS Help