yatex

view yatexgen.el @ 45:b0fc9c2950cd

Prepare for supporting Emacs-19.
author yuuji
date Sun, 24 Jul 1994 15:07:23 +0000
parents b7b023a74293
children cd1b63102eed
line source
1 ;;; -*- Emacs-Lisp -*-
2 ;;; YaTeX add-in function generator.
3 ;;; yatexgen.el rev.2
4 ;;; (c )1991-1994 by HIROSE Yuuji.[yuuji@ae.keio.ac.jp]
5 ;;; Last modified Fri Jul 8 00:46:09 1994 on figaro
6 ;;; $Id$
8 (require 'yatex)
9 (provide 'yatexgen)
11 (defmacro YaTeX-setq (var japanese english)
12 (list 'setq var
13 (if YaTeX-japan japanese english))
14 )
16 (put 'YaTeX-setq 'lisp-indent-hook 1)
18 (YaTeX-setq YaTeX-generate-initial-message
19 " 自動生成モードへようこそ!!
21 初めてやる人はこのバッファの例にしたがって指示通りにやって練習してね。
22 本番の時もこのバッファに出るメッセージを *よく読んで* 操作しないとう
23 まく関数が作れないよ!!
25 ではリターンキーを押して下さい。"
26 " Welcome to auto-generation mode!!
28 If this is your first trial, exercise this according to example and
29 following my messages. Then, at making actual function, operate
30 reading my messages *carefully*, or you'll fail to generate appropriate
31 function.
33 Hit return key!"
34 )
36 (YaTeX-setq YaTeX-generate-start-message
37 "さぁはじめるよ.\n1.登録したい補完をやってみて.
38 たとえば section 型補完の \\documentstyle だったら \\documentstyle{}
39 だけをいれてみてね. ちゃんと『〜型補完』を使わないとダメよ!。
40 で、おわったらりたーん!!"
41 "Let's begin completion for which you want to make add-in function.
42 If you want to make add-in function for \\documentstyle input only
43 `\\documentstyle{}' *with* completion of yatex-mode.
44 If you finish this, please press RET."
45 )
47 (YaTeX-setq YaTeX-generate-abort-message
48 "やめた、やめた〜いめんどくせ〜"
49 "Aborted."
50 )
52 (YaTeX-setq YaTeX-generate-same-message
53 "それじゃ、なにも変わってねぇだろーが! やめた。"
54 "I found no difference between them. So I'm quitting."
55 )
57 (YaTeX-setq YaTeX-generate-invalid-message
58 "それは、ちと無理というものじゃ."
59 "It's impossible."
60 )
62 (YaTeX-setq YaTeX-generate-idontknow-message
63 "う〜ん、難しくてよくわからないなぁ。ばかでごめんねェ〜"
64 "Sorry I can't tell your adding method."
65 )
67 (YaTeX-setq YaTeX-generate-confirm-message
68 "ということは、付け足したい部分はこれでいいのね"
69 "Is it additional string of add-in function?"
70 )
72 (YaTeX-setq YaTeX-generate-output-message
73 "2.じゃ、それにくっつけたいものを *カーソルの位置に* 足してみて.
74 さっきの \\documentstyle{} の例だと \\documentstyle[12pt]{} とかにするの。
75 しつこいようだけど、今の位置からカーソル動かしちゃダメよ!!
76 で、またおわったらりたーん!!"
77 "2.Then input additional string *at CURSOR POSITION*
78 According to last example \\documentstyle{},
79 modify it \\documentstyle[12pt]{}. RET to finish."
80 )
82 (YaTeX-setq YaTeX-generate-put-arg-message
83 "3.このうち、キーボードから読み込んで欲しい文字列を順に入れて。
84 さっきの \\documentstyle[12pt]{} だったら、付加する文字は[12pt]だけど
85 手で入れたいのは 12pt の部分だけですね。
86 で、全部入れ終ったら、りたーんだけうってね!!"
87 "3.In this string, extract string which you want to input from key
88 board with quiry afterwards. For example, though additional string is
89 \\documentstyle[12pt]{}, but you want enter only `12pt' by hand.
90 RET to finish!"
91 )
93 (YaTeX-setq YaTeX-generate-read-prompt-message
94 "4.では、あとでこれらの文字列を読み込む時に、どういうプロンプトを
95 出したいですか? 順に入れて下さい。面倒なら単にリターンを打ってね。
96 さっきの 12pt の部分だったら、『サイズは』とかがおすすめ。"
97 "4.When you use this add-in function afterwards, what message
98 do you like to be prompted with to enter these values. In last
99 example `12pt', typical prompt string may be `Size?: '."
100 )
102 (YaTeX-setq YaTeX-generate-done-message
103 "よし! これが、君の作りたかった関数だ。~/.emacs にでも入れてせいぜい
104 楽してくれ。このバッファ(*ご案内*)を yatex-mode にしておくから
105 できた関数が本当にお望みの動作をするか確かめてみるといいかもね。
106 ところで、この関数こんなに簡単だろう? そろそろ自分で書いたらどう?
107 "
108 "OK! This is the definition of function you want to make! Add
109 this description to your ~/.emacs or so. Use this buffer(*Guide*)
110 for testing of this function please.
111 But you can see this function quite easy, can't you? You had better
112 write your most favorite add-in function yourself!
113 "
114 )
116 (YaTeX-setq YaTeX-generate-nomatch-message
117 "こらこら、そんな文字列どこにもねーぞ!!"
118 "No such string in additional string."
119 )
120 (YaTeX-setq YaTeX-generate-buffer
121 "*付加関数生成バッファ*"
122 "*Generate-add-in-function*"
123 )
125 (YaTeX-setq YaTeX-generate-message-buffer
126 "*ご案内*"
127 "*Guide*"
128 )
130 (YaTeX-setq YaTeX-generate-bug-message
131 "ごめ〜ん!! ちょっと、このアドイン関数つくるの失敗しちゃったみたい!!
132 作者まで連絡してくださ〜〜〜い!"
133 "Sorry I failed to make add-in function for you...
134 Send bug report to me."
135 )
137 (YaTeX-setq YaTeX-generate-narrow-message
138 "画面がせますぎるような気がします。"
139 "Too narrow screen height."
140 )
142 (defvar YaTeX-generate-message-height
143 10 "Window height of YaTeX-generate-message-buffer")
145 ;;;
146 ;Generate mode.
147 ;;;
148 (defun YaTeX-generate ()
149 "Genarate YaTeX add-in function with enquiry."
150 (interactive)
151 (if (< (screen-height) (+ YaTeX-generate-message-height 10))
152 (error YaTeX-generate-narrow-message))
153 (put 'YaTeX-generate 'disabled t)
154 (save-window-excursion
155 (unwind-protect
156 (let (input output (i 0) (beg 0) end add-in map map1 si str slist
157 (from (make-marker)) (to (make-marker)))
158 (delete-other-windows)
159 (switch-to-buffer YaTeX-generate-message-buffer)
160 (yatex-mode)
161 (erase-buffer)
162 (insert YaTeX-generate-initial-message)
163 (read-string
164 (if YaTeX-japan "リターンキーを押して下さい." "Press RETURN."))
165 (erase-buffer)
166 (insert YaTeX-generate-start-message)
167 (pop-to-buffer (get-buffer-create YaTeX-generate-buffer))
168 (enlarge-window (- (window-height) YaTeX-generate-message-height 1))
169 (erase-buffer)
170 (yatex-mode)
171 (use-local-map (setq map (copy-keymap YaTeX-mode-map)))
172 (define-key (current-local-map) "\n" 'exit-recursive-edit)
173 (define-key (current-local-map) "\r" 'exit-recursive-edit)
174 (define-key (current-local-map) "\C-g" 'abort-recursive-edit)
175 (setq map1 (copy-keymap map))
176 (YaTeX-suppress-sparse-keymap map)
177 ;;First get input form.
178 (recursive-edit)
179 (setq input (buffer-string)
180 end (1- (length input)))
181 (if (string= "" input) (error YaTeX-generate-abort-message))
182 (YaTeX-generate-move-to-add-in-position)
183 (set-marker from (1- (point))) ;;Can't write before `from'
184 (set-marker to (1+ (point))) ;;Can't write after `to'
185 ;;Second get output form.
186 (setq beg (1- (point)));;Cheat begin point!
187 (YaTeX-generate-display-message YaTeX-generate-output-message)
188 (use-local-map map1)
189 (fset 'si (symbol-function 'self-insert-command))
190 (defun self-insert-command (arg)
191 (interactive "p")
192 (if (or (not (equal (buffer-name) YaTeX-generate-buffer))
193 (and (> (point) (marker-position from))
194 (< (point) (marker-position to))))
195 (insert (this-command-keys)) (ding)))
196 (unwind-protect
197 (recursive-edit)
198 (fset 'self-insert-command (symbol-function 'si)))
199 (setq output (buffer-string))
200 (cond ((string= "" output) (error YaTeX-generate-abort-message))
201 ((string= input output) (error YaTeX-generate-same-message))
202 ((< (length output) (length input))
203 (error YaTeX-generate-invalid-message)))
204 ;;(while (and (< beg end) (= (aref input beg) (aref output i)))
205 ;; (setq beg (1+ beg) i (1+ i))) ;;for universal use.
206 (setq i (1- (length output)))
207 (while (and (>= end beg) (= (aref output i) (aref input end)))
208 (setq end (1- end) i (1- i)))
209 (setq add-in (substring output beg
210 (if (= i (1- (length output))) nil (1+ i))))
211 (erase-buffer)
212 (insert add-in)
213 (if (not (y-or-n-p YaTeX-generate-confirm-message))
214 (error YaTeX-generate-idontknow-message))
215 ;;Extract arguments.
216 (YaTeX-generate-display-message YaTeX-generate-put-arg-message)
217 (setq i 1)
218 (while (not (string=
219 "" (setq str (read-string (format "Arg %d: " i)))))
220 (if (not (string-match (regexp-quote str) add-in))
221 (progn
222 (ding)
223 (YaTeX-generate-display-message
224 YaTeX-generate-nomatch-message -1))
225 (setq slist (append slist (list (list str))) i (1+ i)))
226 );input all of arguments.
227 ;;Compare with output string.
228 (set-buffer YaTeX-generate-buffer) ;;for safety
229 (emacs-lisp-mode)
230 (if (> i 1)
231 (YaTeX-generate-parse-add-in slist add-in)
232 (erase-buffer)
233 (insert "(defun " (YaTeX-generate-function-name) " ()\n")
234 (insert "\"" (YaTeX-generate-lisp-quote add-in) "\")\n")
235 (indent-region (point-min) (point-max) nil)
236 (message (if YaTeX-japan
237 "このくらいの関数手で書け!!"
238 "You don't need me to make such easy function.")))
239 );let
240 (put 'YaTeX-generate 'disabled nil)
241 (put 'YaTeX-addin 'disabled nil)
242 ))
243 (YaTeX-generate-display-message YaTeX-generate-done-message)
244 (switch-to-buffer YaTeX-generate-buffer)
245 (condition-case error
246 (eval-current-buffer)
247 (error (insert YaTeX-generate-bug-message)))
248 (pop-to-buffer YaTeX-generate-message-buffer)
249 )
251 (defun YaTeX-generate-parse-add-in (args add-in)
252 "Parse add-in string and extract argument for it.
253 Variable add-in is referred in parent function."
254 (let ((i 1) j (case-fold-search nil) ;i holds argument number
255 (prompt (make-vector (length args) ""))
256 (used (make-vector (length add-in) nil))
257 func-name (string ""))
258 ;;Phase 1. extract argument from add-in string.
259 (mapcar
260 '(lambda (arg)
261 (let ((index 0) (match 0) beg end (carg (car arg)))
262 (YaTeX-generate-display-message
263 YaTeX-generate-read-prompt-message)
264 (aset prompt (1- i)
265 (read-string
266 (format
267 (if YaTeX-japan "%d番目(%s)を読む時?: "
268 "When reading argument #%d(%s)?: ") i (car arg))))
269 (while (string-match (regexp-quote carg) (substring add-in index))
270 (setq beg (+ index (match-beginning 0))
271 end (+ index (match-end 0)))
272 (if (aref used beg) nil
273 (setq match (1+ match))
274 (cond
275 ((= match 1)
276 ;;(setq arg (append arg (list (list beg end))))
277 (YaTeX-generate-register-match))
278 ((YaTeX-generate-ask-match-position)
279 (YaTeX-generate-register-match))))
280 (setq index end))
281 (setq i (1+ i))))
282 args)
283 ;;Phase 2. Generate function!!
284 (setq i 0)
285 (setq func-name (YaTeX-generate-function-name))
286 (while (< i (length add-in))
287 (setq beg i j (aref used i))
288 (while (and (< i (length add-in)) (equal j (aref used i)))
289 (setq i (1+ i)))
290 (if j ;If it is argument.
291 (setq string (concat string (format " arg%d" j)))
292 (setq string
293 (concat string " \""
294 (YaTeX-generate-quote-quote (substring add-in beg i))
295 "\""))
296 ))
297 (erase-buffer)
298 (setq i 1)
299 (insert
300 "(defun " func-name " ()\n"
301 " (let (")
302 (mapcar
303 '(lambda (arg)
304 (insert (format "(arg%d (read-string \"%s: \"))\n"
305 i (aref prompt (1- i))))
306 (setq i (1+ i)))
307 args)
308 (delete-region (point) (progn (forward-line -1) (end-of-line) (point)))
309 (insert ")\n(concat " (YaTeX-generate-lisp-quote string)
310 ")))\n")
311 (indent-region (point-min) (point) nil)
312 used)
313 )
315 (defun YaTeX-generate-ask-match-position ()
316 "Ask user whether match-position is in his expectation,
317 Referencing variables in parent function YaTeX-generate-parse-add-in."
318 (pop-to-buffer YaTeX-generate-message-buffer)
319 (goto-char (point-max))
320 (insert "\n\n"
321 (format (if YaTeX-japan "%d 番目の引数 %s って"
322 "Is argument #%d's value `%s' also corresponding to")
323 i carg) "\n" add-in "\n")
324 (indent-to-column beg)
325 (let ((c beg))
326 (while (< c end) (insert "^") (setq c (1+ c))))
327 (insert "\n" (if YaTeX-japan "ここにも対応してるの?"
328 "this underlined part too?"))
329 (other-window -1)
330 (y-or-n-p (if YaTeX-japan "下線部はあってますか" "Is underline right"))
331 )
333 (defun YaTeX-generate-register-match ()
334 (nconc arg (list (list beg end)))
335 (let ((x beg))
336 (while (< x end) (aset used x i)(setq x (1+ x))))
337 )
339 (defun YaTeX-generate-display-message (mes &optional bottom)
340 "Display message to generation buffer."
341 (pop-to-buffer YaTeX-generate-message-buffer)
342 (goto-char (point-max))
343 (insert "\n\n")
344 (if bottom (recenter (1- bottom)) (recenter 0))
345 (insert mes)
346 (other-window -1)
347 )
349 (defun YaTeX-generate-move-to-add-in-position ()
350 "Move cursor where add-in function should insert string."
351 (cond
352 ((eq YaTeX-current-completion-type 'begin)
353 (goto-char (point-min))
354 (skip-chars-forward "^{")
355 (setq env-name
356 (buffer-substring (1+ (point))
357 (progn (skip-chars-forward "^}") (point))))
358 (forward-char 1))
359 ((eq YaTeX-current-completion-type 'section)
360 (goto-char (point-min))
361 (skip-chars-forward "^{"))
362 ((eq YaTeX-current-completion-type 'maketitle)
363 (goto-char (point-max))
364 (if (= (preceding-char) ? )
365 (forward-char -1)))
366 )
367 )
369 (defun YaTeX-generate-function-name ()
370 (concat
371 "YaTeX:"
372 (cond
373 ((eq YaTeX-current-completion-type 'begin) env-name)
374 ((eq YaTeX-current-completion-type 'section) section-name)
375 ((eq YaTeX-current-completion-type 'maketitle) single-command)))
376 )
378 (defun YaTeX-generate-lisp-quote (str)
379 (let ((len (length str))(i 0) (quote ""))
380 (while (< i len)
381 (if (= (aref str i) ?\\)
382 (setq quote (concat quote "\\")))
383 (if (= (aref str i) 127)
384 (setq quote (concat quote "\""))
385 (setq quote (concat quote (substring str i (1+ i)))))
386 (setq i (1+ i)))
387 quote)
388 )
390 (defun YaTeX-generate-quote-quote (str)
391 (let ((len (length str))(i 0) (quote ""))
392 (while (< i len)
393 (if (= (aref str i) ?\")
394 (setq quote (concat quote (char-to-string 127))))
395 (setq quote (concat quote (substring str i (1+ i))))
396 (setq i (1+ i)))
397 quote)
398 )
400 (defun YaTeX-suppress-sparse-keymap (map)
401 (let ((i ? ))
402 (while (< i 127)
403 (define-key map (char-to-string i) 'undefined)
404 (setq i (1+ i))))
405 )
407 ;;;
408 ;; Auto-generate Function for Lispers.
409 ;;;
410 (defun YaTeX-generate-read-completion-type (nth)
411 (message
412 "Read type(%d): (S)tring (C)omplete (F)ile ([)option (P)osition co(O)rd. (q)uit" nth)
413 (let ((c (read-char)))
414 (cond
415 ((= c ?s) 'string)
416 ((= c ?c) 'completion)
417 ((= c ?f) 'file)
418 ((= c ?\[) 'option)
419 ((= c ?p) 'oneof)
420 ((= c ?o) 'coord)
421 ;;((= c ?m) 'macro)
422 (t 'quit)))
423 )
424 (defun YaTeX-generate-read-completion-table ()
425 (let ((i 1) cand (cands "(") (cb (current-buffer))
426 (buf (get-buffer-create " *Candidates*")))
427 (save-window-excursion
428 (save-excursion
429 (YaTeX-showup-buffer buf nil)
430 (set-buffer buf)
431 (erase-buffer)
432 (while (string<
433 ""
434 (setq cand (read-string (format "Item[%d](RET to exit): " i))))
435 (setq cands (concat cands (format "(""%s"")\n" cand))
436 i (1+ i))
437 (insert cand "\n"))
438 (kill-buffer buf)))
439 ;;(set-buffer cb)
440 (concat cands ")"))
441 )
442 (defun YaTeX-generate-corresponding-paren (left)
443 (cond
444 ((equal left "{") "}")
445 ((equal left "[") "]")
446 ((equal left "(") ")")
447 ((equal left "<") ">")
448 ((equal left "\\begin{" "}"))
449 (t left))
450 )
451 (defun YaTeX-generate-create-read-string (&optional nth)
452 (concat
453 "(read-string """
454 (read-string (if nth (format "Prompt for argument#%d: " nth) "Prompt: "))
455 ": ""\n"
456 """" (read-string "Default: ") """"
457 ")\n")
458 )
459 (defun YaTeX-generate-create-completing-read (&optional nth)
460 (concat
461 "(completing-read """
462 (read-string (if nth (format "Prompt for argument#%d: " nth) "Prompt: "))
463 ": ""\n"
464 (format "'%s\n" (YaTeX-generate-read-completion-table))
465 "nil "
466 (format "%s)" (y-or-n-p "Require match? ")))
467 )
468 (defun YaTeX-generate-create-read-file-name (&optional nth)
469 (concat
470 "(read-file-name """
471 (read-string (if nth (format "Prompt for argument#%d: " nth) "Prompt: "))
472 ": "" nil nil t """")\n")
473 )
474 (defun YaTeX-generate-create-read-oneof (&optional nth readpos)
475 (concat
476 (if readpos
477 "(YaTeX:read-position """
478 "(YaTeX:read-oneof """)
479 (read-string "Acceptable characters: " "lcr") """)\n")
480 )
481 (defun YaTeX-generate-option-type (command)
482 (let ((func (format "YaTeX:%s" command)) leftp
483 (buf (get-buffer-create YaTeX-generate-buffer)) type (n 1))
484 (set-buffer buf)
485 (erase-buffer)
486 (insert "(defun " func " ()\n (concat\n")
487 (catch 'done
488 (while t
489 (setq type (YaTeX-generate-read-completion-type n))
490 (insert
491 (cond
492 ;;Read string
493 ((eq type 'string)
494 (concat """" (setq leftp (read-string "Left parenthesis: " "{"))
495 """\n"
496 (YaTeX-generate-create-read-string)
497 """" (YaTeX-generate-corresponding-paren leftp) """"
498 ))
500 ;;Completing-read
501 ((eq type 'completion)
502 (concat """" (setq leftp (read-string "Left parenthesis: " "{"))
503 """\n"
504 (YaTeX-generate-create-completing-read)
505 """" (YaTeX-generate-corresponding-paren leftp) """")
506 )
507 ((eq type 'file)
508 (concat """" (setq leftp (read-string "Left parenthesis: " "{"))
509 """\n"
510 (YaTeX-generate-create-read-file-name)
511 """" (YaTeX-generate-corresponding-paren leftp) """")
512 )
513 ((eq type 'oneof)
514 (YaTeX-generate-create-read-oneof nil t)
515 )
516 ((eq type 'option)
517 (concat "(let ((op (read-string """
518 (read-string "Prompt: ")
519 ": "")))\n"
520 "(if (string< """" op)\n"
521 " (concat ""["" op ""]"")\n"
522 " """"))\n")
523 )
525 ((eq type 'coord)
526 (concat "(YaTeX:read-coordinates """
527 (read-string "Prompt for coordinates: ")
528 ": """)
529 )
530 ((eq type 'macro)
531 (error "not yet supported")
532 )
533 (t (throw 'done t))))
534 (setq n (1+ n))))
535 (insert "))\n") ;close defun
536 (goto-char (point-min))
537 (while (not (eobp)) (lisp-indent-line) (forward-line 1))
538 (eval-current-buffer)
539 buf)
540 )
541 (defun YaTeX-generate-argument-type (command argc)
542 "Create an argument-type add-in function."
543 (interactive)
544 (let ((func (format "YaTeX::%s" command)) (argp 1)
545 (cb (current-buffer))
546 (buf (get-buffer-create YaTeX-generate-buffer)))
547 (set-buffer buf)
548 (erase-buffer)
549 (insert "(defun " func " (&optional argp)\n(cond\n")
550 (while (<= argp argc)
551 (insert (format "((equal argp %d)\n" argp))
552 (setq type (YaTeX-generate-read-completion-type argp))
553 (insert
554 (cond
555 ((eq type 'string)
556 (concat (YaTeX-generate-create-read-string argp)))
557 ((eq type 'completion)
558 (concat (YaTeX-generate-create-completing-read argp)))
559 ((eq type 'oneof)
560 (YaTeX-generate-create-read-oneof))
561 ((eq type 'file)
562 (concat (YaTeX-generate-create-read-file-name argp)))
563 (t ""))
564 ")\n")
565 (setq argp (1+ argp)))
566 (insert "))\n")
567 (goto-char (point-min))
568 (while (not (eobp)) (lisp-indent-line) (forward-line 1))
569 (eval-current-buffer)
570 (set-buffer cb)
571 (YaTeX-update-table
572 (if (> argc 1) (list command argc) (list command))
573 'section-table 'user-section-table 'tmp-section-table)
574 buf)
575 )
576 (defun YaTeX-generate-simple (&optional command)
577 "Simple but requiring some elisp knowledge add-in generator."
578 (interactive)
579 (or command
580 (setq command
581 (completing-read
582 (format "Making add-in function for (default %s): " section-name)
583 (append
584 section-table user-section-table tmp-section-table
585 article-table user-article-table
586 env-table user-env-table tmp-env-table
587 singlecmd-table user-singlecmd-table tmp-singlecmd-table)
588 nil nil)
589 command (if (string= "" command) section-name command)))
590 (message "(o)追加型? (a)引数型? (yatexadd.docを参照のこと) :")
591 (YaTeX-showup-buffer
592 (if (= (read-char) ?o)
593 (YaTeX-generate-option-type command)
594 (YaTeX-generate-argument-type
595 command
596 (string-to-int (read-string "How many arguments?: ")))) nil)
597 )