yatex
view yatex19.el @ 56:a9653fbd1c1c
Bug fix version
| author | yuuji |
|---|---|
| date | Thu, 29 Jun 1995 13:46:57 +0000 |
| parents | 5f4b18da14b3 |
| children | 18f4939986e6 |
line source
1 ;;; -*- Emacs-Lisp -*-
2 ;;; YaTeX facilities for Emacs 19
3 ;;; (c )1994-1995 by HIROSE Yuuji.[yuuji@ae.keio.ac.jp]
4 ;;; Last modified Mon May 15 15:50:04 1995 on inspire
5 ;;; $Id$
7 ;;; とりあえず hilit19 を使っている時に色が付くようにして
8 ;;; メニューバーでごにょごにょできるようにしただけ。
9 ;;; いったい誰がメニューバー使ってLaTeXソース書くんだろうか?
10 ;;; まあいいや練習練習。後ろの方にちょっとコメントあり。
11 ;;; 真中辺にあるけど、hilit19.el 対応の方は結構本気。
13 (require 'yatex)
15 (defun YaTeX-19-define-sub-menu (map vec &rest bindings)
16 "Define sub-menu-item in MAP at vector VEC as BINDINGS.
17 BINDINGS is a form with optional length: (symbol title binding).
18 When you defined menu-bar keymap such like:
19 (define-key foo-map [menu-bar foo] (make-sparse-keymap \"foo menu\"))
20 and you want to define sub menu for `foo menu' as followings.
21 foo -> menu1 (calling function `func1')
22 menu2 (doing interactive call `(func2 ...)'
23 Call this function like this:
24 (YaTeX-19-define-sub-menu foo-map [menu-bar foo]
25 '(m1 \"Function 1\" func1)
26 '(m2 \"Function 2\" (lambda () (interactive) (func2 ...))))
27 where
28 `m1' and `m2' are the keymap symbol for sub-menu of `[menu-bar foo].
29 `Funtion 1' and `Function 2' are the title strings for sub-menu.
30 "
31 (let ((i 0) (vec2 (make-vector (1+ (length vec)) nil)))
32 (while (< i (length vec))
33 (aset vec2 i (aref vec i))
34 (setq i (1+ i)))
35 (setq bindings (reverse bindings))
36 (mapcar
37 (function
38 (lambda (bind)
39 (aset vec2 (1- (length vec2)) (car bind)) ;set menu-symbol
40 (define-key map vec2
41 (cons (car (cdr bind))
42 (car (cdr (cdr bind)))))))
43 bindings)))
45 ;; Menu for Typeset relating processes ----------------------------------------
46 (define-key YaTeX-mode-map [menu-bar yatex]
47 (cons "YaTeX" (make-sparse-keymap "YaTeX")))
48 (define-key YaTeX-mode-map [menu-bar yatex process]
49 (cons "Process" (make-sparse-keymap "Process")))
50 (YaTeX-19-define-sub-menu
51 YaTeX-mode-map [menu-bar yatex process]
52 '(buffer "LaTeX" (lambda () (interactive) (YaTeX-typeset-menu nil ?j)))
53 '(kill "Kill LaTeX" (lambda () (interactive) (YaTeX-typeset-menu nil ?k)))
54 '(bibtex "BibTeX" (lambda () (interactive) (YaTeX-typeset-menu nil ?b)))
55 '(makeindex "makeindex" (lambda () (interactive) (YaTeX-typeset-menu nil ?i)))
56 '(preview "Preview" (lambda () (interactive) (YaTeX-typeset-menu nil ?p)))
57 '(lpr "lpr" (lambda () (interactive) (YaTeX-typeset-menu nil ?l)))
58 '(lpq "lpq" (lambda () (interactive) (YaTeX-typeset-menu nil ?q)))
59 )
61 ;; Help for LaTeX ------------------------------------------------------------
62 (YaTeX-19-define-sub-menu
63 YaTeX-mode-map [menu-bar yatex]
64 '(sephelp "--")
65 '(help "Help on LaTeX commands" YaTeX-help)
66 '(apropos "Apropos on LaTeX commands" YaTeX-apropos))
68 ;; Switch modes --------------------------------------------------------------
69 (define-key YaTeX-mode-map [menu-bar yatex switch]
70 (cons "Switching YaTeX's modes" (make-sparse-keymap "modes")))
71 (or YaTeX-auto-math-mode
72 (define-key YaTeX-mode-map [menu-bar yatex switch math]
73 '("Toggle math mode" . (lambda () (interactive)
74 (YaTeX-switch-mode-menu nil ?t)))))
75 (define-key YaTeX-mode-map [menu-bar yatex switch mod]
76 '("Toggle modify mode" . (lambda () (interactive)
77 (YaTeX-switch-mode-menu nil ?m))))
79 ;; % menu --------------------------------------------------------------------
80 (define-key YaTeX-mode-map [menu-bar yatex percent]
81 (cons "Edit %# notation" (make-sparse-keymap "Edit %# notation")))
82 (YaTeX-19-define-sub-menu
83 YaTeX-mode-map [menu-bar yatex percent]
84 '(! "Change LaTeX typesetter(%#!)"
85 (lambda () (interactive) (YaTeX-%-menu nil nil ?!)))
86 '(begend "Set %#BEGIN-%#END on region"
87 (lambda () (interactive) (YaTeX-%-menu nil nil ?b)))
88 '(lpr "Change LPR format"
89 (lambda () (interactive) (YaTeX-%-menu nil nil ?l))))
91 ;; What position -------------------------------------------------------------
92 (YaTeX-19-define-sub-menu
93 YaTeX-mode-map [menu-bar yatex]
94 '(what "What column in tabular" YaTeX-what-column))
96 ;; Document hierarchy ------------------------------------------------------
97 (YaTeX-19-define-sub-menu
98 YaTeX-mode-map [menu-bar yatex]
99 '(hier "Display document hierarchy" YaTeX-display-hierarchy-directly))
101 ;; Jump cursor ---------------------------------------------------------------
102 (define-key YaTeX-mode-map [menu-bar yatex jump]
103 (cons "Jump cursor"
104 (make-sparse-keymap "Jump cursor")))
105 (YaTeX-19-define-sub-menu
106 YaTeX-mode-map [menu-bar yatex jump]
107 '(corres "Goto corersponding position" YaTeX-goto-corresponding-*)
108 '(main "Visit main source" (lambda () (interactive) (YaTeX-visit-main)))
109 '(main-other "Visit main source other window" YaTeX-visit-main-other-window)
110 )
112 ;; ===========================================================================
113 (define-key YaTeX-mode-map [menu-bar yatex sepcom]
114 '("---" . nil))
116 ;; Comment/Uncomment ---------------------------------------------------------
117 (YaTeX-19-define-sub-menu
118 YaTeX-mode-map [menu-bar yatex]
119 '(comment "Comment region or environment" YaTeX-comment-region)
120 '(uncomment "Unomment region or environment" YaTeX-uncomment-region)
121 '(commentp "Comment paragraph" YaTeX-comment-paragraph)
122 '(uncommentp "Uncomment paragraph" YaTeX-uncomment-paragraph)
123 '(sepcom "--" nil)
124 )
127 ;; ===========================================================================
128 ;; Change/Kill/Fill
129 (YaTeX-19-define-sub-menu
130 YaTeX-mode-map [menu-bar yatex]
131 '(change "Change macros" YaTeX-change-*)
132 '(kill "Kill macros" YaTeX-kill-*)
133 '(fillitem "Fill \\item" YaTeX-fill-item)
134 '(newline "Newline" YaTeX-intelligent-newline)
135 '(sepchg "--" nil)
136 )
138 ;; Menu for completions ------------------------------------------------------
141 ;;;(YaTeX-19-define-sub-menu
142 ;;; YaTeX-mode-map [menu-bar yatex]
143 ;;; '(secr "Section-type command on region" YaTeX-make-section-region)
144 ;;; '(sec "Section-type command" YaTeX-make-section))
146 (define-key YaTeX-mode-map [menu-bar yatex sectionr]
147 (cons "Section-type region(long name)"
148 (make-sparse-keymap "Enclose region with section-type macro")))
149 (define-key YaTeX-mode-map [menu-bar yatex section]
150 (cons "Section-type(long name)"
151 (make-sparse-keymap "Section-type macro")))
152 (let ((sorted-section
153 (sort
154 (delq nil
155 (mapcar (function (lambda (s)
156 (if (> (length (car s)) 5)
157 (car s))))
158 (append section-table user-section-table)))
159 'string<)))
160 (apply 'YaTeX-19-define-sub-menu
161 YaTeX-mode-map [menu-bar yatex section]
162 (mapcar (function (lambda (secname)
163 (list (intern secname) secname
164 (list 'lambda ()
165 (list 'interactive)
166 (list 'YaTeX-make-section
167 nil nil nil secname)))))
168 sorted-section))
169 (apply 'YaTeX-19-define-sub-menu
170 YaTeX-mode-map [menu-bar yatex sectionr]
171 (mapcar (function (lambda (secname)
172 (list (intern secname) secname
173 (list 'lambda ()
174 (list 'interactive)
175 (list 'YaTeX-make-section
176 nil
177 (list 'region-beginning)
178 (list 'region-end)
179 secname)))))
180 sorted-section)))
182 (define-key YaTeX-mode-map [menu-bar yatex envr]
183 (cons "Environment region" (make-sparse-keymap "Environment region")))
184 (define-key YaTeX-mode-map [menu-bar yatex env]
185 (cons "Environment" (make-sparse-keymap "Environment")))
186 (let (prev envname)
187 (mapcar
188 (function
189 (lambda (envalist)
190 (setq envname (car envalist))
191 (define-key-after
192 (lookup-key YaTeX-mode-map [menu-bar yatex env])
193 (vector (intern envname))
194 (cons envname
195 (list 'lambda () (list 'interactive)
196 (list 'YaTeX-insert-begin-end
197 envname nil)))
198 prev)
199 (define-key-after
200 (lookup-key YaTeX-mode-map [menu-bar yatex envr])
201 (vector (intern envname))
202 (cons envname
203 (list 'lambda () (list 'interactive)
204 (list 'YaTeX-insert-begin-end
205 envname t)))
206 prev)
207 (setq prev (intern envname))))
208 (sort (append env-table user-env-table)
209 '(lambda (x y) (string< (car x) (car y))))))
211 ;; Other key bindings for window-system
212 ;(YaTeX-define-key [?\C- ] 'YaTeX-do-completion)
213 (define-key YaTeX-mode-map [?\M-\C- ] 'YaTeX-mark-environment)
215 ;; Highlightening
216 ;; メニューに比べてこっちは結構本気でやってます。
217 ;; だって文書構造がとっても分かり易いんだもん。
218 ;; みんなも hilit19.el を使おう!
219 ;;
220 ;; さて、まずは対応する {} をピカピカ範囲とするような関数を作る。
221 ;; これは hilit-LaTeX.el を参考にした。でも、ちゃんと section 型コマンドの
222 ;; 引数を数えて正しい位置までピカピカさせるよ〜ん!
224 (defun YaTeX-19-region-section-type (pattern)
225 "Return list of starting and end point of section-type commands of PATTERN."
226 (if (re-search-forward pattern nil t)
227 (let ((m0 (match-beginning 0)) cmd (argc 1))
228 (setq cmd (substring (YaTeX-match-string 0) 1 -1)
229 argc (or (car (cdr (YaTeX-lookup-table cmd 'section))) argc))
230 (cons m0
231 (progn (skip-chars-backward "^{") (forward-char -2)
232 (while (> argc 0)
233 (skip-chars-forward "^{")
234 (forward-list 1)
235 (setq argc (1- argc)))
236 (point))))))
238 (defun YaTeX-19-region-large-type (pattern)
239 "Return list of large-type contents.
240 Assumes PATTERN begins with `{'."
241 (if (re-search-forward pattern nil t)
242 (let ((m0 (match-beginning 0)))
243 (goto-char m0)
244 (skip-chars-forward "^ \t\n")
245 (skip-chars-forward " \t\n")
246 (cons (point)
247 (progn (goto-char m0) (forward-list 1)
248 (1- (point)))))))
250 ;; 些細なことだが % の前の文字もピカリとさせてしまうようで… >hilit19
251 ;; ↓この関数は下の hilit-set-mode-patterns の "[^\\]\\(%\\).*$" に
252 ;; 依存している
253 (defun YaTeX-19-region-comment (pattern)
254 "Return list of comment start and end point."
255 (if (re-search-forward pattern nil t)
256 (cons (match-beginning 2) (match-end 0))))
258 ;;(make-face 'tt)
259 ;;(set-face-font 'tt "-schumacher-clean-medium-r-normal--*-*-*-*-*-*-*-*")
260 ;;(hilit-translate 'tt "white")
262 (defvar YaTeX-hilit-patterns-alist
263 '(
264 ;; comments
265 (YaTeX-19-region-comment "\\([^\\]\\|^\\)\\(%\\).*$" comment)
267 (YaTeX-19-region-section-type "\\\\footnote\\(mark\\|text\\)?{" keyword)
268 ("\\\\[a-z]+box" 0 keyword)
269 (YaTeX-19-region-section-type "\\\\\\(v\\|h\\)space\\(\*\\)?{" keyword)
271 ;; (re-)define new commands/environments/counters
272 (YaTeX-19-region-section-type
273 "\\\\\\(re\\)?new\\(environment\\|command\\|theorem\\){" defun)
274 (YaTeX-19-region-section-type
275 "\\\\\\(re\\)?new\\(length\\|counter\\){" define)
277 ;; various declarations/definitions
278 (YaTeX-19-region-section-type
279 "\\\\\\(set\\|setto\\|addto\\)\\(length\\|width\\|counter\\){"
280 define)
281 (YaTeX-19-region-section-type
282 "\\\\\\(title\\|author\\|date\\|thanks\\){" define)
284 ("\\\\documentstyle\\(\\[.*\\]\\)?{" "}" decl)
285 ("\\\\\\(begin\\|end\\|nofiles\\|includeonly\\){" "}" decl)
286 ("\\\\\\(raggedright\\|makeindex\\|makeglossary\\|maketitle\\)\\b" 0 decl)
287 ("\\\\\\(pagestyle\\|thispagestyle\\|pagenumbering\\){" "}" decl)
288 ("\\\\\\(normalsize\\|small\\|footnotesize\\|scriptsize\\|tiny\\|large\\|Large\\|LARGE\\|huge\\|Huge\\)\\b" 0 decl)
289 ("\\\\\\(appendix\\|tableofcontents\\|listoffigures\\|listoftables\\)\\b"
290 0 decl)
291 ("\\\\\\(bf\\|em\\|it\\|rm\\|sf\\|sl\\|ss\\|tt\\)\\b" 0 decl)
293 ;; label-like things
294 ;;this should be customized by YaTeX-item-regexp
295 ("\\\\\\(sub\\)*item\\b\\(\\[[^]]*\\]\\)?" 0 label)
296 (YaTeX-19-region-section-type
297 "\\\\caption\\(\\[[^]]*\\]\\)?{" label)
299 ;; formulas
300 ("[^\\]\\\\(" "\\\\)" formula) ; \( \)
301 ("[^\\]\\\\\\[" "\\\\\\]" formula) ; \[ \]
302 ("\\\\begin{\\(eqn\\|equation\\)" "\\\\end{\\(eqn\\|equation\\)" formula)
303 ("[^\\$]\\($\\($[^$]*\\$\\|[^$]*\\)\\$\\)" 1 formula) ; '$...$' or '$$...$$'
305 ;; things that bring in external files
306 ("\\\\\\(include\\|input\\|bibliography\\){" "}" include)
308 ;; "wysiwyg" emphasis -- these don't work with nested expressions
309 (YaTeX-19-region-large-type "{\\\\\\(em\\|it\\|sl\\)" italic)
310 (YaTeX-19-region-large-type "{\\\\bf" bold)
311 ;;;(YaTeX-19-region-large-type "{\\\\tt" tt)
312 ;;;("\\\\begin{verbatim" "\\\\end{verbatim" tt)
314 ("``" "''" string)
316 ;; things that do some sort of cross-reference
317 (YaTeX-19-region-section-type
318 "\\\\\\(\\(no\\)?cite\\|\\(page\\)?ref\\|label\\|index\\|glossary\\){"
319 crossref)
320 )
321 "*Hiliting pattern alist for LaTeX text.")
323 ;;(defvar YaTeX-hilit-pattern-adjustment-default nil)
324 ;; ↑いらなくなった。
325 (defvar YaTeX-hilit-pattern-adjustment-private nil
326 "*Adjustment hilit-pattern-alist for default yatex-mode's pattern.")
327 (defvar YaTeX-hilit-sectioning-face
328 '(yellow/dodgerblue yellow/cornflowerblue)
329 "*Hilightening face for sectioning unit. '(FaceForLight FaceForDark)")
330 (defvar YaTeX-sectioning-patterns-alist nil
331 "Hilightening patterns for sectioning units.")
332 (defvar YaTeX-hilit-singlecmd-face
333 '(slateblue2 aquamarine)
334 "*Hilightening face for maketitle type. '(FaceForLight FaceForDark)")
336 ;;; セクションコマンドを、構造レベルの高さに応じて色の濃度を変える
337 ;;; 背景が黒でないと何が嬉しいのか分からないに違いない.
338 ;;; もしかして白地の時は構造レベルに応じて色を明るくしたほうが良いのか?
339 (cond
340 ((and (featurep 'hilit19) (fboundp 'x-color-values))
341 (let*((sectface
342 (car (if (eq hilit-background-mode 'dark)
343 (cdr YaTeX-hilit-sectioning-face)
344 YaTeX-hilit-sectioning-face)))
345 (sectcol (symbol-name sectface))
346 sect-pat-alist)
347 (if (string-match "/" sectcol)
348 (let (colorvalue fR fG fB bR bG bB list pat fg bg level from face)
349 (require 'yatexsec)
350 (setq fg (substring sectcol 0 (string-match "/" sectcol))
351 bg (substring sectcol (1+ (string-match "/" sectcol)))
352 colorvalue (x-color-values fg)
353 fR (/ (nth 0 colorvalue) 256)
354 fG (/ (nth 1 colorvalue) 256)
355 fB (/ (nth 2 colorvalue) 256)
356 colorvalue (x-color-values bg)
357 bR (/ (nth 0 colorvalue) 256)
358 bG (/ (nth 1 colorvalue) 256)
359 bB (/ (nth 2 colorvalue) 256)
360 list YaTeX-sectioning-level)
361 (while list
362 (setq pat (concat YaTeX-ec-regexp (car (car list)) "\\*?{")
363 level (cdr (car list))
364 fg (format "hex-%02x%02x%02x"
365 (- fR (/ (* level fR) 40)) ;40 musn't be constant
366 (- fG (/ (* level fG) 40))
367 (- fB (/ (* level fB) 40)))
368 bg (format "hex-%02x%02x%02x"
369 (- bR (/ (* level bR) 15)) ;15 musn't be constant
370 (- bG (/ (* level bG) 15))
371 (- bB (/ (* level bB) 15)))
372 from (intern (format "sectioning-%d" level))
373 face (intern (concat fg "/" bg)))
374 (hilit-translate from face)
375 (setq sect-pat-alist
376 (cons;;(list pat "}" face)
377 (list 'YaTeX-19-region-section-type pat face)
378 sect-pat-alist))
379 (setq list (cdr list)))
380 (setq YaTeX-sectioning-patterns-alist sect-pat-alist))))))
382 ;; ローカルなマクロを読み込んだ後 redraw すると
383 ;; ローカルマクロを keyword として光らせる(keywordじゃまずいかな…)。
384 (defun YaTeX-19-collect-macros ()
385 (cond
386 ((and (featurep 'hilit19) (fboundp 'hilit-translate))
387 (let ((get-face
388 (function
389 (lambda (table)
390 (cond
391 ((eq hilit-background-mode 'light) (car table))
392 ((eq hilit-background-mode 'dark) (car (cdr table)))
393 (t nil))))))
394 (hilit-translate
395 ;;sectioning (funcall get-face YaTeX-hilit-sectioning-face)
396 macro (funcall get-face YaTeX-hilit-singlecmd-face)))
397 (setq hilit-patterns-alist ;Remove at first.
398 (delq 'yatex-mode hilit-patterns-alist)
399 hilit-patterns-alist
400 (cons
401 (cons 'yatex-mode
402 (append
403 YaTeX-sectioning-patterns-alist
404 YaTeX-hilit-pattern-adjustment-private
405 ;;YaTeX-hilit-pattern-adjustment-default
406 YaTeX-hilit-patterns-alist
407 (list
408 (list
409 'YaTeX-19-region-section-type
410 (concat "\\\\\\("
411 (mapconcat
412 (function (lambda (s) (regexp-quote (car s))))
413 (append user-section-table tmp-section-table)
414 "\\|")
415 "\\){")
416 'keyword)
417 (list
418 (concat "\\\\\\("
419 (mapconcat
420 (function (lambda (s) (regexp-quote (car s))))
421 (append user-singlecmd-table tmp-singlecmd-table)
422 "\\|")
423 "\\)\\b")
424 0 'macro))))
425 hilit-patterns-alist)))))
426 ;;(YaTeX-19-collect-macros) ;causes an error
427 (defun YaTeX-hilit-recenter (arg)
428 "Collect current local macro and hilit-recenter."
429 (interactive "P")
430 (YaTeX-19-collect-macros)
431 (hilit-recenter arg))
432 (if (fboundp 'hilit-recenter) ;Replace hilit-recenter with
433 (mapcar (function (lambda (key) ;YaTeX-hilit-recenter in yatex-mode
434 (define-key YaTeX-mode-map key 'YaTeX-hilit-recenter)))
435 (where-is-internal 'hilit-recenter)))
437 (defun YaTeX-switch-to-new-window ()
438 (let ((c 0) (i 1) (free (make-string win:max-configs ? )))
439 (while (< i win:max-configs)
440 (or (aref win:configs i) (aset free i (+ i win:base-key)))
441 (setq i (1+ i)))
442 (while (not (string-match (char-to-string c) free))
443 (message "Which window to create? [%s]: " free)
444 (setq c (read-char)))
445 (message "Creating window [%c]" c)
446 (set-buffer (get-buffer-create "*scratch*"))
447 (win:switch-window (- c win:base-key))))
449 (defun YaTeX-visit-main-other-frame ()
450 "Visit main file in other frame.
451 WARNING, This code is not perfect."
452 (interactive)
453 (if (YaTeX-main-file-p) (message "I think this is main LaTeX source.")
454 (let (parent)
455 (save-excursion (YaTeX-visit-main t) (setq parent (current-buffer)))
456 (cond
457 ((get-buffer-window parent t)
458 (goto-buffer-window parent))
459 ((and (featurep 'windows) win:use-frame)
460 (YaTeX-switch-to-new-window)
461 (switch-to-buffer parent))
462 (t (switch-to-buffer-other-frame (buffer-name parent)))))))
464 (defun YaTeX-goto-corresponding-*-other-frame (arg)
465 "Go to corresponding object in other frame."
466 (interactive "P")
467 (let (b p)
468 (save-window-excursion
469 (save-excursion
470 (YaTeX-goto-corresponding-* arg)
471 (setq b (current-buffer) p (point))))
472 (cond
473 ((get-buffer-window b t)
474 (goto-buffer-window b)
475 (goto-char p))
476 ((and (featurep 'windows) win:use-frame)
477 (YaTeX-switch-to-new-window)
478 (switch-to-buffer b)
479 (goto-char p))
480 (t (switch-to-buffer-other-frame (buffer-name b))
481 (goto-char p))))
482 )
484 ;;; reverseVideo にして hilit-background-mode を 'dark
485 ;;; にしている人は数式などが暗くなりすぎて見づらいかもしれない。
486 ;;; 次のコードを hilit19 をロードしている場所の直後に置くとちょっ
487 ;;; とはまし。
488 ;;; (if (eq hilit-background-mode 'dark)
489 ;;; (hilit-translate
490 ;;; string 'mediumspringgreen
491 ;;; formula 'khaki
492 ;;; label 'yellow-underlined))
494 (provide 'yatex19)