yatex
view yatex19.el @ 84:73cba5ddd111
Converted from RCS of yatex
| author | yuuji |
|---|---|
| date | Sun, 27 Sep 2009 13:04:14 +0000 |
| parents | 0734be649cb8 |
| children | f14ec50103d0 |
line source
1 ;;; -*- Emacs-Lisp -*-
2 ;;; YaTeX facilities for Emacs 19
3 ;;; (c)1994-2006 by HIROSE Yuuji.[yuuji@yatex.org]
4 ;;; Last modified Mon Jun 26 11:31:34 2006 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 (YaTeX-19-re-search-in-env
451 ("&\\|\\\\hline" . "tabular\\|equation\\|eqn\\|array\\|align") delimiter)
452 (YaTeX-19-re-search-in-env ("\\\\[+-=><'`]" . "tabbing") delimiter)
453 )
454 "*Hiliting pattern alist for LaTeX text.")
456 ;;(defvar YaTeX-hilit-pattern-adjustment-default nil)
457 ;; ↑いらなくなった。
458 (defvar YaTeX-hilit-pattern-adjustment-private nil
459 "*Adjustment hilit-pattern-alist for default yatex-mode's pattern.")
460 (defvar YaTeX-hilit-sectioning-face
461 '(yellow/dodgerblue yellow/slateblue)
462 "*Hilightening face for sectioning unit. '(FaceForLight FaceForDark)")
463 (defvar YaTeX-hilit-sectioning-attenuation-rate
464 '(15 40)
465 "*Maximum attenuation rate of sectioning face. '(ForeRate BackRate)
466 Each rate specifies how much portion of RGB value should be attenuated
467 towards to lowest sectioning unit. Numbers should be written in percentage.")
468 (defvar YaTeX-sectioning-patterns-alist nil
469 "Hilightening patterns for sectioning units.")
470 (defvar YaTeX-hilit-singlecmd-face
471 '("slateblue2" . "aquamarine")
472 "*Hilightening face for maketitle type. '(FaceForLight FaceForDark)")
474 ;;; セクションコマンドを、構造レベルの高さに応じて色の濃度を変える
475 ;;; 背景が黒でないと何が嬉しいのか分からないに違いない.
476 ;;; もしかして白地の時は構造レベルに応じて色を明るくしたほうが良いのか?
477 ;;; ...どうやらそうでもないらしい。これでいいみたい(2000/12)。
478 ;(if (fboundp 'win32-color-values)
479 ; (fset 'x-color-values 'win32-color-values))
481 (defun YaTeX-19-create-face (sym fgcolor &optional bgcolor)
482 "Create face named SYM with face of FGCOLOR/BGCOLOR."
483 (cond
484 ((and YaTeX-use-font-lock (fboundp 'defface))
485 (custom-declare-face
486 sym
487 (list
488 (list (list
489 '(class color)
490 ;(list 'background YaTeX-background-mode)
491 )
492 (delq nil
493 (append
494 (list ':foreground fgcolor)
495 (if bgcolor
496 (list ':background bgcolor))
497 ))
498 )
499 (list t (list ':bold t ':underline t))
500 )
501 (format "Font lock face for %s" sym)
502 ':group 'font-lock-faces)
503 (set sym sym)
504 sym)
505 ((and YaTeX-use-hilit19 (and (fboundp 'hilit-translate)))
506 (let ((face (intern (concat fgcolor "/" bgcolor))))
507 (if (facep sym)
508 (hilit-translate sym face)
509 (make-face sym)
510 (or (memq sym hilit-predefined-face-list)
511 (progn
512 (set-face-foreground sym fgcolor)
513 (set-face-background sym bgcolor)
514 (setq hilit-predefined-face-list
515 (cons sym hilit-predefined-face-list)))))
516 face))))
518 (cond
519 (YaTeX-use-highlighting
520 (cond
521 (window-system
522 (let*((sectface
523 (car (if (eq YaTeX-background-mode 'dark)
524 (cdr YaTeX-hilit-sectioning-face)
525 YaTeX-hilit-sectioning-face)))
526 (sectcol (symbol-name sectface))
527 (fl YaTeX-use-font-lock)
528 (form (if fl "#%02x%02x%02x" "hex-%02x%02x%02x"))
529 sect-pat-alist)
530 (if (string-match "/" sectcol)
531 (let ((fmin (nth 0 YaTeX-hilit-sectioning-attenuation-rate))
532 (bmin (nth 1 YaTeX-hilit-sectioning-attenuation-rate))
533 colorvalue fR fG fB bR bG bB pat fg bg level from face list lm)
534 (require 'yatexsec)
535 (setq fg (substring sectcol 0 (string-match "/" sectcol))
536 bg (substring sectcol (1+ (string-match "/" sectcol)))
537 colorvalue (x-color-values fg)
538 fR (/ (nth 0 colorvalue) 256)
539 fG (/ (nth 1 colorvalue) 256)
540 fB (/ (nth 2 colorvalue) 256)
541 colorvalue (x-color-values bg)
542 bR (/ (nth 0 colorvalue) 256)
543 bG (/ (nth 1 colorvalue) 256)
544 bB (/ (nth 2 colorvalue) 256)
545 lm YaTeX-sectioning-max-level
546 list YaTeX-sectioning-level)
547 (while list
548 (setq pat (concat YaTeX-ec-regexp (car (car list))
549 ;;"\\*?\\(\\[[^]]*\\]\\)?\\>" ;改行はさむと駄目
550 "\\>"
551 )
552 level (cdr (car list))
553 fg (format form
554 (- fR (/ (* level fR fmin) lm 100))
555 (- fG (/ (* level fG fmin) lm 100))
556 (- fB (/ (* level fB fmin) lm 100)))
557 bg (format form
558 (- bR (/ (* level bR bmin) lm 100))
559 (- bG (/ (* level bG bmin) lm 100))
560 (- bB (/ (* level bB bmin) lm 100)))
561 from (intern (format "YaTeX-sectioning-%d" level))
562 ;;face (intern (concat fg "/" bg))
563 )
564 (setq face (YaTeX-19-create-face from fg bg))
565 (setq sect-pat-alist
566 (cons;;(list pat "}" face)
567 (list 'YaTeX-19-region-section-type pat face)
568 sect-pat-alist))
569 (setq list (cdr list)))
570 (setq YaTeX-sectioning-patterns-alist sect-pat-alist)))))
571 (t ;not window-system
572 (setq YaTeX-sectioning-patterns-alist
573 (list
574 (list
575 (concat YaTeX-ec-regexp
576 "\\(\\(sub\\)*\\(section\\|paragraph\\)\\|chapter"
577 "\\|part\\){[^}]*}")
578 0
579 'define)))))))
581 ;; ローカルなマクロを読み込んだ後 redraw すると
582 ;; ローカルマクロを keyword として光らせる(keywordじゃまずいかな…)。
583 (defvar hilit-patterns-alist nil) ;for absence of hilit19
585 (defun YaTeX-19-collect-macros ()
586 (cond
587 (YaTeX-use-highlighting
588 (let ((get-face
589 (function
590 (lambda (table)
591 (cond
592 ((eq YaTeX-background-mode 'light) (car table))
593 ((eq YaTeX-background-mode 'dark) (cdr table))
594 ;; Default case equals to 'light mode...is it OK?
595 (t (car table))))))
596 sect single pattern-alist)
597 (YaTeX-19-create-face ;;hilit-translate
598 ;;sectioning (funcall get-face YaTeX-hilit-sectioning-face)
599 'macro (funcall get-face YaTeX-hilit-singlecmd-face))
600 (if (setq sect (append user-section-table tmp-section-table))
601 (setq sect (concat "\\\\\\("
602 (mapconcat
603 (function
604 (lambda (s) (regexp-quote (car s))))
605 sect
606 "\\|")
607 "\\)\\>")))
608 (if (setq single (append user-singlecmd-table tmp-singlecmd-table))
609 (setq single (concat "\\\\\\("
610 (mapconcat
611 (function (lambda (s) (regexp-quote (car s))))
612 single
613 "\\|")
614 "\\)\\b")))
615 (cons 'yatex-mode
616 (append
617 (list nil)
618 YaTeX-sectioning-patterns-alist
619 YaTeX-hilit-pattern-adjustment-private
620 ;;YaTeX-hilit-pattern-adjustment-default
621 YaTeX-hilit-patterns-alist
622 (delq nil
623 (list
624 (if sect (list
625 'YaTeX-19-region-section-type
626 sect
627 'keyword))
628 (if single (list single 0 'macro))))))))))
630 ;;2006/6/23 new face, `delimiter' introduced
631 (YaTeX-19-create-face 'delimiter "saddlebrown" "ivory")
633 ;;(YaTeX-19-collect-macros) ;causes an error
634 (defun YaTeX-hilit-setup-alist ()
635 (cond
636 ((boundp 'hilit-patterns-alist)
637 (setq hilit-patterns-alist
638 (delq (assq 'yatex-mode hilit-patterns-alist) hilit-patterns-alist))
639 (if YaTeX-use-hilit19
640 (setq hilit-patterns-alist
641 (cons (YaTeX-19-collect-macros) hilit-patterns-alist))))))
643 (defun YaTeX-hilit-recenter (arg)
644 "Collect current local macro and hilit-recenter."
645 (interactive "P")
646 (YaTeX-hilit-setup-alist)
647 (if (fboundp 'font-lock-mode) (font-lock-mode -1))
648 (hilit-recenter arg))
650 (let ((k (append (where-is-internal 'hilit-recenter)
651 (where-is-internal 'recenter))))
652 (while k
653 (define-key YaTeX-mode-map (car k) 'YaTeX-19-recenter)
654 (setq k (cdr k))))
656 (defun YaTeX-19-recenter (&optional arg)
657 (interactive "P")
658 (if YaTeX-use-hilit19
659 (YaTeX-hilit-recenter arg)
660 (YaTeX-font-lock-recenter arg)))
662 (defun YaTeX-font-lock-recenter (&optional arg)
663 (interactive "P")
664 (cond
665 ((and (boundp 'hilit-patterns-alist)
666 (assq 'yatex-mode hilit-patterns-alist))
667 (if (fboundp 'hilit-unhighlight-region)
668 (hilit-unhighlight-region (point-min) (point-max)))
669 (setq hilit-patterns-alist ;ensure to remove
670 (delq (assq 'yatex-mode hilit-patterns-alist)
671 hilit-patterns-alist))))
672 (setq YaTeX-font-lock-keywords
673 (YaTeX-convert-pattern-hilit2fontlock
674 (cdr (YaTeX-19-collect-macros)))
675 ;;; Keep this section for debugging.
676 ;; YaTeX-font-lock-keywords
677 ;; (append (YaTeX-convert-pattern-hilit2fontlock
678 ;; (cdr (YaTeX-19-collect-macros)))
679 ;; '(((lambda (lim)
680 ;; (YaTeX-19-re-search-in-env '("foo" . "tabular"))
681 ;; ;(search-forward "foo" nil t)
682 ;; )
683 ;; (0 YaTeX-font-lock-delimiter-face))))
684 ;;font-lock-keywords nil
685 font-lock-set-defaults nil)
686 ;;(save-excursion
687 ;; (font-lock-fontify-region (window-start) (window-end))
688 (font-lock-mode -1) ;is stupid, but sure.
689 (font-lock-mode 1)
690 (recenter arg))
692 (defun YaTeX-font-lock-fontify-region (beg end)
693 (interactive "r")
694 (save-excursion (font-lock-fontify-region beg end)))
696 (defun YaTeX-font-lock-fontify-environment ()
697 (interactive)
698 (save-excursion
699 (save-match-data ;is safe after emacs-19
700 (YaTeX-mark-environment)
701 (message "")
702 (YaTeX-font-lock-fontify-region (region-beginning) (region-end)))))
704 (defun YaTeX-font-lock-highlight-menu ()
705 (interactive)
706 (message "Force Highlight: R)egion E)nvironment")
707 (let ((c (read-char)))
708 (cond
709 ((memq c '(?R ?r))
710 (YaTeX-font-lock-fontify-region (region-beginning) (region-end)))
711 ((memq c '(?e ?e))
712 (YaTeX-font-lock-fontify-environment)))))
714 (if YaTeX-use-font-lock
715 (YaTeX-define-key "u" 'YaTeX-font-lock-highlight-menu))
717 (defvar YaTeX-font-lock-keywords nil
718 "Pattern-face alist of yahtml-mode for font-lock")
720 (defun YaTeX-font-lock-set-default-keywords ()
721 (put 'yatex-mode 'font-lock-defaults
722 (list 'YaTeX-font-lock-keywords nil nil))
723 (setq YaTeX-font-lock-keywords
724 (YaTeX-convert-pattern-hilit2fontlock
725 (cons nil
726 (append YaTeX-sectioning-patterns-alist
727 YaTeX-hilit-pattern-adjustment-private
728 YaTeX-hilit-patterns-alist)))))
730 (if YaTeX-use-font-lock
731 (progn
732 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)
733 ;;for those who use both hilit19 and font-lock
734 (if (eq (car hilit-mode-enable-list) 'not)
735 (or (member 'yatex-mode hilit-mode-enable-list)
736 (nconc hilit-mode-enable-list (list 'yatex-mode)))
737 (setq hilit-mode-enable-list
738 (delq 'yatex-mode hilit-mode-enable-list))))
739 (YaTeX-font-lock-set-default-keywords)))
741 (defun YaTeX-switch-to-new-window ()
742 (let ((c 0) (i 1) (free (make-string win:max-configs ? )))
743 (while (< i win:max-configs)
744 (or (aref win:configs i) (aset free i (+ i win:base-key)))
745 (setq i (1+ i)))
746 (while (not (string-match (char-to-string c) free))
747 (message "Which window to create? [%s]: " free)
748 (setq c (read-char)))
749 (message "Creating window [%c]" c)
750 (set-buffer (get-buffer-create "*scratch*"))
751 (win:switch-window (- c win:base-key))))
753 (defun YaTeX-visit-main-other-frame ()
754 "Visit main file in other frame.
755 WARNING, This code is not perfect."
756 (interactive)
757 (if (YaTeX-main-file-p) (message "I think this is main LaTeX source.")
758 (let (parent)
759 (save-excursion (YaTeX-visit-main t) (setq parent (current-buffer)))
760 (cond
761 ((get-buffer-window parent t)
762 (goto-buffer-window parent))
763 ((and (featurep 'windows) win:use-frame)
764 (YaTeX-switch-to-new-window)
765 (switch-to-buffer parent))
766 (t (switch-to-buffer-other-frame (buffer-name parent)))))))
768 (defun YaTeX-goto-corresponding-*-other-frame (arg)
769 "Go to corresponding object in other frame."
770 (interactive "P")
771 (let (b p)
772 (save-window-excursion
773 (save-excursion
774 (YaTeX-goto-corresponding-* arg)
775 (setq b (current-buffer) p (point))))
776 (cond
777 ((get-buffer-window b t)
778 (goto-buffer-window b)
779 (goto-char p))
780 ((and (featurep 'windows) win:use-frame)
781 (YaTeX-switch-to-new-window)
782 (switch-to-buffer b)
783 (goto-char p))
784 (t (switch-to-buffer-other-frame (buffer-name b))
785 (goto-char p)))))
787 ;;; reverseVideo にして hilit-background-mode を 'dark
788 ;;; にしている人は数式などが暗くなりすぎて見づらいかもしれない。
789 ;;; 次のコードを hilit19 をロードしている場所の直後に置くとちょっ
790 ;;; とはまし。
791 ;;; (if (eq hilit-background-mode 'dark)
792 ;;; (hilit-translate
793 ;;; string 'mediumspringgreen
794 ;;; formula 'khaki
795 ;;; label 'yellow-underlined))
796 (and YaTeX-emacs-19
797 (not (featurep 'xemacs))
798 (boundp 'byte-compile-current-file)
799 byte-compile-current-file
800 (progn
801 (if YaTeX-emacs-20 (require 'font-lock))
802 (if (and (boundp 'window-system) window-system)
803 (require 'hilit19)
804 (error "Byte compile this file on window system! Not `-nw'!"))))
806 (provide 'yatex19)
809 ; Local variables:
810 ; fill-prefix: ";;; "
811 ; paragraph-start: "^$\\| \\|;;;$"
812 ; paragraph-separate: "^$\\| \\|;;;$"
813 ; coding: sjis
814 ; End: