Browse code

Added multi-lang support

Jenga Phoenix authored on 2019-03-29 03:35:17
Showing 3 changed files
... ...
@@ -119,21 +119,6 @@
119 119
 (defparameter *watch-directories* nil
120 120
   "A list of directories to watch and parse for defining forms")
121 121
 
122
-
123
-
124
-
125
-
126
-
127
-
128
-
129
-
130
-
131
-
132
-
133
-
134
-
135
-
136
-
137
-
138
-
139
-
122
+;; Interface language.
123
+;; Valid options: 'en (English), 'eo (Esperanto)
124
+(setf translate:*language* 'en)
140 125
new file mode 100644
... ...
@@ -0,0 +1,171 @@
1
+(in-package :able)
2
+
3
+;; translate is nice, but sends a bunch of annoying
4
+;; and unnecessary text to stdout.
5
+(with-open-stream (*standard-output* (make-broadcast-stream))
6
+  (translate:add-translations
7
+    'en
8
+    "File"	"File"
9
+    ;; ----------
10
+    "New file"	"New file"
11
+    "Open file"	"Open file"
12
+    "Open file browser" "Open file browser"
13
+    "Save file"	"Save file"
14
+    "Save as file" "Save as file"
15
+    "Save as file browser" "Save as file browser"
16
+    "Exit"	"Exit"
17
+
18
+    "Edit"	"Edit"
19
+    ;; ----------
20
+    "Cut"  	"Cut"
21
+    "Copy"  	"Copy"
22
+    "Paste" 	"Paste"
23
+
24
+    "Select all"	"Select all"
25
+    "Reindent"	"Reindent"
26
+    "Find"  	"Find"
27
+    "Find again"	"Find again"
28
+    "Goto line"	"Goto line"
29
+
30
+    "Buffers"	"Buffers"
31
+    ;; ----------
32
+    "Next buffer" "Next buffer"
33
+    "Close buffer" "Close buffer"
34
+    "Select buffer" "Select buffer"
35
+
36
+    "Lisp"	"Lisp"
37
+    ;; ----------
38
+    "Macroexpand"	"Macroexpand"
39
+    "Copy to REPL" "Copy to REPL"
40
+    "Complete symbol" "Complete symbol"
41
+    "CLHS lookup"	"CLHS lookup"
42
+    "(Re)load buffer" "(Re)load buffer"
43
+    "Load file"	"Load file"
44
+    "Load ASDF"	"Load ASDF"
45
+    "Compile file" "Compile file"
46
+    "Invoke native debugger" "Invoke native debugger"
47
+    "Reset listener" "Reset listener"
48
+
49
+    "evaluating..." "evaluating..."
50
+    "highlighting..." "highlighting..."
51
+
52
+    ;; info messages
53
+    "search wrapped around file" "search wrapped around file"
54
+    "No Hyperspec entry or src location found"
55
+    "No Hyperspec entry or src location found"
56
+
57
+    ;; error messages
58
+    "no matches"  "no matches"
59
+    "non integer argument supplied to goto"
60
+    "non integer argument supplied to goto"
61
+    "file not found" "file not found"
62
+    "please save before loading" "please save before loading"
63
+    "unsaved files exist...quit anyway?"
64
+    "unsaved files exist...quit anyway?"
65
+
66
+
67
+    "please save before compiling" "please save before compiling"
68
+    "search reached end of file" "search reached end of file"
69
+
70
+    ;; misc
71
+    "untitled"	"untitled"
72
+    "untitled #"	"untitled #"
73
+    "find:"	"find:"
74
+
75
+    "y"   	"y"
76
+    "yes"  	"yes"
77
+    "n"   	"n"
78
+    "no"   	"no"
79
+
80
+    "open:"	"open:"
81
+    "goto:"	"goto:"
82
+    "system:"	"system:"
83
+    "buffer number:" "buffer number:"
84
+    "load:"	"load:"
85
+    "save:"	"save:"
86
+    "unsaved file...close anyway?" "unsaved file...close anyway?"
87
+    "unsaved files exist...quit anyway?" "unsaved files exist...quit anyway?")
88
+
89
+  (translate:add-translations
90
+    'eo
91
+    "File"	"Dosiero"
92
+    ;; ----------
93
+    "New file"	"Nova"
94
+    "Open file"	"Malfermi"
95
+    "Open file browser" "Malfermi per foliumilo"
96
+    "Save file"	"Konservi"
97
+    "Save as file" "Konservi kiel"
98
+    "Save as file browser" "Konservi per foliumilo"
99
+    "Exit"	"Ĉesi"
100
+
101
+    "Edit"	"Redakti"
102
+    ;; ----------
103
+    "Cut"  	"Eltondi"
104
+    "Copy"  	"Kopii"
105
+    "Paste" 	"Alglui"
106
+
107
+    "Select all"	"Elekti ĉion"
108
+    "Reindent"	"Rekrommarĝeni"
109
+    "Find"  	"Serĉi"
110
+    "Find again"	"Reserĉi"
111
+    "Goto line"	"Aliri linion"
112
+
113
+    "Buffers"	"Bufroj"
114
+    ;; ----------
115
+    "Next buffer" "Sekva bufro"
116
+    "Close buffer"
117
+    "Fermi bufron"
118
+    "Select buffer" "Elekti bufron"
119
+
120
+    "Lisp"	"Lispo"
121
+    ;; ----------
122
+    "Macroexpand"	"Makrogeneradi"
123
+    "Copy to REPL" "Kopii al REPL"
124
+    "Complete symbol" "Kompletigi simbolon"
125
+    "CLHS lookup" "Serĉi en CLHS"
126
+    "(Re)load buffer" "(Re)ŝarĝi bufron"
127
+    "Load file"	"Ŝarĝi dosieron"
128
+    "Load ASDF"	"Ŝarĝi ASDF'on"
129
+    "Compile file" "Kompili dosieron"
130
+    "Invoke native debugger" "Alvoki erarserĉilon"
131
+    "Reset listener" "Restartigi aŭskultanton"
132
+
133
+    "evaluating..." "taksanta..."
134
+    "highlighting..." "prilumanta..."
135
+
136
+    ;; info messages
137
+    "search wrapped around file" "serĉado ĉirkaŭfluis en dosiero"
138
+    "No Hyperspec entry or src location found"
139
+    "Hyperspec enigo aŭ src loko netrovita"
140
+
141
+    ;; error messages
142
+    "no matches"  "sen rezultoj"
143
+    "non integer argument supplied to goto"
144
+    "argumento nenombra donita al aliri"
145
+    "file not found" "dosiero netrovita"
146
+    "please save before loading" "bonvolu, konservi antaŭ ŝarĝi"
147
+
148
+
149
+    "please save before compiling" "bonvolu, konservi antaŭ kompili"
150
+    "search reached end of file" "serĉado alvenis finon de doserion"
151
+
152
+    ;; misc
153
+    "untitled"	"sentitolo"
154
+    "untitled #"	"sentitolo #"
155
+    "find:"	"serĉi:"
156
+
157
+    "y"   	"j"
158
+    "yes"  	"jes"
159
+    "n"   	"n"
160
+    "no"   	"ne"
161
+
162
+    "open:"	"malfermi:"
163
+    "goto:"	"aliri:"
164
+    "system:"	"sistemo:"
165
+    "buffer number:" "bufrnombro:"
166
+    "load:"	"ŝarĝi:"
167
+    "save:"	"konservi:"
168
+    "unsaved file...close anyway?"
169
+    "nekonservita doserio...ĉu kvankam ĉesi?"
170
+    "unsaved files exist...quit anyway?"
171
+    "nekonservitaj dosieroj ekzistas...ĉu kvankam ĉesi?"))
... ...
@@ -14,7 +14,7 @@
14 14
     (setf untitled 0))
15 15
   (defun get-untitled ()
16 16
     (concatenate 'string
17
-      "untitled #" (format nil "~d"
17
+      #t"untitled #" (format nil "~d"
18 18
                      (incf untitled)))))
19 19
 
20 20
 ;;; maintain the last directory accessed by load and save operations
... ...
@@ -280,7 +280,7 @@
280 280
           ((equal event 'paste)
281 281
            (apply-highlight txt (text-row-add cur-pos (- amount)) (text-row-add cur-pos 1)))
282 282
           ((equal event 'load)
283
-           (with-status-msg "highlighting..." (apply-highlight txt "1.0" "end"))))))
283
+           (with-status-msg #t"highlighting..." (apply-highlight txt "1.0" "end"))))))
284 284
 
285 285
 (defmethod goto ((text ltk:text) line)
286 286
   (let ((cursor-pos (format nil "~a.0" line)))
... ...
@@ -313,7 +313,7 @@
313 313
 (let ((last-search "") (last-find-at 0))
314 314
   (defmethod search-text ((editor ltk:text))
315 315
     (find-text editor (input-prompt *listener*
316
-                        "find:" (ltk::selected editor))))
316
+                        #t"find:" (ltk::selected editor))))
317 317
   (defmethod search-text-again ((editor ltk:text))
318 318
     (find-text editor last-search))
319 319
   (defmethod find-text ((editor ltk:text) search-text)
... ...
@@ -330,7 +330,7 @@
330 330
              (setf start-pos (search search-text txt-to-search :start2 last-find-at))
331 331
              (unless start-pos
332 332
                (setf start-pos (search search-text txt-to-search :start2 0))
333
-               (info-message "search wrapped around file")))
333
+               (info-message #t"search wrapped around file")))
334 334
             (t
335 335
               ; Previous search result was found in a longer file which has set
336 336
               ; the last found result beyond the maximum index of the text being
... ...
@@ -339,7 +339,7 @@
339 339
       (case start-pos
340 340
         ((nil)
341 341
          (setf last-find-at 0)
342
-         (error-message "search reached end of file"))
342
+         (error-message #t"search reached end of file"))
343 343
         (otherwise
344 344
           (setf start-idx (strpos-to-textidx txt-to-search start-pos))
345 345
           (setf end-pos (+ start-pos txt-to-find-len))
... ...
@@ -588,7 +588,7 @@
588 588
 
589 589
 (defmethod new-buffer-p ((buffer buffer))
590 590
   "Is this a new file?"
591
-  (search "untitled" (slot-value buffer 'file-path)))
591
+  (search #t"untitled" (slot-value buffer 'file-path)))
592 592
 
593 593
 (defmethod saved-buffer-p ((buffer buffer))
594 594
   "Is this buffer saved?"
... ...
@@ -768,7 +768,7 @@
768 768
               (transform-file-list
769 769
                 (filter-matches files text)))
770 770
             (case (length pathname-matches)
771
-              (0 (error-message "no matches"))
771
+              (0 (error-message #t"no matches"))
772 772
               (1 (insert-command listener (correct-path (cdr (first pathname-matches)))))
773 773
               (otherwise
774 774
                 (insert-command listener
... ...
@@ -794,7 +794,7 @@
794 794
       ; Re-bind a new instance of USER-STREAM on each EVAL, in case it's
795 795
       ; required by a call to READ*, ensuring a pristine input stream.
796 796
       (with-able-streams 'user-stream
797
-        (with-status-msg "evaluating..."
797
+        (with-status-msg #t"evaluating..."
798 798
           ; Note the explicit handling of REPL variables.
799 799
           (handler-case (let ((form (read-from-string code-string)))
800 800
                           (setq +++ ++ ++ + + - - form)
... ...
@@ -973,13 +973,15 @@
973 973
       (otherwise user-answer))))
974 974
 
975 975
 (defmethod yes-no ((listener listener) message
976
-                   &optional (affirmative-answers '("y" "yes")) (default-answer "yes"))
976
+                   &optional
977
+		   (affirmative-answers (list #t"y" #t"yes"))
978
+		   (default-answer #t"yes"))
977 979
   "Prompts the user for input where any of affirmative-answers constitues 'yes'."
978 980
   (let ((user-answer (input-prompt listener message default-answer)))
979 981
     (prompt listener)
980 982
     (member user-answer affirmative-answers :test 'string-equal)))
981 983
 
982
-(defmethod get-filename ((listener listener) &optional (text "open:"))
984
+(defmethod get-filename ((listener listener) &optional (text #t"open:"))
983 985
   (let (filepath)
984 986
     (with-temporary-value (complete-mode listener) 'pathname
985 987
       (let ((last-directory (format nil "~a/" (correct-path (get-last-directory)))))
... ...
@@ -1040,10 +1042,10 @@
1040 1042
 
1041 1043
 (defun create-menus ()
1042 1044
   (let* ((mb (ltk:make-menubar))
1043
-         (mfile (ltk:make-menu mb "File"))
1044
-         (medit (ltk:make-menu mb "Edit"))
1045
-         (mbuffer (ltk:make-menu mb "Buffers"))
1046
-         (mlisp (ltk:make-menu mb "Lisp")))
1045
+         (mfile (ltk:make-menu mb #t"File"))
1046
+         (medit (ltk:make-menu mb #t"Edit"))
1047
+         (mbuffer (ltk:make-menu mb #t"Buffers"))
1048
+         (mlisp (ltk:make-menu mb #t"Lisp")))
1047 1049
     (setf *buffer-menubar* mbuffer)
1048 1050
 
1049 1051
     (macrolet ((with-menu (menu &body body)
... ...
@@ -1055,65 +1057,68 @@
1055 1057
                                `(ltk:make-menubutton ,',menu ,name #',op))))
1056 1058
                        (text-action (name op)
1057 1059
                          ;; an action that needs the current buffer
1058
-                         (let ((key (function-key op)))
1059
-                           `(ltk:make-menubutton ,',menu
1060
-                                                 ,(if key
1061
-                                                      (format nil "~A ~A" name key)
1062
-                                                      name)
1063
-                                                 (lambda ()
1064
-                                                   (,op (get-current-text-ctrl *buffer-manager*))))))
1060
+                         (let ((key (function-key op))
1061
+			       (op-current-text
1062
+				 `(lambda ()
1063
+				    (,op (get-current-text-ctrl *buffer-manager*)))))
1064
+
1065
+			   (if key
1066
+			     `(ltk:make-menubutton ,',menu (format nil "~A ~A" ,name ,key)
1067
+						   ,op-current-text)
1068
+			     `(ltk:make-menubutton ,',menu ,name
1069
+						   ,op-current-text))))
1065 1070
                        (separator ()
1066 1071
                          `(ltk:add-separator ,',menu)))
1067 1072
                     ,@body)))
1068 1073
       (with-menu mfile
1069
-        (action "New file" on-new-file)
1070
-        (action "Open file" on-open-file)
1071
-	(action "Open file browser" on-open-file-browser)
1074
+        (action #t"New file" on-new-file)
1075
+        (action #t"Open file" on-open-file)
1076
+	(action #t"Open file browser" on-open-file-browser)
1072 1077
         (separator)
1073
-        (action "Save file" on-save-file)
1074
-        (action "Save as file" on-save-as-file)
1075
-	(action "Save as file browser" on-save-as-file-browser)
1078
+        (action #t"Save file" on-save-file)
1079
+        (action #t"Save as file" on-save-as-file)
1080
+	(action #t"Save as file browser" on-save-as-file-browser)
1076 1081
         (separator)
1077
-        (action "Exit" on-quit))
1082
+        (action #t"Exit" on-quit))
1078 1083
       (with-menu medit
1079
-        (text-action "Cut" on-cut)
1080
-        (text-action "Copy" on-copy)
1081
-        (text-action "Paste" on-paste)
1084
+        (text-action #t"Cut" on-cut)
1085
+        (text-action #t"Copy" on-copy)
1086
+        (text-action #t"Paste" on-paste)
1082 1087
         (separator)
1083
-        (text-action "Select all" on-select-all)
1084
-        (text-action "Reindent" on-re-indent)
1088
+        (text-action #t"Select all" on-select-all)
1089
+        (text-action #t"Reindent" on-re-indent)
1085 1090
         (separator)
1086
-        (action "Find" on-search)
1087
-        (action "Find again" on-search-again)
1088
-        (action "Goto line" on-goto))
1091
+        (action #t"Find" on-search)
1092
+        (action #t"Find again" on-search-again)
1093
+        (action #t"Goto line" on-goto))
1089 1094
       (with-menu mbuffer
1090
-        (action "Next buffer" on-next-file)
1095
+        (action #t"Next buffer" on-next-file)
1091 1096
         (separator)
1092
-        (action "Close buffer" on-close-file)
1097
+        (action #t"Close buffer" on-close-file)
1093 1098
 	(separator)
1094
-	(action "Select buffer" on-select-file)
1099
+	(action #t"Select buffer" on-select-file)
1095 1100
 	;; sacrificial placeholder for the current buffer list
1096 1101
 	;; update the magic number in update-current-buffers when adding/removing entries
1097 1102
 	(ltk:make-menubutton mbuffer "" nil))
1098 1103
       (with-menu mlisp
1099
-        (text-action "Macroexpand" on-macro-expand)
1100
-        (text-action "Copy to REPL" on-copy-sexp-to-repl)
1101
-        (ltk:make-menubutton mlisp "Complete symbol"
1104
+        (text-action #t"Macroexpand" on-macro-expand)
1105
+        (text-action #t"Copy to REPL" on-copy-sexp-to-repl)
1106
+        (ltk:make-menubutton mlisp #t"Complete symbol"
1102 1107
                              (lambda ()
1103 1108
                                (let* ((buffer (selected-buffer *buffer-manager*))
1104 1109
                                       (text (ltk:textbox buffer)))
1105 1110
                                  (unless (plaintextp buffer)
1106 1111
                                    (on-code-complete text)))))
1107
-        (text-action "CLHS lookup" on-lookup-definition)
1112
+        (text-action #t"CLHS lookup" on-lookup-definition)
1108 1113
         (separator)
1109
-        (action "(Re)load buffer" on-reload-file)
1110
-        (action "Load file" on-load-file)
1111
-        (action "Load ASDF" on-asdf-load)
1114
+        (action #t"(Re)load buffer" on-reload-file)
1115
+        (action #t"Load file" on-load-file)
1116
+        (action #t"Load ASDF" on-asdf-load)
1112 1117
         (separator)
1113
-        (action "Compile file" on-compile-file)
1118
+        (action #t"Compile file" on-compile-file)
1114 1119
         (separator)
1115
-        (action "Invoke native debugger" on-invoke-debugger)
1116
-        (action "Reset listener" on-reset-listener)))))
1120
+        (action #t"Invoke native debugger" on-invoke-debugger)
1121
+        (action #t"Reset listener" on-reset-listener)))))
1117 1122
 
1118 1123
 (defun on-reset-listener (&optional event)
1119 1124
   (reset *listener*))
... ...
@@ -1126,12 +1131,12 @@
1126 1131
   (search-text-again (get-current-text-ctrl *buffer-manager*)))
1127 1132
 
1128 1133
 (defun on-goto (&optional event)
1129
-  (let ((input (input-prompt *listener* "goto:")))
1134
+  (let ((input (input-prompt *listener* #t"goto:")))
1130 1135
     (cond ((eq (length input) 0)
1131 1136
            nil)
1132 1137
           ((typep (read-from-string input) 'integer)
1133 1138
            (goto (get-current-text-ctrl *buffer-manager*) (parse-integer input)))
1134
-          (t (error-message "non integer argument supplied to goto"))))
1139
+          (t (error-message #t"non integer argument supplied to goto"))))
1135 1140
   (prompt *listener* :clear t))
1136 1141
 
1137 1142
 (defun open-file (filepath)
... ...
@@ -1145,7 +1150,7 @@
1145 1150
              (if (equal (find-buffer *buffer-manager* filepath) nil)
1146 1151
                  (add-buffer *buffer-manager* filepath t)
1147 1152
                  (select-buffer *buffer-manager* filepath)))
1148
-            (t (error-message "file not found")))
1153
+            (t (error-message #t"file not found")))
1149 1154
       file-exists-p)))
1150 1155
 
1151 1156
 (defun on-open-file (&optional event)
... ...
@@ -1157,7 +1162,7 @@
1157 1162
   (open-file (ltk:get-open-file)))
1158 1163
 
1159 1164
 (defun on-load-file (&optional event)
1160
-  (let* ((filepath (get-filename *listener* "load:"))
1165
+  (let* ((filepath (get-filename *listener* #t"load:"))
1161 1166
          (pathname (open-file filepath)))
1162 1167
     (when pathname
1163 1168
       (evaluator *listener*
... ...
@@ -1179,13 +1184,13 @@
1179 1184
 (defun on-save-file (&optional event)
1180 1185
   (let* ((file (selected-buffer *buffer-manager*))
1181 1186
          (path (if (new-buffer-p file)
1182
-                   (get-filename *listener* "save:")
1187
+                   (get-filename *listener* #t"save:")
1183 1188
                    (file-path file))))
1184 1189
     (save-file file path)))
1185 1190
 
1186 1191
 (defun on-save-as-file (&optional event)
1187 1192
   (let* ((file (selected-buffer *buffer-manager*))
1188
-         (path (get-filename *listener* "save:")))
1193
+         (path (get-filename *listener* #t"save:")))
1189 1194
     (save-file file path)))
1190 1195
 
1191 1196
 (defun on-save-as-file-browser (&optional event)
... ...
@@ -1201,7 +1206,7 @@
1201 1206
           (evaluator *listener*
1202 1207
             (format nil "(load \"~a\")" file-path))
1203 1208
           (prompt *listener*))
1204
-        (error-message "please save before loading"))))
1209
+        (error-message #t"please save before loading"))))
1205 1210
 
1206 1211
 (defun on-compile-file (&optional event)
1207 1212
   (let ((buffer (selected-buffer *buffer-manager*)))
... ...
@@ -1211,7 +1216,7 @@
1211 1216
             (format nil
1212 1217
               "(compile-file \"~a\")" (file-path (selected-buffer *buffer-manager*))))
1213 1218
           (prompt *listener*))
1214
-        (error-message "please save before compiling"))))
1219
+        (error-message #t"please save before compiling"))))
1215 1220
 
1216 1221
 (defun on-new-file (&optional event)
1217 1222
   (add-buffer *buffer-manager* (get-untitled)))
... ...
@@ -1220,11 +1225,11 @@
1220 1225
   (let ((curbuffer (selected-buffer *buffer-manager*)))
1221 1226
     (cond ((saved-buffer-p curbuffer)
1222 1227
            (close-buffer curbuffer *buffer-manager*))
1223
-          (t (when (yes-no *listener* "unsaved file...close anyway?")
1228
+          (t (when (yes-no *listener* #t"unsaved file...close anyway?")
1224 1229
                (close-buffer curbuffer *buffer-manager*))))))
1225 1230
 
1226 1231
 (defun on-asdf-load (&optional event)
1227
-  (let ((system (input-prompt *listener* "system:")))
1232
+  (let ((system (input-prompt *listener* #t"system:")))
1228 1233
     (when system
1229 1234
       (evaluator *listener*
1230 1235
         (concatenate 'string
... ...
@@ -1239,7 +1244,7 @@
1239 1244
 
1240 1245
 (defun on-select-file (&optional n)
1241 1246
   (unless (integerp n)
1242
-    (setf n (parse-integer (input-prompt *listener* "buffer number:"))))
1247
+    (setf n (parse-integer (input-prompt *listener* #t"buffer number:"))))
1243 1248
   (when (integerp n)
1244 1249
     (select-buffer *buffer-manager*
1245 1250
       ;; compensate for the reversed order
... ...
@@ -1268,7 +1273,7 @@
1268 1273
   (let ((unsaved-buffers (all-saved-buffer-p *buffer-manager*)))
1269 1274
     (cond ((= (length unsaved-buffers) 0)
1270 1275
            (shutdown))
1271
-          (t (when (yes-no *listener* "unsaved files exist...quit anyway?")
1276
+          (t (when (yes-no *listener* #t"unsaved files exist...quit anyway?")
1272 1277
                (shutdown))))))
1273 1278
 
1274 1279
 (defun on-escape (&optional event)
... ...
@@ -1280,7 +1285,7 @@
1280 1285
       (case (get (tstree:get-metadata *symbols* symbol) :type)
1281 1286
         (user (on-navigate-to-definition symbol))
1282 1287
         (system (hyperspec-lookup symbol))
1283
-        (otherwise (info-message "No Hyperspec entry or src location found"))))))
1288
+        (otherwise (info-message #t"No Hyperspec entry or src location found"))))))
1284 1289
 
1285 1290
 (defmethod on-macro-expand ((text ltk:text))
1286 1291
   (let ((sexp (sexp-before-cursor text)))