yatex
view yatex19.el @ 183:1c41dc8a28eb
doc fix
| author | yuuji@gentei.org |
|---|---|
| date | Thu, 13 Oct 2011 10:16:58 +0900 |
| parents | f14ec50103d0 |
| children | 58d11a018721 |
line source
1 ;;; -*- Emacs-Lisp -*-
2 ;;; YaTeX facilities for Emacs 19 or later
3 ;;; (c)1994-2009 by HIROSE Yuuji.[yuuji@yatex.org]
4 ;;; Last modified Mon Sep 28 10:45:30 2009 on firestorm
5 ;;; $Id$
7 ;(require 'yatex)
9 (and (boundp 'YaTeX-use-hilit19)
10 YaTeX-use-hilit19
11 (require 'hilit19))
13 (defvar YaTeX-use-highlighting (or YaTeX-use-font-lock YaTeX-use-hilit19)
14 "*Use highlighting buffer or not.")
15 (defvar YaTeX-background-mode
16 (or (if (fboundp 'get-frame-background-mode)
17 (get-frame-background-mode (selected-frame)))
18 (if (fboundp 'frame-parameters)
19 (cdr (assq 'background-mode (frame-parameters))))
20 (if (boundp 'frame-background-mode)
21 frame-background-mode)
22 (if (boundp 'hilit-background-mode)
23 hilit-background-mode)
24 (if (face-background 'default)
25 (if (> (+ 32768 32768 32768)
26 (apply '+
27 (funcall (if (fboundp 'color-rgb-components)
28 'color-rgb-components
29 'x-color-values)
30 (face-background 'default))))
31 'dark
32 'light))))
34 (defvar YaTeX-mode-menu-map (make-sparse-keymap "YaTeX"))
35 (defvar YaTeX-mode-menu-map-process (make-sparse-keymap "Process"))
36 (define-key YaTeX-mode-map [menu-bar yatex]
37 (cons "YaTeX" YaTeX-mode-menu-map))
38 (YaTeX-define-menu
39 'YaTeX-mode-menu-map-process
40 (nreverse
41 '((buffer "LaTeX" . (lambda () (interactive) (YaTeX-typeset-menu nil ?j)))
42 (kill "Kill LaTeX" . (lambda () (interactive) (YaTeX-typeset-menu nil ?k)))
43 (bibtex "BibTeX" . (lambda () (interactive) (YaTeX-typeset-menu nil ?b)))
44 (mindex "makeindex" . (lambda () (interactive) (YaTeX-typeset-menu nil ?i)))
45 (preview "Preview" . (lambda () (interactive) (YaTeX-typeset-menu nil ?p)))
46 (lpr "lpr" . (lambda () (interactive) (YaTeX-typeset-menu nil ?l)))
47 (lpq "lpq" . (lambda () (interactive) (YaTeX-typeset-menu nil ?q))))))
48 (defvar YaTeX-mode-menu-map-modes (make-sparse-keymap "Modes"))
49 (YaTeX-define-menu
50 'YaTeX-mode-menu-map-modes
51 (delq nil
52 (nreverse
53 (list
54 (if YaTeX-auto-math-mode nil
55 (cons 'math (cons "Toggle math-mode"
56 '(lambda () (interactive)
57 (YaTeX-switch-mode-menu nil ?t)))))
58 (cons 'mod (cons "Toggle Modify Mode"
59 '(lambda () (interactive)
60 (YaTeX-switch-mode-menu nil ?m))))))))
61 (defvar YaTeX-mode-menu-map-percent (make-sparse-keymap "percent"))
62 (YaTeX-define-menu
63 'YaTeX-mode-menu-map-percent
64 (nreverse
65 '((! "Change LaTeX typesetter(%#!)"
66 . (lambda () (interactive) (YaTeX-%-menu nil nil ?!)))
67 (begend "Set %#BEGIN-%#END on region"
68 . (lambda () (interactive) (YaTeX-%-menu nil nil ?b)))
69 (lpr "Change LPR format"
70 . (lambda () (interactive) (YaTeX-%-menu nil nil ?l))))))
72 (defvar YaTeX-mode-menu-map-jump (make-sparse-keymap "jump"))
73 (YaTeX-define-menu
74 'YaTeX-mode-menu-map-jump
75 (nreverse
76 '((corres "Goto corersponding position" . YaTeX-goto-corresponding-*)
77 (main "Visit main source"
78 . (lambda () (interactive) (YaTeX-visit-main)))
79 (main-other "Visit main source other window"
80 . YaTeX-visit-main-other-window))))
82 (defvar YaTeX-mode-menu-map-comment (make-sparse-keymap "comment"))
83 (YaTeX-define-menu
84 'YaTeX-mode-menu-map-comment
85 (nreverse
86 '((comment "Comment region or environment" . YaTeX-comment-region)
87 (uncomment "Unomment region or environment" . YaTeX-uncomment-region)
88 (commentp "Comment paragraph" . YaTeX-comment-paragraph)
89 (uncommentp "Uncomment paragraph" . YaTeX-uncomment-paragraph))))
91 (YaTeX-define-menu
92 'YaTeX-mode-menu-map
93 (nreverse
94 (list
95 ;; Change/Kill/Fill -------------------------------------------------------
96 (cons (list 'chg "Change") (cons "Change macros" 'YaTeX-change-*))
97 (cons (list 'kill "Kill") (cons "Kill macros" 'YaTeX-kill-*))
98 (cons (list 'fill "Fill") (cons "Fill \\item" 'YaTeX-fill-item))
99 (cons (list 'nl "Newline") (cons "Newline" 'YaTeX-intelligent-newline))
100 ;; ========================================================================
101 (cons (list 'sep1 "---") (cons "---" nil))
102 ;; Comment/Uncomment ------------------------------------------------------
103 (cons (list 'comment "comment") (cons "Comment region or environment"
104 'YaTeX-comment-region))
105 (cons (list 'uncomment "uncomment") (cons "Uncomment region or environment"
106 'YaTeX-uncomment-region))
107 (cons (list 'commentp "commentp") (cons "Comment paragraph"
108 'YaTeX-comment-paragraph))
109 (cons (list 'uncommentp "uncommentp") (cons "Uncomment paragraph"
110 'YaTeX-uncomment-paragraph))
111 ;; ========================================================================
112 (cons (list 'sep2 "---") (cons "---" nil))
113 ;; Jump cursor ------------------------------------------------------------
114 (cons (list 'jump "jump") (cons "Jump Cursor" YaTeX-mode-menu-map-jump))
115 ;; Document hierarchy ---------------------------------------------------
116 (cons (list 'hier "hier") (cons "Display Document hierarchy"
117 'YaTeX-display-hierarchy))
118 ;; What position ----------------------------------------------------------
119 (cons (list 'col "column") (cons "What column in tabular"
120 'YaTeX-what-column))
121 ;; % menu -----------------------------------------------------------------
122 (cons (list 'percent "percent") (cons "Edit %# notation"
123 YaTeX-mode-menu-map-percent))
124 ;; Switch modes -----------------------------------------------------------
125 (cons (list 'mode "mode") (cons "Switching YaTeX's modes"
126 YaTeX-mode-menu-map-modes))
127 ;; ========================================================================
128 (cons (list 'sep "---") (cons "---" nil))
129 ;; Help for LaTeX ---------------------------------------------------------
130 (cons (list 'ap "apr") (cons "Apropos on LaTeX commands" 'YaTeX-apropos))
131 (cons (list 'help "help") (cons "Help on LaTeX commands" 'YaTeX-help))
132 ;; Menu for Typeset relating processes ------------------------------------
133 (cons (list 'process "Process menu")
134 (cons "Process" YaTeX-mode-menu-map-process)))
135 ))
137 ;; Make section-type commands menu -------------------------------------------
138 (defvar YaTeX-mode-menu-map-sectionr
139 (make-sparse-keymap "Enclose region with section-type macro"))
140 (defvar YaTeX-mode-menu-map-section (make-sparse-keymap "Section-type macro"))
141 (let ((sorted-section
142 (sort
143 (delq nil
144 (mapcar (function (lambda (s)
145 (if (> (length (car s)) 5)
146 (car s))))
147 (append section-table user-section-table)))
148 'string<)))
149 (YaTeX-define-menu
150 'YaTeX-mode-menu-map-section
151 (mapcar
152 (function (lambda (secname)
153 (cons (intern secname)
154 (cons secname
155 (list 'lambda ()
156 (list 'interactive)
157 (list 'YaTeX-make-section
158 nil nil nil
159 secname))))))
160 sorted-section))
161 (YaTeX-define-menu
162 'YaTeX-mode-menu-map-sectionr
163 (mapcar
164 (function (lambda (secname)
165 (cons (intern secname)
166 (cons secname
167 (list 'lambda ()
168 (list 'interactive)
169 (list 'YaTeX-make-section
170 nil
171 (list 'region-beginning)
172 (list 'region-end)
173 secname))))))
174 sorted-section)))
176 (YaTeX-define-menu
177 'YaTeX-mode-menu-map
178 (nreverse
179 (list
180 (cons '(sectionr "Section-type (long name)")
181 (cons "Section type" YaTeX-mode-menu-map-section))
182 (cons '(section "Section-type region (long name)")
183 (cons "Section type region (long name)"
184 YaTeX-mode-menu-map-sectionr)))))
186 ;; Make large-type commands menu ---------------------------------------------
187 (defvar YaTeX-mode-menu-map-envr (make-sparse-keymap "Environment region"))
188 (defvar YaTeX-mode-menu-map-env (make-sparse-keymap "Environment"))
190 (let ((sorted-env
191 (sort
192 (mapcar (function (lambda (s) (car s)))
193 (append env-table user-env-table))
194 'string<)))
195 (YaTeX-define-menu
196 'YaTeX-mode-menu-map-env
197 (mapcar
198 (function (lambda (envname)
199 (cons (intern envname)
200 (cons envname
201 (list 'lambda ()
202 (list 'interactive)
203 (list 'YaTeX-insert-begin-end
204 envname nil))))))
205 sorted-env))
206 (YaTeX-define-menu
207 'YaTeX-mode-menu-map-envr
208 (mapcar
209 (function (lambda (envname)
210 (cons (intern envname)
211 (cons envname
212 (list 'lambda ()
213 (list 'interactive)
214 (list 'YaTeX-insert-begin-end
215 envname t))))))
216 sorted-env)))
217 (YaTeX-define-menu
218 'YaTeX-mode-menu-map
219 (nreverse
220 (list
221 (cons '(envr "Environment")
222 (cons "Environment" YaTeX-mode-menu-map-env))
223 (cons '(env "Environment region")
224 (cons "Environment region"
225 YaTeX-mode-menu-map-envr)))))
227 (and (featurep 'xemacs)
228 (add-hook 'yatex-mode-hook
229 '(lambda ()
230 (or (assoc "YaTeX" current-menubar)
231 (progn
232 (set-buffer-menubar (copy-sequence current-menubar))
233 (add-submenu nil YaTeX-mode-menu-map))))))
235 ;; Other key bindings for window-system
236 ;(YaTeX-define-key [?\C- ] 'YaTeX-do-completion)
237 (define-key YaTeX-mode-map [?\M-\C- ] 'YaTeX-mark-environment)
239 ;; Highlightening
240 ;; メニューに比べてこっちは結構本気でやってます。
241 ;; だって文書構造がとっても分かり易いんだもん。
242 ;; みんなも hilit19.el を使おう!
243 ;; とかいってるうちに hilit19 って obsolete になってしまった…
244 ;; …ということで、hilit19 用のパターンを font-lock に変換する関数を
245 ;; 作成してなんとか font-lock にも対応(2000年12月)。
246 ;; しかし、font-lock は仕様が変わりやすい雰囲気でずっと動き続けるか
247 ;; どうかは不明。むしろ進化の止まったhilit19を使い続ける方が安心と
248 ;; 言えないこともないが世の流れは読めず……。
249 ;;
250 ;; さて、まずは対応する {} をピカピカ範囲とするような関数を作る。
251 ;; これは hilit-LaTeX.el を参考にした。でも、ちゃんと section 型コマンドの
252 ;; 引数を数えて正しい位置までピカピカさせるよ〜ん!
254 (defun YaTeX-19-region-section-type (pattern)
255 "Return cons of starting and end point of section-type commands of PATTERN."
256 (if (re-search-forward pattern nil t)
257 (let ((m0 (match-beginning 0)) (e0 (match-end 0)) cmd (argc 1))
258 (setq cmd (substring (YaTeX-match-string 0) 1)
259 argc (or (car (cdr (YaTeX-lookup-table cmd 'section))) argc))
260 (if (= argc 0) (cons m0 (point)) ;引数個数0ならマッチした領域
261 (skip-chars-forward " \n\t*")
262 (while (looking-at "\\[") (forward-list 1)) ;optionならスキップ
263 (skip-chars-forward " \n\t")
264 (prog1
265 (if (looking-at "{") ;{}が始まるならちゃんとしたsection型
266 (cons m0
267 (condition-case err
268 (progn
269 ;;(skip-chars-backward "^{") (forward-char -2)
270 (while (> argc 0)
271 (skip-chars-forward "^{")
272 (forward-list 1)
273 (setq argc (1- argc)))
274 (point))
275 (error m0)))
276 ;{}でないならたぶん \verb 環境などにあるダミー
277 (cons m0 e0))
278 ;;move to re-search end not to make font-lock confused
279 (goto-char e0))))))
281 (defun YaTeX-19-region-large-type (pattern)
282 "Return cons of large-type contents.
283 Assumes PATTERN begins with `{'."
284 (if (re-search-forward pattern nil t)
285 (let ((m0 (match-beginning 0)) (e0 (match-end 0))p)
286 (goto-char m0)
287 (skip-chars-forward "^ \t\n")
288 (skip-chars-forward " \t\n")
289 (prog1
290 (cons (setq p (point))
291 (condition-case err
292 (progn (goto-char m0) (forward-list 1) (1- (point)))
293 (error (1+ p))))
294 ;;move to re-search end not to make font-lock confused
295 (goto-char e0)))))
297 (defun YaTeX-19-region-env-type (envptn)
298 "Return cons of environment contents specified by ENVPTN as regexp."
299 (if (and (looking-at envptn) ;;re-search-forward envptn nil t)
300 (save-excursion
301 (not(search-backward YaTeX-comment-prefix
302 (point-beginning-of-line) t))))
303 (let ((m0 (match-beginning 0)) (e0 (match-end 0))
304 (env (YaTeX-match-string 1))
305 (nextline (progn (forward-line 1) (point))))
306 (goto-char m0)
307 ;(message "max=%d" (point-max))(sit-for 2)
308 (condition-case err
309 (if (YaTeX-goto-corresponding-environment)
310 (prog1
311 (cons nextline (match-beginning 0))
312 (goto-char e0)))
313 (error nil)))))
315 (defun YaTeX-19-region-paren-math (ptn)
316 "Return cons of \(...\) or \[...\] type math environment."
317 (if (looking-at "\\\\\\([\[(]\\)")
318 (let*((ptype (cdr (assoc (YaTeX-match-string 1)
319 '(("(" . ")") ("[" "]")))))
320 (b (match-beginning 0))
321 (e (match-end 0)))
322 (condition-case err
323 (if (re-search-forward
324 (concat "[^\\]\\\\" (regexp-quote ptype))
325 nil t)
326 (prog1 (cons b (match-beginning 0))
327 (goto-char e)))
328 (error nil)))))
330 (defun YaTeX-19-region-math-sub (ptn)
331 "Return cons of _{...}"
332 (if (and (looking-at ptn)
333 (eq YaTeX-font-lock-formula-face
334 (get-text-property (point) 'face)))
335 (let ((e (match-end 0)) (p (point)))
336 (goto-char e)
337 (prog1
338 (condition-case ()
339 (if (looking-at "{")
340 (cons (1+ (point))
341 (progn (forward-list 1) (1- (point))))
342 (cons e
343 (cond
344 ((looking-at (concat YaTeX-ec-regexp
345 YaTeX-TeX-token-regexp))
346 (match-end 0))
347 ;; other case??
348 (t (1+ (point)))))))
349 (goto-char e)))))
351 ;; 些細なことだが % の前の文字もピカリとさせてしまうようで… >hilit19
352 ;; ↓この関数は下の hilit-set-mode-patterns の "[^\\]\\(%\\).*$" に
353 ;; 依存している
354 (defun YaTeX-19-region-comment (pattern)
355 "Return list of comment start and end point."
356 (if (re-search-forward pattern nil t)
357 (cons (match-beginning 2) (match-end 0))))
359 ;; 2006/6/23 match only if it's in specified envrironment.
360 (defun YaTeX-19-re-search-in-env (ptn_env)
361 (catch 'done
362 ;; For font-lock, this function should find it.
363 (let (md r)
364 (while (YaTeX-re-search-active-forward
365 (car ptn_env) YaTeX-comment-prefix nil t)
366 (setq md (match-data)
367 r (string-match (cdr ptn_env)
368 (or (YaTeX-inner-environment 'quick) "")))
369 (store-match-data md)
370 (if r (setq r (cons (match-beginning 0) (match-end 0))))
371 (if (or YaTeX-use-hilit19 r) (throw 'done r))
372 (goto-char (match-end 0)))
373 (throw 'done r))))
375 ;;(make-face 'tt)
376 ;;(set-face-font 'tt "-schumacher-clean-medium-r-normal--*-*-*-*-*-*-*-*")
377 ;;(hilit-translate 'tt "white")
379 ;; font-lockの関数呼びパターンの場合は正規表現が行末までマッチすると
380 ;; hilit候補対象外にされてしまうので1字手前で正規表現を止める
381 (defvar YaTeX-hilit-patterns-alist
382 '(
383 ;; formulas
384 (YaTeX-19-region-math-sub "[^\\]^" YaTeX-font-lock-math-sup-face overwrite)
385 (YaTeX-19-region-math-sub "[^\\]_" YaTeX-font-lock-math-sub-face overwrite)
386 (YaTeX-19-region-env-type
387 "\\\\begin{\\(equation\\|eqnarray\\|displaymath\\|\\(x?x?\\|fl\\)align\\|multline\\|gather\\)" formula)
388 ;(YaTeX-19-region-paren-math "\\\\" formula)
389 ;;("[^\\]\\\\(" "\\\\)" formula) ; \( \)
390 ;;("[^\\]\\\\\\[" "\\\\\\]" formula) ; \[ \]
391 ;; comments
392 (YaTeX-19-region-comment "\\([^\\]\\|^\\)\\(%\\).*$" comment)
394 (YaTeX-19-region-section-type "\\\\footnote\\(mark\\|text\\)?\\>" keyword)
395 ("\\\\[a-z]+box" 0 keyword)
396 (YaTeX-19-region-section-type "\\\\\\(v\\|h\\)space\\>" keyword)
398 ;; (re-)define new commands/environments/counters
399 (YaTeX-19-region-section-type
400 "\\\\\\(re\\)?new\\(environment\\|command\\|theorem\\|length\\|counter\\)\\>"
401 defun)
402 (YaTeX-19-region-section-type
403 "\\\\textbf\\>" bold)
405 ;; various declarations/definitions
406 (YaTeX-19-region-section-type
407 "\\\\\\(set\\|setto\\|addto\\)\\(length\\|width\\|counter\\)\\>"
408 define)
409 (YaTeX-19-region-section-type
410 "\\\\\\(title\\|author\\|date\\|thanks\\)\\>" define)
412 ("\\\\document\\(style\\|class\\)\\(\\[.*\\]\\)?{" "}" decl)
414 ("\\\\\\(begin\\|end\\|nofiles\\|includeonly\\|usepackage\\(\\[.*\\]\\)?\\){" "}" decl)
415 ("\\\\\\(raggedright\\|makeindex\\|makeglossary\\|maketitle\\)\\b" 0 decl)
416 ("\\\\\\(pagestyle\\|thispagestyle\\|pagenumbering\\){" "}" decl)
417 ("\\\\\\(normalsize\\|small\\|footnotesize\\|scriptsize\\|tiny\\|large\\|Large\\|LARGE\\|huge\\|Huge\\)\\b" 0 decl)
418 ("\\\\\\(appendix\\|tableofcontents\\|listoffigures\\|listoftables\\)\\b"
419 0 decl)
420 ("\\\\\\(bf\\|em\\|it\\|rm\\|sf\\|sl\\|ss\\|tt\\)\\b" 0 decl)
422 ;; label-like things
423 ;;this should be customized by YaTeX-item-regexp
424 ("\\\\\\(sub\\)*item\\b\\(\\[[^]]*\\]\\)?" 0 label)
425 (YaTeX-19-region-section-type
426 "\\\\\\(caption\\|bibitem\\)\\(\\[[^]]*\\]\\)?\\>" label)
428 ;; things that do some sort of cross-reference
429 (YaTeX-19-region-section-type
430 "\\\\\\(\\(no\\|possessive\\)?cite[a-z]*\\|[a-z]*ref\\|label\\|index\\|glossary\\)\\>"
431 crossref)
433 ;; things that bring in external files
434 ("\\\\\\(include\\|input\\|bibliography\\(style\\)?\\){" "}" include)
436 ;; ("\\\\begin{\\(eqn\\|equation\\|x?x?align\\|split\\|multline\\|gather\\)"
437 ;; "\\\\end{\\(eqn\\|equation\\|x?x?align\\|split\\|multline\\|gather\\).*}"
438 ;; formula)
439 ("\\([^\\$]\\|^\\)\\($\\($[^$]*\\$\\|[^$]*\\)\\$\\)" 2 formula); '$...$' or '$$...$$'
441 ;; "wysiwyg" emphasis -- these don't work on nested expressions
442 (YaTeX-19-region-large-type "{\\\\\\(em\\|it\\|sl\\)" italic)
443 (YaTeX-19-region-large-type "{\\\\bf" bold)
444 ;;;(YaTeX-19-region-large-type "{\\\\tt" tt)
445 ;;;("\\\\begin{verbatim" "\\\\end{verbatim" tt)
447 ("``" "''" string)
448 ("\\\\\\(new\\|clear\\(double\\)?\\)page\\>\\|\\\\\\(\\\\\\|cr\\)\\>"
449 0 delimiter)
450 ;; re-search-in-env seems to make it slow down. 2007/2/11
451 ;;(YaTeX-19-re-search-in-env
452 ;; ("&\\|\\\\hline" . "tabular\\|equation\\|eqn\\|array\\|align") delimiter)
453 ;;(YaTeX-19-re-search-in-env ("\\\\[+-=><'`]" . "tabbing") delimiter)
454 ("&\\|\\\\hline\\|\\\\[+-=><'`]" 0 delimiter)
455 )
456 "*Hiliting pattern alist for LaTeX text.")
458 ;;(defvar YaTeX-hilit-pattern-adjustment-default nil)
459 ;; ↑いらなくなった。
460 (defvar YaTeX-hilit-pattern-adjustment-private nil
461 "*Adjustment hilit-pattern-alist for default yatex-mode's pattern.")
462 (defvar YaTeX-hilit-sectioning-face
463 '(yellow/dodgerblue yellow/slateblue)
464 "*Hilightening face for sectioning unit. '(FaceForLight FaceForDark)")
465 (defvar YaTeX-hilit-sectioning-attenuation-rate
466 '(15 40)
467 "*Maximum attenuation rate of sectioning face. '(ForeRate BackRate)
468 Each rate specifies how much portion of RGB value should be attenuated
469 towards to lowest sectioning unit. Numbers should be written in percentage.")
470 (defvar YaTeX-sectioning-patterns-alist nil
471 "Hilightening patterns for sectioning units.")
472 (defvar YaTeX-hilit-singlecmd-face
473 '("slateblue2" . "aquamarine")
474 "*Hilightening face for maketitle type. '(FaceForLight FaceForDark)")
476 ;;; セクションコマンドを、構造レベルの高さに応じて色の濃度を変える
477 ;;; 背景が黒でないと何が嬉しいのか分からないに違いない.
478 ;;; もしかして白地の時は構造レベルに応じて色を明るくしたほうが良いのか?
479 ;;; ...どうやらそうでもないらしい。これでいいみたい(2000/12)。
480 ;(if (fboundp 'win32-color-values)
481 ; (fset 'x-color-values 'win32-color-values))
483 (defun YaTeX-19-create-face (sym fgcolor &optional bgcolor)
484 "Create face named SYM with face of FGCOLOR/BGCOLOR."
485 (cond
486 ((and YaTeX-use-font-lock (fboundp 'defface))
487 (custom-declare-face
488 sym
489 (list
490 (list (list
491 '(class color)
492 ;(list 'background YaTeX-background-mode)
493 )
494 (delq nil
495 (append
496 (list ':foreground fgcolor)
497 (if bgcolor
498 (list ':background bgcolor))
499 ))
500 )
501 (list t (list ':bold t ':underline t))
502 )
503 (format "Font lock face for %s" sym)
504 ':group 'font-lock-faces)
505 (set sym sym)
506 sym)
507 ((and YaTeX-use-hilit19 (and (fboundp 'hilit-translate)))
508 (let ((face (intern (concat fgcolor "/" bgcolor))))
509 (if (facep sym)
510 (hilit-translate sym face)
511 (make-face sym)
512 (or (memq sym hilit-predefined-face-list)
513 (progn
514 (set-face-foreground sym fgcolor)
515 (set-face-background sym bgcolor)
516 (setq hilit-predefined-face-list
517 (cons sym hilit-predefined-face-list)))))
518 face))))
520 (cond
521 (YaTeX-use-highlighting
522 (cond
523 (window-system
524 (let*((sectface
525 (car (if (eq YaTeX-background-mode 'dark)
526 (cdr YaTeX-hilit-sectioning-face)
527 YaTeX-hilit-sectioning-face)))
528 (sectcol (symbol-name sectface))
529 (fl YaTeX-use-font-lock)
530 (form (if fl "#%02x%02x%02x" "hex-%02x%02x%02x"))
531 sect-pat-alist)
532 (if (string-match "/" sectcol)
533 (let ((fmin (nth 0 YaTeX-hilit-sectioning-attenuation-rate))
534 (bmin (nth 1 YaTeX-hilit-sectioning-attenuation-rate))
535 colorvalue fR fG fB bR bG bB pat fg bg level from face list lm)
536 (require 'yatexsec)
537 (setq fg (substring sectcol 0 (string-match "/" sectcol))
538 bg (substring sectcol (1+ (string-match "/" sectcol)))
539 colorvalue (x-color-values fg)
540 fR (/ (nth 0 colorvalue) 256)
541 fG (/ (nth 1 colorvalue) 256)
542 fB (/ (nth 2 colorvalue) 256)
543 colorvalue (x-color-values bg)
544 bR (/ (nth 0 colorvalue) 256)
545 bG (/ (nth 1 colorvalue) 256)
546 bB (/ (nth 2 colorvalue) 256)
547 lm YaTeX-sectioning-max-level
548 list YaTeX-sectioning-level)
549 (while list
550 (setq pat (concat YaTeX-ec-regexp (car (car list))
551 ;;"\\*?\\(\\[[^]]*\\]\\)?\\>" ;改行はさむと駄目
552 "\\>"
553 )
554 level (cdr (car list))
555 fg (format form
556 (- fR (/ (* level fR fmin) lm 100))
557 (- fG (/ (* level fG fmin) lm 100))
558 (- fB (/ (* level fB fmin) lm 100)))
559 bg (format form
560 (- bR (/ (* level bR bmin) lm 100))
561 (- bG (/ (* level bG bmin) lm 100))
562 (- bB (/ (* level bB bmin) lm 100)))
563 from (intern (format "YaTeX-sectioning-%d" level))
564 ;;face (intern (concat fg "/" bg))
565 )
566 (setq face (YaTeX-19-create-face from fg bg))
567 (setq sect-pat-alist
568 (cons;;(list pat "}" face)
569 (list 'YaTeX-19-region-section-type pat face)
570 sect-pat-alist))
571 (setq list (cdr list)))
572 (setq YaTeX-sectioning-patterns-alist sect-pat-alist)))))
573 (t ;not window-system
574 (setq YaTeX-sectioning-patterns-alist
575 (list
576 (list
577 (concat YaTeX-ec-regexp
578 "\\(\\(sub\\)*\\(section\\|paragraph\\)\\|chapter"
579 "\\|part\\){[^}]*}")
580 0
581 'define)))))))
583 ;; ローカルなマクロを読み込んだ後 redraw すると
584 ;; ローカルマクロを keyword として光らせる(keywordじゃまずいかな…)。
585 (defvar hilit-patterns-alist nil) ;for absence of hilit19
587 (defun YaTeX-19-collect-macros ()
588 (cond
589 (YaTeX-use-highlighting
590 (let ((get-face
591 (function
592 (lambda (table)
593 (cond
594 ((eq YaTeX-background-mode 'light) (car table))
595 ((eq YaTeX-background-mode 'dark) (cdr table))
596 ;; Default case equals to 'light mode...is it OK?
597 (t (car table))))))
598 sect single pattern-alist)
599 (YaTeX-19-create-face ;;hilit-translate
600 ;;sectioning (funcall get-face YaTeX-hilit-sectioning-face)
601 'macro (funcall get-face YaTeX-hilit-singlecmd-face))
602 (if (setq sect (append user-section-table tmp-section-table))
603 (setq sect (concat "\\\\\\("
604 (mapconcat
605 (function
606 (lambda (s) (regexp-quote (car s))))
607 sect
608 "\\|")
609 "\\)\\>")))
610 (if (setq single (append user-singlecmd-table tmp-singlecmd-table))
611 (setq single (concat "\\\\\\("
612 (mapconcat
613 (function (lambda (s) (regexp-quote (car s))))
614 single
615 "\\|")
616 "\\)\\b")))
617 (cons 'yatex-mode
618 (append
619 (list nil)
620 YaTeX-sectioning-patterns-alist
621 YaTeX-hilit-pattern-adjustment-private
622 ;;YaTeX-hilit-pattern-adjustment-default
623 YaTeX-hilit-patterns-alist
624 (delq nil
625 (list
626 (if sect (list
627 'YaTeX-19-region-section-type
628 sect
629 'keyword))
630 (if single (list single 0 'macro))))))))))
632 ;;2006/6/23 new face, `delimiter' introduced
633 (YaTeX-19-create-face 'delimiter "saddlebrown" "ivory")
635 ;;(YaTeX-19-collect-macros) ;causes an error
636 (defun YaTeX-hilit-setup-alist ()
637 (cond
638 ((boundp 'hilit-patterns-alist)
639 (setq hilit-patterns-alist
640 (delq (assq 'yatex-mode hilit-patterns-alist) hilit-patterns-alist))
641 (if YaTeX-use-hilit19
642 (setq hilit-patterns-alist
643 (cons (YaTeX-19-collect-macros) hilit-patterns-alist))))))
645 (defun YaTeX-hilit-recenter (arg)
646 "Collect current local macro and hilit-recenter."
647 (interactive "P")
648 (YaTeX-hilit-setup-alist)
649 (if (fboundp 'font-lock-mode) (font-lock-mode -1))
650 (hilit-recenter arg))
652 (let ((k (append (where-is-internal 'hilit-recenter)
653 (where-is-internal 'recenter))))
654 (while k
655 (define-key YaTeX-mode-map (car k) 'YaTeX-19-recenter)
656 (setq k (cdr k))))
658 (defun YaTeX-19-recenter (&optional arg)
659 (interactive "P")
660 (if YaTeX-use-hilit19
661 (YaTeX-hilit-recenter arg)
662 (YaTeX-font-lock-recenter arg)))
664 (defun YaTeX-font-lock-recenter (&optional arg)
665 (interactive "P")
666 (cond
667 ((and (boundp 'hilit-patterns-alist)
668 (assq 'yatex-mode hilit-patterns-alist))
669 (if (fboundp 'hilit-unhighlight-region)
670 (hilit-unhighlight-region (point-min) (point-max)))
671 (setq hilit-patterns-alist ;ensure to remove
672 (delq (assq 'yatex-mode hilit-patterns-alist)
673 hilit-patterns-alist))))
674 (setq YaTeX-font-lock-keywords
675 (YaTeX-convert-pattern-hilit2fontlock
676 (cdr (YaTeX-19-collect-macros)))
677 ;;; Keep this section for debugging.
678 ;; YaTeX-font-lock-keywords
679 ;; (append (YaTeX-convert-pattern-hilit2fontlock
680 ;; (cdr (YaTeX-19-collect-macros)))
681 ;; '(((lambda (lim)
682 ;; (YaTeX-19-re-search-in-env '("foo" . "tabular"))
683 ;; ;(search-forward "foo" nil t)
684 ;; )
685 ;; (0 YaTeX-font-lock-delimiter-face))))
686 ;;font-lock-keywords nil
687 font-lock-set-defaults nil)
688 ;;(save-excursion
689 ;; (font-lock-fontify-region (window-start) (window-end))
690 (font-lock-mode -1) ;is stupid, but sure.
691 (font-lock-mode 1)
692 (recenter arg))
694 (defun YaTeX-font-lock-fontify-region (beg end)
695 (interactive "r")
696 (save-excursion (font-lock-fontify-region beg end)))
698 (defun YaTeX-font-lock-fontify-environment ()
699 (interactive)
700 (save-excursion
701 (save-match-data ;is safe after emacs-19
702 (YaTeX-mark-environment)
703 (message "")
704 (YaTeX-font-lock-fontify-region (region-beginning) (region-end)))))
706 (defun YaTeX-font-lock-highlight-menu ()
707 (interactive)
708 (message "Force Highlight: R)egion E)nvironment")
709 (let ((c (read-char)))
710 (cond
711 ((memq c '(?R ?r))
712 (YaTeX-font-lock-fontify-region (region-beginning) (region-end)))
713 ((memq c '(?e ?e))
714 (YaTeX-font-lock-fontify-environment)))))
716 (if YaTeX-use-font-lock
717 (YaTeX-define-key "u" 'YaTeX-font-lock-highlight-menu))
719 (defvar YaTeX-font-lock-keywords nil
720 "Pattern-face alist of yahtml-mode for font-lock")
722 (defun YaTeX-font-lock-set-default-keywords ()
723 (put 'yatex-mode 'font-lock-defaults
724 (list 'YaTeX-font-lock-keywords nil nil))
725 (setq YaTeX-font-lock-keywords
726 (YaTeX-convert-pattern-hilit2fontlock
727 (cons nil
728 (append YaTeX-sectioning-patterns-alist
729 YaTeX-hilit-pattern-adjustment-private
730 YaTeX-hilit-patterns-alist)))))
732 (if YaTeX-use-font-lock
733 (progn
734 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)
735 ;;for those who use both hilit19 and font-lock
736 (if (eq (car hilit-mode-enable-list) 'not)
737 (or (member 'yatex-mode hilit-mode-enable-list)
738 (nconc hilit-mode-enable-list (list 'yatex-mode)))
739 (setq hilit-mode-enable-list
740 (delq 'yatex-mode hilit-mode-enable-list))))
741 (YaTeX-font-lock-set-default-keywords)))
743 (defun YaTeX-switch-to-new-window ()
744 (let ((c 0) (i 1) (free (make-string win:max-configs ? )))
745 (while (< i win:max-configs)
746 (or (aref win:configs i) (aset free i (+ i win:base-key)))
747 (setq i (1+ i)))
748 (while (not (string-match (char-to-string c) free))
749 (message "Which window to create? [%s]: " free)
750 (setq c (read-char)))
751 (message "Creating window [%c]" c)
752 (set-buffer (get-buffer-create "*scratch*"))
753 (win:switch-window (- c win:base-key))))
755 (defun YaTeX-visit-main-other-frame ()
756 "Visit main file in other frame.
757 WARNING, This code is not perfect."
758 (interactive)
759 (if (YaTeX-main-file-p) (message "I think this is main LaTeX source.")
760 (let (parent)
761 (save-excursion (YaTeX-visit-main t) (setq parent (current-buffer)))
762 (cond
763 ((get-buffer-window parent t)
764 (goto-buffer-window parent))
765 ((and (featurep 'windows) win:use-frame)
766 (YaTeX-switch-to-new-window)
767 (switch-to-buffer parent))
768 (t (switch-to-buffer-other-frame (buffer-name parent)))))))
770 (defun YaTeX-goto-corresponding-*-other-frame (arg)
771 "Go to corresponding object in other frame."
772 (interactive "P")
773 (let (b p)
774 (save-window-excursion
775 (save-excursion
776 (YaTeX-goto-corresponding-* arg)
777 (setq b (current-buffer) p (point))))
778 (cond
779 ((get-buffer-window b t)
780 (goto-buffer-window b)
781 (goto-char p))
782 ((and (featurep 'windows) win:use-frame)
783 (YaTeX-switch-to-new-window)
784 (switch-to-buffer b)
785 (goto-char p))
786 (t (switch-to-buffer-other-frame (buffer-name b))
787 (goto-char p)))))
789 ;;; reverseVideo にして hilit-background-mode を 'dark
790 ;;; にしている人は数式などが暗くなりすぎて見づらいかもしれない。
791 ;;; 次のコードを hilit19 をロードしている場所の直後に置くとちょっ
792 ;;; とはまし。
793 ;;; (if (eq hilit-background-mode 'dark)
794 ;;; (hilit-translate
795 ;;; string 'mediumspringgreen
796 ;;; formula 'khaki
797 ;;; label 'yellow-underlined))
798 (and YaTeX-emacs-19
799 (not (featurep 'xemacs))
800 (boundp 'byte-compile-current-file)
801 byte-compile-current-file
802 (progn
803 (if YaTeX-emacs-20 (require 'font-lock))
804 (if (and (boundp 'window-system) window-system)
805 (require 'hilit19)
806 (error "Byte compile this file on window system! Not `-nw'!"))))
808 (provide 'yatex19)
811 ; Local variables:
812 ; fill-prefix: ";;; "
813 ; paragraph-start: "^$\\| \\|;;;$"
814 ; paragraph-separate: "^$\\| \\|;;;$"
815 ; coding: sjis
816 ; End: