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