yatex

view yatex19.el @ 353:2a72779d9c50

Rewrite lambda notations to suppress annoying warnings from emacs24
author HIROSE Yuuji <yuuji@gentei.org>
date Sun, 21 Dec 2014 14:20:01 +0900
parents 8d3156073892
children d69fd7b1ac4d
line source
1 ;;; yatex19.el -- YaTeX facilities for Emacs 19 or later
2 ;;; (c)1994-2013 by HIROSE Yuuji.[yuuji@yatex.org]
3 ;;; Last modified Sun Dec 21 14:03:48 2014 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 (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 (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 (cond
488 ((and YaTeX-use-font-lock (fboundp 'defface))
489 (custom-declare-face
490 sym
491 (list
492 (list (list
493 '(class color)
494 ;(list 'background YaTeX-background-mode)
495 )
496 (delq nil
497 (append
498 (list ':foreground fgcolor)
499 (if bgcolor
500 (list ':background bgcolor))
501 ))
502 )
503 (list t (list ':bold t ':underline t))
504 )
505 (format "Font lock face for %s" sym)
506 ':group 'font-lock-faces)
507 (set sym sym)
508 sym)
509 ((and YaTeX-use-hilit19 (and (fboundp 'hilit-translate)))
510 (let ((face (intern (concat fgcolor "/" bgcolor))))
511 (if (facep sym)
512 (hilit-translate sym face)
513 (make-face sym)
514 (or (memq sym hilit-predefined-face-list)
515 (progn
516 (set-face-foreground sym fgcolor)
517 (set-face-background sym bgcolor)
518 (setq hilit-predefined-face-list
519 (cons sym hilit-predefined-face-list)))))
520 face))))
522 (cond
523 (YaTeX-use-highlighting
524 (cond
525 (window-system
526 (let*((sectface
527 (car (if (eq YaTeX-background-mode 'dark)
528 (cdr YaTeX-hilit-sectioning-face)
529 YaTeX-hilit-sectioning-face)))
530 (sectcol (symbol-name sectface))
531 (fl YaTeX-use-font-lock)
532 (form (if fl "#%02x%02x%02x" "hex-%02x%02x%02x"))
533 sect-pat-alist)
534 (if (string-match "/" sectcol)
535 (let ((fmin (nth 0 YaTeX-hilit-sectioning-attenuation-rate))
536 (bmin (nth 1 YaTeX-hilit-sectioning-attenuation-rate))
537 colorvalue fR fG fB bR bG bB pat fg bg level from face list lm)
538 (require 'yatexsec)
539 (setq fg (substring sectcol 0 (string-match "/" sectcol))
540 bg (substring sectcol (1+ (string-match "/" sectcol)))
541 colorvalue (x-color-values fg)
542 fR (/ (nth 0 colorvalue) 256)
543 fG (/ (nth 1 colorvalue) 256)
544 fB (/ (nth 2 colorvalue) 256)
545 colorvalue (x-color-values bg)
546 bR (/ (nth 0 colorvalue) 256)
547 bG (/ (nth 1 colorvalue) 256)
548 bB (/ (nth 2 colorvalue) 256)
549 lm YaTeX-sectioning-max-level
550 list YaTeX-sectioning-level)
551 (while list
552 (setq pat (concat YaTeX-ec-regexp (car (car list))
553 ;;"\\*?\\(\\[[^]]*\\]\\)?\\>" ;改行はさむと駄目
554 "\\>"
555 )
556 level (cdr (car list))
557 fg (format form
558 (- fR (/ (* level fR fmin) lm 100))
559 (- fG (/ (* level fG fmin) lm 100))
560 (- fB (/ (* level fB fmin) lm 100)))
561 bg (format form
562 (- bR (/ (* level bR bmin) lm 100))
563 (- bG (/ (* level bG bmin) lm 100))
564 (- bB (/ (* level bB bmin) lm 100)))
565 from (intern (format "YaTeX-sectioning-%d" level))
566 ;;face (intern (concat fg "/" bg))
567 )
568 (setq face (YaTeX-19-create-face from fg bg))
569 (setq sect-pat-alist
570 (cons;;(list pat "}" face)
571 (list 'YaTeX-19-region-section-type pat face)
572 sect-pat-alist))
573 (setq list (cdr list)))
574 (setq YaTeX-sectioning-patterns-alist sect-pat-alist)))))
575 (t ;not window-system
576 (setq YaTeX-sectioning-patterns-alist
577 (list
578 (list
579 (concat YaTeX-ec-regexp
580 "\\(\\(sub\\)*\\(section\\|paragraph\\)\\|chapter"
581 "\\|part\\){[^}]*}")
582 0
583 'define)))))))
585 ;; ローカルなマクロを読み込んだ後 redraw すると
586 ;; ローカルマクロを keyword として光らせる(keywordじゃまずいかな…)。
587 (defvar hilit-patterns-alist nil) ;for absence of hilit19
589 (defun YaTeX-19-collect-macros ()
590 (cond
591 (YaTeX-use-highlighting
592 (let ((get-face
593 (function
594 (lambda (table)
595 (cond
596 ((eq YaTeX-background-mode 'light) (car table))
597 ((eq YaTeX-background-mode 'dark) (cdr table))
598 ;; Default case equals to 'light mode...is it OK?
599 (t (car table))))))
600 sect single pattern-alist)
601 (YaTeX-19-create-face ;;hilit-translate
602 ;;sectioning (funcall get-face YaTeX-hilit-sectioning-face)
603 'macro (funcall get-face YaTeX-hilit-singlecmd-face))
604 (if (setq sect (append user-section-table tmp-section-table))
605 (setq sect (concat "\\\\\\("
606 (mapconcat
607 (function
608 (lambda (s) (regexp-quote (car s))))
609 sect
610 "\\|")
611 "\\)\\>")))
612 (if (setq single (append user-singlecmd-table tmp-singlecmd-table))
613 (setq single (concat "\\\\\\("
614 (mapconcat
615 (function (lambda (s) (regexp-quote (car s))))
616 single
617 "\\|")
618 "\\)\\b")))
619 (cons 'yatex-mode
620 (append
621 (list nil)
622 YaTeX-sectioning-patterns-alist
623 YaTeX-hilit-pattern-adjustment-private
624 ;;YaTeX-hilit-pattern-adjustment-default
625 YaTeX-hilit-patterns-alist
626 (delq nil
627 (list
628 (if sect (list
629 'YaTeX-19-region-section-type
630 sect
631 'keyword))
632 (if single (list single 0 'macro))))))))))
634 ;;2006/6/23 new face, `delimiter' introduced
635 (YaTeX-19-create-face 'delimiter "saddlebrown" "ivory")
637 ;;(YaTeX-19-collect-macros) ;causes an error
638 (defun YaTeX-hilit-setup-alist ()
639 (cond
640 ((boundp 'hilit-patterns-alist)
641 (setq hilit-patterns-alist
642 (delq (assq 'yatex-mode hilit-patterns-alist) hilit-patterns-alist))
643 (if YaTeX-use-hilit19
644 (setq hilit-patterns-alist
645 (cons (YaTeX-19-collect-macros) hilit-patterns-alist))))))
647 (defun YaTeX-hilit-recenter (arg)
648 "Collect current local macro and hilit-recenter."
649 (interactive "P")
650 (YaTeX-hilit-setup-alist)
651 (if (fboundp 'font-lock-mode) (font-lock-mode -1))
652 (hilit-recenter arg))
654 (let ((k (append (where-is-internal 'hilit-recenter)
655 (where-is-internal 'recenter))))
656 (while k
657 (define-key YaTeX-mode-map (car k) 'YaTeX-19-recenter)
658 (setq k (cdr k))))
660 (defun YaTeX-19-recenter (&optional arg)
661 (interactive "P")
662 (if YaTeX-use-hilit19
663 (YaTeX-hilit-recenter arg)
664 (YaTeX-font-lock-recenter arg)))
666 (defun YaTeX-font-lock-recenter (&optional arg)
667 (interactive "P")
668 (cond
669 ((and (boundp 'hilit-patterns-alist)
670 (assq 'yatex-mode hilit-patterns-alist))
671 (if (fboundp 'hilit-unhighlight-region)
672 (hilit-unhighlight-region (point-min) (point-max)))
673 (setq hilit-patterns-alist ;ensure to remove
674 (delq (assq 'yatex-mode hilit-patterns-alist)
675 hilit-patterns-alist))))
676 (setq YaTeX-font-lock-keywords
677 (YaTeX-convert-pattern-hilit2fontlock
678 (cdr (YaTeX-19-collect-macros)))
679 ;;; Keep this section for debugging.
680 ;; YaTeX-font-lock-keywords
681 ;; (append (YaTeX-convert-pattern-hilit2fontlock
682 ;; (cdr (YaTeX-19-collect-macros)))
683 ;; '(((lambda (lim)
684 ;; (YaTeX-19-re-search-in-env '("foo" . "tabular"))
685 ;; ;(search-forward "foo" nil t)
686 ;; )
687 ;; (0 YaTeX-font-lock-delimiter-face))))
688 ;;font-lock-keywords nil
689 font-lock-set-defaults nil)
690 ;;(save-excursion
691 ;; (font-lock-fontify-region (window-start) (window-end))
692 (font-lock-mode -1) ;is stupid, but sure.
693 (font-lock-mode 1)
694 (recenter arg))
696 (defun YaTeX-font-lock-fontify-region (beg end)
697 (interactive "r")
698 (save-excursion (font-lock-fontify-region beg end)))
700 (defun YaTeX-font-lock-fontify-environment ()
701 (interactive)
702 (save-excursion
703 (save-match-data ;is safe after emacs-19
704 (YaTeX-mark-environment)
705 (message "")
706 (YaTeX-font-lock-fontify-region (region-beginning) (region-end)))))
708 (defun YaTeX-font-lock-highlight-menu ()
709 (interactive)
710 (message "Force Highlight: R)egion E)nvironment")
711 (let ((c (read-char)))
712 (cond
713 ((memq c '(?R ?r))
714 (YaTeX-font-lock-fontify-region (region-beginning) (region-end)))
715 ((memq c '(?e ?e))
716 (YaTeX-font-lock-fontify-environment)))))
718 (if YaTeX-use-font-lock
719 (YaTeX-define-key "u" 'YaTeX-font-lock-highlight-menu))
721 (defvar YaTeX-font-lock-keywords nil
722 "Pattern-face alist of yahtml-mode for font-lock")
724 (defun YaTeX-font-lock-set-default-keywords ()
725 (put 'yatex-mode 'font-lock-defaults
726 (list 'YaTeX-font-lock-keywords nil nil))
727 (setq YaTeX-font-lock-keywords
728 (YaTeX-convert-pattern-hilit2fontlock
729 (cons nil
730 (append YaTeX-sectioning-patterns-alist
731 YaTeX-hilit-pattern-adjustment-private
732 YaTeX-hilit-patterns-alist)))))
734 (if YaTeX-use-font-lock
735 (progn
736 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)
737 ;;for those who use both hilit19 and font-lock
738 (if (eq (car hilit-mode-enable-list) 'not)
739 (or (member 'yatex-mode hilit-mode-enable-list)
740 (nconc hilit-mode-enable-list (list 'yatex-mode)))
741 (setq hilit-mode-enable-list
742 (delq 'yatex-mode hilit-mode-enable-list))))
743 (YaTeX-font-lock-set-default-keywords)))
745 (defun YaTeX-switch-to-new-window ()
746 (let ((c 0) (i 1) (free (make-string win:max-configs ? )))
747 (while (< i win:max-configs)
748 (or (aref win:configs i) (aset free i (+ i win:base-key)))
749 (setq i (1+ i)))
750 (while (not (string-match (char-to-string c) free))
751 (message "Which window to create? [%s]: " free)
752 (setq c (read-char)))
753 (message "Creating window [%c]" c)
754 (set-buffer (get-buffer-create "*scratch*"))
755 (win:switch-window (- c win:base-key))))
757 (defun YaTeX-visit-main-other-frame ()
758 "Visit main file in other frame.
759 WARNING, This code is not perfect."
760 (interactive)
761 (if (YaTeX-main-file-p) (message "I think this is main LaTeX source.")
762 (let (parent)
763 (save-excursion (YaTeX-visit-main t) (setq parent (current-buffer)))
764 (cond
765 ((get-buffer-window parent t)
766 (goto-buffer-window parent))
767 ((and (featurep 'windows) win:use-frame)
768 (YaTeX-switch-to-new-window)
769 (switch-to-buffer parent))
770 (t (switch-to-buffer-other-frame (buffer-name parent)))))))
772 (defun YaTeX-goto-corresponding-*-other-frame (arg)
773 "Go to corresponding object in other frame."
774 (interactive "P")
775 (let (b p)
776 (save-window-excursion
777 (save-excursion
778 (YaTeX-goto-corresponding-* arg)
779 (setq b (current-buffer) p (point))))
780 (cond
781 ((get-buffer-window b t)
782 (goto-buffer-window b)
783 (goto-char p))
784 ((and (featurep 'windows) win:use-frame)
785 (YaTeX-switch-to-new-window)
786 (switch-to-buffer b)
787 (goto-char p))
788 (t (switch-to-buffer-other-frame (buffer-name b))
789 (goto-char p)))))
791 ;;; reverseVideo にして hilit-background-mode を 'dark
792 ;;; にしている人は数式などが暗くなりすぎて見づらいかもしれない。
793 ;;; 次のコードを hilit19 をロードしている場所の直後に置くとちょっ
794 ;;; とはまし。
795 ;;; (if (eq hilit-background-mode 'dark)
796 ;;; (hilit-translate
797 ;;; string 'mediumspringgreen
798 ;;; formula 'khaki
799 ;;; label 'yellow-underlined))
800 (and YaTeX-emacs-19
801 (not (featurep 'xemacs))
802 (boundp 'byte-compile-current-file)
803 byte-compile-current-file
804 (progn
805 (if YaTeX-emacs-20 (require 'font-lock))
806 (if (and (boundp 'window-system) window-system)
807 (require 'hilit19)
808 (error "Byte compile this file on window system! Not `-nw'!"))))
810 (provide 'yatex19)
813 ; Local variables:
814 ; fill-prefix: ";;; "
815 ; paragraph-start: "^$\\| \\|;;;$"
816 ; paragraph-separate: "^$\\| \\|;;;$"
817 ; coding: sjis
818 ; End: