yatex
view yatex19.el @ 458:1a891f775194
'figure' and 'figcaption'
| author | HIROSE Yuuji <yuuji@gentei.org> |
|---|---|
| date | Tue, 16 May 2017 08:30:04 +0859 |
| parents | 8c8757ac9b62 |
| children | 723f136edde5 |
line source
1 ;;; yatex19.el -- YaTeX facilities for Emacs 19 or later -*- coding: sjis -*-
2 ;;; (c)1994-2017 by HIROSE Yuuji.[yuuji@yatex.org]
3 ;;; Last modified Thu Jan 5 17:45:46 2017 on firestorm
4 ;;; $Id$
6 ;;; Code:
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 (boundp 'frame-background-mode)
19 frame-background-mode)
20 (if (fboundp 'frame-parameters)
21 (cdr (assq 'background-mode (frame-parameters))))
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 (function(lambda () (interactive)
58 (YaTeX-switch-mode-menu nil ?t))))))
59 (cons 'mod (cons "Toggle Modify Mode"
60 (function(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 (function
231 (lambda ()
232 (or (assoc "YaTeX" current-menubar)
233 (progn
234 (set-buffer-menubar (copy-sequence current-menubar))
235 (add-submenu nil YaTeX-mode-menu-map)))))))
237 ;; Other key bindings for window-system
238 ;(YaTeX-define-key [?\C- ] 'YaTeX-do-completion)
239 (define-key YaTeX-mode-map [?\M-\C- ] 'YaTeX-mark-environment)
241 ;; Highlightening
242 ;; メニューに比べてこっちは結構本気でやってます。
243 ;; だって文書構造がとっても分かり易いんだもん。
244 ;; みんなも hilit19.el を使おう!
245 ;; とかいってるうちに hilit19 って obsolete になってしまった…
246 ;; …ということで、hilit19 用のパターンを font-lock に変換する関数を
247 ;; 作成してなんとか font-lock にも対応(2000年12月)。
248 ;; しかし、font-lock は仕様が変わりやすい雰囲気でずっと動き続けるか
249 ;; どうかは不明。むしろ進化の止まったhilit19を使い続ける方が安心と
250 ;; 言えないこともないが世の流れは読めず……。
251 ;;
252 ;; さて、まずは対応する {} をピカピカ範囲とするような関数を作る。
253 ;; これは hilit-LaTeX.el を参考にした。でも、ちゃんと section 型コマンドの
254 ;; 引数を数えて正しい位置までピカピカさせるよ〜ん!
256 (defun YaTeX-19-region-section-type (pattern)
257 "Return cons of starting and end point of section-type commands of PATTERN."
258 (if (re-search-forward pattern nil t)
259 (let ((m0 (match-beginning 0)) (e0 (match-end 0)) cmd (argc 1))
260 (setq cmd (substring (YaTeX-match-string 0) 1)
261 argc (or (car (cdr (YaTeX-lookup-table cmd 'section))) argc))
262 (if (= argc 0) (cons m0 (point)) ;引数個数0ならマッチした領域
263 (skip-chars-forward " \n\t*")
264 (while (looking-at "\\[") (forward-list 1)) ;optionならスキップ
265 (skip-chars-forward " \n\t")
266 (prog1
267 (if (looking-at "{") ;{}が始まるならちゃんとしたsection型
268 (cons m0
269 (condition-case err
270 (progn
271 ;;(skip-chars-backward "^{") (forward-char -2)
272 (while (> argc 0)
273 (skip-chars-forward "^{")
274 (forward-list 1)
275 (setq argc (1- argc)))
276 (point))
277 (error m0)))
278 ;{}でないならたぶん \verb 環境などにあるダミー
279 (cons m0 e0))
280 ;;move to re-search end not to make font-lock confused
281 (goto-char e0))))))
283 (defun YaTeX-19-region-large-type (pattern)
284 "Return cons of large-type contents.
285 Assumes PATTERN begins with `{'."
286 (if (re-search-forward pattern nil t)
287 (let ((m0 (match-beginning 0)) (e0 (match-end 0))p)
288 (goto-char m0)
289 (skip-chars-forward "^ \t\n")
290 (skip-chars-forward " \t\n")
291 (prog1
292 (cons (setq p (point))
293 (condition-case err
294 (progn (goto-char m0) (forward-list 1) (1- (point)))
295 (error (1+ p))))
296 ;;move to re-search end not to make font-lock confused
297 (goto-char e0)))))
299 (defun YaTeX-19-region-env-type (envptn)
300 "Return cons of environment contents specified by ENVPTN as regexp."
301 (if (and (looking-at envptn) ;;re-search-forward envptn nil t)
302 (save-excursion
303 (not(search-backward YaTeX-comment-prefix
304 (point-beginning-of-line) t))))
305 (let ((m0 (match-beginning 0)) (e0 (match-end 0))
306 (env (YaTeX-match-string 1))
307 (nextline (progn (forward-line 1) (point))))
308 (goto-char m0)
309 ;(message "max=%d" (point-max))(sit-for 2)
310 (condition-case err
311 (if (YaTeX-goto-corresponding-environment)
312 (prog1
313 (cons nextline (match-beginning 0))
314 (goto-char e0)))
315 (error nil)))))
317 (defun YaTeX-19-region-paren-math (ptn)
318 "Return cons of \(...\) or \[...\] type math environment."
319 (if (looking-at "\\\\\\([\[(]\\)")
320 (let*((ptype (cdr (assoc (YaTeX-match-string 1)
321 '(("(" . ")") ("[" "]")))))
322 (b (match-beginning 0))
323 (e (match-end 0)))
324 (condition-case err
325 (if (re-search-forward
326 (concat "[^\\]\\\\" (regexp-quote ptype))
327 nil t)
328 (prog1 (cons b (match-beginning 0))
329 (goto-char e)))
330 (error nil)))))
332 (defun YaTeX-19-region-math-sub (ptn)
333 "Return cons of _{...}"
334 (if (and (looking-at ptn)
335 (eq YaTeX-font-lock-formula-face
336 (get-text-property (point) 'face)))
337 (let ((e (match-end 0)) (p (point)))
338 (goto-char e)
339 (prog1
340 (condition-case ()
341 (if (looking-at "{")
342 (cons (1+ (point))
343 (progn (forward-list 1) (1- (point))))
344 (cons e
345 (cond
346 ((looking-at (concat YaTeX-ec-regexp
347 YaTeX-TeX-token-regexp))
348 (match-end 0))
349 ;; other case??
350 (t (1+ (point)))))))
351 (goto-char e)))))
353 ;; 些細なことだが % の前の文字もピカリとさせてしまうようで… >hilit19
354 ;; ↓この関数は下の hilit-set-mode-patterns の "[^\\]\\(%\\).*$" に
355 ;; 依存している
356 (defun YaTeX-19-region-comment (pattern)
357 "Return list of comment start and end point."
358 (if (re-search-forward pattern nil t)
359 (cons (match-beginning 2) (match-end 0))))
361 ;; 2006/6/23 match only if it's in specified envrironment.
362 (defun YaTeX-19-re-search-in-env (ptn_env)
363 (catch 'done
364 ;; For font-lock, this function should find it.
365 (let (md r)
366 (while (YaTeX-re-search-active-forward
367 (car ptn_env) YaTeX-comment-prefix nil t)
368 (setq md (match-data)
369 r (string-match (cdr ptn_env)
370 (or (YaTeX-inner-environment 'quick) "")))
371 (store-match-data md)
372 (if r (setq r (cons (match-beginning 0) (match-end 0))))
373 (if (or YaTeX-use-hilit19 r) (throw 'done r))
374 (goto-char (match-end 0)))
375 (throw 'done r))))
377 ;;(make-face 'tt)
378 ;;(set-face-font 'tt "-schumacher-clean-medium-r-normal--*-*-*-*-*-*-*-*")
379 ;;(hilit-translate 'tt "white")
381 ;; font-lockの関数呼びパターンの場合は正規表現が行末までマッチすると
382 ;; hilit候補対象外にされてしまうので1字手前で正規表現を止める
383 (defvar YaTeX-hilit-patterns-alist
384 '(
385 ;; formulas
386 (YaTeX-19-region-math-sub "[^\\]^" YaTeX-font-lock-math-sup-face overwrite)
387 (YaTeX-19-region-math-sub "[^\\]_" YaTeX-font-lock-math-sub-face overwrite)
388 (YaTeX-19-region-env-type
389 "\\\\begin{\\(equation\\|eqnarray\\|displaymath\\|\\(x?x?\\|fl\\)align\\|multline\\|gather\\)" formula)
390 ;(YaTeX-19-region-paren-math "\\\\" formula)
391 ;;("[^\\]\\\\(" "\\\\)" formula) ; \( \)
392 ;;("[^\\]\\\\\\[" "\\\\\\]" formula) ; \[ \]
393 ;; comments
394 (YaTeX-19-region-comment "\\([^\\]\\|^\\)\\(%\\).*$" comment)
396 (YaTeX-19-region-section-type "\\\\footnote\\(mark\\|text\\)?\\>" keyword)
397 ("\\\\[a-z]+box" 0 keyword)
398 (YaTeX-19-region-section-type "\\\\\\(v\\|h\\)space\\>" keyword)
400 ;; (re-)define new commands/environments/counters
401 (YaTeX-19-region-section-type
402 "\\\\\\(re\\)?new\\(environment\\|command\\|theorem\\|length\\|counter\\)\\>"
403 defun)
404 (YaTeX-19-region-section-type
405 "\\\\textbf\\>" bold)
407 ;; various declarations/definitions
408 (YaTeX-19-region-section-type
409 "\\\\\\(set\\|setto\\|addto\\)\\(length\\|width\\|counter\\)\\>"
410 define)
411 (YaTeX-19-region-section-type
412 "\\\\\\(title\\|author\\|date\\|thanks\\)\\>" define)
414 ("\\\\document\\(style\\|class\\)\\(\\[.*\\]\\)?{" "}" decl)
416 ("\\\\\\(begin\\|end\\|nofiles\\|includeonly\\|usepackage\\(\\[.*\\]\\)?\\){" "}" decl)
417 ("\\\\\\(raggedright\\|makeindex\\|makeglossary\\|maketitle\\)\\b" 0 decl)
418 ("\\\\\\(pagestyle\\|thispagestyle\\|pagenumbering\\){" "}" decl)
419 ("\\\\\\(normalsize\\|small\\|footnotesize\\|scriptsize\\|tiny\\|large\\|Large\\|LARGE\\|huge\\|Huge\\)\\b" 0 decl)
420 ("\\\\\\(appendix\\|tableofcontents\\|listoffigures\\|listoftables\\)\\b"
421 0 decl)
422 ("\\\\\\(bf\\|em\\|it\\|rm\\|sf\\|sl\\|ss\\|tt\\)\\b" 0 decl)
424 ;; label-like things
425 ;;this should be customized by YaTeX-item-regexp
426 ("\\\\\\(sub\\)*item\\b\\(\\[[^]]*\\]\\)?" 0 label)
427 (YaTeX-19-region-section-type
428 "\\\\\\(caption\\|bibitem\\)\\(\\[[^]]*\\]\\)?\\>" label)
430 ;; things that do some sort of cross-reference
431 (YaTeX-19-region-section-type
432 "\\\\\\(\\(no\\|possessive\\)?cite[a-z]*\\|[a-z]*ref\\|label\\|index\\|glossary\\)\\>"
433 crossref)
435 ;; things that bring in external files
436 ("\\\\\\(include\\|input\\|bibliography\\(style\\)?\\){" "}" include)
438 ;; ("\\\\begin{\\(eqn\\|equation\\|x?x?align\\|split\\|multline\\|gather\\)"
439 ;; "\\\\end{\\(eqn\\|equation\\|x?x?align\\|split\\|multline\\|gather\\).*}"
440 ;; formula)
441 ("\\([^\\$]\\|^\\)\\($\\($[^$]*\\$\\|[^$]*\\)\\$\\)" 2 formula); '$...$' or '$$...$$'
443 ;; "wysiwyg" emphasis -- these don't work on nested expressions
444 (YaTeX-19-region-large-type "{\\\\\\(em\\|it\\|sl\\)" italic)
445 (YaTeX-19-region-large-type "{\\\\bf" bold)
446 ;;;(YaTeX-19-region-large-type "{\\\\tt" tt)
447 ;;;("\\\\begin{verbatim" "\\\\end{verbatim" tt)
449 ("``" "''" string)
450 ("\\\\\\(new\\|clear\\(double\\)?\\)page\\>\\|\\\\\\(\\\\\\|cr\\)\\>"
451 0 delimiter)
452 ;; re-search-in-env seems to make it slow down. 2007/2/11
453 ;;(YaTeX-19-re-search-in-env
454 ;; ("&\\|\\\\hline" . "tabular\\|equation\\|eqn\\|array\\|align") delimiter)
455 ;;(YaTeX-19-re-search-in-env ("\\\\[+-=><'`]" . "tabbing") delimiter)
456 ("&\\|\\\\hline\\|\\\\[+-=><'`]" 0 delimiter)
457 )
458 "*Hiliting pattern alist for LaTeX text.")
460 ;;(defvar YaTeX-hilit-pattern-adjustment-default nil)
461 ;; ↑いらなくなった。
462 (defvar YaTeX-hilit-pattern-adjustment-private nil
463 "*Adjustment hilit-pattern-alist for default yatex-mode's pattern.")
464 (defvar YaTeX-hilit-sectioning-face
465 '(yellow/dodgerblue yellow/slateblue)
466 "*Hilightening face for sectioning unit. '(FaceForLight FaceForDark)")
467 (defvar YaTeX-hilit-sectioning-attenuation-rate
468 '(15 40)
469 "*Maximum attenuation rate of sectioning face. '(ForeRate BackRate)
470 Each rate specifies how much portion of RGB value should be attenuated
471 towards to lowest sectioning unit. Numbers should be written in percentage.")
472 (defvar YaTeX-sectioning-patterns-alist nil
473 "Hilightening patterns for sectioning units.")
474 (defvar YaTeX-hilit-singlecmd-face
475 '("slateblue2" . "aquamarine")
476 "*Hilightening face for maketitle type. '(FaceForLight FaceForDark)")
478 ;;; セクションコマンドを、構造レベルの高さに応じて色の濃度を変える
479 ;;; 背景が黒でないと何が嬉しいのか分からないに違いない.
480 ;;; もしかして白地の時は構造レベルに応じて色を明るくしたほうが良いのか?
481 ;;; ...どうやらそうでもないらしい。これでいいみたい(2000/12)。
482 ;(if (fboundp 'win32-color-values)
483 ; (fset 'x-color-values 'win32-color-values))
485 (defun YaTeX-19-create-face (sym fgcolor &optional bgcolor)
486 "Create face named SYM with face of FGCOLOR/BGCOLOR."
487 (if (consp fgcolor)
488 (setq fgcolor (if (eq YaTeX-background-mode 'light)
489 (car fgcolor)
490 (cdr fgcolor))))
491 (if (consp bgcolor)
492 (setq bgcolor (if (eq YaTeX-background-mode 'light)
493 (car bgcolor)
494 (cdr bgcolor))))
495 (cond
496 ((and YaTeX-use-font-lock (fboundp 'defface))
497 (custom-declare-face
498 sym
499 (list
500 (list (list
501 '(class color)
502 ;(list 'background YaTeX-background-mode)
503 )
504 (delq nil
505 (append
506 (list ':foreground fgcolor)
507 (if bgcolor
508 (list ':background bgcolor))
509 ))
510 )
511 (list t (list ':bold t ':underline t))
512 )
513 (format "Font lock face for %s" sym)
514 ':group 'font-lock-faces)
515 (set sym sym)
516 sym)
517 ((and YaTeX-use-hilit19 (and (fboundp 'hilit-translate)))
518 (let ((face (intern (concat fgcolor "/" bgcolor))))
519 (if (facep sym)
520 (hilit-translate sym face)
521 (make-face sym)
522 (or (memq sym hilit-predefined-face-list)
523 (progn
524 (set-face-foreground sym fgcolor)
525 (set-face-background sym bgcolor)
526 (setq hilit-predefined-face-list
527 (cons sym hilit-predefined-face-list)))))
528 face))))
530 (cond
531 (YaTeX-use-highlighting
532 (cond
533 (window-system
534 (let*((sectface
535 (car (if (eq YaTeX-background-mode 'dark)
536 (cdr YaTeX-hilit-sectioning-face)
537 YaTeX-hilit-sectioning-face)))
538 (sectcol (symbol-name sectface))
539 (fl YaTeX-use-font-lock)
540 (form (if fl "#%02x%02x%02x" "hex-%02x%02x%02x"))
541 sect-pat-alist)
542 (if (string-match "/" sectcol)
543 (let ((fmin (nth 0 YaTeX-hilit-sectioning-attenuation-rate))
544 (bmin (nth 1 YaTeX-hilit-sectioning-attenuation-rate))
545 colorvalue fR fG fB bR bG bB pat fg bg level from face list lm)
546 (require 'yatexsec)
547 (setq fg (substring sectcol 0 (string-match "/" sectcol))
548 bg (substring sectcol (1+ (string-match "/" sectcol)))
549 colorvalue (x-color-values fg)
550 fR (/ (nth 0 colorvalue) 256)
551 fG (/ (nth 1 colorvalue) 256)
552 fB (/ (nth 2 colorvalue) 256)
553 colorvalue (x-color-values bg)
554 bR (/ (nth 0 colorvalue) 256)
555 bG (/ (nth 1 colorvalue) 256)
556 bB (/ (nth 2 colorvalue) 256)
557 lm YaTeX-sectioning-max-level
558 list YaTeX-sectioning-level)
559 (while list
560 (setq pat (concat YaTeX-ec-regexp (car (car list))
561 ;;"\\*?\\(\\[[^]]*\\]\\)?\\>" ;改行はさむと駄目
562 "\\>"
563 )
564 level (cdr (car list))
565 fg (format form
566 (- fR (/ (* level fR fmin) lm 100))
567 (- fG (/ (* level fG fmin) lm 100))
568 (- fB (/ (* level fB fmin) lm 100)))
569 bg (format form
570 (- bR (/ (* level bR bmin) lm 100))
571 (- bG (/ (* level bG bmin) lm 100))
572 (- bB (/ (* level bB bmin) lm 100)))
573 from (intern (format "YaTeX-sectioning-%d" level))
574 ;;face (intern (concat fg "/" bg))
575 )
576 (setq face (YaTeX-19-create-face from fg bg))
577 (setq sect-pat-alist
578 (cons;;(list pat "}" face)
579 (list 'YaTeX-19-region-section-type pat face)
580 sect-pat-alist))
581 (setq list (cdr list)))
582 (setq YaTeX-sectioning-patterns-alist sect-pat-alist)))))
583 (t ;not window-system
584 (setq YaTeX-sectioning-patterns-alist
585 (list
586 (list
587 (concat YaTeX-ec-regexp
588 "\\(\\(sub\\)*\\(section\\|paragraph\\)\\|chapter"
589 "\\|part\\){[^}]*}")
590 0
591 'define)))))))
593 ;; ローカルなマクロを読み込んだ後 redraw すると
594 ;; ローカルマクロを keyword として光らせる(keywordじゃまずいかな…)。
595 (defvar hilit-patterns-alist nil) ;for absence of hilit19
597 (defun YaTeX-19-collect-macros ()
598 (cond
599 (YaTeX-use-highlighting
600 (let ((get-face
601 (function
602 (lambda (table)
603 (cond
604 ((eq YaTeX-background-mode 'light) (car table))
605 ((eq YaTeX-background-mode 'dark) (cdr table))
606 ;; Default case equals to 'light mode...is it OK?
607 (t (car table))))))
608 sect single pattern-alist)
609 (YaTeX-19-create-face ;;hilit-translate
610 ;;sectioning (funcall get-face YaTeX-hilit-sectioning-face)
611 'macro (funcall get-face YaTeX-hilit-singlecmd-face))
612 (if (setq sect (append user-section-table tmp-section-table))
613 (setq sect (concat "\\\\\\("
614 (mapconcat
615 (function
616 (lambda (s) (regexp-quote (car s))))
617 sect
618 "\\|")
619 "\\)\\>")))
620 (if (setq single (append user-singlecmd-table tmp-singlecmd-table))
621 (setq single (concat "\\\\\\("
622 (mapconcat
623 (function (lambda (s) (regexp-quote (car s))))
624 single
625 "\\|")
626 "\\)\\b")))
627 (cons 'yatex-mode
628 (append
629 (list nil)
630 YaTeX-sectioning-patterns-alist
631 YaTeX-hilit-pattern-adjustment-private
632 ;;YaTeX-hilit-pattern-adjustment-default
633 YaTeX-hilit-patterns-alist
634 (delq nil
635 (list
636 (if sect (list
637 'YaTeX-19-region-section-type
638 sect
639 'keyword))
640 (if single (list single 0 'macro))))))))))
642 ;;2006/6/23 new face, `delimiter' introduced
643 (YaTeX-19-create-face
644 'delimiter '("saddlebrown" . "lightyellow") '("ivory". "navy"))
646 ;;(YaTeX-19-collect-macros) ;causes an error
647 (defun YaTeX-hilit-setup-alist ()
648 (cond
649 ((boundp 'hilit-patterns-alist)
650 (setq hilit-patterns-alist
651 (delq (assq 'yatex-mode hilit-patterns-alist) hilit-patterns-alist))
652 (if YaTeX-use-hilit19
653 (setq hilit-patterns-alist
654 (cons (YaTeX-19-collect-macros) hilit-patterns-alist))))))
656 (defun YaTeX-hilit-recenter (arg)
657 "Collect current local macro and hilit-recenter."
658 (interactive "P")
659 (YaTeX-hilit-setup-alist)
660 (if (fboundp 'font-lock-mode) (font-lock-mode -1))
661 (hilit-recenter arg))
663 (let ((k (append (where-is-internal 'hilit-recenter)
664 (where-is-internal 'recenter))))
665 (while k
666 (define-key YaTeX-mode-map (car k) 'YaTeX-19-recenter)
667 (setq k (cdr k))))
669 (defun YaTeX-19-recenter (&optional arg)
670 (interactive "P")
671 (if YaTeX-use-hilit19
672 (YaTeX-hilit-recenter arg)
673 (YaTeX-font-lock-recenter arg)))
675 (defun YaTeX-font-lock-recenter (&optional arg)
676 (interactive "P")
677 (cond
678 ((and (boundp 'hilit-patterns-alist)
679 (assq 'yatex-mode hilit-patterns-alist))
680 (if (fboundp 'hilit-unhighlight-region)
681 (hilit-unhighlight-region (point-min) (point-max)))
682 (setq hilit-patterns-alist ;ensure to remove
683 (delq (assq 'yatex-mode hilit-patterns-alist)
684 hilit-patterns-alist))))
685 (setq YaTeX-font-lock-keywords
686 (YaTeX-convert-pattern-hilit2fontlock
687 (cdr (YaTeX-19-collect-macros)))
688 ;;; Keep this section for debugging.
689 ;; YaTeX-font-lock-keywords
690 ;; (append (YaTeX-convert-pattern-hilit2fontlock
691 ;; (cdr (YaTeX-19-collect-macros)))
692 ;; '(((lambda (lim)
693 ;; (YaTeX-19-re-search-in-env '("foo" . "tabular"))
694 ;; ;(search-forward "foo" nil t)
695 ;; )
696 ;; (0 YaTeX-font-lock-delimiter-face))))
697 ;;font-lock-keywords nil
698 font-lock-set-defaults nil)
699 ;;(save-excursion
700 ;; (font-lock-fontify-region (window-start) (window-end))
701 (font-lock-mode -1) ;is stupid, but sure.
702 (font-lock-mode 1)
703 (recenter arg))
705 (defun YaTeX-font-lock-fontify-region (beg end)
706 (interactive "r")
707 (save-excursion (font-lock-fontify-region beg end)))
709 (defun YaTeX-font-lock-fontify-environment ()
710 (interactive)
711 (save-excursion
712 (save-match-data ;is safe after emacs-19
713 (YaTeX-mark-environment)
714 (message "")
715 (YaTeX-font-lock-fontify-region (region-beginning) (region-end)))))
717 (defun YaTeX-font-lock-highlight-menu ()
718 (interactive)
719 (message "Force Highlight: R)egion E)nvironment")
720 (let ((c (read-char)))
721 (cond
722 ((memq c '(?R ?r))
723 (YaTeX-font-lock-fontify-region (region-beginning) (region-end)))
724 ((memq c '(?e ?e))
725 (YaTeX-font-lock-fontify-environment)))))
727 (if YaTeX-use-font-lock
728 (YaTeX-define-key "u" 'YaTeX-font-lock-highlight-menu))
730 (defvar YaTeX-font-lock-keywords nil
731 "Pattern-face alist of yahtml-mode for font-lock")
733 (defun YaTeX-font-lock-set-default-keywords ()
734 (put 'yatex-mode 'font-lock-defaults
735 (list 'YaTeX-font-lock-keywords nil nil))
736 (setq YaTeX-font-lock-keywords
737 (YaTeX-convert-pattern-hilit2fontlock
738 (cons nil
739 (append YaTeX-sectioning-patterns-alist
740 YaTeX-hilit-pattern-adjustment-private
741 YaTeX-hilit-patterns-alist)))))
743 (if YaTeX-use-font-lock
744 (progn
745 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)
746 ;;for those who use both hilit19 and font-lock
747 (if (eq (car hilit-mode-enable-list) 'not)
748 (or (member 'yatex-mode hilit-mode-enable-list)
749 (nconc hilit-mode-enable-list (list 'yatex-mode)))
750 (setq hilit-mode-enable-list
751 (delq 'yatex-mode hilit-mode-enable-list))))
752 (YaTeX-font-lock-set-default-keywords)))
754 (defun YaTeX-switch-to-new-window ()
755 (let ((c 0) (i 1) (free (make-string win:max-configs ? )))
756 (while (< i win:max-configs)
757 (or (aref win:configs i) (aset free i (+ i win:base-key)))
758 (setq i (1+ i)))
759 (while (not (string-match (char-to-string c) free))
760 (message "Which window to create? [%s]: " free)
761 (setq c (read-char)))
762 (message "Creating window [%c]" c)
763 (set-buffer (get-buffer-create "*scratch*"))
764 (win:switch-window (- c win:base-key))))
766 (defun YaTeX-visit-main-other-frame ()
767 "Visit main file in other frame.
768 WARNING, This code is not perfect."
769 (interactive)
770 (if (YaTeX-main-file-p) (message "I think this is main LaTeX source.")
771 (let (parent)
772 (save-excursion (YaTeX-visit-main t) (setq parent (current-buffer)))
773 (cond
774 ((get-buffer-window parent t)
775 (goto-buffer-window parent))
776 ((and (featurep 'windows) win:use-frame)
777 (YaTeX-switch-to-new-window)
778 (switch-to-buffer parent))
779 (t (switch-to-buffer-other-frame (buffer-name parent)))))))
781 (defun YaTeX-goto-corresponding-*-other-frame (arg)
782 "Go to corresponding object in other frame."
783 (interactive "P")
784 (let (b p)
785 (save-window-excursion
786 (save-excursion
787 (YaTeX-goto-corresponding-* arg)
788 (setq b (current-buffer) p (point))))
789 (cond
790 ((get-buffer-window b t)
791 (goto-buffer-window b)
792 (goto-char p))
793 ((and (featurep 'windows) win:use-frame)
794 (YaTeX-switch-to-new-window)
795 (switch-to-buffer b)
796 (goto-char p))
797 (t (switch-to-buffer-other-frame (buffer-name b))
798 (goto-char p)))))
800 ;;; reverseVideo にして hilit-background-mode を 'dark
801 ;;; にしている人は数式などが暗くなりすぎて見づらいかもしれない。
802 ;;; 次のコードを hilit19 をロードしている場所の直後に置くとちょっ
803 ;;; とはまし。
804 ;;; (if (eq hilit-background-mode 'dark)
805 ;;; (hilit-translate
806 ;;; string 'mediumspringgreen
807 ;;; formula 'khaki
808 ;;; label 'yellow-underlined))
809 (and YaTeX-emacs-19
810 (not (featurep 'xemacs))
811 (boundp 'byte-compile-current-file)
812 byte-compile-current-file
813 (progn
814 (if YaTeX-emacs-20 (require 'font-lock))
815 (if (and (boundp 'window-system) window-system)
816 (require 'hilit19)
817 (error "Byte compile this file on window system! Not `-nw'!"))))
819 (provide 'yatex19)
822 ; Local variables:
823 ; fill-prefix: ";;; "
824 ; paragraph-start: "^$\\| \\|;;;$"
825 ; paragraph-separate: "^$\\| \\|;;;$"
826 ; coding: sjis
827 ; End: