yatex / yatexgen.el
HIROSE Yuuji on 26 Dec 2014 19 KB Start for 1.79
;;; yatexgen.el --- YaTeX add-in function generator(rev.5)

;;; (c)1991-1995,1999,2000 by HIROSE Yuuji.[]
;;; Last modified Sun Dec 21 14:04:49 2014 on firestorm
;;; $Id$

;;; Code:
(require 'yatex)

(defmacro YaTeX-setq (var japanese english)
  (list 'setq var
	(if YaTeX-japan japanese english)))

(put 'YaTeX-setq 'lisp-indent-hook 1)

(YaTeX-setq YaTeX-generate-initial-message
  "             自動生成モードへようこそ!!

本番の時もこのバッファに出るメッセージを *よく読んで* 操作しないとう

  "             Welcome to auto-generation mode!!

If this is your first trial, exercise this according to example and
following my messages.  Then, at making actual function, operate
reading my messages *carefully*, or you'll fail to generate appropriate

  Hit return key!")

(YaTeX-setq YaTeX-generate-start-message
たとえば section 型補完の \\documentstyle だったら \\documentstyle{}
だけをいれてみてね. ちゃんと『〜型補完』を使わないとダメよ!。
  "Let's begin completion for which you want to make add-in function.
If you want to make add-in function for \\documentstyle input only
`\\documentstyle{}' *with* completion of yatex-mode.
If you finish this, please press RET.")

(YaTeX-setq YaTeX-generate-abort-message

(YaTeX-setq YaTeX-generate-same-message
  "それじゃ、なにも変わってねぇだろーが! やめた。"
  "I found no difference between them.  So I'm quitting.")

(YaTeX-setq YaTeX-generate-invalid-message
  "It's impossible.")

(YaTeX-setq YaTeX-generate-idontknow-message
  "Sorry I can't tell your adding method.")

(YaTeX-setq YaTeX-generate-confirm-message
  "Is it additional string of add-in function?")

(YaTeX-setq YaTeX-generate-output-message
  "2.じゃ、それにくっつけたいものを *カーソルの位置に* 足してみて. 
さっきの \\documentstyle{} の例だと \\documentstyle[12pt]{} とかにするの。
  "2.Then input additional string *at CURSOR POSITION*
According to last example \\documentstyle{},
modify it \\documentstyle[12pt]{}.  RET to finish.")

(YaTeX-setq YaTeX-generate-put-arg-message
さっきの \\documentstyle[12pt]{} だったら、付加する文字は[12pt]だけど
手で入れたいのは 12pt の部分だけですね。
  "3.In this string, extract string which you want to input from key
board with quiry afterwards.  For example, though additional string is
\\documentstyle[12pt]{}, but you want enter only `12pt' by hand.
RET to finish!")

(YaTeX-setq YaTeX-generate-read-prompt-message
出したいですか? 順に入れて下さい。面倒なら単にリターンを打ってね。
さっきの 12pt の部分だったら、『サイズは』とかがおすすめ。"
  "4.When you use this add-in function afterwards, what message
do you like to be prompted with to enter these values.  In last
example `12pt', typical prompt string may be `Size?: '.")

(YaTeX-setq YaTeX-generate-done-message
  "よし! これが、君の作りたかった関数だ。~/.emacs にでも入れてせいぜい
楽してくれ。このバッファ(*ご案内*)を yatex-mode にしておくから
  ところで、この関数こんなに簡単だろう? そろそろ自分で書いたらどう?
  "OK! This is the definition of function you want to make!  Add
this description to your ~/.emacs or so.  Use this buffer(*Guide*)
for testing of this function please.
  But you can see this function quite easy, can't you? You had better
write your most favorite add-in function yourself!

(YaTeX-setq YaTeX-generate-nomatch-message
  "No such string in additional string.")

(YaTeX-setq YaTeX-generate-buffer

(YaTeX-setq YaTeX-generate-message-buffer

(YaTeX-setq YaTeX-generate-bug-message
  "ごめ〜ん!! ちょっと、このアドイン関数つくるの失敗しちゃったみたい!!
  "Sorry I failed to make add-in function for you...
Send bug report to me.")

(YaTeX-setq YaTeX-generate-narrow-message
  "Too narrow screen height.")

(defvar YaTeX-generate-message-height
  10 "Window height of YaTeX-generate-message-buffer")

;; Do you need learning for generated function?
;; If you need, please tell me (
;;(defvar YaTeX-generate-variables-for-learning nil)
;;(defvar YaTeX-generate-current-completion-table nil)

;Generate mode.
(defun YaTeX-generate ()
  "Genarate YaTeX add-in function with enquiry."
  (if (< (YaTeX-screen-height) (+ YaTeX-generate-message-height 10))
      (error YaTeX-generate-narrow-message))
  (put 'YaTeX-generate 'disabled t)
	(let (input output (i 0) (beg 0) end add-in map map1 si str slist
		    (from (make-marker)) (to (make-marker)))
	  (switch-to-buffer YaTeX-generate-message-buffer)
	  (insert YaTeX-generate-initial-message)
	   (if YaTeX-japan "リターンキーを押して下さい." "Press RETURN."))
	  (insert YaTeX-generate-start-message)
	  (pop-to-buffer (get-buffer-create YaTeX-generate-buffer))
	  (enlarge-window (- (window-height) YaTeX-generate-message-height 1))
	  (use-local-map (setq map (copy-keymap YaTeX-mode-map)))
	  (define-key (current-local-map) "\n" 'exit-recursive-edit)
	  (define-key (current-local-map) "\r" 'exit-recursive-edit)
	  (define-key (current-local-map) "\C-g" 'abort-recursive-edit)
	  (setq map1 (copy-keymap map))
	  (YaTeX-suppress-sparse-keymap map)
	  ;;First get input form.
	  (setq input (YaTeX-minibuffer-string)
		end (1- (length input)))
	  (if (string= "" input) (error YaTeX-generate-abort-message))
	  (set-marker from (1- (point)))  ;;Can't write before `from'
	  (set-marker to (1+ (point)))    ;;Can't write after `to'
	  ;;Second get output form.
	  (setq beg (1- (point)));;Cheat begin point!
	  (YaTeX-generate-display-message YaTeX-generate-output-message)
	  (use-local-map map1)
	  (fset 'si (symbol-function 'self-insert-command))
	  (defun self-insert-command (arg)
	    (interactive "p")
	    (if (or (not (equal (buffer-name) YaTeX-generate-buffer))
		    (and (> (point) (marker-position from))
			 (< (point) (marker-position to))))
		(insert (this-command-keys)) (ding)))
	    (fset 'self-insert-command (symbol-function 'si)))
	  (setq output (YaTeX-minibuffer-string))
	  (cond ((string= "" output)	(error YaTeX-generate-abort-message))
		((string= input output)	(error YaTeX-generate-same-message))
		((< (length output) (length input))
		 (error YaTeX-generate-invalid-message)))
	  ;;(while (and (< beg end) (= (aref input beg) (aref output i)))
	  ;;  (setq beg (1+ beg) i (1+ i))) ;;for universal use.
	  (setq i (1- (length output)))
	  (while (and (>= end beg) (= (aref output i) (aref input end)))
	    (setq end (1- end) i (1- i)))
	  (setq add-in (substring output beg
				  (if (= i (1- (length output))) nil (1+ i))))
	  (insert add-in)
	  (if (not (y-or-n-p YaTeX-generate-confirm-message))
	      (error YaTeX-generate-idontknow-message))
	  ;;Extract arguments.
	  (YaTeX-generate-display-message YaTeX-generate-put-arg-message)
	  (setq i 1)
	  (while (not (string=
		       "" (setq str (read-string (format "Arg %d: " i)))))
	    (if (not (string-match (regexp-quote str) add-in))
		   YaTeX-generate-nomatch-message -1))
	      (setq slist (append slist (list (list str))) i (1+ i)))
	    );input all of arguments.
	  ;;Compare with output string.
	  (set-buffer YaTeX-generate-buffer) ;;for safety
	  (if (> i 1)
	      (YaTeX-generate-parse-add-in slist add-in)
	    (insert "(defun " (YaTeX-generate-function-name) " ()\n")
	    (insert "\"" (YaTeX-generate-lisp-quote add-in) "\")\n")
	    (indent-region (point-min) (point-max) nil)
	    (message (if YaTeX-japan
		       "You don't need me to make such easy function.")))
      (put 'YaTeX-generate 'disabled nil)
      (put 'YaTeX-addin 'disabled nil)
  (YaTeX-generate-display-message YaTeX-generate-done-message)
  (switch-to-buffer YaTeX-generate-buffer)
  (condition-case error
    (error (insert YaTeX-generate-bug-message)))
  (pop-to-buffer YaTeX-generate-message-buffer))

(defun YaTeX-generate-parse-add-in (args add-in)
  "Parse add-in string and extract argument for it.
Variable add-in is referred in parent function."
  (let ((i 1) j (case-fold-search nil) ;i holds argument number
	(prompt (make-vector (length args) ""))
	(used (make-vector (length add-in) nil))
	func-name (string ""))
    ;;Phase 1. extract argument from add-in string.
      (lambda (arg)
	(let ((index 0) (match 0) beg end (carg (car arg)))
	  (aset prompt (1- i)
		  (if YaTeX-japan "%d番目(%s)を読む時?: "
		    "When reading argument #%d(%s)?: ") i (car arg))))
	  (while (string-match (regexp-quote carg) (substring add-in index))
	    (setq beg (+ index (match-beginning 0))
		  end (+ index (match-end 0)))
	    (if (aref used beg) nil
	      (setq match (1+ match))
	       ((= match 1)
		;;(setq arg (append arg (list (list beg end))))
	    (setq index end))
	  (setq i (1+ i)))))
    ;;Phase 2. Generate function!!
    (setq i 0)
    (setq func-name (YaTeX-generate-function-name))
    (while (< i (length add-in))
      (setq beg i j (aref used i))
      (while (and (< i (length add-in)) (equal j (aref used i)))
	(setq i (1+ i)))
      (if j		;If it is argument.
	  (setq string (concat string (format " arg%d" j)))
	(setq string
	      (concat string " \""
		      (YaTeX-generate-quote-quote (substring add-in beg i))
    (setq i 1)
     "(defun " func-name " ()\n"
     "  (let (")
      (lambda (arg)
	(insert (format "(arg%d (read-string \"%s: \"))\n"
			i (aref prompt (1- i))))
	(setq i (1+ i))))
    (delete-region (point) (progn (forward-line -1) (end-of-line) (point)))
    (insert ")\n(concat " (YaTeX-generate-lisp-quote string)
    (indent-region (point-min) (point) nil)

(defun YaTeX-generate-ask-match-position ()
  "Ask user whether match-position is in his expectation,
Referencing variables in parent function YaTeX-generate-parse-add-in."
  (pop-to-buffer YaTeX-generate-message-buffer)
  (goto-char (point-max))
  (insert "\n\n"
	  (format (if YaTeX-japan "%d 番目の引数 %s って"
		    "Is argument #%d's value `%s' also corresponding to")
		  i carg) "\n" add-in "\n")
  (indent-to-column beg)
  (let ((c beg))
    (while (< c end) (insert "^") (setq c (1+ c))))
  (insert "\n" (if YaTeX-japan "ここにも対応してるの?"
		 "this underlined part too?"))
  (other-window -1)
  (y-or-n-p (if YaTeX-japan "下線部はあってますか" "Is underline right")))

(defun YaTeX-generate-register-match ()
  (nconc arg (list (list beg end)))
  (let ((x beg))
    (while (< x end) (aset used x i)(setq x (1+ x)))))

(defun YaTeX-generate-display-message (mes &optional bottom)
  "Display message to generation buffer."
  (pop-to-buffer YaTeX-generate-message-buffer)
  (goto-char (point-max))
  (insert "\n\n")
  (if bottom (recenter (1- bottom)) (recenter 0))
  (insert mes)
  (other-window -1))

(defun YaTeX-generate-move-to-add-in-position ()
  "Move cursor where add-in function should insert string."
   ((eq YaTeX-current-completion-type 'begin)
    (goto-char (point-min))
    (skip-chars-forward "^{")
    (setq YaTeX-env-name
	  (buffer-substring (1+ (point))
			    (progn (skip-chars-forward "^}") (point))))
    (forward-char 1))
   ((eq YaTeX-current-completion-type 'section)
    (goto-char (point-min))
    (skip-chars-forward "^{"))
   ((eq YaTeX-current-completion-type 'maketitle)
    (goto-char (point-max))
    (if (= (preceding-char) ? )
	(forward-char -1)))))

(defun YaTeX-generate-function-name ()
    ((eq YaTeX-current-completion-type 'begin) YaTeX-env-name)
    ((eq YaTeX-current-completion-type 'section) YaTeX-section-name)
    ((eq YaTeX-current-completion-type 'maketitle) YaTeX-single-command))))

(defun YaTeX-generate-lisp-quote (str)
  (let ((len (length str))(i 0) (quote ""))
    (while (< i len)
      (if (= (aref str i) ?\\)
	  (setq quote (concat quote "\\")))
      (if (= (aref str i) 127)
	  (setq quote (concat quote "\""))
	(setq quote (concat quote (substring str i (1+ i)))))
      (setq i (1+ i)))

(defun YaTeX-generate-quote-quote (str)
  (let ((len (length str))(i 0) (quote ""))
    (while (< i len)
      (if (= (aref str i) ?\")
	  (setq quote (concat quote (char-to-string 127))))
      (setq quote (concat quote (substring str i (1+ i))))
      (setq i (1+ i)))

(defun YaTeX-suppress-sparse-keymap (map)
  (let ((i ? ))
    (while (< i 127)
      (define-key map (char-to-string i) 'undefined)
      (setq i (1+ i)))))

;; Auto-generate Function for Lispers.
(defun YaTeX-generate-read-completion-type (nth)
"Read type(%d): (S)tring (C)omplete (F)ile ([)option (P)osition co(O)rd. (q)uit" nth)
  (let ((c (read-char)))
     ((= c ?s) 'string)
     ((= c ?c) 'completion)
     ((= c ?f) 'file)
     ((= c ?\[) 'option)
     ((= c ?p) 'oneof)
     ((= c ?o) 'coord)
     ;;((= c ?m) 'macro)
     (t        'quit))))

(defun YaTeX-generate-read-completion-table ()
  (let ((i 1) cand (cands "(") (cb (current-buffer))
	(buf (get-buffer-create " *Candidates*")))
      (YaTeX-showup-buffer buf nil)
      (set-buffer buf)
      (while (string<
	      (setq cand (read-string (format "Item[%d](RET to exit): " i))))
	(setq cands (concat cands (format "(\"%s\")\n" cand))
	      i (1+ i))
	(insert cand "\n"))
      (kill-buffer buf)))
    ;;(set-buffer cb)
    (setq YaTeX-generate-current-completion-table (concat cands ")"))))

(defun YaTeX-generate-corresponding-paren (left)
   ((equal left "{") "}")
   ((equal left "[") "]")
   ((equal left "(") ")")
   ((equal left "<") ">")
   ((equal left "\\begin{") "}")
   (t left)))

(defun YaTeX-generate-create-read-string (&optional nth)
   "(read-string \""
   (read-string (if nth (format "Prompt for argument#%d: " nth) "Prompt: "))
   ": \"\n"
   "\"" (read-string "Default: ") "\""

(defun YaTeX-generate-create-completing-read (&optional nth)
       "(completing-read \""
	(if nth (format "Prompt for argument#%d: " nth) "Prompt: "))
       ": \"\n"
       (format "'%s\n" (YaTeX-generate-read-completion-table))
       "nil "
       (format "%s)" (y-or-n-p "Require match? ")))
    (if nil ;;;(y-or-n-p "Do you need learning for this completion?")
	(setq YaTeX-generate-variables-for-learning
	       (cons (format "YaTeX-%s-%d" command (or nth 0))

(defun YaTeX-generate-create-read-file-name (&optional nth)
   "(read-file-name \""
   (read-string (if nth (format "Prompt for argument#%d: " nth) "Prompt: "))
   ": \" "" \"\" t \"\")\n"))

(defun YaTeX-generate-create-read-oneof (&optional nth readpos)
   (if readpos
       "(YaTeX:read-position \""
     "(YaTeX:read-oneof \"")
   (read-string "Acceptable characters: " "lcr") "\")\n"))

(defun YaTeX-generate-option-type (command)
  (let ((func (format "YaTeX:%s" command)) leftp
	(buf (get-buffer-create YaTeX-generate-buffer)) type (n 1))
    (set-buffer buf)
    (insert "(defun " func " ()\n  (concat\n")
    (catch 'done
      (while t
	(setq type (YaTeX-generate-read-completion-type n))
	  ;;Read string
	  ((eq type 'string)
	   (concat "\"" (setq leftp (read-string "Left parenthesis: " "("))
		   "\"" (YaTeX-generate-corresponding-paren leftp) "\"")
	  ((eq type 'completion)
	   (concat "\"" (setq leftp (read-string "Left parenthesis: " "{"))
		   "\"" (YaTeX-generate-corresponding-paren leftp) "\"")
	  ((eq type 'file)
	   (concat "\"" (setq leftp (read-string "Left parenthesis: " "("))
		   "\"" (YaTeX-generate-corresponding-paren leftp) "\"")
	  ((eq type 'oneof)
	   (YaTeX-generate-create-read-oneof nil t)
	  ((eq type 'option)
	   (concat "(let ((op (read-string \""
		   (read-string "Prompt: ")
		   ": \")))\n"
		   "(if (string< \"\" op)\n"
		   "    (concat \"[\" op \"]\")\n"
		   "  \"\"))\n")
	  ((eq type 'coord)
	   (concat "(YaTeX:read-coordinates \""
		   (read-string "Prompt for coordinates: ")
		   ": \")\n")
	  ((eq type 'macro)
	   (error "not yet supported")
	  (t (throw 'done t))))
	(setq n (1+ n))))
    (insert "))\n")			;close defun
    (goto-char (point-min))
    (while (not (eobp)) (lisp-indent-line) (forward-line 1))

(defun YaTeX-generate-argument-type (command argc)
  "Create an argument-type add-in function."
  (let ((func (format "YaTeX::%s" command)) (argp 1)
	(cb (current-buffer))
	(buf (get-buffer-create YaTeX-generate-buffer)))
    (set-buffer buf)
    (insert "(defun " func " (&optional argp)\n(cond\n")
    (while (<= argp argc)
      (insert (format "((equal argp %d)\n" argp))
      (setq type (YaTeX-generate-read-completion-type argp))
	((eq type 'string)
	 (concat (YaTeX-generate-create-read-string argp)))
	((eq type 'completion)
	 (concat (YaTeX-generate-create-completing-read argp)))
	((eq type 'oneof)
	((eq type 'file)
	 (concat (YaTeX-generate-create-read-file-name argp)))
	(t ""))
      (setq argp (1+ argp)))
    (insert "))\n")
    (goto-char (point-min))
    (while (not (eobp)) (lisp-indent-line) (forward-line 1))
    (set-buffer cb)
     (if (> argc 1) (list command argc) (list command))
     'section-table 'user-section-table 'tmp-section-table)

(defun YaTeX-generate-simple (&optional command)
  "Simple but requiring some elisp knowledge add-in generator."
  (setq YaTeX-generate-variables-for-learning nil)
  (or command
      (setq command
	      "Making add-in function for (default %s): " YaTeX-section-name)
	      section-table user-section-table tmp-section-table
	      env-table     user-env-table     tmp-env-table
	      singlecmd-table user-singlecmd-table tmp-singlecmd-table)
	     nil nil)
	    command (if (string= "" command) YaTeX-section-name command)))
    (YaTeX-japan "(o)追加型? (a)引数型? (yatexadd.docを参照のこと) :")
    (t "(O)ption? (A)rgument?")))
   (if (= (read-char) ?o)
       (YaTeX-generate-option-type command)
      (string-to-int (read-string "How many arguments?: ")))) nil))

(provide 'yatexgen)